From a03b8aea543689d1fdb8c7b70ffdec9678833db6 Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Wed, 31 Dec 2014 21:24:48 -0800 Subject: 477 - reading moves in the chessboard app --- chessboard-rawterm.mu | 84 +++++++++++++++++++++++++++++++++++++++++++++++++-- mu.arc | 28 +++++++++++++++-- 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 + address + (let (name types) rest + (= type*.name (obj size 1 + address t + elem types))) + + ; array + array + (let (name types) rest + (= type*.name (obj array t + elem types))) + ; before