GaucheのWindowsコンソール処理のパッチ(2014-6-22)

console.stub.diff

--- 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.scm.diff

--- 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