(in-package :screamer-user)


(defmacro aif (expr then else)
    `(let ((it ,expr))
        (if it ,then ,else)))

(defmacro awhen (expr &body body)
    `(let ((it ,expr))
        (when it ,@body)))

(defmacro dodirections ((dir &optional result-form) &body body)
    `(dolist (,dir '(:north :south :west :east) ,result-form)
        ,@body))


#|    

      bitsquares
63 62 61 60 59 58 57 56 
55 54 53 52 51 50 49 48
47 46 45 44 43 42 41 40
39 38 37 36 35 34 33 32 
31 30 29 28 27 26 25 24 
23 22 21 20 19 18 17 16 
15 14 13 12 11 10 09 08 
07 06 05 04 30 02 01 00

|#

(defun debug-gethash (key hashtable)
    (multiple-value-bind (item found?) (gethash key hashtable)
        (unless found? 
            (error "********** key ~A not found in hashtable!! " key))
        item))

(defmacro dobitsquares (bitsquare-and-index-vars &body body)
    `(dotimes (,(cadr bitsquare-and-index-vars) 64)
        (let ((,(car bitsquare-and-index-vars) (get-bitsquare ,(cadr bitsquare-and-index-vars))))
            ,@body)))

(defmacro get-bitsquare (square)
    (if (numberp square)
        (aref +flat-bitsquares+ square)
        `(aref +flat-bitsquares+ ,square)))


#|
(declaim (inline qboard-iterator-start))    
(defun qboard-iterator-start (qboard-designator)
    (ecase qboard-designator
        (:northwest 36)
        (:northeast 32)
        (:southwest 4)
        (:southeast 0)))
|#

#|
(defun make-qboard-iterator (qboard-designator)
    (let ((current (ecase qboard-designator
                       (:northwest 36)
                       (:northeast 32)
                       (:southwest 4)
                       (:southeast 0)))
          (traversed-count 0))
        (flet ((incr ()                    
                    (if (zerop (mod traversed-count 4))                
                        (incf current 5)
                        (incf current))
                    (incf traversed-count)))
            #'(lambda () 
                (case traversed-count 
                    (16 (return (values nil nil)))
                    (0 (incf traversed-count))
                    (t (incr)))
                (values t current)))))
|#


; todo: check input - all too easy to get an infinite loop!
(defun make-subboard-iterator (start-row start-col end-row end-col)
    (let ((row nil)
          (col nil))
        (flet ((incr ()                    
                    (if row
                        (if (= col end-col)
                            (if (= row end-row)
                                nil
                                (setq col start-col row (1+ row)))
                            (setq col (1+ col)))
                        (setq row start-row col start-col))))
            #'(lambda () 
                (values (incr) (+ col (* 8 row)))))))





(defun coord-ok? (n)
    (and (>= n 0)
         (< n 8)))

(defun coords-ok? (x y)
    (and (coord-ok? x)
        (coord-ok? y)))

(defun intersect? (bitboard1 bitboard2)
    (not (zerop (logand bitboard1 bitboard2))))




(defun get-north-neighbour-index (index)
    (let ((n (+ index 8)))
        (when (< n 64)
            n)))

(defun get-south-neighbour-index (index)
    (let ((n (- index 8)))
        (when (>= n 0)
            n)))

(defun get-west-neighbour-index (index)
    (let ((n (1+ index)))
        (unless (zerop (mod n 8))
            n)))

(defun get-east-neighbour-index (index)
    (unless (zerop (mod index 8))
        (1- index)))


(defun get-neighbour-index (index direction)
    (ecase direction
        (:north (get-north-neighbour-index index))
        (:south (get-south-neighbour-index index))
        (:west (get-west-neighbour-index index))
        (:east (get-east-neighbour-index index))))




(defun freeneighbour? (idx direction board)
    "returns neighbour's index if neighbour is free, nil otherwise"
    (awhen (get-neighbour-index idx direction)
        (when (zerop (logand (get-bitsquare it) board))
            it)))

;todo: define similar fun for x y coords and use those throughout
(defun square-free? (square board)
    (zerop (logand (get-bitsquare square) board)))


(defun freeneighbours-count (idx board)
    (let ((freeneighbours 0))
        (dodirections (dir)                            
            (when (freeneighbour? idx dir board)
                (incf freeneighbours)))
        freeneighbours))


#|
(declaim (inline corner-square))
(defun corner-square (corner-designator)
    (ecase corner-designator
        (:northwest 63)
        (:northeast 56)
        (:southwest 7)
        (:southeast 0)))
|#

(defun get-corner-instance (corner-designator list)
    "Takes a corner designator(:northeast etc.) and a list of pm-instances. Returns first pm-instance intersecting with the corner square."
    (dolist (inst list)
        (when (intersect? inst (get-bitsquare (ecase corner-designator
                                                (:northwest 63)
                                                (:northeast 56)
                                                (:southwest 7)
                                                (:southeast 0))))
            (return inst))))

#|
(defun cartesian (a b)
    (mapcan
        #'(lambda(n)
            (mapcar #'(lambda(m)(list n m)) b)) a))
|#

; this version (which i lifted off some website) is at least 1.297269/0.543603 times faster than my (elegant) definition
(defun distribute-left (set1 set2)
    (cond ((null set2) nil) 
           (t (cons (list set1 (car set2)) (distribute-left set1 (cdr set2))))))

(defun cartesian (set1 set2)
    (cond ((null set1) nil) 
           (t (append (distribute-left (car set1) set2) (cartesian (cdr set1) set2)))))

; todo: may be rewritten to use this method: screen out the corner piece. make boards (logior ...) and check intersection on boards
(defun adjacent-sides-intersect? (side1 side2)
    (dolist (x (cartesian side1 side2))
        (when (not (= (car x) (cadr x)))
            (when (apply #'intersect? x)
                (return t)))))
    
(defun get-pm-indices-list ()
  #-made-to-work
  (loop for x from 0 below +pm-types-count+ collect x)
  #+made-to-work
  (let ((x 0) (|to-16844| +pm-types-count+) (|by-16845| 1))
    (let ((|accumulator-16842| (list nil)))
      (declare (type list |accumulator-16842|))
      (let ((|aux-var-16847| |accumulator-16842|))
        (block nil
          (tagbody (progn (when (or (>= x |to-16844|)) (go |end-loop-16841|)))
                   |begin-loop-16840| (setq |aux-var-16847| (last (rplacd |aux-var-16847| (list x))))
                   (progn
                     (let ((|temp-16846| (+ x |by-16845|))) (setq x |temp-16846|))
                     (when (or (>= x |to-16844|)) (go |end-loop-16841|)))
                   (go |begin-loop-16840|)
                   |end-loop-16841| (return-from nil (cdr |accumulator-16842|)))))))
  )

;; $Id: //info.ravenbrook.com/user/ndl/lisp/contest/entries/denis-mashkevich/utils.lisp#1 $