guile-bitboard/chess-board.scm

(add-to-load-path (dirname (current-filename)))

(define-module (chess-board)
  #:export (chessboard-letter->column-table
            chessboard-number->row-table
            column->chessboard-letter-table
            chessboard-letter->column
            chessboard-number->row
            column->chessboard-letter
            make-bitvector-from-chessboard-coords
            create-initial-chess-board

            make-chessboard
            chessboard?
            chessboard-white-bb
            chessboard-black-bb
            chessboard-pawns-bb
            chessboard-knights-bb
            chessboard-bishops-bb
            chessboard-rooks-bb
            chessboard-queens-bb
            chessboard-kings-bb))

;; SRFI 9: record types
(use-modules (ice-9 hash-table)
             (srfi srfi-9)
             (srfi srfi-9 gnu)
             (bit-vector-utils)
             ((bitboard) #:prefix bb:))

(define-immutable-record-type <chessboard>
  ;; define constructor
  (make-chessboard white-bb
                   black-bb
                   pawns-bb
                   knights-bb
                   bishops-bb
                   rooks-bb
                   queens-bb
                   kings-bb)
  ;; define predicate
  chessboard?
  ;; define accessors
  (white-bb chessboard-white-bb)
  (black-bb chessboard-black-bb)
  (pawns-bb chessboard-pawns-bb)
  (knights-bb chessboard-knights-bb)
  (bishops-bb chessboard-bishops-bb)
  (rooks-bb chessboard-rooks-bb)
  (queens-bb chessboard-queens-bb)
  (kings-bb chessboard-kings-bb))

(set-record-type-printer!
 <chessboard>
 (λ (record port)
   (display (simple-format #f "\n#<<chessboard>\n") port)
   (display (simple-format #f "  white:\n  ~s\n" (chessboard-white-bb record)) port)
   (display (simple-format #f "  black:\n  ~s\n" (chessboard-black-bb record)) port)
   (display (simple-format #f "  pawns:\n  ~s\n" (chessboard-pawns-bb record)) port)
   (display (simple-format #f "  knights:\n  ~s\n" (chessboard-knights-bb record)) port)
   (display (simple-format #f "  bishops:\n  ~s\n" (chessboard-bishops-bb record)) port)
   (display (simple-format #f "  rooks:\n  ~s\n" (chessboard-rooks-bb record)) port)
   (display (simple-format #f "  queens:\n  ~s\n" (chessboard-queens-bb record)) port)
   (display (simple-format #f "  kings:\n  ~s>" (chessboard-kings-bb record)) port)))

(define chessboard-letter->column-table
  (alist->hash-table
   '((a . 0) (b . 1) (c . 2) (d . 3) (e . 4) (f . 5) (g . 6) (h . 7))))

(define chessboard-number->row-table
  (alist->hash-table
   '((1 . 0) (2 . 1) (3 . 2) (4 . 3) (5 . 4) (6 . 5) (7 . 6) (8 . 7))))

(define column->chessboard-letter-table
  (alist->hash-table
   '((0 . a) (1 . b) (2 . c) (3 . d) (4 . e) (5 . f) (6 . g) (7 . h))))

(define (chessboard-letter->column letter)
  (hash-ref chessboard-letter->column-table
            letter
            #f))
(define (chessboard-number->row number)
  (hash-ref chessboard-number->row-table
            number
            #f))

;; (define (get-row-part coords)
;;   (cdr coords))
;; (define (get-col-part coords)
;;   (car coords))

(define (column->chessboard-letter column)
  (hash-ref column->letter-table column #f))

(define (make-bitvector-from-chessboard-coords coords row-count col-count)
  (define (iter bv coords)
    (cond
     [(null? coords) bv]
     [else
      (let* ([current-elem (car coords)]
             [idx (bb:coords->index (chessboard-number->row (get-row-part current-elem))
                                    (chessboard-letter->column (get-col-part current-elem))
                                    row-count
                                    col-count)])
        (display (simple-format #f "index: ~a\n" idx))
        (bitvector-set! bv idx #t)
        (iter bv (cdr coords)))]))
  (let ([initial-bv (make-bitvector (* row-count col-count) #f)])
    (iter initial-bv coords)))

(define (create-initial-chess-board)
  (define black-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((a . 8) (b . 8) (c . 8) (d . 8) (e . 8) (f . 8) (g . 8) (h . 8)
        (a . 7) (b . 7) (c . 7) (d . 7) (e . 7) (f . 7) (g . 7) (h . 7))
      8 8)
     8 8 'chess))
  (define white-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((a . 1) (b . 1) (c . 1) (d . 1) (e . 1) (f . 1) (g . 1) (h . 1)
        (a . 2) (b . 2) (c . 2) (d . 2) (e . 2) (f . 2) (g . 2) (h . 2))
      8 8)
     8 8 'chess))
  (define pawns-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((a . 2) (b . 2) (c . 2) (d . 2) (e . 2) (f . 2) (g . 2) (h . 2)
        (a . 7) (b . 7) (c . 7) (d . 7) (e . 7) (f . 7) (g . 7) (h . 7))
      8 8)
     8 8 'chess))
  (define knights-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((b . 1) (g . 1) (b . 8) (g . 8))
      8 8)
     8 8 'chess))
  (define bishops-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((c . 1) (f . 1) (c . 8) (f . 8))
      8 8)
     8 8 'chess))
  (define rooks-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((a . 1) (h . 1) (a . 8) (h . 8))
      8 8)
     8 8 'chess))
  (define queens-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((d . 1) (d . 8))
      8 8)
     8 8 'chess))
  (define kings-bb
    (make-bitboard
     (make-bitvector-from-chessboard-coords
      '((e . 1) (e . 8))
      8 8)
     8 8 'chess))
  (make-chessboard white-bb
                   black-bb
                   pawns-bb
                   knights-bb
                   bishops-bb
                   rooks-bb
                   queens-bb
                   kings-bb))