;; ===================
;; DEFINITION OF TERMS
;; ===================

;; square name:
;;   is the symbol, which stands for the coordinates of a square on a real
;;   chess board.

;; square mask:
;;   is defined as the integer / bitmap, which represents that
;;   square.

;; For example if the mapping of squares is rank by rank, from rank A to rank H,
;; starting at A1, then H1 would be mapped to the integer 2^7 and A1 would be
;; mapped to 2^0.

;; square index:
;;   the index of a square, interval: [0..square-count)

(define-module (generation direction))

(use-modules
 ;; SRFI 60: procedures for treating integers as bits
 (srfi srfi-60)
 (ice-9 format)
 (ice-9 hash-table)
 (utils inspection)
 (utils bits))


(define-public square-index->square-mask
  (lambda (square-index)
    "Calculate the integer, which can be used as bit mask
for the given square index."
    (expt 2 square-index)))


;; Define a vector, which contains square names, represented by symbols.
(define-public SQUARES
  ;; vector, constant time access
  '#(A1 B1 C1 D1 E1 F1 G1 H1
     A2 B2 C2 D2 E2 F2 G2 H2
     A3 B3 C3 D3 E3 F3 G3 H3
     A4 B4 C4 D4 E4 F4 G4 H4
     A5 B5 C5 D5 E5 F5 G5 H5
     A6 B6 C6 D6 E6 F6 G6 H6
     A7 B7 C7 D7 E7 F7 G7 H7
     A8 B8 C8 D8 E8 F8 G8 H8))

;; Define a map, which can be used to translate from a square name like 'A1 to
;; an integer index of the square.
(define MAP:SQ-NAME->SQ-INDEX
  (let* ([square-count 64]
         [lookup-table (make-hash-table 64)])
    (let loop ([index 0])
      (cond
       [(< index square-count)
        (hash-set! lookup-table
                   (lookup-square-by-index index)
                   index)
        (loop (+ index 1))]
       [else lookup-table]))))


;; Define a vector, which contains square masks. At some index into the vector
;; the mask for the square is stored. For example at index 0 the mask 1 (a
;; single 1 bit, representing the integer 1) will be stored. To visualize this
;; imagine a bit set to 1 with 63 leading bits set to 0, interpreted as an
;; integer.
(define VEC:SQ-MASKS
  (let* ([element-count 64]
         [positions (make-vector element-count 0)])
    (let loop ([index 0])
      (cond
       [(< index element-count)
        (vector-set! positions index (square-index->square-mask index))
        (loop (+ index 1))]
       [else positions]))))


(define make-rank-vector
  (lambda (squares board-width)
    "Create a vector, which stores bit masks for whole ranks on the chess
board. At index 0 the bit mask for the first rank will be stored."

    (define calculate-ranks-count
      (lambda (squares board-width)
        "Calculate the number of ranks on the chess board."
        (inexact->exact
         (floor
          (/ (vector-length squares)
             board-width)))))

    (define make-rank-mask
      (lambda (rank-index board-width)
        "Create a bit mask for a whole rank, given the index of the rank and the
width of the chess board."
        ;; First calculate the bit mask for the first rank. It will be used
        ;; later to bit shift to get the bit masks of other ranks.
        (let ([first-rank-mask (- (expt 2 board-width) 1)])
          (cond
           [(> rank-index 0)
            ;; Shift bits to the left by a number, which is a multiple of the
            ;; width of the chess board. The resulting bit mask will be the bit
            ;; mask of another rank.
            (bit-left-shift first-rank-mask (* board-width rank-index))]
           [else first-rank-mask]))))

    (let* ([ranks-count (calculate-ranks-count squares board-width)]
           [rank-vector (make-vector ranks-count)])
      ;; Fill the vector with bit masks for whole ranks in a loop.
      (let loop ([rank-index 0])
        (cond
         ;; For each rank set the bit mask at the respective index.
         [(< rank-index ranks-count)
          (vector-set! rank-vector
                       rank-index
                       (make-rank-mask rank-index board-width))
          (loop (+ rank-index 1))]
         [else rank-vector])))))


(define make-file-vector
  (lambda (squares board-height)
    "Create a lookup vector for bit masks for files of rectangular boards. This
is done by calculating the mask for the first file and bit shifting its bits, to
get the file bit mask for another file. For example when we want to get the file
bit mask of the 3. file, the bits are shifted by 2. Ultimately all masks are
stored in a lookup table, which can be indexed by the file index of the file bit
mask one wants to get out. For example on a chess board to get the bit mask for
the E-file one would use 4 as an index to the created vector."
    ;; UNIT TEST: (hash-ref (make-file-vector (make-vector 64 0) 8) 1) -> #x0202020202020202
    ;; UNIT TEST: (= (hash-ref (make-file-vector (make-vector 64 0) 8) 1) #x0202020202020202)

    (define calculate-files-count
      (lambda (squares board-height)
        "Calculate the number of files a rectangular board has."
        (inexact->exact
         (floor
          (/ (vector-length squares)
             board-height)))))

    (define calculate-first-file
      (lambda (board-height board-width)
        "Calculate the first file of a rectangular board. This is achieved by
starting with 1, representing a 1 bit at the place of the first square. Then
that 1 is shifted up the board by bit shifting by as many bits as the board has
files (width of the board) and adding another 1. This is repeated until all bits
of the first file are set to 1."
        (let ([square1 1])
          (let loop ([first-file square1]
                     [ranks-created-count 1])
            (cond
             [(< ranks-created-count board-height)
              ;; Move ranks up by 1 rank and add a new first rank by adding 1.
              (loop (+ (bit-left-shift first-file board-width) 1)
                    (+ ranks-created-count 1))]
             [else first-file])))))

    (let* ([board-width
            ;; assume rectangular shape of the board
            (/ (vector-length squares) board-height)]
           [file-vector (make-vector board-width)]
           [first-file-mask (calculate-first-file board-height board-width)])
      (let loop ([file-index 0])
        (cond
         [(< file-index board-width)
          (vector-set! file-vector
                       file-index
                       (bit-left-shift first-file-mask file-index))
          (loop (+ file-index 1))]
         [else file-vector])))))


(define make-bidirectional-mapping
  (lambda (vec1 vec2)
    "Create 2 hash tables, translating unidirectionally from each of the given
vectors to the other. -- Q: Does this make sense? If I have an index to one of
the vectors, I can use it for the other vector as well and do not need a hash
table, which is less performant for lookups than the vectors. -- A: Yes, it does
make sense. There is a direct mapping from square indices to bit masks, but not
from square names to bit masks. Given a square name, one might want to get the
associated bit mask. Square names cannot be used as indices to any other
vectors."
    (let* ([element-count (min (vector-length vec1) (vector-length vec2))]
           [lookup-table1 (make-hash-table element-count)]
           [lookup-table2 (make-hash-table element-count)])
      (let loop ([index 0])
        (cond
         [(< index element-count)
          (let ([vec1-val (vector-ref vec1 index)]
                [vec2-val (vector-ref vec2 index)])
            (hash-set! lookup-table1 vec1-val vec2-val)
            (hash-set! lookup-table2 vec2-val vec1-val)
            (loop (+ index 1)))]
         [else (values lookup-table1 lookup-table2)])))))


(define RANKS
  (make-rank-vector SQUARES 8))


(define FILES
  (make-file-vector SQUARES 8))


(define-values (MAP:SQ->MASKS MAP:MASKS->SQ)
  (make-bidirectional-mapping SQUARES VEC:SQ-MASKS))

;; TODO: mapping of squares to indices like 0,1,2,3,4,...,61,62,63


;; ======================
;; DATA ABSTRACTION LAYER
;; ======================

;; Now follow the procedures one should use to access the data structures of
;; squares. If we only ever use these procedures, we can change the
;; representation of squares easily.

(define-public lookup-square-mask
  (lambda (square)
    "Receive a square (symbol expressing coordinates of a real chess board) and
return the bitmap."
    (hash-ref MAP:SQ->MASKS square)))

(define-public lookup-square
  (lambda (mask)
    "Receive a square mask (bitmap representing a selection of the square if
used with logical and and another bitmap) and return the square."
    (hash-ref MAP:MASKS->SQ mask)))

(define-public lookup-rank-mask
  (lambda (rank-index)
    (vector-ref RANKS rank-index)))

(define-public lookup-file-mask
  (lambda (file-index)
    (vector-ref FILES file-index)))

(define-public lookup-square-by-index
  (lambda (index)
    (vector-ref SQUARES index)))
