commit 676eb183016517e0ebf4e11ab530c13172b68604 (patch)
parent 8d78b3ae7e2fd121a192a48f821abe9dee8eeff7
Author: Alex Karle <alex@alexkarle.com>
Date: Sat, 14 May 2022 19:01:31 -0400
Update core data structure, start regex parser
My laptop is about to die and this flight's outlets seem
to not like my X220, so this is all for now :(
I updated the nested lists to be a single list because
I think it'll be easier to update. I also considered a vector
and a associative list--I think both would work, but lets
see how this goes first!
TODO:
* Create an "update" function that updates the board
* Create a "findpiece" function that disambiguates a move
* Hook up both to "move" -- findpiece, update to empty, then
update the destination to the piece
Diffstat:
M | cheeplay.scm | | | 94 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------- |
1 file changed, 64 insertions(+), 30 deletions(-)
diff --git a/cheeplay.scm b/cheeplay.scm
@@ -1,28 +1,25 @@
#!/usr/local/bin/chicken-csi -ss
-(import (chicken io) (chicken format))
-
-(define B
- '((BR BN BB BQ BK BB BN BR)
- (BP BP BP BP BP BP BP BP)
- (x x x x x x x x)
- (x x x x x x x x)
- (x x x x x x x x)
- (x x x x x x x x)
- (WP WP WP WP WP WP WP WP)
- (WR WN WB WQ WK WB WN WR)))
-
-(define (fori lst proc)
- ;; cdr's down 'lst', calling proc w each element and the index
- (let loop ((i 0) (items lst))
- (if (null? items)
- 'ok
- (begin (proc (car items) i) (loop (+ i 1) (cdr items))))))
-
-(define (prpiece x i j)
+(import (chicken io)
+ (chicken format)
+ (chicken irregex)
+ (chicken string))
+
+; TODO: use a vector!
+(define (newboard)
+ '(BR BN BB BQ BK BB BN BR
+ BP BP BP BP BP BP BP BP
+ x x x x x x x x
+ x x x x x x x x
+ x x x x x x x x
+ x x x x x x x x
+ WP WP WP WP WP WP WP WP
+ WR WN WB WQ WK WB WN WR))
+
+(define (prpiece x i)
; Print the unicode version of the piece
(display (format "~A "
(cond
- ((eq? 'x x) (if (= 0 (modulo (+ i j) 2)) "■" "□"))
+ ((eq? 'x x) (if (= 0 (modulo (+ i (floor (/ i 8))) 2)) "■" "□"))
((eq? 'BK x) "♔")
((eq? 'BQ x) "♕")
((eq? 'BR x) "♖")
@@ -37,23 +34,60 @@
((eq? 'WP x) "♟")
(else (error "bad piece!"))))))
-(define (prboard)
- (fori B (lambda (row i)
- (fori row (lambda (x j) (prpiece x i j)))
- (newline))))
+(define (prboard board)
+ (let loop ((b board) (i 0))
+ (if (not (null? b))
+ (begin
+ (if (and (> i 0) (= (modulo i 8) 0)) (newline))
+ (prpiece (car b) i)
+ (loop (cdr b) (+ i 1)))))
+ (newline))
+
+(define (findpiece name m)
+ ; given a name 'BQ' and a next move, return coord pair of piece
+ (newline)
+ )
+
+
+(define (move board m)
+ ; deciphers move m and returns a new board w updates
+ (cond
+ ; turn counts have no effect on the board
+ ((irregex-match "^[0-9]+\\.$" m) board)
+ ; Regular move
+ ((irregex-match "^[QKNBR]?[a-h]?[1-8]?x?[a-h][1-8][+#]?$" m) board)
+ ; Castle
+ ((irregex-match "^O-O$" m) board)
+ ; TODO: queen's side castle
+ ; ((irregex-match "^O-O-O$" m) board)
+ ; TODO: Promotion of a pawn
+ ; ((irregex-match "^[a-h][1-8]=[QNBR][+#]?$" m) board)
+ ; End game
+ ; TODO: return state of game for display
+ ((irregex-match "^0-1$" m) board)
+ ((irregex-match "^1-0$" m) board)
+ ((irregex-match "^1/2-1/2$" m) board)
+ (else (error (format "bad move! ~A\n" m)))))
+
(define (replay file)
(call-with-input-file file (lambda (p)
- (define (parse section)
+ (define (parse section board)
(let ((l (read-line p)))
(if (not (eof-object? l))
(if (eq? section 'tag)
(begin (print l)
(if (equal? l "")
- (parse 'movetext)
- (parse 'tag)))
- (prboard)))))
- (parse 'tag))))
+ (parse 'movetext board)
+ (parse 'tag board)))
+ (let loop ((tokens (string-split l " ")))
+ (if (not (null? tokens))
+ (begin
+ (print (car tokens))
+ (move board (car tokens))
+ (loop (cdr tokens)))
+ (parse 'movetext board)))))))
+ (parse 'tag (newboard)))))
(define (main args)
(if (null? args)