#!/usr/local/bin/chicken-csi -ss
(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 (floor (/ i 8))) 2)) "■" "□"))
      ((eq? 'BK x) "♔")
      ((eq? 'BQ x) "♕")
      ((eq? 'BR x) "♖")
      ((eq? 'BB x) "♗")
      ((eq? 'BN x) "♘")
      ((eq? 'BP x) "♙")
      ((eq? 'WK x) "♚")
      ((eq? 'WQ x) "♛")
      ((eq? 'WR x) "♜")
      ((eq? 'WB x) "♝")
      ((eq? 'WN x) "♞")
      ((eq? 'WP x) "♟")
      (else (error "bad piece!"))))))

(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 board)
      (let ((l (read-line p)))
        (if (not (eof-object? l))
          (if (eq? section 'tag)
            (begin (print l)
              (if (equal? l "")
                (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)
    (display "usage: cheeplay FILE.pgn\n")
    (replay (car args))))