diff options
Diffstat (limited to 'archive/1.vm.arc/chessboard.mu')
| -rw-r--r-- | archive/1.vm.arc/chessboard.mu | 259 |
1 files changed, 259 insertions, 0 deletions
diff --git a/archive/1.vm.arc/chessboard.mu b/archive/1.vm.arc/chessboard.mu new file mode 100644 index 00000000..45fc12da --- /dev/null +++ b/archive/1.vm.arc/chessboard.mu @@ -0,0 +1,259 @@ +;; data structure: board +(primitive square) +(address square-address (square)) ; pointer. verbose but sadly necessary for now +(array file (square)) ; ranks and files are arrays of squares +(address file-address (file)) +(address file-address-address (file-address)) ; pointer to a pointer +(array board (file-address)) +(address board-address (board)) + +(function init-board [ + (default-space:space-address <- new space:literal 30:literal) + (initial-position:integer-array-address <- next-input) + ; assert(length(initial-position) == 64) +;? ($print initial-position:integer-array-address/deref) ;? 1 + (len:integer <- length initial-position:integer-array-address/deref) +;? ($print len:integer) ;? 1 +;? ($print (("\n" literal))) ;? 1 + (correct-length?:boolean <- equal len:integer 64:literal) + (assert correct-length?:boolean (("chessboard had incorrect size" literal))) + (b:board-address <- new board:literal 8:literal) + (col:integer <- copy 0:literal) + { begin + (done?:boolean <- equal col:integer 8:literal) + (break-if done?:boolean) + (file:file-address-address <- index-address b:board-address/deref col:integer) + (file:file-address-address/deref <- init-file initial-position:integer-array-address col:integer) + (col:integer <- add col:integer 1:literal) + (loop) + } + (reply b:board-address) +]) + +(function init-file [ + (default-space:space-address <- new space:literal 30:literal) + (position:integer-array-address <- next-input) + (index:integer <- next-input) + (index:integer <- multiply index:integer 8:literal) + (result:file-address <- new file:literal 8:literal) + (row:integer <- copy 0:literal) + { begin + (done?:boolean <- equal row:integer 8:literal) + (break-if done?:boolean) + (dest:square-address <- index-address result:file-address/deref row:integer) + (dest:square-address/deref <- index position:integer-array-address/deref index:integer) + (row:integer <- add row:integer 1:literal) + (index:integer <- add index:integer 1:literal) + (loop) + } + (reply result:file-address) +]) + +(function print-board [ + (default-space:space-address <- new space:literal 30:literal) + (screen:terminal-address <- next-input) + (b:board-address <- next-input) + (row:integer <- copy 7:literal) + ; print each row + { begin + (done?:boolean <- less-than row:integer 0:literal) + (break-if done?:boolean) + ; print rank number as a legend + (rank:integer <- add row:integer 1:literal) + (print-integer screen:terminal-address rank:integer) + (s:string-address <- new " | ") + (print-string screen:terminal-address s:string-address) + ; print each square in the row + (col:integer <- copy 0:literal) + { begin + (done?:boolean <- equal col:integer 8:literal) + (break-if done?:boolean) + (f:file-address <- index b:board-address/deref col:integer) + (s:square <- index f:file-address/deref row:integer) + (print-character screen:terminal-address s:square) + (print-character screen:terminal-address ((#\space literal))) + (col:integer <- add col:integer 1:literal) + (loop) + } + (row:integer <- subtract row:integer 1:literal) + (cursor-to-next-line screen:terminal-address) + (loop) + } + ; print file letters as legend + (s:string-address <- new " +----------------") + (print-string screen:terminal-address s:string-address) + (cursor-to-next-line screen:terminal-address) + (s:string-address <- new " a b c d e f g h") + (print-string screen:terminal-address s:string-address) + (cursor-to-next-line screen:terminal-address) +]) + +;; data structure: move +(and-record move [ + from:integer-integer-pair + to:integer-integer-pair +]) + +(address move-address (move)) + +(function read-move [ + (default-space:space-address <- new space:literal 30:literal) + (stdin:channel-address <- next-input) + (from-file:integer <- read-file stdin:channel-address) + { begin + (break-if from-file:integer) + (reply nil:literal) + } + (from-rank:integer <- read-rank stdin:channel-address) + (expect-stdin stdin:channel-address ((#\- literal))) + (to-file:integer <- read-file stdin:channel-address) + (to-rank:integer <- read-rank stdin:channel-address) + (expect-stdin stdin:channel-address ((#\newline 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) +]) + +; todo: assumes stdin is always at raw address 1 +(function read-file [ + (default-space:space-address <- new space:literal 30:literal) + (stdin:channel-address <- next-input) + (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address) +;? ($print x:tagged-value) ;? 1 +;? ($print (("\n" literal))) ;? 1 + (a:character <- copy ((#\a literal))) + (file-base:integer <- character-to-integer a:character) + (c:character <- maybe-coerce x:tagged-value character:literal) +;? ($print (("AAA " literal))) ;? 1 +;? ($print c:character) ;? 1 +;? ($print (("\n" literal))) ;? 1 + { begin + (quit:boolean <- equal c:character ((#\q literal))) + (break-unless quit:boolean) + (reply nil:literal) + } + (file:integer <- character-to-integer c:character) + (file:integer <- subtract file:integer file-base:integer) + ; assert('a' <= from-file <= 'h') + (above-min:boolean <- greater-or-equal file:integer 0:literal) + (assert above-min:boolean (("file too low" literal))) + (below-max:boolean <- lesser-or-equal file:integer 7:literal) + (assert below-max:boolean (("file too high" literal))) + (reply file:integer) +]) + +(function read-rank [ + (default-space:space-address <- new space:literal 30:literal) + (stdin:channel-address <- next-input) + (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address) + (c:character <- maybe-coerce x:tagged-value character:literal) +;? ($print (("BBB " literal))) ;? 1 +;? ($print c:character) ;? 1 +;? ($print (("\n" literal))) ;? 1 + { begin + (quit:boolean <- equal c:character ((#\q literal))) + (break-unless quit:boolean) + (reply nil:literal) + } + (rank:integer <- character-to-integer c:character) + (one:character <- copy ((#\1 literal))) + (rank-base:integer <- character-to-integer one:character) + (rank:integer <- subtract rank:integer rank-base:integer) + ; assert('1' <= rank <= '8') + (above-min:boolean <- greater-or-equal rank:integer 0:literal) + (assert above-min:boolean (("rank too low" literal))) + (below-max:boolean <- lesser-or-equal rank:integer 7:literal) + (assert below-max:boolean (("rank too high" literal))) + (reply rank:integer) +]) + +; slurp a character and check that it matches +(function expect-stdin [ + (default-space:space-address <- new space:literal 30:literal) + (stdin:channel-address <- next-input) + (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address) + (c:character <- maybe-coerce x:tagged-value character:literal) + (expected:character <- next-input) + (match?:boolean <- equal c:character expected:character) + (assert match?:boolean (("expected character not found" literal))) +]) + +(function make-move [ + (default-space:space-address <- new space:literal 30:literal) + (b:board-address <- next-input) + (m:move-address <- next-input) + (x:integer-integer-pair <- get m:move-address/deref from:offset) + (from-file:integer <- get x:integer-integer-pair 0:offset) + (from-rank:integer <- get x:integer-integer-pair 1:offset) + (f:file-address <- index b:board-address/deref from-file:integer) + (src:square-address <- index-address f:file-address/deref from-rank:integer) + (x:integer-integer-pair <- get m:move-address/deref to:offset) + (to-file:integer <- get x:integer-integer-pair 0:offset) + (to-rank:integer <- get x:integer-integer-pair 1:offset) + (f:file-address <- index b:board-address/deref to-file:integer) + (dest:square-address <- index-address f:file-address/deref to-rank:integer) + (dest:square-address/deref <- copy src:square-address/deref) + (src:square-address/deref <- copy ((#\_ literal))) + (reply b:board-address) +]) + +(function chessboard [ + (default-space:space-address <- new space:literal 30:literal) + (initial-position:integer-array-address <- init-array ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)) + ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal)) + ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal)) + ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal)) + ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal)) + ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal)) + ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal)) + ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))) + (b:board-address <- init-board initial-position:integer-array-address) + (cursor-mode) + ; hook up stdin + (stdin:channel-address <- init-channel 1:literal) + (fork-helper send-keys-to-stdin:fn nil:literal/globals nil:literal/limit nil:literal/keyboard stdin:channel-address) + ; buffer stdin + (buffered-stdin:channel-address <- init-channel 1:literal) + (fork-helper buffer-lines:fn nil:literal/globals nil:literal/limit stdin:channel-address buffered-stdin:channel-address) + ($print (("Stupid text-mode chessboard. White pieces in uppercase; black pieces in lowercase. No checking for legal moves." literal))) + (cursor-to-next-line nil:literal/terminal) + { begin + (cursor-to-next-line nil:literal/terminal) + (print-board nil:literal/terminal b:board-address) + (cursor-to-next-line nil:literal/terminal) + ($print (("Type in your move as <from square>-<to square>. For example: 'a2-a4'. Then press <enter>." literal))) + (cursor-to-next-line nil:literal/terminal) + ($print (("Hit 'q' to exit." literal))) + (cursor-to-next-line nil:literal/terminal) + ($print (("move: " literal))) + (m:move-address <- read-move buffered-stdin:channel-address) +;? (retro-mode) ;? 1 +;? ($print stdin:channel-address) ;? 1 +;? ($print (("\n" literal))) ;? 1 +;? ($print buffered-stdin:channel-address) ;? 1 +;? ($print (("\n" literal))) ;? 1 +;? ($dump-memory) ;? 1 +;? (cursor-mode) ;? 1 + (break-unless m:move-address) + (b:board-address <- make-move b:board-address m:move-address) + (loop) + } + (retro-mode) +]) + +(function main [ + (chessboard) +]) + +; todo: +; backspace, ctrl-u |