about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2015-01-13 19:38:53 -0800
committerKartik K. Agaram <vc@akkartik.com>2015-01-13 19:38:53 -0800
commit7ea584b892d1a82fc179a4314304da9a09ecee9e (patch)
tree490365195d83e1ab6d3132340e88087aabe066f2
parentb38d7fff33abf80bf90bc91e470c87ed175ab3c3 (diff)
downloadmu-7ea584b892d1a82fc179a4314304da9a09ecee9e.tar.gz
549 - suppress prints in read-move
This is the sort of thing we want to make super easy.

But there's a bug at the moment: chessboard prints junk input at second move.
-rw-r--r--chessboard-cursor.arc.t1
-rw-r--r--chessboard-cursor.mu26
-rw-r--r--mu.arc12
3 files changed, 33 insertions, 6 deletions
diff --git a/chessboard-cursor.arc.t b/chessboard-cursor.arc.t
index 1b83ac1e..af46c401 100644
--- a/chessboard-cursor.arc.t
+++ b/chessboard-cursor.arc.t
@@ -25,6 +25,7 @@
       (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
       (sleep until-routine-done:literal r:integer/routine)
      ])))
+;? (set dump-trace*)
 (run 'main)
 (if (~ran-to-completion 'main)
   (prn "F - chessboard accepts legal move a2-a4"))
diff --git a/chessboard-cursor.mu b/chessboard-cursor.mu
index 89443f4c..568b8224 100644
--- a/chessboard-cursor.mu
+++ b/chessboard-cursor.mu
@@ -96,6 +96,19 @@
 
 (address move-address (move))
 
+(function print [
+  (default-space:space-address <- new space:literal 30:literal)
+  { begin
+    ; stdout not initialized? skip all prints.
+    (break-if 2:channel-address/raw)
+    (reply)
+  }
+  ; base case prints characters
+  (c:character <- next-input)
+  (x:tagged-value <- save-type c:character)
+  (2:channel-address/raw/deref <- write 2:channel-address/raw x:tagged-value)
+])
+
 (function read-move [
   (default-space:space-address <- new space:literal 30:literal)
   (a:character <- copy ((#\a literal)))
@@ -105,7 +118,7 @@
   ; get from-file
   (x:tagged-value 1:channel-address/raw/deref <- read 1:channel-address/raw)
   (c:character <- maybe-coerce x:tagged-value character:literal)
-  (print-primitive c:character)
+  (print c:character)
   { begin
     (quit:boolean <- equal c:character ((#\q literal)))
     (break-unless quit:boolean)
@@ -121,7 +134,7 @@
   ; get from-rank
   (x:tagged-value 1:channel-address/raw/deref <- read 1:channel-address/raw)
   (c:character <- maybe-coerce x:tagged-value character:literal)
-  (print-primitive c:character)
+  (print c:character)
   (from-rank:integer <- character-to-integer c:character)
   (from-rank:integer <- subtract from-rank:integer rank-base:integer)
   ; assert('1' <= from-rank <= '8')
@@ -132,13 +145,13 @@
   ; slurp hyphen
   (x:tagged-value 1:channel-address/raw/deref <- read 1:channel-address/raw)
   (c:character <- maybe-coerce x:tagged-value character:literal)
-  (print-primitive c:character)
+  (print c:character)
   (hyphen?:boolean <- equal c:character ((#\- literal)))
   (assert hyphen?:boolean (("expected hyphen" literal)))
   ; get to-file
   (x:tagged-value 1:channel-address/raw/deref <- read 1:channel-address/raw)
   (c:character <- maybe-coerce x:tagged-value character:literal)
-  (print-primitive c:character)
+  (print c:character)
   (to-file:integer <- character-to-integer c:character)
   (to-file:integer <- subtract to-file:integer file-base:integer)
   ; assert('a' <= to-file <= 'h')
@@ -149,7 +162,7 @@
   ; get to-rank
   (x:tagged-value 1:channel-address/raw/deref <- read 1:channel-address/raw)
   (c:character <- maybe-coerce x:tagged-value character:literal)
-  (print-primitive c:character)
+  (print c:character)
   (to-rank:integer <- character-to-integer c:character)
   (to-rank:integer <- subtract to-rank:integer rank-base:integer)
   ; assert('1' <= to-rank <= '8')
@@ -198,6 +211,9 @@
   ; hook up stdin
   (1:channel-address/raw <- init-channel 1:literal)
   (fork-helper send-keys-to-stdin:fn nil:literal/globals nil:literal/limit 1:channel-address/raw)
+  ; hook up stdout
+  (2:channel-address/raw <- init-channel 1:literal)
+  (fork-helper send-prints-to-stdout:fn nil:literal/globals nil:literal/limit 2:channel-address/raw)
   { begin
     (clear-screen)
     (print-primitive (("Stupid text-mode chessboard. White pieces in uppercase; black pieces in lowercase. No checking for legal moves." literal)))
diff --git a/mu.arc b/mu.arc
index 1c4dccc9..6b89a213 100644
--- a/mu.arc
+++ b/mu.arc
@@ -1897,6 +1897,17 @@
   }
 )
 
+(init-fn send-prints-to-stdout
+  (default-space:space-address <- new space:literal 30:literal)
+  (stdout:channel-address <- next-input)
+  { begin
+    (x:tagged-value stdout:channel-address/deref <- read stdout:channel-address)
+    (c:character <- maybe-coerce x:tagged-value character:literal)
+    (print-primitive c:character)
+    (loop)
+  }
+)
+
 ; after all system software is loaded:
 (freeze system-function*)
 )  ; section 100 for system software
@@ -1904,7 +1915,6 @@
 ;; load all provided files and start at 'main'
 (reset)
 ;? (new-trace "main")
-;? (set dump-trace*)
 (awhen (pos "--" argv)
   (map add-code:readfile (cut argv (+ it 1)))
 ;?   (= dump-trace* (obj whitelist '("run")))