about summary refs log tree commit diff stats
path: root/arc/chessboard.mu
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2015-05-05 21:17:24 -0700
committerKartik K. Agaram <vc@akkartik.com>2015-05-05 21:17:24 -0700
commitb96af395b9af2ff9df94b3e82213171f30827c8d (patch)
tree17c8c12648ccc25625e2534ec8d74fbe8f1542cc /arc/chessboard.mu
parent2e3b597fe85b654e82b891c22d50754fa5a26156 (diff)
downloadmu-b96af395b9af2ff9df94b3e82213171f30827c8d.tar.gz
1276 - make C++ version the default
I've tried to update the Readme, but there are at least a couple of issues.
Diffstat (limited to 'arc/chessboard.mu')
-rw-r--r--arc/chessboard.mu259
1 files changed, 259 insertions, 0 deletions
diff --git a/arc/chessboard.mu b/arc/chessboard.mu
new file mode 100644
index 00000000..45fc12da
--- /dev/null
+++ b/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