;; $Id: tictactoe.lisp,v 1.1.1.1 2008/10/12 04:05:34 alamos Exp $
;; Mapping to the opponent
(defconstant opponent '((#\x . #\o) (#\o . #\x )))
(defstruct game
  (position "         ")
  (player #\o)
  (result nil)
  (ply 0))

(defstruct move square value)

(defun display_position (pos)
  (format t  "+-----+-----+-----+~%")
  (format t  "|     |     |     |~%")
  (format t  "|  ~a  |  ~a  |  ~a  |~%"
	  (elt pos 0) (elt pos 1) (elt pos 2)) 
  (format t  "|     |     |     |~%")
  (format t  "+-----+-----+-----+~%")
  (format t  "|     |     |     |~%")
  (format t  "|  ~a  |  ~a  |  ~a  |~%"
	  (elt pos 3) (elt pos 4) (elt pos 5)) 
  (format t  "|     |     |     |~%")
  (format t  "+-----+-----+-----+~%")
  (format t  "|     |     |     |~%")
  (format t  "|  ~a  |  ~a  |  ~a  |~%"
	  (elt pos 6) (elt pos 7) (elt pos 8)) 
  (format t  "|     |     |     |~%")
  (format t  "+-----+-----+-----+~%"))

(defun test_slice (player pos offset step)
  (dotimes (i 3 T)
    (unless (char= (elt pos offset) player) (return-from test_slice nil))
    (incf offset step)))

(defun game_won (player pos)
  (or 
   ;; Diagonals
   (test_slice player pos 0 4)
   (test_slice player pos 2 2)
   ;; Rows
   (test_slice player pos 0 1)
   (test_slice player pos 3 1)
   (test_slice player pos 6 1)
   ;; Columns
   (test_slice player pos 0 3)
   (test_slice player pos 1 3)
   (test_slice player pos 2 3)
   ))

(defun unoccupied_squares (position &aux squares)
  ;; Squares in the order of importance
  (dolist (square '(4 0 2 6 8 1 3 5 7) (nreverse squares))
    (if (char= (elt position square) #\SPACE)
	(push square squares))))


(defun child_position (position square player)
  (let ((newpos (copy-seq position)))
    (setf (elt newpos square) player)
    newpos))

(defun min_max (game &aux best_move)
  (let ((moves (generate_moves game)))
    (dolist (m moves)
     (let ((new_game (apply_move game m)))
       (unless (game-result new_game)
	 (let ((move (min_max new_game)))
	   (setf (move-value m) (- (move-value move)))
	))
       (when (or (null best_move)  (> (move-value m) (move-value best_move)))
	   (setf best_move m)
	)
       ))
    best_move
    ))

;; Remember:
;; Alpha is the guaranteed score for max.
;; Beta  is the maximum score max can hope for.
(defun alpha_beta (game alpha beta
		   &aux best_move
			(moves (generate_moves game)))
  (dolist (m moves)
    (let ((new_game (apply_move game m)))
      (unless (game-result new_game)
	(let ((move (alpha_beta new_game (- beta) (- alpha))))
	  (setf (move-value m) (- (move-value move)))
	  ))
      (when (or (null best_move)  (> (move-value m) (move-value best_move)))
	(setf best_move m
	      alpha  (move-value m))
	(when (> alpha beta)
	  (return))
	)
      ))
  best_move
)


(defun apply_move (game move)
  (let ((new_game
	 (make-game
	  :position  (child_position (game-position game) (move-square move) (game-player game))
	  :player    (cdr (assoc (game-player game) opponent))
	  :ply       (1+ (game-ply game))
	  )))
    (cond
     ((game_won (game-player game) (game-position new_game))
      (setf (move-value move)  (- 100 (game-ply new_game))
	    (game-result new_game)  :won))
     (t
      ;;Number of occupied squares is the value
      (when (= (game-ply new_game) 9)
	(setf (game-result new_game) :stalemate)) 
      (setf (move-value move) (- 9 (game-ply new_game)))))
    new_game
    ))

(defun generate_moves (game
		       &aux (squares (unoccupied_squares (game-position game))))
  (unless (plusp (length squares))
    (setf (game-result game) :stalemate))
  (mapcar #'(lambda (sq) (make-move :square sq)) squares))

(defun play (&aux
	     (game (make-game))
	     squares
	     square
	     move)
  
  (display_game game)
  (setf squares (unoccupied_squares (game-position game)))
  (prompt squares)
  (tagbody
    begin
    (setf square (read))
    (unless (member square squares)
      (syntax square)
      (go begin))
    (format t "You chose ~d.~%" square)
    (setf move (make-move :square square)
	  game (apply_move game move))
    (display_game game)	
    (when (game-result game)
      (ecase (game-result game)
	(:won
	 (format t "You won! Congratulations.~%"))
	(:stalemate
	 (format t "It's a stalemate, mate!~%"))
	)
      (return-from play)
      )
    (setf move (time (alpha_beta game -1000 1000)))
    ;;(setf move (min_max game))
    (setf game (apply_move game move))
    (display_game game)
    (when (game-result game)
      (ecase (game-result game)
	(:won
	 (format t "I won. Perhaps the next time you will have more luck.~%"))
	(:stalemate
	 (format t "It's a stalemate, mate!~%")))
      (return-from play))
    (setf squares (unoccupied_squares (game-position game)))
    (prompt squares)
    (go begin)))


(defun display_game (game)
  (display_position (game-position game))
  (format t "Ply: ~d~%" (game-ply game))
  (format t "~C to move~%" (game-player game)))


(defun prompt (squares)
  (format t "Enter square (legal are ~a):~%" squares))

(defun syntax (square)
   (format t "Illegal move: ~d~%" square))

;;(play)