1
2
3
4 def main [
5 local-scope
6 open-console
7 clear-screen 0/screen
8
9
10
11
12
13
14
15
16 chessboard 0/screen, 0/console
17
18 close-console
19 ]
20
21
22
23 scenario print-board-and-read-move [
24 local-scope
25 trace-until 100/app
26
27 assume-screen 120/width, 20/height
28
29 assume-console [
30 ¦ type [a2-a4
31 ]
32 ]
33 run [
34 ¦ screen, console <- chessboard screen, console
35 ¦
36 ¦ cursor-icon:char <- copy 9251/␣
37 ¦ screen <- print screen, cursor-icon
38 ]
39 screen-should-contain [
40
41
42 ¦ .Stupid text-mode chessboard. White pieces in uppercase; black pieces in lowercase. No checking for legal moves. .
43 ¦ . .
44 ¦ .8 | r n b q k b n r .
45 ¦ .7 | p p p p p p p p .
46 ¦ .6 | .
47 ¦ .5 | .
48 ¦ .4 | P .
49 ¦ .3 | .
50 ¦ .2 | P P P P P P P .
51 ¦ .1 | R N B Q K B N R .
52 ¦ . +---------------- .
53 ¦ . a b c d e f g h .
54 ¦ . .
55 ¦ .Type in your move as <from square>-<to square>. For example: 'a2-a4'. Then press <enter>. .
56 ¦ . .
57 ¦ .Hit 'q' to exit. .
58 ¦ . .
59 ¦ .move: ␣ .
60 ¦ . .
61 ¦ . .
62 ]
63 ]
64
65
66
67 type board = &:@:&:@:char
68
69 def chessboard screen:&:screen, console:&:console -> screen:&:screen, console:&:console [
70 local-scope
71 load-inputs
72 board:board <- initial-position
73
74 stdin-in:&:source:char, stdin-out:&:sink:char <- new-channel 10/capacity
75 start-running send-keys-to-channel, console, stdin-out, screen
76
77 buffered-stdin-in:&:source:char, buffered-stdin-out:&:sink:char <- new-channel 10/capacity
78 start-running buffer-lines, stdin-in, buffered-stdin-out
79 {
80 ¦ print screen, [Stupid text-mode chessboard. White pieces in uppercase; black pieces in lowercase. No checking for legal moves.
81 ]
82 ¦ cursor-to-next-line screen
83 ¦ print screen, board
84 ¦ cursor-to-next-line screen
85 ¦ print screen, [Type in your move as <from square>-<to square>. For example: 'a2-a4'. Then press <enter>.
86 ]
87 ¦ cursor-to-next-line screen
88 ¦ print screen [Hit 'q' to exit.
89 ]
90 ¦ {
91 ¦ ¦ cursor-to-next-line screen
92 ¦ ¦ screen <- print screen, [move: ]
93 ¦ ¦ m:&:move, quit:bool, error:bool <- read-move buffered-stdin-in, screen
94 ¦ ¦ break-if quit, +quit
95 ¦ ¦ buffered-stdin-in <- clear buffered-stdin-in
96 ¦ ¦ loop-if error
97 ¦ }
98 ¦ board <- make-move board, m
99 ¦ screen <- clear-screen screen
100 ¦ loop
101 }
102 +quit
103 ]
104
105
106
107 def new-board initial-position:&:@:char -> board:board [
108 local-scope
109 load-inputs
110
111 len:num <- length *initial-position
112 correct-length?:bool <- equal len, 64
113 assert correct-length?, [chessboard had incorrect size]
114
115 board <- new {(address array character): type}, 8
116 col:num <- copy 0
117 {
118 ¦ done?:bool <- equal col, 8
119 ¦ break-if done?
120 ¦ file:&:@:char <- new-file initial-position, col
121 ¦ *board <- put-index *board, col, file
122 ¦ col <- add col, 1
123 ¦ loop
124 }
125 ]
126
127 def new-file position:&:@:char, index:num -> result:&:@:char [
128 local-scope
129 load-inputs
130 index <- multiply index, 8
131 result <- new character:type, 8
132 row:num <- copy 0
133 {
134 ¦ done?:bool <- equal row, 8
135 ¦ break-if done?
136 ¦ square:char <- index *position, index
137 ¦ *result <- put-index *result, row, square
138 ¦ row <- add row, 1
139 ¦ index <- add index, 1
140 ¦ loop
141 }
142 ]
143
144 def print screen:&:screen, board:board -> screen:&:screen [
145 local-scope
146 load-inputs
147 row:num <- copy 7
148 space:char <- copy 32/space
149
150 {
151 ¦ done?:bool <- lesser-than row, 0
152 ¦ break-if done?
153 ¦
154 ¦ rank:num <- add row, 1
155 ¦ print screen, rank
156 ¦ print screen, [ | ]
157 ¦
158 ¦ col:num <- copy 0
159 ¦ {
160 ¦ ¦ done?:bool <- equal col:num, 8
161 ¦ ¦ break-if done?
162 ¦ ¦ f:&:@:char <- index *board, col
163 ¦ ¦ c:char <- index *f, row
164 ¦ ¦ bg:num <- square-color row, col
165 ¦ ¦ print screen, c, 7/white, bg
166 ¦ ¦ print screen, space
167 ¦ ¦ col <- add col, 1
168 ¦ ¦ loop
169 ¦ }
170 ¦ row <- subtract row, 1
171 ¦ cursor-to-next-line screen
172 ¦ loop
173 }
174
175 print screen, [ +----------------]
176 cursor-to-next-line screen
177 print screen, [ a b c d e f g h]
178 cursor-to-next-line screen
179 ]
180
181 def square-color row:num, col:num -> result:num [
182 local-scope
183 load-inputs
184 result <- copy 0/black
185 x:num <- add row, col
186 _, rem:num <- divide-with-remainder x, 2
187 return-if rem, 238
188 ]
189
190 def initial-position -> board:board [
191 local-scope
192
193
194
195
196
197
198
199
200
201 initial-position:&:@:char <- new-array 82/R, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 114/r, 78/N, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 110/n, 66/B, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 98/b, 81/Q, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 113/q, 75/K, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 107/k, 66/B, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 98/b, 78/N, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 110/n, 82/R, 80/P, 32/blank, 32/blank, 32/blank, 32/blank, 112/p, 114/r
202
203
204
205
206
207
208
209
210 board <- new-board initial-position
211 ]
212
213 scenario printing-the-board [
214 local-scope
215 board:board <- initial-position
216 assume-screen 30/width, 12/height
217 run [
218 ¦ screen <- print screen, board
219 ]
220 screen-should-contain [
221
222 ¦ .8 | r n b q k b n r .
223 ¦ .7 | p p p p p p p p .
224 ¦ .6 | .
225 ¦ .5 | .
226 ¦ .4 | .
227 ¦ .3 | .
228 ¦ .2 | P P P P P P P P .
229 ¦ .1 | R N B Q K B N R .
230 ¦ . +---------------- .
231 ¦ . a b c d e f g h .
232 ¦ . .
233 ¦ . .
234 ]
235 ]
236
237
238
239 container move [
240
241 from-file:num
242 from-rank:num
243 to-file:num
244 to-rank:num
245 ]
246
247
248 def read-move stdin:&:source:char, screen:&:screen -> result:&:move, quit?:bool, error?:bool, stdin:&:source:char, screen:&:screen [
249 local-scope
250 load-inputs
251 from-file:num, quit?:bool, error?:bool <- read-file stdin, screen
252 return-if quit?, 0/dummy
253 return-if error?, 0/dummy
254
255 result:&:move <- new move:type
256 *result <- put *result, from-file:offset, from-file
257 from-rank:num, quit?, error? <- read-rank stdin, screen
258 return-if quit?, 0/dummy
259 return-if error?, 0/dummy
260 *result <- put *result, from-rank:offset, from-rank
261 error? <- expect-from-channel stdin, 45/dash, screen
262 return-if error?, 0/dummy, 0/quit
263 to-file:num, quit?, error? <- read-file stdin, screen
264 return-if quit?, 0/dummy
265 return-if error?, 0/dummy
266 *result <- put *result, to-file:offset, to-file
267 to-rank:num, quit?, error? <- read-rank stdin, screen
268 return-if quit?, 0/dummy
269 return-if error?, 0/dummy
270 *result <- put *result, to-rank:offset, to-rank
271 error? <- expect-from-channel stdin, 10/newline, screen
272 return-if error?, 0/dummy, 0/quit
273 ]
274
275
276 def read-file stdin:&:source:char, screen:&:screen -> file:num, quit:bool, error:bool, stdin:&:source:char, screen:&:screen [
277 local-scope
278 load-inputs
279 c:char, eof?:bool, stdin <- read stdin
280 return-if eof?, 0/dummy, 1/quit, 0/error
281 q-pressed?:bool <- equal c, 81/Q
282 return-if q-pressed?, 0/dummy, 1/quit, 0/error
283 q-pressed? <- equal c, 113/q
284 return-if q-pressed?, 0/dummy, 1/quit, 0/error
285 empty-fake-keyboard?:bool <- equal c, 0/eof
286 return-if empty-fake-keyboard?, 0/dummy, 1/quit, 0/error
287 {
288 ¦ newline?:bool <- equal c, 10/newline
289 ¦ break-unless newline?
290 ¦ print screen, [that's not enough]
291 ¦ return 0/dummy, 0/quit, 1/error
292 }
293 file:num <- subtract c, 97/a
294
295 {
296 ¦ above-min:bool <- greater-or-equal file, 0
297 ¦ break-if above-min
298 ¦ print screen, [file too low: ]
299 ¦ print screen, c
300 ¦ cursor-to-next-line screen
301 ¦ return 0/dummy, 0/quit, 1/error
302 }
303 {
304 ¦ below-max:bool <- lesser-than file, 8
305 ¦ break-if below-max
306 ¦ print screen, [file too high: ]
307 ¦ print screen, c
308 ¦ return 0/dummy, 0/quit, 1/error
309 }
310 return file, 0/quit, 0/error
311 ]
312
313
314 def read-rank stdin:&:source:char, screen:&:screen -> rank:num, quit?:bool, error?:bool, stdin:&:source:char, screen:&:screen [
315 local-scope
316 load-inputs
317 c:char, eof?:bool, stdin <- read stdin
318 return-if eof?, 0/dummy, 1/quit, 0/error
319 q-pressed?:bool <- equal c, 81/Q
320 return-if q-pressed?, 0/dummy, 1/quit, 0/error
321 q-pressed? <- equal c, 113/q
322 return-if q-pressed?, 0/dummy, 1/quit, 0/error
323 empty-fake-keyboard?:bool <- equal c, 0/eof
324 return-if empty-fake-keyboard?, 0/dummy, 1/quit, 0/error
325 {
326 ¦ newline?:bool <- equal c, 10
327 ¦ break-unless newline?
328 ¦ print screen, [that's not enough]
329 ¦ return 0/dummy, 0/quit, 1/error
330 }
331 rank:num <- subtract c, 49/'1'
332
333 {
334 ¦ above-min:bool <- greater-or-equal rank, 0
335 ¦ break-if above-min
336 ¦ print screen, [rank too low: ]
337 ¦ print screen, c
338 ¦ return 0/dummy, 0/quit, 1/error
339 }
340 {
341 ¦ below-max:bool <- lesser-or-equal rank, 7
342 ¦ break-if below-max
343 ¦ print screen, [rank too high: ]
344 ¦ print screen, c
345 ¦ return 0/dummy, 0/quit, 1/error
346 }
347 return rank, 0/quit, 0/error
348 ]
349
350
351
352 def expect-from-channel stdin:&:source:char, expected:char, screen:&:screen -> result:bool, stdin:&:source:char, screen:&:screen [
353 local-scope
354 load-inputs
355 c:char, eof?:bool, stdin <- read stdin
356 return-if eof? 1/true
357 {
358 ¦ match?:bool <- equal c, expected
359 ¦ break-if match?
360 ¦ print screen, [expected character not found]
361 }
362 result <- not match?
363 ]
364
365 scenario read-move-blocking [
366 local-scope
367 assume-screen 20/width, 2/height
368 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
369 read-move-routine:num/routine <- start-running read-move, source, screen
370 run [
371 ¦
372 ¦ wait-for-routine-to-block read-move-routine
373 ¦ read-move-state:num <- routine-state read-move-routine
374 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
375 ¦ assert waiting?, [
376 F read-move-blocking: routine failed to pause after coming up (before any keys were pressed)]
377 ¦
378 ¦ sink <- write sink, 97/a
379 ¦ restart read-move-routine
380 ¦
381 ¦ wait-for-routine-to-block read-move-routine
382 ¦ read-move-state <- routine-state read-move-routine
383 ¦ waiting? <- not-equal read-move-state, 2/discontinued
384 ¦ assert waiting?, [
385 F read-move-blocking: routine failed to pause after rank 'a']
386 ¦
387 ¦ sink <- write sink, 50/'2'
388 ¦ restart read-move-routine
389 ¦
390 ¦ wait-for-routine-to-block read-move-routine
391 ¦ read-move-state <- routine-state read-move-routine
392 ¦ waiting? <- not-equal read-move-state, 2/discontinued
393 ¦ assert waiting?, [
394 F read-move-blocking: routine failed to pause after file 'a2']
395 ¦
396 ¦ sink <- write sink, 45/'-'
397 ¦ restart read-move-routine
398 ¦
399 ¦ wait-for-routine-to-block read-move-routine
400 ¦ read-move-state <- routine-state read-move-routine
401 ¦ waiting? <- not-equal read-move-state, 2/discontinued
402 ¦ assert waiting?, [
403 F read-move-blocking: routine failed to pause after hyphen 'a2-']
404 ¦
405 ¦ sink <- write sink, 97/a
406 ¦ restart read-move-routine
407 ¦
408 ¦ wait-for-routine-to-block read-move-routine
409 ¦ read-move-state <- routine-state read-move-routine
410 ¦ waiting? <- not-equal read-move-state, 2/discontinued
411 ¦ assert waiting?, [
412 F read-move-blocking: routine failed to pause after rank 'a2-a']
413 ¦
414 ¦ sink <- write sink, 52/'4'
415 ¦ restart read-move-routine
416 ¦
417 ¦ wait-for-routine-to-block read-move-routine
418 ¦ read-move-state <- routine-state read-move-routine
419 ¦ waiting? <- not-equal read-move-state, 2/discontinued
420 ¦ assert waiting?, [
421 F read-move-blocking: routine failed to pause after file 'a2-a4']
422 ¦
423 ¦ sink <- write sink, 10
424 ¦ restart read-move-routine
425 ¦
426 ¦ wait-for-routine-to-block read-move-routine
427 ¦ read-move-state <- routine-state read-move-routine
428 ¦ completed?:bool <- equal read-move-state, 1/completed
429 ¦ assert completed?, [
430 F read-move-blocking: routine failed to terminate on newline]
431 ¦ trace 1, [test], [reached end]
432 ]
433 trace-should-contain [
434 ¦ test: reached end
435 ]
436 ]
437
438 scenario read-move-quit [
439 local-scope
440 assume-screen 20/width, 2/height
441 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
442 read-move-routine:num <- start-running read-move, source, screen
443 run [
444 ¦
445 ¦ wait-for-routine-to-block read-move-routine
446 ¦ read-move-state:num <- routine-state read-move-routine
447 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
448 ¦ assert waiting?, [
449 F read-move-quit: routine failed to pause after coming up (before any keys were pressed)]
450 ¦
451 ¦ sink <- write sink, 113/q
452 ¦ restart read-move-routine
453 ¦
454 ¦ wait-for-routine-to-block read-move-routine
455 ¦ read-move-state <- routine-state read-move-routine
456 ¦ completed?:bool <- equal read-move-state, 1/completed
457 ¦ assert completed?, [
458 F read-move-quit: routine failed to terminate on 'q']
459 ¦ trace 1, [test], [reached end]
460 ]
461 trace-should-contain [
462 ¦ test: reached end
463 ]
464 ]
465
466 scenario read-move-illegal-file [
467 local-scope
468 assume-screen 20/width, 2/height
469 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
470 read-move-routine:num <- start-running read-move, source, screen
471 run [
472 ¦
473 ¦ wait-for-routine-to-block read-move-routine
474 ¦ read-move-state:num <- routine-state read-move-routine
475 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
476 ¦ assert waiting?, [
477 F read-move-illegal-file: routine failed to pause after coming up (before any keys were pressed)]
478 ¦ sink <- write sink, 50/'2'
479 ¦ restart read-move-routine
480 ¦ wait-for-routine-to-block read-move-routine
481 ]
482 screen-should-contain [
483 ¦ .file too low: 2 .
484 ¦ . .
485 ]
486 ]
487
488 scenario read-move-illegal-rank [
489 local-scope
490 assume-screen 20/width, 2/height
491 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
492 read-move-routine:num <- start-running read-move, source, screen
493 run [
494 ¦
495 ¦ wait-for-routine-to-block read-move-routine
496 ¦ read-move-state:num <- routine-state read-move-routine
497 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
498 ¦ assert waiting?, [
499 F read-move-illegal-rank: routine failed to pause after coming up (before any keys were pressed)]
500 ¦ sink <- write sink, 97/a
501 ¦ sink <- write sink, 97/a
502 ¦ restart read-move-routine
503 ¦ wait-for-routine-to-block read-move-routine
504 ]
505 screen-should-contain [
506 ¦ .rank too high: a .
507 ¦ . .
508 ]
509 ]
510
511 scenario read-move-empty [
512 local-scope
513 assume-screen 20/width, 2/height
514 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
515 read-move-routine:num <- start-running read-move, source, screen
516 run [
517 ¦
518 ¦ wait-for-routine-to-block read-move-routine
519 ¦ read-move-state:num <- routine-state read-move-routine
520 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
521 ¦ assert waiting?, [
522 F read-move-empty: routine failed to pause after coming up (before any keys were pressed)]
523 ¦ sink <- write sink, 10/newline
524 ¦ sink <- write sink, 97/a
525 ¦ restart read-move-routine
526 ¦ wait-for-routine-to-block read-move-routine
527 ]
528 screen-should-contain [
529 ¦ .that's not enough .
530 ¦ . .
531 ]
532 ]
533
534 def make-move board:board, m:&:move -> board:board [
535 local-scope
536 load-inputs
537 from-file:num <- get *m, from-file:offset
538 from-rank:num <- get *m, from-rank:offset
539 to-file:num <- get *m, to-file:offset
540 to-rank:num <- get *m, to-rank:offset
541 from-f:&:@:char <- index *board, from-file
542 to-f:&:@:char <- index *board, to-file
543 src:char/square <- index *from-f, from-rank
544 *to-f <- put-index *to-f, to-rank, src
545 *from-f <- put-index *from-f, from-rank, 32/space
546 ]
547
548 scenario making-a-move [
549 local-scope
550 assume-screen 30/width, 12/height
551 board:board <- initial-position
552 move:&:move <- new move:type
553 *move <- merge 6/g, 1/'2', 6/g, 3/'4'
554 run [
555 ¦ board <- make-move board, move
556 ¦ screen <- print screen, board
557 ]
558 screen-should-contain [
559
560 ¦ .8 | r n b q k b n r .
561 ¦ .7 | p p p p p p p p .
562 ¦ .6 | .
563 ¦ .5 | .
564 ¦ .4 | P .
565 ¦ .3 | .
566 ¦ .2 | P P P P P P P .
567 ¦ .1 | R N B Q K B N R .
568 ¦ . +---------------- .
569 ¦ . a b c d e f g h .
570 ¦ . .
571 ]
572 ]