;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- File: search/domains/ttt.lisp

;;;; The Game of Tic-Tac-Toe

;;; Generalized Tic-Tac-Toe, in which any number of players take turns
;;; placing marks on an NxN board, trying to get K marks in a row.  There
;;; are much more efficient representations than what we have chosen here,
;;; but this suffices to run an environment quickly.  If an agent wants to
;;; search a large number of possible game states, then the agent should use
;;; its own efficient representation.  After all, an agent's internal
;;; representation is independent of what's "actually" out there in the
;;; environment.

(defstructure (ttt-game (:include game) (:constructor create-ttt-game))
  "Define an NxN tic-tac-toe game in which the object is to get K in a row."
  n k)

(defun make-ttt-game (&key (n 3) (k n) (players '(X O)))
  "Define an NxN tic-tac-toe game in which the object is to get K in a row."
  (create-ttt-game
   :n n :k k
   :initial-state (make-game-state
		   :board (make-array (list n n) :initial-element '-)
		   :players players)))

(defmethod legal-moves ((game ttt-game) state)
  "List all possible legal moves."
  (let* ((board (game-state-board state))
	 (dims (array-dimensions board)))
    ;; Iterate over all squares; make moves in empty ones.
    (let ((moves nil))
     (dotimes (x (xy-x dims))
       (dotimes (y (xy-y dims))
	 (when (eq (aref board x y) '-)
	   (push (@ x y) moves))))
     moves)))

(defmethod make-move ((game ttt-game) state move)
  "Return the new state that results from making this move."
  (make-game-state
   :board (let ((new-board (copy-array (game-state-board state))))
	    (setf (aref new-board (xy-x move) (xy-y move))
		  (current-player state))
	    new-board)
   :players (left-rotate (game-state-players state))
   :scores (copy-list (game-state-scores state))
   :previous-move move))

(defmethod game-over? ((game ttt-game) state)
  "Checks if the last player to move made a complete row,
   column, or diagonal of length k, or if the board is full.
   If so, assign scores and return true; otherwise return nil."
  (let* ((n (ttt-game-n game))
	 (k (ttt-game-k game))
	 (board (game-state-board state))
	 (players (game-state-players state))
	 (x (first (game-state-previous-move state)))
	 (y (second (game-state-previous-move state)))
	 (previous (previous-player state)))
    (cond ((and x y
		(or (check-k-in-a-row board x y n k +1  0 previous)
		    (check-k-in-a-row board x y n k  0 +1 previous)
		    (check-k-in-a-row board x y n k -1 +1 previous)
		    (check-k-in-a-row board x y n k +1 +1 previous)))
	   (for each player in players do
		(setf (getf (game-state-scores state) player)
		      (if (eq player previous) +1 -1)))
	   'win)
	  ((not (find '- (array->vector board)))
	   'draw)
	  (t nil))))
	     
;;;; Auxiliary Functions

(defun check-k-in-a-row (board x y n k dx dy player)
  "Does player have k in a row, through (x y) in direction (+/-dx +/-dy)?"
  (>= (+ (count-pieces-in-direction board x y n (- dx) (- dy) player) 
	 (count-pieces-in-direction board x y n dx dy player)
	 -1) ; because the piece at (x y) gets counted twice
      k))

(defun count-pieces-in-direction (board x y n dx dy player)
  "Count player's pieces starting at (x y) going in direction (dx dy)."
  (if (and (< -1 x n) (< -1 y n) (eq (aref board x y) player))
      (+ 1 (count-pieces-in-direction board (+ x dx) (+ y dy)
				      n dx dy player))
    0))