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:&:screen, console:&:console <- chessboard screen:&:screen, console:&: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-ingredients
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-board 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-ingredients
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-ingredients
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-board screen:&:screen, board:board -> screen:&:screen [
145 local-scope
146 load-ingredients
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?:bool
162 ¦ ¦ f:&:@:char <- index *board, col
163 ¦ ¦ c:char <- index *f, row
164 ¦ ¦ print screen, c
165 ¦ ¦ print screen, space
166 ¦ ¦ col <- add col, 1
167 ¦ ¦ loop
168 ¦ }
169 ¦ row <- subtract row, 1
170 ¦ cursor-to-next-line screen
171 ¦ loop
172 }
173
174 print screen, [ +----------------]
175 cursor-to-next-line screen
176 print screen, [ a b c d e f g h]
177 cursor-to-next-line screen
178 ]
179
180 def initial-position -> board:board [
181 local-scope
182
183
184
185
186
187
188
189
190
191 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
192
193
194
195
196
197
198
199
200 board <- new-board initial-position
201 ]
202
203 scenario printing-the-board [
204 local-scope
205 board:board <- initial-position
206 assume-screen 30/width, 12/height
207 run [
208 ¦ screen:&:screen <- print-board screen:&:screen, board
209 ]
210 screen-should-contain [
211
212 ¦ .8 | r n b q k b n r .
213 ¦ .7 | p p p p p p p p .
214 ¦ .6 | .
215 ¦ .5 | .
216 ¦ .4 | .
217 ¦ .3 | .
218 ¦ .2 | P P P P P P P P .
219 ¦ .1 | R N B Q K B N R .
220 ¦ . +---------------- .
221 ¦ . a b c d e f g h .
222 ¦ . .
223 ¦ . .
224 ]
225 ]
226
227
228
229 container move [
230
231 from-file:num
232 from-rank:num
233 to-file:num
234 to-rank:num
235 ]
236
237
238 def read-move stdin:&:source:char, screen:&:screen -> result:&:move, quit?:bool, error?:bool, stdin:&:source:char, screen:&:screen [
239 local-scope
240 load-ingredients
241 from-file:num, quit?:bool, error?:bool <- read-file stdin, screen
242 return-if quit?, 0/dummy
243 return-if error?, 0/dummy
244
245 result:&:move <- new move:type
246 *result <- put *result, from-file:offset, from-file
247 from-rank:num, quit?, error? <- read-rank stdin, screen
248 return-if quit?, 0/dummy
249 return-if error?, 0/dummy
250 *result <- put *result, from-rank:offset, from-rank
251 error? <- expect-from-channel stdin, 45/dash, screen
252 return-if error?, 0/dummy, 0/quit
253 to-file:num, quit?, error? <- read-file stdin, screen
254 return-if quit?:bool, 0/dummy
255 return-if error?:bool, 0/dummy
256 *result <- put *result, to-file:offset, to-file
257 to-rank:num, quit?, error? <- read-rank stdin, screen
258 return-if quit?, 0/dummy
259 return-if error?, 0/dummy
260 *result <- put *result, to-rank:offset, to-rank
261 error? <- expect-from-channel stdin, 10/newline, screen
262 return-if error?, 0/dummy, 0/quit
263 ]
264
265
266 def read-file stdin:&:source:char, screen:&:screen -> file:num, quit:bool, error:bool, stdin:&:source:char, screen:&:screen [
267 local-scope
268 load-ingredients
269 c:char, eof?:bool, stdin <- read stdin
270 return-if eof?, 0/dummy, 1/quit, 0/error
271 {
272 ¦ q-pressed?:bool <- equal c, 81/Q
273 ¦ break-unless q-pressed?
274 ¦ return 0/dummy, 1/quit, 0/error
275 }
276 {
277 ¦ q-pressed? <- equal c, 113/q
278 ¦ break-unless q-pressed?
279 ¦ return 0/dummy, 1/quit, 0/error
280 }
281 {
282 ¦ empty-fake-keyboard?:bool <- equal c, 0/eof
283 ¦ break-unless empty-fake-keyboard?
284 ¦ return 0/dummy, 1/quit, 0/error
285 }
286 {
287 ¦ newline?:bool <- equal c, 10/newline
288 ¦ break-unless newline?
289 ¦ print screen, [that's not enough]
290 ¦ return 0/dummy, 0/quit, 1/error
291 }
292 file:num <- subtract c, 97/a
293
294 {
295 ¦ above-min:bool <- greater-or-equal file, 0
296 ¦ break-if above-min
297 ¦ print screen, [file too low: ]
298 ¦ print screen, c
299 ¦ cursor-to-next-line screen
300 ¦ return 0/dummy, 0/quit, 1/error
301 }
302 {
303 ¦ below-max:bool <- lesser-than file, 8
304 ¦ break-if below-max
305 ¦ print screen, [file too high: ]
306 ¦ print screen, c
307 ¦ return 0/dummy, 0/quit, 1/error
308 }
309 return file, 0/quit, 0/error
310 ]
311
312
313 def read-rank stdin:&:source:char, screen:&:screen -> rank:num, quit?:bool, error?:bool, stdin:&:source:char, screen:&:screen [
314 local-scope
315 load-ingredients
316 c:char, eof?:bool, stdin <- read stdin
317 return-if eof?, 0/dummy, 1/quit, 0/error
318 {
319 ¦ q-pressed?:bool <- equal c, 8/Q
320 ¦ break-unless q-pressed?
321 ¦ return 0/dummy, 1/quit, 0/error
322 }
323 {
324 ¦ q-pressed? <- equal c, 113/q
325 ¦ break-unless q-pressed?
326 ¦ return 0/dummy, 1/quit, 0/error
327 }
328 {
329 ¦ newline?:bool <- equal c, 10
330 ¦ break-unless newline?
331 ¦ print screen, [that's not enough]
332 ¦ return 0/dummy, 0/quit, 1/error
333 }
334 rank:num <- subtract c, 49/'1'
335
336 {
337 ¦ above-min:bool <- greater-or-equal rank, 0
338 ¦ break-if above-min
339 ¦ print screen, [rank too low: ]
340 ¦ print screen, c
341 ¦ return 0/dummy, 0/quit, 1/error
342 }
343 {
344 ¦ below-max:bool <- lesser-or-equal rank, 7
345 ¦ break-if below-max
346 ¦ print screen, [rank too high: ]
347 ¦ print screen, c
348 ¦ return 0/dummy, 0/quit, 1/error
349 }
350 return rank, 0/quit, 0/error
351 ]
352
353
354
355 def expect-from-channel stdin:&:source:char, expected:char, screen:&:screen -> result:bool, stdin:&:source:char, screen:&:screen [
356 local-scope
357 load-ingredients
358 c:char, eof?:bool, stdin <- read stdin
359 return-if eof? 1/true
360 {
361 ¦ match?:bool <- equal c, expected
362 ¦ break-if match?
363 ¦ print screen, [expected character not found]
364 }
365 result <- not match?
366 ]
367
368 scenario read-move-blocking [
369 local-scope
370 assume-screen 20/width, 2/height
371 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
372 read-move-routine:num/routine <- start-running read-move, source, screen:&:screen
373 run [
374 ¦
375 ¦ wait-for-routine-to-block read-move-routine
376 ¦ read-move-state:num <- routine-state read-move-routine
377 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
378 ¦ assert waiting?, [
379 F read-move-blocking: routine failed to pause after coming up (before any keys were pressed)]
380 ¦
381 ¦ sink <- write sink, 97/a
382 ¦ restart read-move-routine
383 ¦
384 ¦ wait-for-routine-to-block read-move-routine
385 ¦ read-move-state <- routine-state read-move-routine
386 ¦ waiting? <- not-equal read-move-state, 2/discontinued
387 ¦ assert waiting?, [
388 F read-move-blocking: routine failed to pause after rank 'a']
389 ¦
390 ¦ sink <- write sink, 50/'2'
391 ¦ restart read-move-routine
392 ¦
393 ¦ wait-for-routine-to-block read-move-routine
394 ¦ read-move-state <- routine-state read-move-routine
395 ¦ waiting? <- not-equal read-move-state, 2/discontinued
396 ¦ assert waiting?, [
397 F read-move-blocking: routine failed to pause after file 'a2']
398 ¦
399 ¦ sink <- write sink, 45/'-'
400 ¦ restart read-move-routine
401 ¦
402 ¦ wait-for-routine-to-block read-move-routine
403 ¦ read-move-state <- routine-state read-move-routine
404 ¦ waiting? <- not-equal read-move-state, 2/discontinued
405 ¦ assert waiting?, [
406 F read-move-blocking: routine failed to pause after hyphen 'a2-']
407 ¦
408 ¦ sink <- write sink, 97/a
409 ¦ restart read-move-routine
410 ¦
411 ¦ wait-for-routine-to-block read-move-routine
412 ¦ read-move-state <- routine-state read-move-routine
413 ¦ waiting? <- not-equal read-move-state, 2/discontinued
414 ¦ assert waiting?, [
415 F read-move-blocking: routine failed to pause after rank 'a2-a']
416 ¦
417 ¦ sink <- write sink, 52/'4'
418 ¦ restart read-move-routine
419 ¦
420 ¦ wait-for-routine-to-block read-move-routine
421 ¦ read-move-state <- routine-state read-move-routine
422 ¦ waiting? <- not-equal read-move-state, 2/discontinued
423 ¦ assert waiting?, [
424 F read-move-blocking: routine failed to pause after file 'a2-a4']
425 ¦
426 ¦ sink <- write sink, 10
427 ¦ restart read-move-routine
428 ¦
429 ¦ wait-for-routine-to-block read-move-routine
430 ¦ read-move-state <- routine-state read-move-routine
431 ¦ completed?:bool <- equal read-move-state, 1/completed
432 ¦ assert completed?, [
433 F read-move-blocking: routine failed to terminate on newline]
434 ¦ trace 1, [test], [reached end]
435 ]
436 trace-should-contain [
437 ¦ test: reached end
438 ]
439 ]
440
441 scenario read-move-quit [
442 local-scope
443 assume-screen 20/width, 2/height
444 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
445 read-move-routine:num <- start-running read-move, source, screen:&:screen
446 run [
447 ¦
448 ¦ wait-for-routine-to-block read-move-routine
449 ¦ read-move-state:num <- routine-state read-move-routine
450 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
451 ¦ assert waiting?, [
452 F read-move-quit: routine failed to pause after coming up (before any keys were pressed)]
453 ¦
454 ¦ sink <- write sink, 113/q
455 ¦ restart read-move-routine
456 ¦
457 ¦ wait-for-routine-to-block read-move-routine
458 ¦ read-move-state <- routine-state read-move-routine
459 ¦ completed?:bool <- equal read-move-state, 1/completed
460 ¦ assert completed?, [
461 F read-move-quit: routine failed to terminate on 'q']
462 ¦ trace 1, [test], [reached end]
463 ]
464 trace-should-contain [
465 ¦ test: reached end
466 ]
467 ]
468
469 scenario read-move-illegal-file [
470 local-scope
471 assume-screen 20/width, 2/height
472 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
473 read-move-routine:num <- start-running read-move, source, screen:&:screen
474 run [
475 ¦
476 ¦ wait-for-routine-to-block read-move-routine
477 ¦ read-move-state:num <- routine-state read-move-routine
478 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
479 ¦ assert waiting?, [
480 F read-move-illegal-file: routine failed to pause after coming up (before any keys were pressed)]
481 ¦ sink <- write sink, 50/'2'
482 ¦ restart read-move-routine
483 ¦ wait-for-routine-to-block read-move-routine
484 ]
485 screen-should-contain [
486 ¦ .file too low: 2 .
487 ¦ . .
488 ]
489 ]
490
491 scenario read-move-illegal-rank [
492 local-scope
493 assume-screen 20/width, 2/height
494 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
495 read-move-routine:num <- start-running read-move, source, screen:&:screen
496 run [
497 ¦
498 ¦ wait-for-routine-to-block read-move-routine
499 ¦ read-move-state:num <- routine-state read-move-routine
500 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
501 ¦ assert waiting?, [
502 F read-move-illegal-rank: routine failed to pause after coming up (before any keys were pressed)]
503 ¦ sink <- write sink, 97/a
504 ¦ sink <- write sink, 97/a
505 ¦ restart read-move-routine
506 ¦ wait-for-routine-to-block read-move-routine
507 ]
508 screen-should-contain [
509 ¦ .rank too high: a .
510 ¦ . .
511 ]
512 ]
513
514 scenario read-move-empty [
515 local-scope
516 assume-screen 20/width, 2/height
517 source:&:source:char, sink:&:sink:char <- new-channel 2/capacity
518 read-move-routine:num <- start-running read-move, source, screen:&:screen
519 run [
520 ¦
521 ¦ wait-for-routine-to-block read-move-routine
522 ¦ read-move-state:num <- routine-state read-move-routine
523 ¦ waiting?:bool <- not-equal read-move-state, 2/discontinued
524 ¦ assert waiting?, [
525 F read-move-empty: routine failed to pause after coming up (before any keys were pressed)]
526 ¦ sink <- write sink, 10/newline
527 ¦ sink <- write sink, 97/a
528 ¦ restart read-move-routine
529 ¦ wait-for-routine-to-block read-move-routine
530 ]
531 screen-should-contain [
532 ¦ .that's not enough .
533 ¦ . .
534 ]
535 ]
536
537 def make-move board:board, m:&:move -> board:board [
538 local-scope
539 load-ingredients
540 from-file:num <- get *m, from-file:offset
541 from-rank:num <- get *m, from-rank:offset
542 to-file:num <- get *m, to-file:offset
543 to-rank:num <- get *m, to-rank:offset
544 from-f:&:@:char <- index *board, from-file
545 to-f:&:@:char <- index *board, to-file
546 src:char/square <- index *from-f, from-rank
547 *to-f <- put-index *to-f, to-rank, src
548 *from-f <- put-index *from-f, from-rank, 32/space
549 ]
550
551 scenario making-a-move [
552 local-scope
553 assume-screen 30/width, 12/height
554 board:board <- initial-position
555 move:&:move <- new move:type
556 *move <- merge 6/g, 1/'2', 6/g, 3/'4'
557 run [
558 ¦ board <- make-move board, move
559 ¦ screen:&:screen <- print-board screen:&:screen, board
560 ]
561 screen-should-contain [
562
563 ¦ .8 | r n b q k b n r .
564 ¦ .7 | p p p p p p p p .
565 ¦ .6 | .
566 ¦ .5 | .
567 ¦ .4 | P .
568 ¦ .3 | .
569 ¦ .2 | P P P P P P P .
570 ¦ .1 | R N B Q K B N R .
571 ¦ . +---------------- .
572 ¦ . a b c d e f g h .
573 ¦ . .
574 ]
575 ]