(in-package :polyominos)

(defvar *board* nil "The board we are trying to solve")

(defun reset-board ()
  (let* ((board-list '( 
		       (()
			(nil nil nil -1)
			(nil nil nil  1)
			(nil nil nil -1)
			(nil nil nil  1)
			(nil nil nil -1)
			(nil nil nil  1)
			(nil nil nil -1)
			(nil nil nil  1)
			())
		       
		       ((nil nil -1 nil) () () () () () () () () ( 1 nil nil nil))
		       ((nil nil  1 nil) () () () () () () () () (-1 nil nil nil))
		       ((nil nil -1 nil) () () () () () () () () ( 1 nil nil nil))
		       ((nil nil  1 nil) () () () () () () () () (-1 nil nil nil))
		       ((nil nil -1 nil) () () () () () () () () ( 1 nil nil nil))
		       ((nil nil  1 nil) () () () () () () () () (-1 nil nil nil))
		       ((nil nil -1 nil) () () () () () () () () ( 1 nil nil nil))
		       ((nil nil  1 nil) () () () () () () () () (-1 nil nil nil)) 
		       
		       (()
			(nil  1 nil nil)
			(nil -1 nil nil)
			(nil  1 nil nil)
			(nil -1 nil nil)
			(nil  1 nil nil)
			(nil -1 nil nil)
			(nil -1 nil nil)
			(nil -1 nil nil)
			())))
	 (board-flipped
	  (mapcar #'(lambda (l)
		      (mapcar #'make-board-segment l))
		  (rotate (rotate board-list)))))
    (setq *board* (make-array '(10 10) :initial-contents board-flipped))
    'reset))

(defstruct board-element label notches placed?)

(defsetf board-element-left (elmt) (new-val)
  `(setf (svref (board-element-notches ,elmt) 0) ,new-val))
(defsetf board-element-top (elmt) (new-val)
  `(setf (svref (board-element-notches ,elmt) 1) ,new-val))
(defsetf board-element-right (elmt) (new-val)
  `(setf (svref (board-element-notches ,elmt) 2) ,new-val))
(defsetf board-element-bottom (elmt) (new-val)
  `(setf (svref (board-element-notches ,elmt) 3) ,new-val))

(defun board-element-left (elmt)
  (svref (board-element-notches elmt) 0))
(defun board-element-top (elmt)
  (svref (board-element-notches elmt) 1))
(defun board-element-right (elmt)
  (svref (board-element-notches elmt) 2))
(defun board-element-bottom (elmt)
  (svref (board-element-notches elmt) 3))

(defun board-element-notch (elmt num)
  (svref (board-element-notches elmt) num))

(defun make-board-segment (segment-def)
  (let ((elmt (make-board-element :label #\ )))
    (if (null segment-def)
	(setf (board-element-notches elmt) (make-array 4 :initial-element nil))
      (progn
       (setf (board-element-notches elmt) (make-array 4 :initial-contents segment-def))
       (setf (board-element-placed? elmt) t)))
    elmt))

(defun board-elt (board x y)
  (aref board y x))

(defsetf board-elt (board x y) (new-section)
  `(setf (aref ,board ,y ,x) ,new-section))
         
(defun print-board (board &optional (stream *standard-output*))
  (flet ((translate-tab (i)
			(cond ((null i) #\ )
			      ((= i -1) #\i)
			      ((= i  1) #\o))))
    (dotimes (j 10)
      (dotimes (z 3)
	(format stream "~%")
	(dotimes (i 10)
	  (cond ((= z 0) (format stream "  ~C  "
				 (translate-tab
				  (board-element-top
				   (board-elt board i j)))))
		((= z 1) (aif (board-elt board i j)
			      (format stream "~C ~C ~C"
				      (translate-tab
				       (board-element-left it))
				      (board-element-label it)
				      (translate-tab
				       (board-element-right it)))
			      (princ "  X  " stream)))
		(t (format stream "  ~C  "
			   (translate-tab
			    (board-element-bottom (board-elt board i j)))))))))))
  
(defun print-board-condensed (board &optional (stream *standard-output*))
  (format stream "~%")
  (dotimes (j 10)
    (dotimes (i 10)
      (aif (board-elt board i j)
	   (format stream "~C" (board-element-label it))
	   (format stream " ")))
    (format stream "~%")))


;; $Id: //info.ravenbrook.com/user/ndl/lisp/contest/entries/anthony-juckel/solution1/board.lisp#1 $