;; Quarto game
;; Jacob M. Peck
;; CSC 416 - Graci
;; 20101115

;; imports
(load "lp.l")

;; 1) modelling a piece
(defclass piece ()
  (
    (color :accessor piece-color :initarg :color :initform 'BLUE)
    (size :accessor piece-size :initarg :size :initform 'SMALL)
    (style :accessor piece-style :initarg :style :initform 'HOLLOW)
    (shape :accessor piece-shape :initarg :shape :initform 'CIRCLE)
  )
)

;; 2) test the piece class
(defmethod task2--piece-demo (&aux p1 p2)
  (setf p1 (make-instance 'piece))
  (setf p2 (make-instance 'piece :size 'BIG :style 'SOLID :shape 'SQUARE))
  (format t "size=~A color=~A style=~A shape=~A"
            (piece-size p1)
            (piece-color p1) 
            (piece-style p1) 
            (piece-shape p1)
  ) (terpri)
  (format t "size=~A color=~A style=~A shape=~A"
            (piece-size p2)
            (piece-color p2) 
            (piece-style p2) 
            (piece-shape p2)
  ) (terpri)
  NIL
)

;; 3) "display piece" method
(defmethod display ((p piece))
  (format t "piece: size=~A color=~A style=~A shape=~A"
            (piece-size p)
            (piece-color p) 
            (piece-style p) 
            (piece-shape p)
  ) (terpri)
)

;; 4) test the display method
(defmethod task4--display-piece-demo (&aux p1 p2)
  (setf p1 (make-instance 'piece))
  (setf p2 (make-instance 'piece :size 'BIG :style 'SOLID :shape 'SQUARE))
  (display p1)
  (display p2)
  NIL
)

;; 5) establish the pieces
(defmethod establish-pieces ()
  (setf *bbhc* (make-instance 'piece :size 'BIG))
  (setf (get 'print-rep *bbhc*) "(B-)")
  (setf *bbhs* (make-instance 'piece :size 'BIG :shape 'SQUARE))
  (setf (get 'print-rep *bbhs*) "[B-]")
  (setf *bbsc* (make-instance 'piece :size 'BIG :style 'SOLID))
  (setf (get 'print-rep *bbsc*) "(B+)")
  (setf *bbss* (make-instance 'piece :size 'BIG :style 'SOLID :shape 'SQUARE))
  (setf (get 'print-rep *bbss*) "[B+]")
  (setf *brhc* (make-instance 'piece :size 'BIG :color 'RED))
  (setf (get 'print-rep *brhc*) "(R-)")
  (setf *brhs* (make-instance 'piece :size 'BIG :color 'RED :shape 'SQUARE))
  (setf (get 'print-rep *brhs*) "[R-]")
  (setf *brsc* (make-instance 'piece :size 'BIG :color 'RED :style 'SOLID))
  (setf (get 'print-rep *brsc*) "(R+)")
  (setf *brss* (make-instance 'piece :size 'BIG :color 'RED :style 'SOLID :shape 'SQUARE))
  (setf (get 'print-rep *brss*) "[R+]")
  (setf *sbhc* (make-instance 'piece))
  (setf (get 'print-rep *sbhc*) "(b-)")
  (setf *sbhs* (make-instance 'piece :shape 'SQUARE))
  (setf (get 'print-rep *sbhs*) "[b-]")
  (setf *sbsc* (make-instance 'piece :style 'SOLID))
  (setf (get 'print-rep *sbsc*) "(b+)")
  (setf *sbss* (make-instance 'piece :style 'SOLID :shape 'SQUARE))
  (setf (get 'print-rep *sbss*) "[b+]")
  (setf *srhc* (make-instance 'piece :color 'RED))
  (setf (get 'print-rep *srhc*) "(r-)")
  (setf *srhs* (make-instance 'piece :color 'RED :shape 'SQUARE))
  (setf (get 'print-rep *srhs*) "[r-]")
  (setf *srsc* (make-instance 'piece :color 'RED :style 'SOLID))
  (setf (get 'print-rep *srsc*) "(r+)")
  (setf *srss* (make-instance 'piece :color 'RED :style 'SOLID :shape 'SQUARE))
  (setf (get 'print-rep *srss*) "[r+]")
  (setf *pieces* (list *bbhc* *bbhs* *bbsc* *bbss* *brhc* *brhs* *brsc* *brss*
                       *sbhc* *sbhs* *sbsc* *sbss* *srhc* *srhs* *srsc* *srss*))
  NIL
)

;; 6) test establish-pieces
(defmethod task6--establish-pieces-demo ()
  (establish-pieces)
  (mapcar #'display *pieces*)
  NIL
)

;; 7) add print-rep properties to piece names
; see establish-pieces

;; 8) test print-reps
(defmethod task8--print-rep-demo ()
  (establish-pieces)
  (format t "*BBHS* ~A~%" (get 'print-rep *BBHS*))
  (format t "*SRSC* ~A~%" (get 'print-rep *SRSC*))
  NIL
)

;; 9) to-string (piece)
(defmethod to-string ((p piece))
  (get 'print-rep p)
)

;; 10) to-string test
(defmethod task10--to-string-demo ()
  (establish-pieces)
  (format t "~A~%" (write-to-string (mapcar #'to-string *pieces*)))
  (format t "*BBHS* ~A~%" (to-string *BBHS*))
  (format t "*SRSC* ~A~%" (to-string *SRSC*))
  NIL
)

;; 11) think about printing available pieces

;; 12) to-string (list)
(defmethod to-string ((l list) &aux s)
  (cond
    ((= 1 (length l))
      (if (symbolp (car l))
        (write-to-string (car l))
        (car l)
      )
    )
    (t
      (if (symbolp (car l))
        (setf s (write-to-string (car l)))
        (setf s (car l))
      )
      (concatenate 'string s " " (to-string (cdr l)))
    )
  )
)

;; 13) test to-string
(defmethod task13--to-string-demo ()
  (format t "~A~%" (to-string '(coffee tea)))
  (format t "~A~%" (to-string '("[B+]" "(b-)" "(R+)")))
  NIL
)

;; 14) color predicates
(defmethod is-red-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-color p) 'RED)
    )
  )
)

(defmethod is-blue-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-color p) 'BLUE)
    )
  )
)

;; 15) test the color predicates
(defmethod task15--color-predicates-demo ()
  (establish-pieces)
  (format t "*BBHS* is BLUE: ~A~%*BBHS* is RED:  ~A~%"
            (is-blue-p *bbhs*) (is-red-p *bbhs*))
  (format t "*SRSC* is BLUE: ~A~%*SRSC* is RED:  ~A~%"
            (is-blue-p *srsc*) (is-red-p *srsc*))
  NIL
)

;; 16) display available pieces
(defmethod display-available-pieces ()
  (format t "~A~%~A~%"
    (to-string (mapcar #'to-string (filter #'is-red-p *avail*)))
    (to-string (mapcar #'to-string (filter #'is-blue-p *avail*)))
  )
)

;; 17) display demo
(defmethod task17--display-available-pieces-demo ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (mapcar #'display *avail*)
  (display-available-pieces)
  NIL
)

;; 18) model the board
(defclass board ()
  (
    (d1 :accessor board-d1 :initform 'NIL)
    (d2 :accessor board-d2 :initform 'NIL)
    (d3 :accessor board-d3 :initform 'NIL)
    (d4 :accessor board-d4 :initform 'NIL)
    (c1 :accessor board-c1 :initform 'NIL)
    (c2 :accessor board-c2 :initform 'NIL)
    (c3 :accessor board-c3 :initform 'NIL)
    (c4 :accessor board-c4 :initform 'NIL)
    (b1 :accessor board-b1 :initform 'NIL)
    (b2 :accessor board-b2 :initform 'NIL)
    (b3 :accessor board-b3 :initform 'NIL)
    (b4 :accessor board-b4 :initform 'NIL)
    (a1 :accessor board-a1 :initform 'NIL)
    (a2 :accessor board-a2 :initform 'NIL)
    (a3 :accessor board-a3 :initform 'NIL)
    (a4 :accessor board-a4 :initform 'NIL)
  )
)

;; 19) demo the board
(defmethod task19--board-demo ()
  (setf *board* (make-instance 'board))
  (format t "Initial board...~%")
  (display-board-objects *board*)
  (populate-with-animals *board*)
  (format t "Animal playground...~%")
  (display-board-objects *board*)
  NIL
)

(defmethod populate-with-animals ((b board))
  (setf (board-a1 b) 'cat)
  (setf (board-a2 b) 'dog)
  (setf (board-a3 b) 'cow)
  (setf (board-b1 b) 'bat)
  (setf (board-b2 b) 'ape)
  (setf (board-b3 b) 'auk)
  (setf (board-b4 b) 'yak)
  (setf (board-c2 b) 'emu)
  (setf (board-c3 b) 'fox)
  (setf (board-c4 b) 'owl)
  (setf (board-d1 b) 'pig)
  (setf (board-d3 b) 'rat)
  NIL
)

(defmethod display-board-objects ((b board))
  (format t "d1=~A d2=~A d3=~A d4=~A ~%"
    (board-d1 b) (board-d2 b) (board-d3 b) (board-d4 b)
  )
  (format t "c1=~A c2=~A c3=~A c4=~A ~%"
    (board-c1 b) (board-c2 b) (board-c3 b) (board-c4 b)
  )
  (format t "b1=~A b2=~A b3=~A b4=~A ~%"
    (board-b1 b) (board-b2 b) (board-b3 b) (board-b4 b)
  )
  (format t "a1=~A a2=~A a3=~A a4=~A ~%"
    (board-a1 b) (board-a2 b) (board-a3 b) (board-a4 b)
  )
  NIL
)

;; 20) row referencing methods
(defmethod board-row ((r symbol) (b board))
  (cond
    ((eq r 'd) (board-row-d b))
    ((eq r 'c) (board-row-c b))
    ((eq r 'b) (board-row-b b))
    ((eq r 'a) (board-row-a b))
  )
)

(defmethod board-row-d ((b board))
  (list (board-d1 b) (board-d2 b) (board-d3 b) (board-d4 b))
)

(defmethod board-row-c ((b board))
  (list (board-c1 b) (board-c2 b) (board-c3 b) (board-c4 b))
)

(defmethod board-row-b ((b board))
  (list (board-b1 b) (board-b2 b) (board-b3 b) (board-b4 b))
)

(defmethod board-row-a ((b board))
  (list (board-a1 b) (board-a2 b) (board-a3 b) (board-a4 b))
)

;; 21) test row referencers
(defmethod task21--board-row-demo ()
  (setf *board* (make-instance 'board))
  (populate-with-animals *board*)
  (format t "Animal playground... ~%")
  (display-board-objects *board*)
  (format t "Row d = ~A~%" (board-row 'd *board*))
  (format t "Row c = ~A~%" (board-row 'c *board*))
  (format t "Row b = ~A~%" (board-row 'b *board*))
  (format t "Row a = ~A~%" (board-row 'a *board*))
  NIL
)

;; 22) column referencers
(defmethod board-col ((c number) (b board))
  (cond
    ((= c 1) (board-col-1 b))
    ((= c 2) (board-col-2 b))
    ((= c 3) (board-col-3 b))
    ((= c 4) (board-col-4 b))
  )
)

(defmethod board-col-1 ((b board))
  (list (board-d1 b) (board-c1 b) (board-b1 b) (board-a1 b))
)

(defmethod board-col-2 ((b board))
  (list (board-d2 b) (board-c2 b) (board-b2 b) (board-a2 b))
)

(defmethod board-col-3 ((b board))
  (list (board-d3 b) (board-c3 b) (board-b3 b) (board-a3 b))
)

(defmethod board-col-4 ((b board))
  (list (board-d4 b) (board-c4 b) (board-b4 b) (board-a4 b))
)

;; 23) test col referencers
(defmethod task23--board-col-demo ()
  (setf *board* (make-instance 'board))
  (populate-with-animals *board*)
  (format t "Animal playground... ~%")
  (display-board-objects *board*)
  (format t "Col 1 = ~A~%" (board-col 1 *board*))
  (format t "Col 2 = ~A~%" (board-col 2 *board*))
  (format t "Col 3 = ~A~%" (board-col 3 *board*))
  (format t "Col 4 = ~A~%" (board-col 4 *board*))
  NIL
)

;; 24) diagonal referencers
(defmethod board-diagonal ((d symbol) (b board))
  (cond
    ((eq d 'major) (board-diagonal-major b))
    ((eq d 'minor) (board-diagonal-minor b))
  )
)

(defmethod board-diagonal-major ((b board))
  (list (board-a1 b) (board-b2 b) (board-c3 b) (board-d4 b))
)

(defmethod board-diagonal-minor ((b board))
  (list (board-d1 b) (board-c2 b) (board-b3 b) (board-a4 b))
)

;; 25) test diagonal referencers
(defmethod task25--board-diagonal-demo ()
  (setf *board* (make-instance 'board))
  (populate-with-animals *board*)
  (format t "Animal playground... ~%")
  (display-board-objects *board*)
  (format t "Major diagonal = ~A~%" (board-diagonal 'major *board*))
  (format t "Minor diagonal = ~A~%" (board-diagonal 'minor *board*))
  NIL
)

;; 26) board display
(defmethod display ((b board))
  (format t "D    ~A~%" (to-board-row-string (board-row-d b)))
  (format t "C    ~A~%" (to-board-row-string (board-row-c b)))
  (format t "B    ~A~%" (to-board-row-string (board-row-b b)))
  (format t "A    ~A~%" (to-board-row-string (board-row-a b)))
  (format t "     1    2    3    4 ~%")
  NIL
)

(defmethod padded-piece-or-empty-string ((pn t))
  (cond
    ((null pn) "**** ")
    ((eq (type-of pn) 'piece)
      (concatenate 'string (to-string pn) " ")
    )
    (t
      "???? "
    )
  )
)

(defmethod to-board-row-string ((row list) &aux string-list)
  (setf string-list (mapcar #'padded-piece-or-empty-string row))
  (apply #'concatenate 'string string-list)
)

;; 27) test board display
(defmethod task27--display-board-demo (&aux board)
  (setf board (make-instance 'board))
  (format t "Initial board... ~%")
  (display board)
  (populate-with-animals board)
  (format t "Animal playground... ~%")
  (display board)
  (setf board (make-instance 'board))
  (format t "Initial board... ~%")
  (display board)
  (establish-pieces)
  (populate-with-pieces board)
  (format t "Quarto playground... ~%")
  (display board)
  NIL
)

(defmethod populate-with-pieces ((b board))
  (setf (board-a1 b) *bbhs*)
  (setf (board-a2 b) *bbss*)
  (setf (board-a3 b) *sbhs*)
  (setf (board-b1 b) *sbss*)
  (setf (board-b2 b) *brhs*)
  (setf (board-b3 b) *brss*)
  (setf (board-b4 b) *srhs*)
  (setf (board-c2 b) *srss*)
  (setf (board-c3 b) *bbhc*)
  (setf (board-c4 b) *bbsc*)
  (setf (board-d1 b) *srhc*)
  (setf (board-d3 b) *srhc*)
  NIL
)

;; 28) model players
(defclass player ()
  (
    (name :accessor player-name :initarg :name)
  )
)

(defclass human-player (player) () )

(defclass r-machine-player (player) () )

(defclass h-machine-player (player) () )

(defclass m-machine-player (player) () )

(defmethod display ((p player))
  (format t "< PLAYER NAME =~A >~%" (player-name p))
)

;; 29) test player classes
(defmethod task29--player-demo ()
  (setf p (make-instance 'player :name 'hobbit))
  (display p)
  (setf q (make-instance 'human-player :name 'harry))
  (display q)
  NIL
)

;; 30) model state of the game
(defclass state ()
  (
    (board :accessor state-board :initarg :board :initform (make-instance 'board))
    (player :accessor state-player :initarg :player :initform NIL)
  )
)

(defmethod display ((s state))
  (display (state-board s))
  (format t "Current player = ~A~%" (player-name (state-player s)))
  NIL
)

;; 31) demo the state
(defmethod task31--state-demo ()
  (setf p (make-instance 'player :name 'fluffy))
  (setf s (make-instance 'state :player p))
  (display s)
)

;; 32) model the game
(defclass game ()
  (
    (state :accessor game-state :initarg :state)
    (player1 :accessor game-player1 :initarg :player1)
    (player2 :accessor game-player2 :initarg :player2)
  )
)

(defmethod display ((g game))
  (format t "Player 1: ~A~%" (player-name (game-player1 g)))
  (format t "Player 2: ~A~%" (player-name (game-player2 g)))
  (format t "Game state:~%")
  (display (game-state g))
  NIL
)

;; 33) test the game
(defmethod task33--game-demo ()
  (setf p (make-instance 'player :name 'one))
  (setf q (make-instance 'player :name 'two))
  (setf s (make-instance 'state :player p))
  (setf g (make-instance 'game :state s :player1 p :player2 q))
  (display g)
  NIL
)

;; 34) h-h-game
(defmethod h-h-game ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (let (state player1 player2 name1 name2 first initial-state game)
    (princ "Name of player 1? ") (setf name1 (read))
    (princ "Name of player 2? ") (setf name2 (read))
    (setf player1 (make-instance 'human-player :name name1))
    (setf player2 (make-instance 'human-player :name name2))
    (setf first (establish-first-player player1 player2))
    (setf initial-state (make-instance 'state :player first))
    (make-instance 'game
      :state initial-state
      :player1 player1
      :player2 player2
    )
  )
)

(defmethod establish-first-player ((p player) (q player) &aux name)
  (format t "Who will move first, ~A or ~A? "
    (player-name p)
    (player-name q)
  )
  (setf name (read))
  (if (not (member name (list (player-name p) (player-name q))))
    (establish-first-player p q)
    (if (eq name (player-name p)) p q)
  )
)

;; 35) test h-h-game
(defmethod task35--h-h-game-demo ()
  (display (h-h-game))
  NIL
)

;; 36) play method
(defmethod play ((g game))
  (loop
    (terpri)
    (display (state-board (game-state g)))
    (terpri)
    (if (game-over-p g)
      (return-from play (wind-up-game g))
    )
    (move g)
  )
)

;; 37) game-over-p
(defmethod game-over-p ((g game) &aux board)
  (setf board (state-board (game-state g)))
  (or
    (four-in-a-row board)
    (four-in-a-col board)
    (four-in-a-diagonal board)
  )
)

;; 38) same-size-p
(defmethod same-size-p ((p1 piece) (p2 piece))
  (eql (piece-size p1) (piece-size p2))
)

;; 39) test same-size-p
(defmethod task39--same-size-p-demo ()
  (establish-pieces)
  (format t "For ~A and ~A the same size result = ~A~%"
    (to-string *bbhs*) (to-string *brhs*) (same-size-p *bbhs* *brhs*)
  )
  (format t "For ~A and ~A the same size result = ~A~%"
    (to-string *sbhs*) (to-string *srhs*) (same-size-p *sbhs* *srhs*)
  )
  (format t "For ~A and ~A the same size result = ~A~%"
    (to-string *bbhs*) (to-string *srhs*) (same-size-p *bbhs* *srhs*)
  )
  (format t "For ~A and ~A the same size result = ~A~%"
    (to-string *sbhs*) (to-string *brhs*) (same-size-p *sbhs* *brhs*)
  )
  NIL
)

;; 40) same-color-p
(defmethod same-color-p ((p1 piece) (p2 piece))
  (eql (piece-color p1) (piece-color p2))
)

;; 41) test same-color-p
(defmethod task41--same-color-p-demo ()
  (establish-pieces)
  (format t "For ~A and ~A the same color result = ~A~%"
    (to-string *bbhs*) (to-string *sbhs*) (same-color-p *bbhs* *sbhs*)
  )
  (format t "For ~A and ~A the same color result = ~A~%"
    (to-string *brhs*) (to-string *srhs*) (same-color-p *brhs* *srhs*)
  )
  (format t "For ~A and ~A the same color result = ~A~%"
    (to-string *bbhs*) (to-string *srhs*) (same-color-p *bbhs* *srhs*)
  )
  (format t "For ~A and ~A the same color result = ~A~%"
    (to-string *srhs*) (to-string *bbhs*) (same-color-p *srhs* *bbhs*)
  )
  NIL
)

;; 42) same-style-p
(defmethod same-style-p ((p1 piece) (p2 piece))
  (eql (piece-style p1) (piece-style p2))
)

;; 43) test same-style-p
(defmethod task43--same-style-p-demo ()
  (establish-pieces)
  (format t "For ~A and ~A the same style result = ~A~%"
    (to-string *bbhs*) (to-string *sbhs*) (same-style-p *bbhs* *sbhs*)
  )
  (format t "For ~A and ~A the same style result = ~A~%"
    (to-string *brss*) (to-string *srss*) (same-style-p *brss* *srss*)
  )
  (format t "For ~A and ~A the same style result = ~A~%"
    (to-string *bbhs*) (to-string *srss*) (same-style-p *bbhs* *srss*)
  )
  (format t "For ~A and ~A the same style result = ~A~%"
    (to-string *srss*) (to-string *bbhs*) (same-style-p *srss* *bbhs*)
  )
  NIL
)

;; 44) same-shape-p
(defmethod same-shape-p ((p1 piece) (p2 piece))
  (eql (piece-shape p1) (piece-shape p2))
)

;; 45) test same-shape-p
(defmethod task45--same-shape-p-demo ()
  (establish-pieces)
  (format t "For ~A and ~A the same shape result = ~A~%"
    (to-string *bbhs*) (to-string *sbhs*) (same-style-p *bbhs* *sbhs*)
  )
  (format t "For ~A and ~A the same shape result = ~A~%"
    (to-string *brsc*) (to-string *srsc*) (same-style-p *brsc* *srsc*)
  )
  (format t "For ~A and ~A the same shape result = ~A~%"
    (to-string *bbhs*) (to-string *srsc*) (same-style-p *bbhs* *srsc*)
  )
  (format t "For ~A and ~A the same shape result = ~A~%"
    (to-string *srsc*) (to-string *bbhs*) (same-style-p *srsc* *bbhs*)
  )
  NIL
)

;; 46) uniform-p
(defmethod uniform-p ((l list))
  (= (length l) (count (car l) l))
)

;; 47) uniform-p demo
(defmethod task47--uniform-p-demo (&aux sal1 sal2)
  (setf sal1 '(this this this this this))
  (format t "~A is uniform? ~A~%" sal1 (uniform-p sal1))
  (setf sal2 '(this that the other))
  (format t "~A is uniform? ~A~%" sal2 (uniform-p sal2))
)

;; 48) uniform-size-p
(defmethod uniform-size-p ((qp list))
  (uniform-p (mapcar #'piece-size qp))
)

;; 49) uniform-size-p demo
(defmethod task49--uniform-size-p-demo (&aux pl1 pl2 pl3)
  (establish-pieces)
  (setf pl1 (list *bbhc* *brss* *brss* *brhc*))
  (format t "~A is uniform in size? ~A~%"
    (mapcar #'to-string pl1) (uniform-size-p pl1)
  )
  (setf pl2 (list *sbhc* *srss* *srss* *srhc*))
  (format t "~A is uniform in size? ~A~%"
    (mapcar #'to-string pl2) (uniform-size-p pl2)
  )
  (setf pl3 (list *bbhc* *brss* *srss* *brhc*))
  (format t "~A is uniform in size? ~A~%"
    (mapcar #'to-string pl3) (uniform-size-p pl3)
  )
  NIL
)

;; 50) uniform-color-p
(defmethod uniform-color-p ((qp list))
  (uniform-p (mapcar #'piece-color qp))
)

;; 51) uniform-color-p demo
(defmethod task51--uniform-color-p-demo (&aux pl1 pl2 pl3)
  (establish-pieces)
  (setf pl1 (list *bbhc* *bbss* *bbss* *bbsc*))
  (format t "~A is uniform in color? ~A~%"
    (mapcar #'to-string pl1) (uniform-color-p pl1)
  )
  (setf pl2 (list *srhc* *srss* *srss* *srsc*))
  (format t "~A is uniform in color? ~A~%"
    (mapcar #'to-string pl2) (uniform-color-p pl2)
  )
  (setf pl3 (list *bbhc* *brss* *srss* *brhc*))
  (format t "~A is uniform in color? ~A~%"
    (mapcar #'to-string pl3) (uniform-color-p pl3)
  )
  NIL
)

;; 52) uniform-style-p
(defmethod uniform-style-p ((qp list))
  (uniform-p (mapcar #'piece-style qp))
)

;; 53) uniform-style-p demo
(defmethod task53--uniform-style-p-demo (&aux pl1 pl2 pl3)
  (establish-pieces)
  (setf pl1 (list *bbsc* *bbss* *sbss* *brsc*))
  (format t "~A is uniform in style? ~A~%"
    (mapcar #'to-string pl1) (uniform-style-p pl1)
  )
  (setf pl2 (list *srhc* *sbhs* *brhs* *srhc*))
  (format t "~A is uniform in style? ~A~%"
    (mapcar #'to-string pl2) (uniform-style-p pl2)
  )
  (setf pl3 (list *bbhc* *brss* *srss* *brhc*))
  (format t "~A is uniform in style? ~A~%"
    (mapcar #'to-string pl3) (uniform-style-p pl3)
  )
  NIL
)

;; 54) uniform-shape-p
(defmethod uniform-shape-p ((qp list))
  (uniform-p (mapcar #'piece-shape qp))
)

;; 55) uniform-shape-p demo
(defmethod task55--uniform-shape-p-demo (&aux pl1 pl2 pl3)
  (establish-pieces)
  (setf pl1 (list *bbhs* *bbss* *sbss* *brsc*))
  (format t "~A is uniform in shape? ~A~%"
    (mapcar #'to-string pl1) (uniform-shape-p pl1)
  )
  (setf pl2 (list *bbhs* *sbhs* *brhs* *srhs*))
  (format t "~A is uniform in shape? ~A~%"
    (mapcar #'to-string pl2) (uniform-shape-p pl2)
  )
  (setf pl3 (list *bbhc* *brss* *srss* *brhc*))
  (format t "~A is uniform in shape? ~A~%"
    (mapcar #'to-string pl3) (uniform-shape-p pl3)
  )
  NIL
)

;; 56) similar-pieces-p
(defmethod similar-pieces-p ((qp list))
  (or
    (uniform-size-p qp)
    (uniform-color-p qp)
    (uniform-style-p qp)
    (uniform-shape-p qp)
  )
)

;; 57) test similar-pieces-p
(defmethod task57--similar-pieces-p-demo (&aux set1 set2 set3 set4 set5)
  (establish-pieces)
  (setf set1 (list *bbsc* *brsc* *sbhc*)) ; all cirlces
  (format t "The set ~A are similar? ~A~%"
    (mapcar #'to-string set1) (similar-pieces-p set1)
  )
  (setf set2 (list *bbsc* *brsc* *bbhs*)) ; all big
  (format t "The set ~A are similar? ~A~%"
    (mapcar #'to-string set2) (similar-pieces-p set2)
  )
  (setf set3 (list *bbsc* *bbss* *sbsc*)) ; all blue
  (format t "The set ~A are similar? ~A~%"
    (mapcar #'to-string set3) (similar-pieces-p set3)
  )
  (setf set4 (list *bbsc* *brsc* *sbsc*)) ; all solid
  (format t "The set ~A are similar? ~A~%"
    (mapcar #'to-string set4) (similar-pieces-p set4)
  )
  (setf set5 (list *bbsc* *brhc* *sbss*)) ; nothing
  (format t "The set ~A are similar? ~A~%"
    (mapcar #'to-string set5) (similar-pieces-p set5)
  )
  NIL
)

;; 58) four-similar-pieces
(defmethod four-similar-pieces ((line list))
  (cond
    ((member NIL line)
      NIL
    )
    (t
      (similar-pieces-p line)
    )
  )
)

;; 59) test four-similar-pieces
(defmethod task59--four-similar-pieces-demo ()
  (establish-pieces)
  (setf line1 (list *bbss* *sbss* *brsc* *srsc* ))
  (format t "The line ~A consists of four similar pieces? ~A~%"
    (mapcar #'piece-or-nil line1) (four-similar-pieces line1)
  )
  (setf line2 (list *bbss* *sbss* NIL *srsc* ))
  (format t "The line ~A consists of four similar pieces? ~A~%"
    (mapcar #'piece-or-nil line2) (four-similar-pieces line2)
  )
  (setf line3 (list *bbss* *sbss* *brsc* *srhc* ))
  (format t "The line ~A consists of four similar pieces? ~A~%"
    (mapcar #'piece-or-nil line3) (four-similar-pieces line3)
  )
  NIL
)

(defmethod piece-or-nil ((pn t))
  (cond
    ((null pn)
      "NIL"
    )
    ((eq (type-of pn) 'piece)
      (concatenate 'string (to-string pn))
    )
    (t
      "????"
    )
  )
)

;; 60) four in a row?
(defmethod four-in-a-row ((b board))
  (or
    (four-similar-pieces (board-row-a b))
    (four-similar-pieces (board-row-b b))
    (four-similar-pieces (board-row-c b))
    (four-similar-pieces (board-row-d b))
  )
)

;; 61) test four-in-a-row
(defmethod task61--four-in-a-row-demo (&aux board)
  (establish-pieces)
  (setf board (make-instance 'board))
  (populate-with-pieces-row board)
  (format t "Quarto board with four in a row...~%")
  (display board)
  (format t "Four in a row? ~A~%" (four-in-a-row board))
  (setf board (make-instance 'board))
  (populate-with-pieces-nothing board)
  (format t "Quarto board with nothing...~%")
  (display board)
  (format t "Four in a row? ~A~%" (four-in-a-row board))
  NIL
)

(defmethod populate-with-pieces-row ((b board))
  (setf (board-a1 b) *bbhs*)
  (setf (board-a2 b) *bbss*)
  (setf (board-a3 b) *sbhs*)
  (setf (board-b1 b) *sbss*)
  (setf (board-b2 b) *brhs*)
  (setf (board-b3 b) *brss*)
  (setf (board-b4 b) *srhs*)
  (setf (board-c2 b) *srss*)
  (setf (board-c3 b) *bbhc*)
  (setf (board-c4 b) *bbsc*)
  (setf (board-d1 b) *srhc*)
  (setf (board-d3 b) *srhc*)
  NIL
)

(defmethod populate-with-pieces-nothing ((b board))
  (setf (board-a1 b) *bbhs*)
  (setf (board-a2 b) *bbss*)
  (setf (board-a3 b) *sbhs*)
  (setf (board-b1 b) *sbsc*)
  (setf (board-b2 b) *brss*)
  (setf (board-b3 b) *brss*)
  (setf (board-b4 b) *srhs*)
  (setf (board-c2 b) *srss*)
  (setf (board-c3 b) *bbhc*)
  (setf (board-c4 b) *bbsc*)
  (setf (board-d1 b) *srhc*)
  (setf (board-d3 b) *srhc*)
  (setf (board-d4 b) *sbhc*)
  NIL
)

;; 62) four in a col?
(defmethod four-in-a-col ((b board))
  (or
    (four-similar-pieces (board-col-1 b))
    (four-similar-pieces (board-col-2 b))
    (four-similar-pieces (board-col-3 b))
    (four-similar-pieces (board-col-4 b))
  )
)

;; 63) test four-in-a-col
(defmethod task63--four-in-a-col-demo (&aux board)
  (establish-pieces)
  (setf board (make-instance 'board))
  (populate-with-pieces-col board)
  (format t "Quarto board with four in a col...~%")
  (display board)
  (format t "Four in a col? ~A~%" (four-in-a-col board))
  (setf board (make-instance 'board))
  (populate-with-pieces-nothing board)
  (format t "Quarto board with nothing...~%")
  (display board)
  (format t "Four in a col? ~A~%" (four-in-a-col board))
  NIL
)

(defmethod populate-with-pieces-col ((b board))
  (setf (board-a1 b) *bbhs*)
  (setf (board-a2 b) *bbss*)
  (setf (board-a3 b) *sbhs*)
  (setf (board-b1 b) *sbss*)
  (setf (board-b2 b) *brhs*)
  (setf (board-b3 b) *brss*)
  (setf (board-b4 b) *srhs*)
  (setf (board-c2 b) *brss*)
  (setf (board-c3 b) *bbhc*)
  (setf (board-c4 b) *bbsc*)
  (setf (board-d1 b) *srhc*)
  (setf (board-d2 b) *brsc*)
  (setf (board-d3 b) *srhc*)
  NIL
)

;; 64) four in a diagonal?
(defmethod four-in-a-diagonal ((b board))
  (or
    (four-similar-pieces (board-diagonal-major b))
    (four-similar-pieces (board-diagonal-minor b))
  )
)

;; 65) test four in a diagonal
(defmethod task65--four-in-a-diagonal-demo (&aux board)
  (establish-pieces)
  (setf board (make-instance 'board))
  (populate-with-pieces-diagonal board)
  (format t "Quarto board with four in a diagonal...~%")
  (display board)
  (format t "Four in a diagonal? ~A~%" (four-in-a-diagonal board))
  (setf board (make-instance 'board))
  (populate-with-pieces-nothing board)
  (format t "Quarto board with nothing...~%")
  (display board)
  (format t "Four in a diagonal? ~A~%" (four-in-a-diagonal board))
  NIL
)

(defmethod populate-with-pieces-diagonal ((b board))
  (setf (board-a1 b) *bbhs*)
  (setf (board-a2 b) *bbss*)
  (setf (board-a3 b) *sbhs*)
  (setf (board-b1 b) *sbss*)
  (setf (board-b2 b) *brhs*)
  (setf (board-b3 b) *brss*)
  (setf (board-b4 b) *srhs*)
  (setf (board-c2 b) *brss*)
  (setf (board-c3 b) *bbhc*)
  (setf (board-c4 b) *bbsc*)
  (setf (board-d1 b) *srhc*)
  (setf (board-d2 b) *brsc*)
  (setf (board-d3 b) *srhc*)
  (setf (board-d4 b) *sbhc*)
  NIL
)

;; 66) game-over-p demo
(defmethod task66--game-over-p-demo ()
  (establish-pieces)
  (let (initial-state player1 player2 p1name p2name first-player g)
    (princ "Name of player 1? ") (setf p1name (read))
    (princ "Name of player 2? ") (setf p2name (read))
    (setf player1 (make-instance 'human-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf initial-state (make-instance 'state :player first-player))
    (setf g (make-instance 'game
      :state initial-state
      :player1 player1
      :player2 player2
    ))
    (populate-with-pieces-for-row-win (state-board (game-state g)))
    (display g)
    (format t "Game over? ~A~%" (game-over-p g))
    (populate-with-pieces-for-col-win (state-board (game-state g)))
    (display g)
    (format t "Game over? ~A~%" (game-over-p g))
    (populate-with-pieces-for-maj-win (state-board (game-state g)))
    (display g)
    (format t "Game over? ~A~%" (game-over-p g))
    (populate-with-pieces-for-min-win (state-board (game-state g)))
    (display g)
    (format t "Game over? ~A~%" (game-over-p g))
    (populate-with-pieces-for-no-win (state-board (game-state g)))
    (display g)
    (format t "Game over? ~A~%" (game-over-p g))
    NIL
  )
)

(defmethod populate-with-pieces-for-row-win ((b board))
  (setf (board-a1 b) NIL)
  (setf (board-a2 b) NIL)
  (setf (board-a3 b) NIL)
  (setf (board-a4 b) NIL)
  (setf (board-b1 b) *brss*)
  (setf (board-b2 b) *srhc*)
  (setf (board-b3 b) *srss*)
  (setf (board-b4 b) *brhc*)
  (setf (board-c1 b) NIL)
  (setf (board-c2 b) NIL)
  (setf (board-c3 b) NIL)
  (setf (board-c4 b) NIL)
  (setf (board-d1 b) NIL)
  (setf (board-d2 b) NIL)
  (setf (board-d3 b) NIL)
  (setf (board-d4 b) NIL)
  NIL
)

(defmethod populate-with-pieces-for-col-win ((b board))
  (setf (board-a1 b) NIL)
  (setf (board-a2 b) NIL)
  (setf (board-a3 b) *sbhs*)
  (setf (board-a4 b) NIL)
  (setf (board-b1 b) NIL)
  (setf (board-b2 b) NIL)
  (setf (board-b3 b) *srss*)
  (setf (board-b4 b) NIL)
  (setf (board-c1 b) NIL)
  (setf (board-c2 b) NIL)
  (setf (board-c3 b) *sbhc*)
  (setf (board-c4 b) NIL)
  (setf (board-d1 b) NIL)
  (setf (board-d2 b) NIL)
  (setf (board-d3 b) *srsc*)
  (setf (board-d4 b) NIL)
  NIL
)

(defmethod populate-with-pieces-for-maj-win ((b board))
  (setf (board-a1 b) *bbss*)
  (setf (board-a2 b) NIL)
  (setf (board-a3 b) NIL)
  (setf (board-a4 b) NIL)
  (setf (board-b1 b) NIL)
  (setf (board-b2 b) *brhs*)
  (setf (board-b3 b) NIL)
  (setf (board-b4 b) NIL)
  (setf (board-c1 b) NIL)
  (setf (board-c2 b) NIL)
  (setf (board-c3 b) *bbhc*)
  (setf (board-c4 b) NIL)
  (setf (board-d1 b) NIL)
  (setf (board-d2 b) NIL)
  (setf (board-d3 b) NIL)
  (setf (board-d4 b) *brhc*)
  NIL
)

(defmethod populate-with-pieces-for-min-win ((b board))
  (setf (board-a1 b) NIL)
  (setf (board-a2 b) NIL)
  (setf (board-a3 b) NIL)
  (setf (board-a4 b) *sbhs*)
  (setf (board-b1 b) NIL)
  (setf (board-b2 b) NIL)
  (setf (board-b3 b) *brss*)
  (setf (board-b4 b) NIL)
  (setf (board-c1 b) NIL)
  (setf (board-c2 b) *srss*)
  (setf (board-c3 b) NIL)
  (setf (board-c4 b) NIL)
  (setf (board-d1 b) *srhs*)
  (setf (board-d2 b) NIL)
  (setf (board-d3 b) NIL)
  (setf (board-d4 b) NIL)
  NIL
)

(defmethod populate-with-pieces-for-no-win ((b board))
  (setf (board-a1 b) *bbhs*)
  (setf (board-a2 b) *bbss*)
  (setf (board-a3 b) NIL)
  (setf (board-a4 b) NIL)
  (setf (board-b1 b) *sbss*)
  (setf (board-b2 b) *brhs*)
  (setf (board-b3 b) NIL)
  (setf (board-b4 b) NIL)
  (setf (board-c1 b) NIL)
  (setf (board-c2 b) NIL)
  (setf (board-c3 b) *bbsc*)
  (setf (board-c4 b) *bbhc*)
  (setf (board-d1 b) NIL)
  (setf (board-d2 b) NIL)
  (setf (board-d3 b) *srhc*)
  (setf (board-d4 b) *srhc*)
  NIL
)

;; 67) Does Not Exist
;; oops, I divided by zero

;; 68) move method
(defmethod move ((g game))
  (make-move g)
  (change-player g)
)

;; 69) change player
(defmethod change-player ((g game))
  (let (state player1 player2 current-player next-player)
    (setf state (game-state g))
    (setf player1 (game-player1 g))
    (setf player2 (game-player2 g))
    (setf current-player (state-player state))
    (if (equal-player current-player player1)
      (setf next-player player2)
      (setf next-player player1)
    )
    (setf (state-player state) next-player)
    NIL
  )
)

(defmethod equal-player ((p player) (q player))
  (eq (player-name p) (player-name q)) ; problem with this... what if both had same name?
)

;; 70) test change player
(defmethod task70--change-player-demo ()
  (establish-pieces)
  (let (state player1 player2 p1name p2name game first-player)
    (princ "Name of player 1? ") (setf p1name (read))
    (princ "Name of player 2? ") (setf p2name (read))
    (setf player1 (make-instance 'human-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf state (make-instance 'state :player first-player))
    (setf g (make-instance 'game
      :state state
      :player1 player1
      :player2 player2
    ))
    (display (current-player g))
    (display (other-player g))
    (format t "Change player...~%")
    (change-player g)
    (display (current-player g))
    (display (other-player g))
    (format t "Change player...~%")
    (change-player g)
    (display (current-player g))
    (display (other-player g))
  )
)

(defmethod current-player ((g game))
  (state-player (game-state g))
)

(defmethod other-player ((g game))
  (let (player1 player2)
    (setf player1 (game-player1 g))
    (setf player2 (game-player2 g))
    (if (equal-player player1 (state-player (game-state g)))
      player2
      player1
    )
  )
)

;; 71) make-move
(defmethod make-move ((g game) &aux piece)
  (display-available-pieces)
  (setf piece (select-piece (current-player g) (state-board (game-state g))))
  (format t "~A: I select ~A for you to place on the board.~%"
    (player-name (current-player g))
    (to-string piece)
  )
  (place-piece (other-player g) piece (state-board (game-state g)))
  NIL
)

;; 72) parse a piece description

; additional predicates (in addition to is-red-p and is-blue-p)
(defmethod is-solid-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-style p) 'SOLID)
    )
  )
)

(defmethod is-hollow-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-style p) 'HOLLOW)
    )
  )
)

(defmethod is-big-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-size p) 'BIG)
    )
  )
)

(defmethod is-small-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-size p) 'SMALL)
    )
  )
)

(defmethod is-square-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-shape p) 'SQUARE)
    )
  )
)

(defmethod is-circle-p ((p piece))
  (cond
    ((null p) NIL)
    (t
      (eql (piece-shape p) 'CIRCLE)
    )
  )
)

(defmethod parse-piece-description ((l list) &aux desc selected)
  (setf filtered (copy-tree *avail*))
  (setf desc (copy-tree l))
  ;(format t "The available pieces are~%~A~%"
  ;  (to-string (mapcar #'to-string filtered))
  ;)
  (cond
    ((eql (car desc) 'BIG)
      (pop desc)
      (setf filtered (filter #'is-big-p filtered))
      NIL
    )
    ((eql (car desc) 'SMALL)
      (pop desc)
      (setf filtered (filter #'is-small-p filtered))
      NIL
    )
    (t
      NIL
    )
  )
  ;(format t "Candidates after size filtering are~%~A~%"
  ;  (if (not (null filtered))
  ;    (to-string (mapcar #'to-string filtered))
  ;    "- none -"
  ;  )
  ;)
  (cond
    ((eq (car desc) 'BLUE)
      (pop desc)
      (setf filtered (filter #'is-blue-p filtered))
      NIL
    )
    ((eq (car desc) 'RED)
      (pop desc)
      (setf filtered (filter #'is-red-p filtered))
      NIL
    )
    (t
      NIL
    )
  )
  ;(format t "Candidates after color filtering are~%~A~%"
  ;  (if (not (null filtered))
  ;    (to-string (mapcar #'to-string filtered))
  ;    "- none -"
  ;  )
  ;)
  (cond
    ((eq (car desc) 'HOLLOW)
      (pop desc)
      (setf filtered (filter #'is-hollow-p filtered))
      NIL
    )
    ((eq (car desc) 'SOLID)
      (pop desc)
      (setf filtered (filter #'is-solid-p filtered))
      NIL
    )
    (t
      NIL
    )
  )
  ;(format t "Candidates after style filtering are~%~A~%"
  ;  (if (not (null filtered))
  ;    (to-string (mapcar #'to-string filtered))
  ;    "- none -"
  ;  )
  ;)
  (cond
    ((eq (car desc) 'SQUARE)
      (pop desc)
      (setf filtered (filter #'is-square-p filtered))
      NIL
    )
    ((eq (car desc) 'CIRCLE)
      (pop desc)
      (setf filtered (filter #'is-circle-p filtered))
      NIL
    )
    (t
      NIL
    )
  )
  ;(format t "Candidates after shape filtering are~%~A~%"
  ;  (if (not (null filtered))
  ;    (to-string (mapcar #'to-string filtered))
  ;    "- none -"
  ;  )
  ;)
  (if (null filtered) 
    (setf selected 'NIL) ;nil if no piece matches
    (setf selected (pick filtered))
  )
  ;(format t "The selection is~%~A~%" 
  ;  (if (not (null selected))
  ;    (to-string selected)
  ;    "NIL"
  ;  )
  ;)
  selected
)

;; 73) parse-piece-description demo
(defmethod task73--parse-piece-description-demo (&aux d p)
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (setf d '(big blue solid square))
  (setf p (parse-piece-description d))
  (format t "~A->~A~%" (write-to-string d) (to-string p))
  (setf d '(big red solid circle))
  (setf p (parse-piece-description d))
  (format t "~A->~A~%" (write-to-string d) (to-string p))
  (setf d '(blue square))
  (setf p (parse-piece-description d))
  (format t "~A->~A~%" (write-to-string d) (to-string p))
  (setf d '(big hollow circle))
  (setf p (parse-piece-description d))
  (format t "~A->~A~%" (write-to-string d) (to-string p))
  NIL
)

;; 74) select a piece to offer player, human
(defmethod select-piece ((hp human-player) (b board) &aux english-piece-description piece)
  (format t "Which piece, ~A? " (player-name hp))
  (setf english-piece-description (read-description))
  (setf piece (parse-piece-description english-piece-description))
  (cond
    ((null piece)
      (format t "No such piece is available.  Select again.~%")
      (select-piece hp b)
    )
    (t
      piece
    )
  )
)

(defmethod read-description (&aux r)
  (setf r (read))
  (cond
    ((not (listp r))
      (format t "Input a list, please: ")
      (read-description)
    )
    (t
      r
    )
  )
)

;; 75) demo select-piece
(defmethod task75--select-piece-demo (&aux player piece)
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (setf player (make-instance 'human-player :name 'x))
  (setf piece (select-piece player))
  (format t "Piece selected is ~A~%" (to-string piece))
  (setf piece (select-piece player))
  (format t "Piece selected is ~A~%" (to-string piece))
  (setf piece (select-piece player))
  (format t "Piece selected is ~A~%" (to-string piece))
  (setf piece (select-piece player))
  (format t "Piece selected is ~A~%" (to-string piece))
  (setf piece (select-piece player))
  (format t "Piece selected is ~A~%" (to-string piece))
  NIL
)

;; 76) available locations
(defmethod available-locations ((b board) &aux spaces)
  (setf spaces '())
  (if (eq 'NIL (board-d4 b)) (push 'D4 spaces))
  (if (eq 'NIL (board-d3 b)) (push 'D3 spaces))
  (if (eq 'NIL (board-d2 b)) (push 'D2 spaces))
  (if (eq 'NIL (board-d1 b)) (push 'D1 spaces))
  (if (eq 'NIL (board-c4 b)) (push 'C4 spaces))
  (if (eq 'NIL (board-c3 b)) (push 'C3 spaces))
  (if (eq 'NIL (board-c2 b)) (push 'C2 spaces))
  (if (eq 'NIL (board-c1 b)) (push 'C1 spaces))
  (if (eq 'NIL (board-b4 b)) (push 'B4 spaces))
  (if (eq 'NIL (board-b3 b)) (push 'B3 spaces))
  (if (eq 'NIL (board-b2 b)) (push 'B2 spaces))
  (if (eq 'NIL (board-b1 b)) (push 'B1 spaces))
  (if (eq 'NIL (board-a4 b)) (push 'A4 spaces))
  (if (eq 'NIL (board-a3 b)) (push 'A3 spaces))
  (if (eq 'NIL (board-a2 b)) (push 'A2 spaces))
  (if (eq 'NIL (board-a1 b)) (push 'A1 spaces))
  spaces
)

;; 77) test available-locations
(defmethod task77--available-locations-demo (&aux board)
  (establish-pieces)
  (setf board (make-instance 'board))
  (format t "Available spaces on an empty board:~%~A~%"
    (available-locations board)
  )
  (setf (board-a1 board) *bbhs*)
  (setf (board-b2 board) *brhs*)
  (setf (board-c3 board) *sbss*)
  (setf (board-d4 board) *srhc*)
  (format t "Available spaces on a board with major diagonal filled:~%~A~%"
    (available-locations board)
  )
)

;; 78) select location
(defmethod select-location ((hp human-player) (p piece) (b board))
  (let (location available-locations)
    (setf available-locations (available-locations b))
    (format t "On which cell will you place ~A, ~A? ~%~A~%> "
      (to-string p)
      (player-name hp)
      available-locations
    )
    (setf location (read))
    (cond
      ((not (member location available-locations))
        (format t "That location cannot be chosen, please try again.~%")
        (select-location hp p b)
      )
      (t
        location
      )
    )
  )
)

;; 79) test select-location
(defmethod task79--select-location-demo ()
  (establish-pieces)
  (setf player (make-instance 'human-player :name 'x))
  (setf board (make-instance 'board))
  (populate-with-pieces-for-sld board)
  (display board)
  (setf location (select-location player *brhc* board))
  (format t "Location selected is ~A~%" location)
  NIL
)

(defmethod populate-with-pieces-for-sld ((b board))
  (setf (board-d1 b) *bbhs*)
  (setf (board-c2 b) *bbss*)
  (setf (board-b3 b) *sbhs*)
  (setf (board-a4 b) *sbss*)
  NIL
)

;; 80) place piece on board
(defmethod place-piece-on-board ((name symbol) (cell symbol) (p piece) (b board))
  (format t "~A:  Placing piece ~A on cell ~A ...~%"
    name
    (to-string p)
    cell
  )
  (cond
    ((eq cell 'a1) (setf (board-a1 b) p))
    ((eq cell 'a2) (setf (board-a2 b) p))
    ((eq cell 'a3) (setf (board-a3 b) p))
    ((eq cell 'a4) (setf (board-a4 b) p))
    ((eq cell 'b1) (setf (board-b1 b) p))
    ((eq cell 'b2) (setf (board-b2 b) p))
    ((eq cell 'b3) (setf (board-b3 b) p))
    ((eq cell 'b4) (setf (board-b4 b) p))
    ((eq cell 'c1) (setf (board-c1 b) p))
    ((eq cell 'c2) (setf (board-c2 b) p))
    ((eq cell 'c3) (setf (board-c3 b) p))
    ((eq cell 'c4) (setf (board-c4 b) p))
    ((eq cell 'd1) (setf (board-d1 b) p))
    ((eq cell 'd2) (setf (board-d2 b) p))
    ((eq cell 'd3) (setf (board-d3 b) p))
    ((eq cell 'd4) (setf (board-d4 b) p))
  )
)

;; 81) demo place piece on board
(defmethod task81--place-piece-on-board-demo ()
  (establish-pieces)
  (let (board piece cell player)
    (setf player (make-instance 'human-player :name 'x))
    (setf board (make-instance 'board))
    (populate-with-pieces-for-sld board)
    (display board)
    (setf piece *bbhs*)
    (setf cell (select-location player piece board))
    (place-piece-on-board (player-name player) cell piece board)
    (display board)
    (setf piece *bbss*)
    (setf cell (select-location player piece board))
    (place-piece-on-board (player-name player) cell piece board)
    (display board)
    (setf piece *srhc*)
    (setf cell (select-location player piece board))
    (place-piece-on-board (player-name player) cell piece board)
    (display board)
    NIL
  )
)

;; 82) place piece
(defmethod place-piece ((hp human-player) (p piece) (b board) &aux location)
  (setf location (select-location hp p b))
  (place-piece-on-board (player-name hp) location p b)
  (setf *avail* (remove p *avail* :test #'piece-equal))
  NIL
)

(defmethod piece-equal ((p1 piece) (p2 piece))
  (and
    (eq (piece-size p1) (piece-size p2))
    (eq (piece-color p1) (piece-color p2))
    (eq (piece-style p1) (piece-style p2))
    (eq (piece-shape p1) (piece-shape p2))
  )
)

;; 83) place-piece demo
(defmethod task83--place-piece-demo ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (setf player (make-instance 'human-player :name 'x))
  (setf board (make-instance 'board))
  (populate-with-pieces-for-ppd board)
  (format t "Quarto board with pieces for ppd...~%")
  (display board)
  (display-available-pieces)
  (place-piece player *brhs* board)
  (display board)
  (display-available-pieces)
  (place-piece player *brsc* board)
  (display board)
  (display-available-pieces)
  (place-piece player *srhs* board)
  (display board)
  (display-available-pieces)
  (place-piece player *srhc* board)
  (display board)
  (display-available-pieces)
  (place-piece player *sbhs* board)
  (display board)
  (display-available-pieces)
  NIL
)

(defmethod populate-with-pieces-for-ppd ((b board))
  (setf (board-d1 b) *bbhs*)
  (setf (board-c2 b) *bbss*)
  (setf (board-b3 b) *sbhs*)
  (setf (board-a4 b) *sbss*)
  NIL
)

;; 84) make-move demo
(defmethod task84--make-move-demo ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (let (state player1 player2 p1name p2name game)
    (princ "Name of player 1? ") (setf p1name (read))
    (princ "Name of player 2? ") (setf p2name (read))
    (setf player1 (make-instance 'human-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf state (make-instance 'state :player first-player))
    (setf g (make-instance 'game
      :state state
      :player1 player1
      :player2 player2
    ))
    (display g)
    (format t "Move 1~%")
    (make-move g)
    (display g)
    (format t "Move 2~%")
    (make-move g)
    (display g)
    (format t "Move 3~%")
    (make-move g)
    (display g)
    (format t "Move 4~%")
    (make-move g)
    (display g)
    NIL
  )
)

;; 85) move demo
(defmethod task85--move-demo ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (let (state player1 player2 p1name p2name game)
    (princ "Name of player 1? ") (setf p1name (read))
    (princ "Name of player 2? ") (setf p2name (read))
    (setf player1 (make-instance 'human-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf state (make-instance 'state :player first-player))
    (setf g (make-instance 'game
      :state state
      :player1 player1
      :player2 player2
    ))
    (display g)
    (format t "Move 1~%")
    (move g)
    (display g)
    (format t "Move 2~%")
    (move g)
    (display g)
    (format t "Move 3~%")
    (move g)
    (display g)
    (format t "Move 4~%")
    (move g)
    (display g)
    NIL
  )
)

;; 86) wind up game
(defmethod wind-up-game ((g game) &aux player)
  (setf player (current-player g))
  (format t "Congratulations, ~A!~%" (player-name player))
  NIL
)

;; 87) demo wind-up-game
(defmethod task87--wind-up-game-demo ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (let (state player1 player2 p1name p2name game)
    (princ "Name of player 1? ") (setf p1name (read))
    (princ "Name of player 2? ") (setf p2name (read))
    (setf player1 (make-instance 'human-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf state (make-instance 'state :player first-player))
    (setf g (make-instance 'game
      :state state
      :player1 player1
      :player2 player2
    ))
    (display g)
    (wind-up-game g)
  )
)

;; 88) demo the play method
(defmethod task88--play-demo (&aux g)
  (setf g (h-h-game))
  (play g)
  NIL
)

;; 89) rm-h-game
(defmethod rm-h-game ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (let (state player1 player2 p1name p2name first-player)
    (princ "Name of random machine player? ") (setf p1name (read))
    (princ "Name of human player? ") (setf p2name (read))
    (setf player1 (make-instance 'r-machine-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf state (make-instance 'state :player first-player))
    (make-instance 'game
      :state state
      :player1 player1
      :player2 player2
    )
  )
)

;; 90) rm select piece
(defmethod select-piece ((rmp r-machine-player) (b board))
  (pick *avail*)
)

;; 91) rm select location
(defmethod select-location ((rmp r-machine-player) (p piece) (b board))
  (pick (available-locations b))
)

;; 92) rm place piece
(defmethod place-piece ((rmp r-machine-player) (p piece) (b board))
  (setf location (select-location rmp p b))
  (place-piece-on-board (player-name rmp) location p b)
  (setf *avail* (remove p *avail* :test #'piece-equal))
  NIL
)

;; 93) demo rm-h-game
(defmethod task93--play-demo (&aux g)
  (setf g (rm-h-game))
  (play g)
  NIL
)

;; 94) hm-h-game
(defmethod hm-h-game ()
  (establish-pieces)
  (setf *avail* (copy-tree *pieces*))
  (let (state player1 player2 p1name p2name first-player)
    (princ "Name of heuristic machine player? ") (setf p1name (read))
    (princ "Name of human player? ") (setf p2name (read))
    (setf player1 (make-instance 'h-machine-player :name p1name))
    (setf player2 (make-instance 'human-player :name p2name))
    (setf first-player (establish-first-player player1 player2))
    (setf state (make-instance 'state :player first-player))
    (make-instance 'game
      :state state
      :player1 player1
      :player2 player2
    )
  )
)

;; 95) hm select piece
(defmethod select-piece ((hmp h-machine-player) (b board) &aux filter color style shape size piece l)
  (setf filter (hm-filter-pieces b))
  
  ;; pick color
  (if (member 'blue filter)
    (if (member 'red filter) 
      (setf color NIL)
      (setf color 'red)
    )
    (if (member 'red filter)
      (setf color 'blue)
      (setf color NIL)
    )
  )
  
  ;; pick size
  (if (member 'big filter)
    (if (member 'small filter)
      (setf size NIL)
      (setf size 'small)
    )
    (if (member 'small filter)
      (setf size 'big)
      (setf size NIL)
    )
  )
  
  ;; pick style
  (if (member 'hollow filter)
    (if (member 'solid filter)
      (setf style NIL)
      (setf style 'solid)
    )
    (if (member 'solid filter)
      (setf style 'hollow)
      (setf style NIL)
    )
  )
  
  ;; pick shape
  (if (member 'square filter)
    (if (member 'circle filter)
      (setf shape NIL)
      (setf shape 'circle)
    )
    (if (member 'circle filter)
      (setf shape 'square)
      (setf shape NIL)
    )
  )
  
  ;; pick piece
  (setf l (remove NIL (list size color style shape)))
  (format t "~A: The piece I'm attempting to pick fits this description: ~A~%"
    (player-name hmp)
    (write-to-string l)
  )
  (setf piece (parse-piece-description l))
  (if (null piece)
    (setf piece (hm-no-such-piece l (cdr l) 0)) ;; work through alternatives if desired piece isn't available
  )
  piece  
)

(defmethod hm-no-such-piece ((original list) (new list) (pos integer) &aux piece)
  (format t "Attempting to pick... : ~A~%" (write-to-string new))
  (setf piece (parse-piece-description new))
  (if (null piece)
    (cond
      ((= 0 (length new))
        (setf piece (pick *avail*)) ; no choices left, pick random piece
      )
      ((= (length original) pos) ; go down one level in the list
        (setf new (cdr (cdr original)))
        (setf original (cdr original))
        (setf piece (hm-no-such-piece original new 0))
      )
      (t ; else, remove next element, and try again.
        (setf piece (hm-no-such-piece
          original
          (remove (nth (+ 1 pos) original) original)
          (+ 1 pos)
        ))
      )
    )
  )
  piece
)

(defmethod hm-filter-pieces ((b board) &aux l)
  (setf l '())
  (if (three-aligned-blue-board b) (push 'blue l))
  (if (three-aligned-red-board b) (push 'red l))
  (if (three-aligned-small-board b) (push 'small l))
  (if (three-aligned-big-board b) (push 'big l))
  (if (three-aligned-hollow-board b) (push 'hollow l))
  (if (three-aligned-solid-board b) (push 'solid l))
  (if (three-aligned-square-board b) (push 'square l))
  (if (three-aligned-circle-board b) (push 'circle l))
  l
)

(defmethod three-aligned-blue ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-blue-p l)))
  )
)

(defmethod three-aligned-red ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-red-p l)))
  )
)

(defmethod three-aligned-small ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-small-p l)))
  )
)

(defmethod three-aligned-big ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-big-p l)))
  )
)

(defmethod three-aligned-solid ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-solid-p l)))
  )
)

(defmethod three-aligned-hollow ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-hollow-p l)))
  )
)

(defmethod three-aligned-square ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-square-p l)))
  )
)

(defmethod three-aligned-circle ((l list))
  (and
    (= 1 (count NIL l))
    (= 3 (length (filter #'is-circle-p l)))
  )
)

(defmethod three-aligned-blue-board ((b board))
  (or
    (three-aligned-blue (board-row-a b))
    (three-aligned-blue (board-row-b b))
    (three-aligned-blue (board-row-c b))
    (three-aligned-blue (board-row-d b))
    (three-aligned-blue (board-col-1 b))
    (three-aligned-blue (board-col-2 b))
    (three-aligned-blue (board-col-3 b))
    (three-aligned-blue (board-col-4 b))
    (three-aligned-blue (board-diagonal-major b))
    (three-aligned-blue (board-diagonal-minor b))
  )
)

(defmethod three-aligned-red-board ((b board))
  (or
    (three-aligned-red (board-row-a b))
    (three-aligned-red (board-row-b b))
    (three-aligned-red (board-row-c b))
    (three-aligned-red (board-row-d b))
    (three-aligned-red (board-col-1 b))
    (three-aligned-red (board-col-2 b))
    (three-aligned-red (board-col-3 b))
    (three-aligned-red (board-col-4 b))
    (three-aligned-red (board-diagonal-major b))
    (three-aligned-red (board-diagonal-minor b))
  )
)

(defmethod three-aligned-small-board ((b board))
  (or
    (three-aligned-small (board-row-a b))
    (three-aligned-small (board-row-b b))
    (three-aligned-small (board-row-c b))
    (three-aligned-small (board-row-d b))
    (three-aligned-small (board-col-1 b))
    (three-aligned-small (board-col-2 b))
    (three-aligned-small (board-col-3 b))
    (three-aligned-small (board-col-4 b))
    (three-aligned-small (board-diagonal-major b))
    (three-aligned-small (board-diagonal-minor b))
  )
)

(defmethod three-aligned-big-board ((b board))
  (or
    (three-aligned-big (board-row-a b))
    (three-aligned-big (board-row-b b))
    (three-aligned-big (board-row-c b))
    (three-aligned-big (board-row-d b))
    (three-aligned-big (board-col-1 b))
    (three-aligned-big (board-col-2 b))
    (three-aligned-big (board-col-3 b))
    (three-aligned-big (board-col-4 b))
    (three-aligned-big (board-diagonal-major b))
    (three-aligned-big (board-diagonal-minor b))
  )
)

(defmethod three-aligned-solid-board ((b board))
  (or
    (three-aligned-solid (board-row-a b))
    (three-aligned-solid (board-row-b b))
    (three-aligned-solid (board-row-c b))
    (three-aligned-solid (board-row-d b))
    (three-aligned-solid (board-col-1 b))
    (three-aligned-solid (board-col-2 b))
    (three-aligned-solid (board-col-3 b))
    (three-aligned-solid (board-col-4 b))
    (three-aligned-solid (board-diagonal-major b))
    (three-aligned-solid (board-diagonal-minor b))
  )
)

(defmethod three-aligned-hollow-board ((b board))
  (or
    (three-aligned-hollow (board-row-a b))
    (three-aligned-hollow (board-row-b b))
    (three-aligned-hollow (board-row-c b))
    (three-aligned-hollow (board-row-d b))
    (three-aligned-hollow (board-col-1 b))
    (three-aligned-hollow (board-col-2 b))
    (three-aligned-hollow (board-col-3 b))
    (three-aligned-hollow (board-col-4 b))
    (three-aligned-hollow (board-diagonal-major b))
    (three-aligned-hollow (board-diagonal-minor b))
  )
)

(defmethod three-aligned-square-board ((b board))
  (or
    (three-aligned-square (board-row-a b))
    (three-aligned-square (board-row-b b))
    (three-aligned-square (board-row-c b))
    (three-aligned-square (board-row-d b))
    (three-aligned-square (board-col-1 b))
    (three-aligned-square (board-col-2 b))
    (three-aligned-square (board-col-3 b))
    (three-aligned-square (board-col-4 b))
    (three-aligned-square (board-diagonal-major b))
    (three-aligned-square (board-diagonal-minor b))
  )
)

(defmethod three-aligned-circle-board ((b board))
  (or
    (three-aligned-circle (board-row-a b))
    (three-aligned-circle (board-row-b b))
    (three-aligned-circle (board-row-c b))
    (three-aligned-circle (board-row-d b))
    (three-aligned-circle (board-col-1 b))
    (three-aligned-circle (board-col-2 b))
    (three-aligned-circle (board-col-3 b))
    (three-aligned-circle (board-col-4 b))
    (three-aligned-circle (board-diagonal-major b))
    (three-aligned-circle (board-diagonal-minor b))
  )
)

;; "nil" predicates, return false for no piece
(defmethod is-blue-p ((n t))
  nil
)

(defmethod is-red-p ((n t))
  nil
)

(defmethod is-big-p ((n t))
  nil
)

(defmethod is-small-p ((n t))
  nil
)

(defmethod is-hollow-p ((n t))
  nil
)

(defmethod is-solid-p ((n t))
  nil
)

(defmethod is-square-p ((n t))
  nil
)

(defmethod is-circle-p ((n t))
  nil
)

;; 96) hm select location
(defmethod select-location ((hmp h-machine-player) (p piece) (b board) &aux location)
  ;; check for three in a row/col/diagonal matching piece
  (setf location (hm-find-location p b))
  ;; place in proper coordinate if there is a match
  ;; place random otherwise
  (cond
    ((null location)
      (pick (available-locations b))
    )
    (t
      location
    )
  )
)

(defmethod hm-find-location ((p piece) (b board) &aux size color style shape)
  (setf size (piece-size p))
  (setf color (piece-color p))
  (setf style (piece-style p))
  (setf shape (piece-shape p))
  ; check diagonals first
  (setf minor-diagonal
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-diagonal-minor b))
        (three-aligned-small (board-diagonal-minor b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-diagonal-minor b))
        (three-aligned-red (board-diagonal-minor b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-diagonal-minor b))
        (three-aligned-solid (board-diagonal-minor b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-diagonal-minor b))
        (three-aligned-circle (board-diagonal-minor b))
      )
    )
  )
  (setf major-diagonal
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-diagonal-major b))
        (three-aligned-small (board-diagonal-major b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-diagonal-major b))
        (three-aligned-red (board-diagonal-major b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-diagonal-major b))
        (three-aligned-solid (board-diagonal-major b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-diagonal-major b))
        (three-aligned-circle (board-diagonal-major b))
      )
    )
  )
  ; check rows second
  (setf row-a
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-row-a b))
        (three-aligned-small (board-row-a b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-row-a b))
        (three-aligned-red (board-row-a b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-row-a b))
        (three-aligned-solid (board-row-a b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-row-a b))
        (three-aligned-circle (board-row-a b))
      )
    )
  )
  (setf row-b
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-row-b b))
        (three-aligned-small (board-row-b b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-row-b b))
        (three-aligned-red (board-row-b b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-row-b b))
        (three-aligned-solid (board-row-b b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-row-b b))
        (three-aligned-circle (board-row-b b))
      )
    )
  )
  (setf row-c
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-row-a b))
        (three-aligned-small (board-row-c b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-row-c b))
        (three-aligned-red (board-row-c b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-row-c b))
        (three-aligned-solid (board-row-c b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-row-c b))
        (three-aligned-circle (board-row-c b))
      )
    )
  )
  (setf row-d
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-row-d b))
        (three-aligned-small (board-row-d b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-row-d b))
        (three-aligned-red (board-row-d b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-row-d b))
        (three-aligned-solid (board-row-d b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-row-d b))
        (three-aligned-circle (board-row-d b))
      )
    )
  )
  ; columns last
  (setf col-1
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-col-1 b))
        (three-aligned-small (board-col-1 b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-col-1 b))
        (three-aligned-red (board-col-1 b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-col-1 b))
        (three-aligned-solid (board-col-1 b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-col-1 b))
        (three-aligned-circle (board-col-1 b))
      )
    )
  )
  (setf col-2
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-col-2 b))
        (three-aligned-small (board-col-2 b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-col-2 b))
        (three-aligned-red (board-col-2 b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-col-2 b))
        (three-aligned-solid (board-col-2 b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-col-2 b))
        (three-aligned-circle (board-col-2 b))
      )
    )
  )
  (setf col-3
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-col-3 b))
        (three-aligned-small (board-col-3 b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-col-3 b))
        (three-aligned-red (board-col-3 b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-col-3 b))
        (three-aligned-solid (board-col-3 b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-col-3 b))
        (three-aligned-circle (board-col-3 b))
      )
    )
  )
  (setf col-4
    (or
      (if (eq size 'BIG)
        (three-aligned-big (board-col-4 b))
        (three-aligned-small (board-col-4 b))
      )
      (if (eq color 'BLUE)
        (three-aligned-blue (board-col-4 b))
        (three-aligned-red (board-col-4 b))
      )
      (if (eq style 'HOLLOW)
        (three-aligned-hollow (board-col-4 b))
        (three-aligned-solid (board-col-4 b))
      )
      (if (eq shape 'SQUARE)
        (three-aligned-square (board-col-4 b))
        (three-aligned-circle (board-col-4 b))
      )
    )
  )
  
  ;; return NIL if none found, else return correct cell
  (if (not (or minor-diagonal major-diagonal row-a row-b row-c row-d col-1 col-2 col-3 col-4))
    NIL
    (cond
      (minor-diagonal
        (cond
          ((null (nth 0 (board-diagonal-minor b)))
            'D1
          )
          ((null (nth 1 (board-diagonal-minor b)))
            'C2
          )
          ((null (nth 2 (board-diagonal-minor b)))
            'B3
          )
          ((null (nth 3 (board-diagonal-minor b)))
            'A4
          )
          (t NIL)
        )
      )
      (major-diagonal
        (cond
          ((null (nth 0 (board-diagonal-major b)))
            'A1
          )
          ((null (nth 1 (board-diagonal-major b)))
            'B2
          )
          ((null (nth 2 (board-diagonal-major b)))
            'C3
          )
          ((null (nth 3 (board-diagonal-major b)))
            'D4
          )
          (t NIL)
        )
      )
      (row-a
        (cond
          ((null (nth 0 (board-row-a b)))
            'A1
          )
          ((null (nth 1 (board-row-a b)))
            'A2
          )
          ((null (nth 2 (board-row-a b)))
            'A3
          )
          ((null (nth 3 (board-row-a b)))
            'A4
          )
          (t NIL)
        )
      )
      (row-b
        (cond
          ((null (nth 0 (board-row-b b)))
            'B1
          )
          ((null (nth 1 (board-row-b b)))
            'B2
          )
          ((null (nth 2 (board-row-b b)))
            'B3
          )
          ((null (nth 3 (board-row-b b)))
            'B4
          )
          (t NIL)
        )
      )
      (row-c
        (cond
          ((null (nth 0 (board-row-c b)))
            'C1
          )
          ((null (nth 1 (board-row-c b)))
            'C2
          )
          ((null (nth 2 (board-row-c b)))
            'C3
          )
          ((null (nth 3 (board-row-c b)))
            'C4
          )
          (t NIL)
        )
      )
      (row-d
        (cond
          ((null (nth 0 (board-row-d b)))
            'D1
          )
          ((null (nth 1 (board-row-d b)))
            'D2
          )
          ((null (nth 2 (board-row-d b)))
            'D3
          )
          ((null (nth 3 (board-row-d b)))
            'D4
          )
          (t NIL)
        )
      )
      (col-1
        (cond
          ((null (nth 0 (board-col-1 b)))
            'D1
          )
          ((null (nth 1 (board-col-1 b)))
            'C1
          )
          ((null (nth 2 (board-col-1 b)))
            'B1
          )
          ((null (nth 3 (board-col-1 b)))
            'A1
          )
          (t NIL)
        )
      )
      (col-2
        (cond
          ((null (nth 0 (board-col-2 b)))
            'D2
          )
          ((null (nth 1 (board-col-2 b)))
            'C2
          )
          ((null (nth 2 (board-col-2 b)))
            'B2
          )
          ((null (nth 3 (board-col-2 b)))
            'A2
          )
          (t NIL)
        )
      )
      (col-3
        (cond
          ((null (nth 0 (board-col-3 b)))
            'D3
          )
          ((null (nth 1 (board-col-3 b)))
            'C3
          )
          ((null (nth 2 (board-col-3 b)))
            'B3
          )
          ((null (nth 3 (board-col-3 b)))
            'A3
          )
          (t NIL)
        )
      )
      (col-4
        (cond
          ((null (nth 0 (board-col-4 b)))
            'D4
          )
          ((null (nth 1 (board-col-4 b)))
            'C4
          )
          ((null (nth 2 (board-col-4 b)))
            'B4
          )
          ((null (nth 3 (board-col-4 b)))
            'A4
          )
          (t NIL)
        )
      )
      (t NIL)
    )
  )
)


;; 97) hm place piece
(defmethod place-piece ((hmp h-machine-player) (p piece) (b board))
  (setf location (select-location hmp p b))
  (place-piece-on-board (player-name hmp) location p b)
  (setf *avail* (remove p *avail* :test #'piece-equal))
  NIL
)

;; 98) demo hm-h-game
(defmethod task98--play-demo (&aux g)
  (setf g (hm-h-game))
  (play g)
  NIL
)

;; end file: quarto.l