archive/0.vm.arc/chessboard.arc.t

   1 (selective-load "mu.arc" section-level)
   2 (set allow-raw-addresses*)
   3 (add-code:readfile "chessboard.mu")
   4 (freeze function*)
   5 (load-system-functions)
   6
   7 (reset2)
   8 (new-trace "read-move-legal")
   9 (run-code main
  10   (default-space:space-address <- new space:literal 30:literal/capacity)
  11   (stdin:channel-address <- init-channel 1:literal)
  12   (r:integer/routine <- fork read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address)
  13   (c:character <- copy ((#\a literal)))
  14   (x:tagged-value <- save-type c:character)
  15   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
  16   (c:character <- copy ((#\2 literal)))
  17   (x:tagged-value <- save-type c:character)
  18   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
  19   (c:character <- copy ((#\- literal)))
  20   (x:tagged-value <- save-type c:character)
  21   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
  22   (c:character <- copy ((#\a literal)))
  23   (x:tagged-value <- save-type c:character)
  24   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
  25   (c:character <- copy ((#\4 literal)))
  26   (x:tagged-value <- save-type c:character)
  27   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
  28   (c:character <- copy ((#\newline literal)))
  29   (x:tagged-value <- save-type c:character)
  30   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
  31   (sleep until-routine-done:literal r:integer/routine)
  32 )
  33 (each routine completed-routines*
  34 ;?   (prn "  " routine)
  35   (awhen rep.routine!error
  36     (prn "error - " it)))
  37 (when (~ran-to-completion 'read-move)
  38   (prn "F - chessboard accepts legal moves (<rank><file>-<rank><file>)"))
  39 ; todo: we can't test that keys pressed are printed to screen
  40 ; but that's at a lower level
  41 ;? (quit)
  42
  43 (reset2)
  44 (new-trace "read-move-incomplete")
  45 ; initialize some variables at specific raw locations
  46 ;? (prn "== init")
  47 (run-code test-init
  48   (1:channel-address/raw <- init-channel 1:literal)
  49   (2:terminal-address/raw <- init-fake-terminal 20:literal 10:literal)
  50   (3:string-address/raw <- get 2:terminal-address/raw/deref data:offset))
  51 (wipe completed-routines*)
  52 ; the component under test; we'll be running this repeatedly
  53 (let read-move-routine (make-routine 'read-move memory*.1 memory*.2)
  54 ;?   (prn "== first key")
  55   (run-code send-first-key
  56     (default-space:space-address <- new space:literal 30:literal/capacity)
  57     (c:character <- copy ((#\a literal)))
  58     (x:tagged-value <- save-type c:character)
  59     (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value))
  60   (wipe completed-routines*)
  61   ; check that read-move consumes it and then goes to sleep
  62   (enq read-move-routine running-routines*)
  63   (run-more)
  64   (when (ran-to-completion 'read-move)
  65     (prn "F - chessboard waits after first letter of move"))
  66   (wipe completed-routines*)
  67   ; send in a few more letters
  68 ;?   (prn "== more keys")
  69   (restart read-move-routine)
  70   (run-code send-more-keys
  71     (default-space:space-address <- new space:literal 30:literal/capacity)
  72     (c:character <- copy ((#\2 literal)))
  73     (x:tagged-value <- save-type c:character)
  74     (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
  75     (c:character <- copy ((#\- literal)))
  76     (x:tagged-value <- save-type c:character)
  77     (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
  78     (c:character <- copy ((#\a literal)))
  79     (x:tagged-value <- save-type c:character)
  80     (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
  81     (c:character <- copy ((#\4 literal)))
  82     (x:tagged-value <- save-type c:character)
  83     (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value))
  84   ; check that read-move consumes them and then goes to sleep
  85   (when (ran-to-completion 'read-move)
  86     (prn "F - chessboard waits after each subsequent letter of move until the last"))
  87   (wipe completed-routines*)
  88   ; send final key
  89 ;?   (prn "== final key")
  90   (restart read-move-routine)
  91 ;?   (set dump-trace*)
  92   (run-code send-final-key
  93     (default-space:space-address <- new space:literal 30:literal/capacity)
  94     (c:character <- copy ((#\newline literal)))
  95     (x:tagged-value <- save-type c:character)
  96     (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value))
  97   ; check that read-move consumes it and -- this time -- returns
  98   (when (~ran-to-completion 'read-move)
  99     (prn "F - 'read-move' completes after final letter of move"))
 100 )
 101
 102 (reset2)
 103 (new-trace "read-move-quit")
 104 (run-code main
 105   (default-space:space-address <- new space:literal 30:literal/capacity)
 106   (stdin:channel-address <- init-channel 1:literal)
 107   (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
 108   (r:integer/routine <- fork-helper read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
 109   (c:character <- copy ((#\q literal)))
 110   (x:tagged-value <- save-type c:character)
 111   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
 112   (sleep until-routine-done:literal r:integer/routine)
 113 )
 114 (when (~ran-to-completion 'read-move)
 115   (prn "F - chessboard quits on move starting with 'q'"))
 116
 117 (reset2)
 118 (new-trace "read-illegal-file")
 119 (run-code main
 120   (default-space:space-address <- new space:literal 30:literal/capacity)
 121   (stdin:channel-address <- init-channel 1:literal)
 122   (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
 123   (r:integer/routine <- fork-helper read-file:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
 124   (c:character <- copy ((#\i literal)))
 125   (x:tagged-value <- save-type c:character)
 126   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
 127   (sleep until-routine-done:literal r:integer/routine)
 128 )
 129 ;? (each routine completed-routines*
 130 ;?   (prn "  " routine))
 131 (when (or (ran-to-completion 'read-file)
 132           (let routine routine-running!read-file
 133             (~posmatch "file too high" rep.routine!error)))
 134   (prn "F - 'read-file' checks that file lies between 'a' and 'h'"))
 135
 136 (reset2)
 137 (new-trace "read-illegal-rank")
 138 (run-code main
 139   (default-space:space-address <- new space:literal 30:literal/capacity)
 140   (stdin:channel-address <- init-channel 1:literal)
 141   (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
 142   (r:integer/routine <- fork-helper read-rank:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
 143   (c:character <- copy ((#\9 literal)))
 144   (x:tagged-value <- save-type c:character)
 145   (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
 146   (sleep until-routine-done:literal r:integer/routine)
 147 )
 148 (when (or (ran-to-completion 'read-rank)
 149           (let routine routine-running!read-rank
 150             (~posmatch "rank too high" rep.routine!error)))
 151   (prn "F - 'read-rank' checks that rank lies between '1' and '8'"))
 152
 153 (reset2)
 154 (new-trace "print-board")
 155 (run-code main
 156   (default-space:space-address <- new space:literal 30:literal/capacity)
 157 ;?   ($print (("init-array\n" literal))) ;? 1
 158   (initial-position:integer-array-address <- init-array ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))
 159                                               ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
 160                                               ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
 161                                               ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal))
 162                                               ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal))
 163                                               ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
 164                                               ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
 165                                               ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)))
 166 ;?   ($print (("init-board\n" literal))) ;? 1
 167   (b:board-address <- init-board initial-position:integer-array-address)
 168   (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
 169   (print-board screen:terminal-address b:board-address)
 170   (1:string-address/raw <- get screen:terminal-address/deref data:offset)
 171 )
 172 (each routine completed-routines*
 173   (awhen rep.routine!error
 174     (prn "error - " it)))
 175 ;? (prn memory*.1)
 176 (when (~screen-contains memory*.1 20
 177           (+ "8 | r n b q k b n r "
 178              "7 | p p p p p p p p "
 179              "6 | _ _ _ _ _ _ _ _ "
 180              "5 | _ _ _ _ _ _ _ _ "
 181              "4 | _ _ _ _ _ _ _ _ "
 182              "3 | _ _ _ _ _ _ _ _ "
 183              "2 | P P P P P P P P "
 184              "1 | R N B Q K B N R "
 185              "  +---------------- "
 186              "    a b c d e f g h "))
 187   (prn "F - print-board works; chessboard begins at @memory*.1"))
 188
 189 ; todo: how to fold this more elegantly with the previous test?
 190 (reset2)
 191 (new-trace "make-move")
 192 (run-code main
 193   (default-space:space-address <- new space:literal 30:literal/capacity)
 194   ; fake screen
 195   (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
 196   ; initial position
 197   (initial-position:integer-array-address <- init-array ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))
 198                                               ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
 199                                               ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
 200                                               ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal))
 201                                               ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal))
 202                                               ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
 203                                               ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
 204                                               ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)))
 205   (b:board-address <- init-board initial-position:integer-array-address)
 206   ; move: a2-a4
 207   (m:move-address <- new move:literal)
 208   (f:integer-integer-pair-address <- get-address m:move-address/deref from:offset)
 209   (dest:integer-address <- get-address f:integer-integer-pair-address/deref 0:offset)
 210   (dest:integer-address/deref <- copy 0:literal)  ; from-file: a
 211   (dest:integer-address <- get-address f:integer-integer-pair-address/deref 1:offset)
 212   (dest:integer-address/deref <- copy 1:literal)  ; from-rank: 2
 213   (t0:integer-integer-pair-address <- get-address m:move-address/deref to:offset)
 214   (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 0:offset)
 215   (dest:integer-address/deref <- copy 0:literal)  ; to-file: a
 216   (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 1:offset)
 217   (dest:integer-address/deref <- copy 3:literal)  ; to-rank: 4
 218   (b:board-address <- make-move b:board-address m:move-address)
 219   (print-board screen:terminal-address b:board-address)
 220   (1:string-address/raw <- get screen:terminal-address/deref data:offset)
 221 )
 222 (each routine completed-routines*
 223   (awhen rep.routine!error
 224     (prn "error - " it)))
 225 ;? (prn memory*.1)
 226 (when (~screen-contains memory*.1 20
 227           (+ "8 | r n b q k b n r "
 228              "7 | p p p p p p p p "
 229              "6 | _ _ _ _ _ _ _ _ "
 230              "5 | _ _ _ _ _ _ _ _ "
 231              "4 | P _ _ _ _ _ _ _ "
 232              "3 | _ _ _ _ _ _ _ _ "
 233              "2 | _ P P P P P P P "
 234              "1 | R N B Q K B N R "
 235              "  +---------------- "
 236              "    a b c d e f g h "))
 237   (prn "F - make-move works; chessboard begins at @memory*.1"))
 238
 239 (reset2)