;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constants & global variables

(defconstant mhz 866.0)

(defconstant open_block '-)
(defconstant closed_block '*)
(defconstant player1 'x)
(defconstant player2 'o)
(defconstant player3 'v)
(defconstant d8 '((0 -1) (1 -1) (1 0) (1 1) (0 1) (-1 1) (-1 0) (-1 -1)))

;; note that this is only used by the sample player
(defconstant ms-per-node-est (/ (* 0.003 mhz) 866.0))

(unless (boundp 'verbose) (defparameter verbose t))

(setq first-round? t)

(defmacro make-isogame-instance (board)
  `#'(lambda (maxtime p1 p2 p3)
       (let ((winner (isogame maxtime p1 p2 p3 ,board)))
	 (cond ((equal winner 'x) p1)
	       ((equal winner 'o) p2)
	       ((equal winner 'v) p3)
	       (t (progn (format t "AGGGGGGGGGGGGGGH~%") p1))))))

(defun isogame (max-time player1-func player2-func player3-func board)
  (let ((xpos (iso-get-player-pos player1 board))
        (opos (iso-get-player-pos player2 board))
	(vpos (iso-get-player-pos player3 board))
        (xtime max-time)
        (otime max-time)
	(vtime max-time)
	(p1-in-play t)
	(p2-in-play t)
	(p3-in-play t)
        (turn player1)
        (move)(start-time)(ms))

    (when verbose
      (format t "~A vs. ~A vs. ~A~%" player1-func player2-func player3-func)
      (format t "Starting position:~%")
      (iso-print-board board))

    ;; mark as first round
    (setq first-round? t)

    (do ((n 3 (1+ n)))
        (nil)

     ; (sleep 1)

      ;; check to see if two players are out of play
      (cond ((and (not p1-in-play) (not p2-in-play)) (return-from isogame player3))
	    ((and (not p1-in-play) (not p3-in-play)) (return-from isogame player2))
	    ((and (not p2-in-play) (not p3-in-play)) (return-from isogame player1)))

      (setf start-time (get-time-ms))

      ;; make a move for player 1
      (when (and (equal turn player1) p1-in-play)
        (if verbose (format t "Round ~A: Player ~A to move... (~Ams left)~%"
                            (floor (/ n 3)) player1 xtime))
        (setf move (funcall player1-func turn xpos opos vpos xtime board))
        (setf ms (- (get-time-ms) start-time))
        (setf xtime (- xtime ms))
        (when (< xtime 0)
          (format t "Player ~A used too much time (~Ams)...~%"
                  player1 ms)
          ;;(return-from isogame player2)
	  ;; for 3 players, instead of returning a winner here, just set player1
	  ;; as out of play.
	  (setf p1-in-play nil)
	  (sleep 5)
	  )

	;; when move is nil, the player cannot move and has lost
	(when (not (first move))
	  (format t "Player ~A cannot move and has lost.~%" player1)
	  (setf p1-in-play nil)
	  (sleep 5)
	  )
        (when (and p1-in-play (not (iso-legal? xpos move board)))
	  (format t "Player ~A made an illegal move and is now out of play.~%" player1)
	  (setf p1-in-play nil)
	  (sleep 5)
	  )
	(when p1-in-play 
          (setf board (iso-effect-move turn xpos move board))
          (setf xpos move))
	(when verbose 
	  (format t "Player ~A used ~Ams deciding to move to ~A~%" turn ms move)
	  )
	)


      ;; make a move for player 3
      (when (and (equal turn player3) p3-in-play)
        (if verbose (format t "Round ~A: Player ~A to move... (~Ams left)~%"
                            (floor (/ n 3)) player3 vtime))
        (setf move (funcall player3-func turn xpos opos vpos vtime board))
        (setf ms (- (get-time-ms) start-time))
        (setf vtime (- vtime ms))
        (when (< vtime 0)
          (format t "Player ~A used too much time (~Ams)...~%"
                  player3 ms)
          ;;(return-from isogame player2)
	  ;; for 3 players, instead of returning a winner here, just set player1
	  ;; as out of play.
	  (setf p3-in-play nil)
	  )
	(when (not (first move))
	  (format t "Player ~A cannot move and has lost.~%" player3)
	  (setf p3-in-play nil)
	  )
        (when (and p3-in-play (not (iso-legal? vpos move board)))
	  (format t "Player ~A made an illegal move and is now out of play.~%" player3)
	  (setf p3-in-play nil)
	  )

	(when p3-in-play 
          (setf board (iso-effect-move turn vpos move board))
          (setf vpos move))
	(when verbose 
	  (format t "Player ~A used ~Ams deciding to move to ~A~%" turn ms move)
	  )
	)
      
      ;; make a move for player 2
      (when (and (equal turn player2) p2-in-play)
        (if verbose (format t "Round ~A: Player ~A to move... (~Ams left)~%"
                            (floor (/ n 3)) player2 otime))
        (setf move (funcall player2-func turn xpos opos vpos otime board))
        (setf ms (- (get-time-ms) start-time))
        (setf otime (- otime ms))
        (when (< otime 0)
          (format t "Player ~A used too much time (~Ams)...~%"
                  player2 ms)
          ;;(return-from isogame player2)
	  ;; for 3 players, instead of returning a winner here, just set player1
	  ;; as out of play.
	  (setf p2-in-play nil)
	  )
	(when (not (first move))
	  (format t "Player ~A cannot move and has lost.~%" player2)
	  (setf p2-in-play nil)
	  )
        (when (and p2-in-play (not (iso-legal? opos move board)))
	  (format t "Player ~A made an illegal move and is now out of play.~%" player2)
	  (setf p2-in-play nil)
	  )
	(when p2-in-play 
          (setf board (iso-effect-move turn opos move board))
          (setf opos move))
	(when verbose 
	  (format t "Player ~A used ~Ams deciding to move to ~A~%" turn ms move)
	  )
	)

      (iso-print-board board)
      
      (format t "Player ~A has completed his turn.~%" turn)
      
      (cond ((equal turn player1) (setf turn player2))
         ((equal turn player2) (setf turn player3))
	   ;; if player 3 just finished, also set first-round? to nil
         ((equal turn player3) (setf turn player1) (setq first-round? nil))
	 )
      ))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Code for a sample player for testing purposes

(defun iso-random-player (turn xpos opos vpos time-left board)
  (let ((my-pos)(his-pos)(moves)(nMoves))

    (when (equal turn player1)
      (setf my-pos xpos)
      (setf his-pos opos))
    (when (equal turn player2)
      (setf my-pos opos)
      (setf his-pos xpos))
    (when (equal turn player3)
      (setf my-pos vpos)
      (setf his-pos xpos))

    (when (null my-pos)
      (return-from iso-random-player (iso-find-best-start-pos board)))

    (setq moves (iso-gen-moves my-pos board))
    (setq nMoves (length moves))
    (cond ((= nMoves 0) (setq ret '(nil nil)))
	  (t (setq ret (nth (random nMoves) moves))))
    ret
    ))

;; in case we don't have a start position, this is a cheap way
;;  to find something decent
(defun iso-find-best-start-pos (board)
  (let ((width (iso-board-width board))
        (height (iso-board-height board))
        (bestScore -1)
        (bestMove)(move)(score))

    (do ((iRow 2 (1+ iRow)))
        ((>= iRow height) bestMove)
      
      (do ((iCol 2 (1+ iCol)))
          ((>= iCol width) bestMove)
        
        (setq move (iso-build-move iCol iRow))
        (when (iso-open? move board)
          (setq score (length (iso-gen-moves move board)))
          (when (> score bestScore)
            (setq bestMove move)
            (setq bestScore score)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internally used functions

;; has the given player won?
(defun iso-win? (player board)
   (and
     (null (iso-gen-moves (iso-get-player-pos (iso-next-player player) board)  board))
     (null (iso-gen-moves (iso-get-player-pos (iso-next-player2 player) board) board))))

;; if player == x, return o.  
;; if player == o, return v.
;; else, return x.
(defun iso-next-player (player)
  (cond ((equal player player1) player2)
	((equal player player2) player3)
	(t player1)))

;; returns the player after the next player
(defun iso-next-player2 (player)
  (cond ((equal player player1) player3)
	((equal player player2) player1)
   	(t player2)))


;; is the given position on the board?
(defun iso-on-board? (move board)
  (let ((w (iso-board-width board))
        (h (iso-board-height board))
        (x (iso-get-x move))
        (y (iso-get-y move)))
    (and (> x 0) (> y 0) (<= x w) (<= y h))))    

(defun iso-open? (move board)
  (equal (iso-get-square move board) open_block))

;; is it posible to move from position a to b on the given board?
(defun iso-path-free? (a b board)
  ;(format t "a: ~A  b: ~A~%" a b)
  (let* ((ax (iso-get-x a))
         (ay (iso-get-y a))
         (bx (iso-get-x b))
         (by (iso-get-y b))
         (dx (- bx ax))
         (dy (- by ay)))
    (if (not (or (equal (abs dx) (abs dy))
                 (equal dx 0)
                 (equal dy 0))) (return-from iso-path-free? nil))
    (setf dx (cond ((> dx 0) 1)((< dx 0) -1)(t 0)))
    (setf dy (cond ((> dy 0) 1)((< dy 0) -1)(t 0)))
    (do ((x (+ ax dx) (+ x dx))
         (y (+ ay dy) (+ y dy)))
        ((and (equal x bx) (equal y by)) t)
      (if (not (equal (iso-get-square (iso-build-move x y) board) open_block))
          (return-from iso-path-free? nil)))))

;; is the given move iso-legal?
(defun iso-legal? (start move board)
  ;(format t "start: ~A  move: ~A~%" start move)
  (and (iso-on-board? move board) (iso-open? move board)
       (or (null start) (iso-path-free? start move board))))


;; given a player and his move, update the board
(defun iso-effect-move (player oldpos move board)
  (iso-set-board-pos player move
                 (if (null oldpos) board
                   (iso-set-board-pos closed_block oldpos board))))

;; set the square at the given position (move) to symbol
(defun iso-set-board-pos (symbol move board)
  (let ((x (iso-get-x move))
        (y (iso-get-y move)))
    (cond ((null board) nil)
          ((<= y 1) (cons (iso-set-row-pos symbol x (first board)) (rest board)))
          (t (cons (first board)
                   (iso-set-board-pos symbol (iso-addm move '(-1 0)) (rest board)))))))

;; set the xth position of the row to symbol
(defun iso-set-row-pos (symbol x row)
  (cond ((null row) nil)
        ((<= x 1) (cons symbol (rest row)))
        (t (cons (first row) (iso-set-row-pos symbol (1- x) (rest row))))))

;; make a board with the given size representing the playable area
(defun iso-make-board (width height)
  (cons (iso-make-row closed_block (+ width 2))
        (append
         (iso-make-interior-rows (+ width 2) height)
        (list (iso-make-row closed_block (+ width 2))))))

;; helper function to make a board
(defun iso-make-interior-rows (width n)
  (cond ((<= n 0) nil)
        (t (cons (iso-make-row open_block width)
                 (iso-make-interior-rows width (1- n))))))

;; create a row filled with the given block symbol
(defun iso-make-row (block width)
  (cons closed_block (append (nlist block (- width 2)) (list closed_block))))

;; pretty print a board
(defun iso-print-board (board)
  (mapcar #'(lambda (x) (format t "~A~%" x)) board)
  (format t "~%"))

;; given a player find his position on a board
(defun iso-get-player-pos (player board)
  (iso-get-player-pos2 player board 1))

;; helper function to find a player's position
(defun iso-get-player-pos2 (player board y)
  (cond ((null board) nil)
        ((member player (first board) :test #'equal)
         (iso-build-move (iso-get-player-pos-row player (first board) 1) y))
        (t (iso-get-player-pos2 player (rest board) (1+ y)))))

;; find a player on a row
(defun iso-get-player-pos-row (player row x)
  (cond ((null row) nil)
        ((equal player (first row)) x)
        (t (iso-get-player-pos-row player (rest row) (1+ x)))))

;; return the symbol at the given position on the board
(defun iso-get-square (move board)
  (let ((x (1- (iso-get-x move)))
        (y (1- (iso-get-y move))))
    (nth x (nth y board))))

;; return the x coordinate (column) of a position
(defun iso-get-x (move)
  (second move))

;; return the y coordinate (row) of a position
(defun iso-get-y (move)
  (first move))

;; return the width of a board
(defun iso-board-width (board)
  (length (first board)))

;; return the height of a board
(defun iso-board-height (board)
  (length board))

;; if (player == X) return O else return X
(defun iso-other-player (player)
  (if (equal player player1) player2 player1))

;; build a position from an x and y coordnate
(defun iso-build-move (x y)
  (list y x))

;; add to moves together
(defun iso-addm (x y)
  (list (+ (first x) (first y))
        (+ (second x) (second y))))

;; count total number of open squares on a board
(defun iso-count-open-spaces (board)
  (apply #'+ (mapcar #'iso-count-open-spaces-row board)))

;; count total number of open squares on a row
(defun iso-count-open-spaces-row (row)
  (let ((n 0))
    (dolist (p row n)
      (if (equal p open_block) (setf n (1+ n))))))

;; generate moves all legal moves from the given position on the given board
(defun iso-gen-moves (start board)
  (iso-gen-moves2 start board d8 nil))

;; try to move in every direction
(defun iso-gen-moves2 (start board dirs moves)
  (if (null dirs) moves
    (iso-gen-moves2 start board (rest dirs)
                (iso-gen-moves3 (iso-addm start (first dirs))
                            board (first dirs) moves))))

;; see how far we can go in the given direction
(defun iso-gen-moves3 (start board dir moves)
  (if (iso-open? start board)
      (iso-gen-moves3 (iso-addm start dir) board dir (cons start moves))
    moves))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sample Boards

(defconstant iso-board01
  '((* * * * * * * *)
    (* - - - - - - *)
    (* - - - - - - *)
    (* - - - - - - *)
    (* - - - - - - *)
    (* - - - - - - *)
    (* * * * * * * *)))

(defconstant iso-board-small
  '((* * * * * * * *)
    (* - - - - - - *)
    (* - X - - O - *)
    (* - - - - - - *)
    (* - - V - - - *)
    (* - - - - - - *)
    (* * * * * * * *)))

(defconstant iso-map1
  '((* * * * * * * * * * * * * * * * * * * * * *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - X - O - - V - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* * * * * * * * * * * * * * * * * * * * * *)))

(defconstant iso-map2
  '((* * * * * * * * * * * * * * * * * * * * * *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - * * V - - - - - - - - *)
    (* - - - - - - - * * * * * * - - - - - - - *)
    (* - - - - - - - * * * * * * - - - - - - - *)
    (* - - - - - - * * * * * * * * - - - - - - *)
    (* - - - - - - * * * * * * * * - - - - - - *)
    (* - - - - - - - * * * * * * - - - - - - - *)
    (* - - - - - - - * * * * * * - - - - - - - *)
    (* - - - - - - - - X * * O - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)  
    (* * * * * * * * * * * * * * * * * * * * * *)))

(defconstant iso-map3
  '((* * * * * * * * * * * * * * * * * * * * * *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - X O - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - V - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* - - - - - - - - - - - - - - - - - - - - *)
    (* * * * * * * * * * * * * * * * * * * * * *)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Here are some testing functions!

;; Notice that the (position) call in compete-many will always return 
;; player #2 as the winner whether player #2 or player #3 wins because 
;; they are (equal) 
(defun iso3-test-me (rounds who time board)
  (let ((iso3 (make-isogame-instance board)))
    (compete-many rounds iso3 3 time 
		  who #'iso-random-player #'iso-random-player)))

(defun player-xxx (turn xpos opos vpos time-left board)
  (iso-random-player turn xpos opos vpos time-left board))

; (iso3-test-me 3 #'player-xxx 100000 iso-map3)
; (iso3-test-me 3 #'player-xxx 10000 iso-map3)
; (iso3-test-me 3 #'player-xxx 10000 iso-board-small)