(in-package :polyominos)

(defstruct polyomino
  label
  symbol
  base
  rotations
  test-cases)

(defun piece-width (piece)
  (array-dimension piece 1))

(defun piece-height (piece)
  (array-dimension piece 0))

(defun make-piece (piece)
  (let ((height (length piece))
	(width (length (car piece))))
    (let ((the-array (make-array `(,(length piece) ,(length (car piece))))))
      (dotimes (i height)
	(dotimes (j width)
	  (let ((the-elmt (elt (elt piece i) j)))
	    (setf (aref the-array i j)
		  (if (null the-elmt)
		      nil
		    (make-array 4 :initial-contents the-elmt))))))
      the-array)))

  
(defmacro defpolyomino (name label omino)
  (let* ((zero omino)
	 (ninety (rotate omino))
	 (one-eighty (rotate ninety))
	 (two-seventy (rotate one-eighty))
         (rotations (make-array 4 :initial-contents (mapcar #'make-piece (list zero ninety one-eighty two-seventy))))
         (test-cases (map 'vector #'generate-test-cases rotations)))
    `(defvar ,name (make-polyomino :label ,label
                                   :symbol ',name
                                   :base ',zero
				   :rotations ',rotations
				   :test-cases ',test-cases))))

(defun polyomino-rotation (polyomino rotation)
  (svref (polyomino-rotations polyomino) rotation))
(defun polyomino-test-case (polyomino testno)
  (svref (polyomino-test-cases polyomino) testno))

(defun section-left (section)
  (if (null section)
      nil
    (svref section 0)))
(defun section-top (section)
  (if (null section)
      nil
    (svref section 1)))
(defun section-right (section)
  (if (null section)
      nil
    (svref section 2)))
(defun section-bottom (section)
  (if (null section)
      nil
  (svref section 3)))

;; This is only called during compile, so don't worry about consing, but
;;  it is called after pieces have been converted to arrays, and the
;;  results are indexed rather heavily, so it should return arrays
(defun generate-test-cases (piece)
  (let ((section nil)
        (cases nil))
    (dotimes (i (piece-width piece))
      (dotimes (j (piece-height piece))
        (setq section (piece-elt piece i j))
        (when section
          (setq cases (cons (make-array '(2 2) :initial-contents (list (list nil nil)
								       (list i j)))
			    cases))
          (awhen (section-left section)
                 (setq cases (cons (make-array '(2 2) :initial-contents (list (list 2 (* it -1))
									      (list (- i 1) j)))
                                   cases)))

          (awhen (section-top section)
                 (setq cases (cons (make-array '(2 2) :initial-contents (list (list 3 (* it -1))
									      (list i (- j 1))))
                                   cases)))
          (awhen (section-right section)
                 (setq cases (cons (make-array '(2 2) :initial-contents (list (list 0 (* it -1))
									      (list (+ i 1) j)))
				   cases)))
          (awhen (section-bottom section)
                 (setq cases (cons (make-array '(2 2) :initial-contents (list (list 1 (* it -1))
									      (list i (+ j 1))))
                                   cases))))))
      (make-array (length cases) :initial-contents cases)))

(defun generate-tester (board x y)
  #'(lambda (test-case)
                                (let ((the-elmt (funcall #'board-elt board
						   (+ (aref test-case 1 0) x)
						   (+ (aref test-case 1 1) y))))
                            (or (not (board-element-placed? the-elmt))
                                (and (not (null (aref test-case 0 0)))
                                     (eql (board-element-notch the-elmt (aref test-case 0 0))
                                          (aref test-case 0 1)))))))


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

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