diff options
Diffstat (limited to 'archive/1.vm.arc/chessboard.mu')
| -rw-r--r-- | archive/1.vm.arc/chessboard.mu | 259 |
1 files changed, 0 insertions, 259 deletions
diff --git a/archive/1.vm.arc/chessboard.mu b/archive/1.vm.arc/chessboard.mu deleted file mode 100644 index 45fc12da..00000000 --- a/archive/1.vm.arc/chessboard.mu +++ /dev/null @@ -1,259 +0,0 @@ -;; 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 |