Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
GaucheのWindowsコンソール処理のパッチ(2014-6-22)
--- console20140622.stub 2014-06-20 15:56:48 +0900
+++ console.stub 2014-06-22 18:33:51 +0900
@@ -268,7 +268,9 @@
:type <boolean>)
(key.repeat-count :c-name "rec.Event.KeyEvent.wRepeatCount"
:type <int>)
- (key.virtual-key-code :c-name "rec.Event.KeyEvent.wVirtualScanCode"
+ (key.virtual-key-code :c-name "rec.Event.KeyEvent.wVirtualKeyCode"
+ :type <int>)
+ (key.virtual-scan-code :c-name "rec.Event.KeyEvent.wVirtualScanCode"
:type <int>)
(key.unicode-char :c-name "rec.Event.KeyEvent.uChar.UnicodeChar"
:type <uint>)
@@ -311,7 +313,7 @@
(define-cise-stmt peek/read-console-input
[(_ proc)
`(let* ([rec (make-input-record)] [cnt::DWORD 0])
- (check (,proc (Scm_WinHandle h '#t)
+ (check (,proc (Scm_WinHandle h '#f)
(& (-> (SCM_WIN_INPUT_RECORD rec) rec))
1 (& cnt)))
(if (== cnt 0) (result SCM_NIL) (result (list rec))))])
@@ -409,6 +411,34 @@
c (& nwritten)))
(result nwritten)))
+(define-cproc sys-fill-console-output-character (h s::<string> len::<ulong>
+ x::<short> y::<short>)
+ ::<int>
+ (let* ([b::(const ScmStringBody*) (SCM_STRING_BODY s)]
+ [c::COORD] [nwritten::DWORD 0] [ch::TCHAR] [wcs::TCHAR*])
+ (= (ref c X) x (ref c Y) y)
+ (= wcs (SCM_MBS2WCS (SCM_STRING_BODY_START b)))
+ (= ch (aref wcs 0))
+ (check (FillConsoleOutputCharacter (Scm_WinHandle h '#f)
+ ch
+ len
+ c (& nwritten)))
+ (result nwritten)))
+
+(define-cproc sys-fill-console-output-attribute (h attr::<ushort> len::<ulong>
+ x::<short> y::<short>)
+ ::<int>
+ (let* ([c::COORD] [nwritten::DWORD 0])
+ (= (ref c X) x (ref c Y) y)
+ (check (FillConsoleOutputAttribute (Scm_WinHandle h '#f)
+ attr
+ len
+ c (& nwritten)))
+ (result nwritten)))
+
+(define-cproc sys-flush-console-input-buffer (h) ::<void>
+ (check (FlushConsoleInputBuffer (Scm_WinHandle h '#f))))
+
;;
;; Console Title
;;
--- windows_orig.scm 2014-06-10 22:38:48 +0900
+++ windows.scm 2014-06-22 00:53:29 +0900
@@ -88,6 +88,9 @@
sys-set-console-window-info
sys-write-console
sys-write-console-output-character
+ sys-fill-console-output-character
+ sys-fill-console-output-attribute
+ sys-flush-console-input-buffer
sys-get-console-title
STD_INPUT_HANDLE STD_OUTPUT_HANDLE STD_ERROR_HANDLE
sys-get-std-handle sys-set-std-handle
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.