#lang racket

(require debug)
(define stdout (current-output-port))
(define ((appls f) l) (apply f l))
(define (char+ . args)
  (integer->char (apply + (map (λ(x)
                                 (cond
                                   [(char? x) (char->integer x)]
                                   [(integer? x) x])) args))))
(define (char- . args)
  (integer->char (apply - (map (λ(x)
                                 (cond
                                   [(char? x) (char->integer x)]
                                   [(integer? x) x])) args))))

(define (print-stars brd ls)
  (begin
    (printf "\n\u3000~a\n"
            (string-join (map (λ(i) (string (char+ #\uff21 i))) (range 8))
                         "\u3000" #:before-first "\u3000" #:after-last "\u3000"))
    (printf "\u3000┏~a┓\n" (string-join
                            (build-list 8 (λ(x) (if (member `(,x 0) ls) "┳" "━"))) "┳"))
    (for {[row brd]
          [y (in-naturals)]}
      (printf "~a" (char- #\uFF18 y))
      (for {[cell row]
            [x (in-naturals)]}
        (match (list (member? `(,x,y) ls) (member? `(,(- x 1),y) ls))
          ['(#t #t)
           (printf "╋~a" cell)]
          ['(#t #f)
           (printf "┣~a" cell)]
          ['(#f #t)
           (printf "┫~a" cell)]
          [else
           (printf "┃~a" cell)]))
      (if (member `(7,y) ls)
          (printf "┫~a\n\u3000" (char- #\uFF18 y))
          (printf "┃~a\n\u3000" (char- #\uFF18 y)))
      (if (< y 7)
          (printf "┣~a┫\n" (string-join (build-list
                                         8 (λ(x)
                                             (match (list(member? `(,x,y) ls)(member?`(,x,(+ y 1)) ls))
                                               ['(#t #t) "╋"]
                                               ['(#t #f) "┻"]
                                               ['(#f #t) "┳"]
                                               [else "━"]))) "╋"))
          (printf "┗~a┛\n" (string-join
                            (build-list 8 (λ(x) (if (member `(,x,y) ls) "┻" "━"))) "┻"))))
    (printf "\u3000~a\n\n"
            (string-join (map (λ(i) (string (char+ #\uff21 i))) (range 8)) "\u3000"
                         #:before-first "\u3000" #:after-last "\u3000"))))

(struct posn (x y))
(define mk-posn
  (case-lambda
    [(ls) (posn (car ls) (cadr ls))]
    [(x y) (posn x y)]))

(struct board (cells)
  #:methods gen:custom-write
  [(define write-proc
     (λ(brd port mode)
       (parameterize {[current-output-port port]}
         (print-stars (board-cells brd) '()))))])

(define (empty-piece pos)
  (match-define (posn x y) pos)
  (if (= 0 (modulo (- x y) 2)) #\space #\_))