(define-module (bit-integer-operations))


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

(define-public max-int
  (λ (num-of-squares)
    (- (expt 2 num-of-squares) 1)))

(define-public make-bit-integer
  (λ (bit-count initial)
    (cond
     [(or (and (boolean? initial) initial)
          (and (integer? initial) (= initial 1)))
      (max-int bit-count)]
     [else 0])))

(define-public val-of-bit-pos
  (λ (bit-pos)
    (expt 2 bit-pos)))

(define-public bit-mask-of-pos
  (λ (pos)
    (val-of-bit-pos pos)))

(define-public get-bit-value-at-pos
  (λ (int pos)
    (if (bit-set? pos int) 1 0)))

(define-public generic-binary-bit-integer-operation
  (λ (int1 int2 proc)
    ;; Example usage of generic-binary-bit-integer-operation:
    ;; (generic-binary-bit-integer-operation
    ;;  200
    ;;  99
    ;;  (lambda (b1 b2)
    ;;    (if (= (+ b1 b2) 2)
    ;;        1
    ;;        0)))
    ;; This would hopefully be the same as:
    ;; (bitwise-and 200 99)
    (let ([max-len (max (integer-length int1) (integer-length int2))])
      (let iter ([pos 0] [result 0])
        (cond
         [(< pos max-len)
          ;; We can AND the integers with a bit mask, which only has a 1 at the position, which we
          ;; are interested in. If the bit of the integer at the position we are interested in is a
          ;; 1, then the AND operation will return an integer not equal 0. Otherwise, if the bit in
          ;; the integer is 0 instead, the AND operation will return 0 as well, because no other
          ;; bits are 1 in both the integer and the bit mask.
          (iter (+ pos 1)
                (proc result
                      pos
                      (get-bit-value-at-pos int1 pos)
                      (get-bit-value-at-pos int2 pos)))]
         [else result])))))

(define-public display-bit-integer
  (lambda* (bit-int
            #:optional (output-port (current-output-port))
            #:key
            (newline #t)
            (padding-length 8)
            (padding-char #\0))
    "Note: This procedure cannot cope with fractions yet."
    (let ([format-string
           (string-append "~"
                          (number->string padding-length)
                          ",'"
                          (list->string (list padding-char))
                          "b"
                          (if newline "\n" ""))])
      (display
       (format #f format-string bit-int) output-port))))

(define-public display-multiple-bit-integers
  (lambda* (ints #:optional (output-port (current-output-port)) #:key (padding-char #\0))
    "This procedure displays multiple integers with a padding filling up to as many positions as the
longest integer is long."
    (let ([longest (apply max (map integer-length ints))])
      (let iter ([remaining-integers ints])
        (cond
         [(null? remaining-integers) 'done]
         [else
          (display-bit-integer (car remaining-integers)
                               output-port
                               #:newline #t
                               #:padding-length longest
                               #:padding-char padding-char)
          (iter (cdr remaining-integers))])))))

(define-public display-bitmap-rank-by-rank-a1-h1
  (lambda* (bitmap bitmap-length row-width
                   #:optional (output-port (current-output-port))
                   #:key
                   (padding-char #\0))
    "This procedure assumes, that the most significant bit (MSB) is representing A1."
    (let ([bit-string
           (string-pad (number->string bitmap 2)
                       bitmap-length
                       padding-char)])
      (let display-chunks ([pos bitmap-length])
        (when (> pos 0)
          (display
           (simple-format
            #f "~a\n"
            (substring bit-string (- pos row-width) pos)) output-port)
          (display-chunks (- pos row-width)))))))

(define-public display-bitmap-rank-by-rank-a8-h8
  (lambda* (bitmap bitmap-length row-width
                   #:optional (output-port (current-output-port))
                   #:key
                   (padding-char #\0))
    "This procedure assumes, that the most significant bit (MSB) is representing A8."
    (let ([bit-string
           (string-pad (number->string bitmap 2)
                       bitmap-length
                       padding-char)])
      (let display-chunks ([pos 0])
        (when (< pos bitmap-length)
          (display
           (simple-format
            #f "~a\n"
            (substring bit-string pos (+ pos row-width))) output-port)
          (display-chunks (+ pos row-width)))))))

;; By default a1-h1 rank by rank is assumed.
(define-public display-bitmap display-bitmap-rank-by-rank-a1-h1)

(define-public string->bit-integer
  (λ (str)
    (let ([chars (string->list str)])
      (let iter ([remaining-chars chars]
                 [result 0]
                 [pos (- (string-length str) 1)])
        (cond
         [(null? remaining-chars)
          result]
         [else
          (iter (cdr remaining-chars)
                (+ result
                   (if (char=? (car remaining-chars) #\1)
                       (val-of-bit-pos pos)
                       0))
                (- pos 1))])))))
