600 - fake keyboard

Use asynchronous channels like 'stdin' for most tests.
Use the synchronous fakes for testing low-level stdin helpers.

2 files changed, 61 insertions, 9 deletions

diff --git a/mu.arc b/mu.arc
index 14ed973d..21c4fb53 100644
--- a/mu.arc
+++ b/mu.arc
@@ -199,8 +199,12 @@
               line-address-address (obj size 1  address t  elem '(line-address))
               screen (obj array t  elem '(line-address))
               screen-address (obj size 1  address t  elem '(screen))
+              ; fake screen
               terminal (obj size 5  and-record t  elems '((integer) (integer) (integer) (integer) (string-address))  fields '(num-rows num-cols cursor-row cursor-col data))
               terminal-address (obj size 1  address t  elem '(terminal))
+              ; fake keyboard
+              keyboard (obj size 2  and-record t  elems '((integer) (string-address))  fields '(index data))
+              keyboard-address (obj size 1  address t  elem '(keyboard))
               )))
 
 ;; managing concurrent routines
@@ -662,16 +666,11 @@
 ;?                        (write (m arg.0))  (pr " => ")  (prn (type (m arg.0)))
                        ((if ($.current-charterm) $.charterm-display pr) (m arg.0))
                        )
-                read-key
+                read-key-from-host
                   (if ($.current-charterm)
                         (and ($.charterm-byte-ready?) ($.charterm-read-key))
                       ($.graphics-open?)
                         ($.ready-key-press Viewport))
-                wait-for-key
-                  (if ($.current-charterm)
-                        ($.charterm-read-key)
-                      ($.graphics-open?)
-                        ($.get-key-press Viewport))
 
                 ; graphics
                 window-on
@@ -1932,6 +1931,31 @@
   (reply result:string-address-array-address)
 )
 
+(init-fn init-keyboard
+  (default-space:space-address <- new space:literal 30:literal)
+  (result:keyboard-address <- new keyboard:literal)
+  (buf:string-address-address <- get-address result:keyboard-address/deref data:offset)
+  (buf:string-address-address/deref <- next-input)
+  (idx:integer-address <- get-address result:keyboard-address/deref index:offset)
+  (idx:integer-address/deref <- copy 0:literal)
+  (reply result:keyboard-address)
+)
+
+(init-fn read-key
+  (default-space:space-address <- new space:literal 30:literal)
+  (x:keyboard-address <- next-input)
+  { begin
+    (break-unless x:keyboard-address)
+    (idx:integer-address <- get-address x:keyboard-address/deref index:offset)
+    (buf:string-address <- get x:keyboard-address/deref data:offset)
+    (c:character <- index buf:string-address/deref idx:integer-address/deref)
+    (idx:integer-address/deref <- add idx:integer-address/deref 1:literal)
+    (reply c:character)
+  }
+  (c:character <- read-key-from-host)
+  (reply c:character)
+)
+
 (init-fn send-keys-to-stdin
   (default-space:space-address <- new space:literal 30:literal)
   (stdin:channel-address <- next-input)
diff --git a/mu.arc.t b/mu.arc.t
index a617ec3a..0e8d31a8 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -4087,10 +4087,9 @@
 
 ; fake screen for tests; prints go to a string
 (reset)
-(new-trace "fake-screen-initial")
-(add-code:readfile "chessboard-cursor.mu")
+(new-trace "fake-screen-empty")
 (add-code
-  '((function! main [
+  '((function main [
       (default-space:space-address <- new space:literal 30:literal/capacity)
       (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
       (5:string-address/raw <- get screen:terminal-address/deref data:offset)
@@ -4112,6 +4111,35 @@
              "                    "))
   (prn "F - fake screen starts out with all spaces"))
 
+; fake keyboard for tests; must initialize keys in advance
+(reset)
+(new-trace "fake-keyboard")
+(add-code
+  '((function main [
+      (default-space:space-address <- new space:literal 30:literal)
+      (s:string-address <- new "foo")
+      (x:keyboard-address <- init-keyboard s:string-address)
+      (1:character-address/raw <- read-key x:keyboard-address)
+     ])))
+(run 'main)
+(when (~is memory*.1 #\f)
+  (prn "F - 'read-key' reads character from provided 'fake keyboard' string"))
+
+; fake keyboard for tests; must initialize keys in advance
+(reset)
+(new-trace "fake-keyboard2")
+(add-code
+  '((function main [
+      (default-space:space-address <- new space:literal 30:literal)
+      (s:string-address <- new "foo")
+      (x:keyboard-address <- init-keyboard s:string-address)
+      (1:character-address/raw <- read-key x:keyboard-address)
+      (1:character-address/raw <- read-key x:keyboard-address)
+     ])))
+(run 'main)
+(when (~is memory*.1 #\o)
+  (prn "F - 'read-key' advances cursor in provided string"))
+
 )  ; section 100
 
 (reset)