bitboard-model.scm 2.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. ;; =================================
  2. ;; EXPLANATION OF THE REPRESENTATION
  3. ;; =================================
  4. ;; Integers are chosen to represent the bits of the bit board. The most
  5. ;; significant bit represents the square with the highest coordinates.
  6. (define-module (bitboard-model)
  7. #:export (make-bb
  8. bb?
  9. bb-bits
  10. bb-height
  11. bb-width
  12. bb-kind))
  13. (use-modules
  14. ;; SRFI 9: record types
  15. (srfi srfi-9)
  16. ((bit-integer-operations) #:prefix bio:))
  17. (define-record-type <bitboard>
  18. ;; define constructor
  19. (make-bb bits height width kind)
  20. ;; define predicate
  21. bb?
  22. ;; define accessors
  23. (bits bb-bits)
  24. (height bb-height)
  25. (width bb-width)
  26. (kind bb-kind))
  27. (define-public create-bb
  28. (λ (bits height width kind)
  29. "This procedure safely creates a bitboard. Safely meaning, that it checks
  30. its arguments and throws an exception, if anything is wrong with the arguments."
  31. (cond
  32. [(not (exact-integer? bits))
  33. (throw 'invalid-bitboard-creation "bits are not an integer" bits)]
  34. [(not (positive? bits))
  35. (throw 'invalid-bitboard-creation "bits are not a positive integer" bits)]
  36. [(not (exact-integer? height))
  37. (throw 'invalid-bitboard-creation "height is not an integer" height)]
  38. [(not (positive? height))
  39. (throw 'invalid-bitboard-creation "height is not a positive integer" height)]
  40. [(not (exact-integer? width))
  41. (throw 'invalid-bitboard-creation "width is not an integer" width)]
  42. [(not (positive? width))
  43. (throw 'invalid-bitboard-creation "width is not a positive integer" width)]
  44. [(not (symbol? kind))
  45. (throw 'invalid-bitboard-creation "kind is not a symbol" kind)]
  46. [(> bits (- (expt 2 (* height width)) 1))
  47. (throw 'invalid-bitboard-creation "integer too big" bits)]
  48. [else
  49. (make-bb bits height width kind)])))
  50. (define-public create-uniform-bb
  51. (lambda* (height width #:key (kind 'unspecified) (initial #f))
  52. "Creates a bitboard with specified height, width, fill and kind."
  53. (let ([num-bits (* height width)])
  54. (make-bb (if initial (bio:max-int num-bits) 0)
  55. height
  56. width
  57. kind))))