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