477 - reading moves in the chessboard app

2 files changed, 108 insertions, 4 deletions

diff --git a/chessboard-rawterm.mu b/chessboard-rawterm.mu
index d7faac5b..0dbf6245 100644
--- a/chessboard-rawterm.mu
+++ b/chessboard-rawterm.mu
@@ -78,11 +78,91 @@
   }
 ])
 
+(and-record move [
+  from:integer-integer-pair
+  to:integer-integer-pair
+])
+
+(address move-address (move))
+
+(function read-move [
+  (a:character <- copy ((#\a literal)))
+  (file-base:integer <- character-to-integer a:character)
+  (file-base:integer <- subtract file-base:integer 1:literal)
+  (one:character <- copy ((#\1 literal)))
+  (rank-base:integer <- character-to-integer one:character)
+  (rank-base:integer <- subtract rank-base:integer 1:literal)
+  ; get from-file
+  (c:character <- wait-for-key)
+  (print-primitive c:character)
+  (from-file:integer <- character-to-integer c:character)
+  (from-file:integer <- subtract from-file:integer file-base:integer)
+  ; assert('a' <= from-file <= 'h')
+  (above-min:boolean <- greater-or-equal from-file:integer 1:literal)
+  (assert above-min:boolean (("from-file too low" literal)))
+  (below-max:boolean <- lesser-or-equal from-file:integer 8:literal)
+  (assert below-max:boolean (("from-file too high" literal)))
+  ; get from-rank
+  (c:character <- wait-for-key)
+  (print-primitive 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)
+  (above-min:boolean <- greater-or-equal from-rank:integer 1:literal)
+  (assert above-min:boolean (("from-rank too low" literal)))
+  (below-max:boolean <- lesser-or-equal from-rank:integer 8:literal)
+  (assert below-max:boolean (("from-rank too high" literal)))
+  ; slurp hyphen
+  (c:character <- wait-for-key)
+  (print-primitive c:character)
+  (hyphen?:boolean <- equal c:character ((#\- literal)))
+  (assert hyphen?:boolean (("expected hyphen" literal)))
+  ; get to-file
+  (c:character <- wait-for-key)
+  (print-primitive 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')
+  (above-min:boolean <- greater-or-equal to-file:integer 1:literal)
+  (assert above-min:boolean (("to-file too low" literal)))
+  (below-max:boolean <- lesser-or-equal to-file:integer 8:literal)
+  (assert below-max:boolean (("to-file too high" literal)))
+  ; get to-rank
+  (c:character <- wait-for-key)
+  (print-primitive 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)
+  (above-min:boolean <- greater-or-equal to-rank:integer 1:literal)
+  (assert above-min:boolean (("to-rank too low" literal)))
+  (below-max:boolean <- lesser-or-equal to-rank:integer 8:literal)
+  (assert below-max:boolean (("to-rank too high" literal)))
+  ; construct the move object
+  (result:move-address <- new move:literal)
+  (f:integer-integer-pair-address <- get-address result:move-address/deref from:offset)
+  (dest:integer-address <- get-address f:integer-integer-pair-address/deref 0:offset)
+  (dest:integer-address/deref <- copy from-file:integer)
+  (dest:integer-address <- get-address f:integer-integer-pair-address/deref 1:offset)
+  (dest:integer-address/deref <- copy from-rank:integer)
+  (t0:integer-integer-pair-address <- get-address result:move-address/deref to:offset)
+  (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 0:offset)
+  (dest:integer-address/deref <- copy to-file:integer)
+  (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 1:offset)
+  (dest:integer-address/deref <- copy to-rank:integer)
+  (reply result:move-address)
+])
+
 (function main [
 ;?   (print-primitive (("\u2654 \u265a" literal)))
+  (default-scope:scope-address <- new scope:literal 30:literal)
   (b:board-address <- read-board)
   (console-on)
-  (clear-screen)
-  (print-board b:board-address)
+  { begin
+    (clear-screen)
+    (print-board b:board-address)
+    (print-primitive (("? " literal)))
+    (m:move-address <- read-move)
+    (loop)
+  }
   (console-off)
 ])
diff --git a/mu.arc b/mu.arc
index 007e0080..1993f81e 100644
--- a/mu.arc
+++ b/mu.arc
@@ -122,6 +122,7 @@
               integer-boolean-pair-array (obj array t  elem '(integer-boolean-pair))
               integer-boolean-pair-array-address (obj size 1  address t  elem '(integer-boolean-pair-array))
               integer-integer-pair (obj size 2  and-record t  elems '((integer) (integer)))
+              integer-integer-pair-address (obj size 1  address t  elem '(integer-integer-pair))
               integer-point-pair (obj size 2  and-record t  elems '((integer) (integer-integer-pair)))
               integer-point-pair-address (obj size 1  address t  elem '(integer-point-pair))
               integer-point-pair-address-address (obj size 1  address t  elem '(integer-point-pair-address))
@@ -507,6 +508,10 @@
                 save-type
                   (annotate 'record `(,((ty arg.0) 0) ,(m arg.0)))
 
+                ; code points for characters
+                character-to-integer
+                  ($.char->integer (m arg.0))
+
                 ; multiprocessing
                 run
                   (run (v arg.0))
@@ -542,6 +547,8 @@
                   (do1 nil ((if ($.current-charterm) $.charterm-display pr) (m arg.0)))
                 read-key
                   (and ($.charterm-byte-ready?) ($.charterm-read-key))
+                wait-for-key
+                  ($.charterm-read-key)
                 bold-mode
                   (do1 nil ($.charterm-bold))
                 non-bold-mode
@@ -976,12 +983,14 @@
           (continue))
         (trace "cn0" instr " " canon.location " " canon.isa-field)
         (let (oargs op args)  (parse-instr instr)
-;?           (tr "about to rename args")
+;?           (tr "about to rename args: @op")
           (if (in op 'get 'get-address)
             ; special case: map field offset by looking up type table
             (with (basetype  (typeof args.0)
                    field  (v args.1))
+;?               (tr 111 " " args.0 " " basetype)
               (assert type*.basetype!and-record "get on non-record @args.0")
+;?               (tr 112)
               (trace "cn0" "field-access @field in @args.0 of type @basetype")
               (when (isa field 'sym)
                 (assert (or (~location field) isa-field.field) "field @args.1 is also a variable")
@@ -1147,6 +1156,19 @@
                                elems (map cdar fields)
                                fields (map caar fields)))))
 
+      ; address <type> <elem-type>
+      address
+        (let (name types)  rest
+          (= type*.name (obj size 1
+                             address t
+                             elem types)))
+
+      ; array <type> <elem-type>
+      array
+        (let (name types)  rest
+          (= type*.name (obj array t
+                             elem types)))
+
       ; before <label> [ <instructions> ]
       ;
       ; multiple before directives => code in order
@@ -1708,6 +1730,7 @@
 
 ;; load all provided files and start at 'main'
 (reset)
+;? (set dump-trace*)
 (awhen (pos "--" argv)
   (map add-code:readfile (cut argv (+ it 1)))
 ;?   (= dump-trace* (obj whitelist '("run" "schedule" "add")))
@@ -1717,6 +1740,7 @@
 ;?   (prn function*!factorial)
   (run 'main)
   (if ($.current-charterm) ($.close-charterm))
-  (prn "\nmemory: " memory*)
+  (prn "\nmemory: " int-canon.memory*)
 ;?   (prn completed-routines*)
 )
+(reset)