;; ----------------------------------------------
;;
;;              Program 4 Driver
;;                  CS 436
;;              November 11, 2004
;;                John Paxton
;;
;; ----------------------------------------------
;;
;; This file provides the driver for the Mancala
;; tournament that will be held on December 10 in
;; EPS 254 during class time.
;;
;; ----------------------------------------------

(defconstant *initial-stones-per-pit* 3)                   ;; stones/pit 
(defconstant *pits-per-player* 6)                          ;; pits/player
(defconstant *board-size* (+ 2 (* 2 *pits-per-player*)))   ;; size of board
(defconstant *white* 1)                                    ;; white player
(defconstant *black* 8)                                    ;; black player
(defconstant *no-error* 'no-error)                         ;; no error

;; ----------------------------------------------
;; WHITE-GET-MOVE: to be defined by you
;; ----------------------------------------------

(defun white-get-move ( board )
  (read)
)

;; ----------------------------------------------
;; BLACK-GET-MOVE: to be defined by you
;; ----------------------------------------------

(defun black-get-move ( board )
  (dotimes (i *pits-per-player* 0)
    (if (> (aref board (+ i *black*)) 0)
        (return (+ i *black*))
    )
  )
)

;; ----------------------------------------------
;; DRIVER 
;; ----------------------------------------------
;; This is the main function that controls the
;; flow of a mancala game between two players
;; ----------------------------------------------

(defun driver ()

  (do
   (
     (mancala-board (make-board))  ;; the mancala board
     (turn *white*)                ;; whose turn it is
      move                         ;; the pit to sow stones from
     (error-code *no-error*)       ;; error code
      mancala-copy                 ;; a copy of the mancala board
   )
   ((game-over-p mancala-board turn error-code) 
        (final-message mancala-board turn error-code))   ;; exit seq
     
     (print-board mancala-board) 

     (setf mancala-copy (copy-board mancala-board))
     (if (equal turn *white*)
         (setf move (time (white-get-move mancala-copy)))
	 (setf move (time (black-get-move mancala-copy)))
     ) 

     (format t "~%~a sows stones from pit ~a~%" (print-name turn) move)

     (if (legal-move-p turn move mancala-board)
         (setf turn (make-move turn move mancala-board))
	 (setf error-code turn)
     )
  ) 
)

;; ----------------------------------------------
;; COPY-BOARD
;; ----------------------------------------------
;; board: the mancala board
;; ----------------------------------------------
;; Make a copy of the mancala board to eventually
;; give to the player.  This allows the player to
;; destructively modify the board without changing
;; the original copy.
;; ----------------------------------------------

(defun copy-board ( board )
  (let
    ((result (make-array *board-size*)))  ;; copy of board

    (dotimes (i *board-size* result)
      (setf (aref result i) (aref board i))
    )
  )
)

;; ----------------------------------------------
;; FINAL-MESSAGE
;; ----------------------------------------------
;; board: the mancala board
;; turn: whose turn it is
;; error-code: denotes a possible illegal play
;; ----------------------------------------------
;; Clears the board and prints out a final message
;; regarding the results of the game.
;; ----------------------------------------------

(defun final-message ( board turn error-code )
  (clear-board board)
  (print-board board)
  (if (equal error-code *no-error*)
      (format t "~%White: ~a, Black: ~a~%" 
         (aref board (mancala-location *white*)) 
	 (aref board (mancala-location *black*)))
      (format t "~%~a made an illegal play and loses.~%" (print-name turn))
  )
)

;; ----------------------------------------------
;; CLEAR-BOARD
;; ----------------------------------------------
;; board: the mancala board
;; ----------------------------------------------
;; Places all remaining stones in the appropriate
;; mancalas.
;; ----------------------------------------------

(defun clear-board ( board )
  (dotimes (i *pits-per-player*)
    (setf (aref board (mancala-location *white*)) 
        (+ (aref board (mancala-location *white*)) (aref board (+ i *white*))))
    (setf (aref board (+ i *white*)) 0)
    (setf (aref board (mancala-location *black*)) 
        (+ (aref board (mancala-location *black*)) (aref board (+ i *black*))))
    (setf (aref board (+ i *black*)) 0)
  )
)

;; ----------------------------------------------
;; MAKE-MOVE
;; ----------------------------------------------
;; turn: whose turn it is
;; move: the move to make
;; board: the mancala board
;; ----------------------------------------------
;; Sows the stones from the appropriate pit.  
;; Returns whose move it is next.
;; ----------------------------------------------

(defun make-move ( turn move board )
  (let
    (
      (my-mancala (mancala-location turn))    ;; my mancala position
      (your-mancala (mancala-location (other-player turn)))
      (seeds (aref board move))               ;; number of seeds to sow
    )

    (setf (aref board move) 0)
    (do
      ((location move))                       ;; current board position
      ((= seeds 0) 
           (check-capture board location turn my-mancala)          ;; exit seq
           (if (= location my-mancala) turn (other-player turn)))  ;; exit seq

        (setf location (mod (+ 1 location) *board-size*))          ;; loop body
	(cond
	  ((not (= location your-mancala))    ;; don't put seeds in
	                                      ;; opponent's mancala
	    (setf (aref board location) (+ 1 (aref board location)))
	    (setf seeds (- seeds 1))
	  )
	)
    )
  )
)

;; ----------------------------------------------
;; CHECK-CAPTURE
;; ----------------------------------------------
;; board: the mancala board
;; location: the location of the last seed sown
;; turn: whose turn it is
;; mancala: location of current player's mancala
;; ----------------------------------------------
;; If the last stone is placed in an empty pit that
;; belongs to a player, all stones in the corresponding
;; column are captured.
;; ----------------------------------------------

(defun check-capture (board location turn mancala)
  (cond
    ((and (>= location turn) (< location (+ turn *pits-per-player*)) 
          (= 1 (aref board location)))
      (setf (aref board mancala) (+ 1 (aref board mancala)))
      (setf (aref board location) 0)
      (setf (aref board mancala) 
            (+ (aref board mancala) (aref board (- *board-size* location))))
      (setf (aref board (- *board-size* location)) 0)
    )
  )
)

;; ----------------------------------------------
;; MANCALA-LOCATION
;; ----------------------------------------------
;; turn: whose turn it is
;; ----------------------------------------------
;; Returns the location of the player's mancala
;; ----------------------------------------------

(defun mancala-location ( turn )
  (if (equal turn *white*) (+ 1 *pits-per-player*) 0)
)

;; ----------------------------------------------
;; OTHER-PLAYER
;; ----------------------------------------------
;; turn: whose turn it is
;; ----------------------------------------------
;; Returns the other player
;; ----------------------------------------------

(defun other-player ( turn )
  (if (equal turn *white*) *black* *white*)
)

;; ----------------------------------------------
;; PRINT-NAME
;; ----------------------------------------------
;; turn: whose turn it is 
;; ----------------------------------------------
;; Returns the printing name of whose turn it is
;; ----------------------------------------------

(defun print-name ( turn )
  (if (equal turn *white*) 'white 'black)
)

;; ----------------------------------------------
;; LEGAL-MOVE-P
;; ----------------------------------------------
;; turn: whose turn it is
;; move: the proposed pit to sow stones from
;; board: the mancala board
;; ----------------------------------------------
;; Returns t if the proposed move is a legal one
;; ----------------------------------------------

(defun legal-move-p ( turn move board )
  (and
    (>= move turn)
    (< move (+ turn *pits-per-player*))
    (> (aref board move) 0)
  )
)

;; ----------------------------------------------
;; GAME-OVER-P
;; ----------------------------------------------
;; board: the mancala board
;; turn: whose turn it is
;; error-code: signals if a player has made an error
;; ----------------------------------------------
;; Checks to see if the game is finished.
;; ----------------------------------------------

(defun game-over-p ( board turn error-code )
  (let
    ((result t))    ;; is the game over?

    (dotimes (i *pits-per-player*) ;; does the player have any non-empty pits?
      (if (not (= 0 (aref board (+ turn i))))
        (setf result nil)
      )
    )

    (if (not (equal error-code *no-error*))  ;; was an illegal move made?
        (setf result t)
    )

    result
  )
)

;; ----------------------------------------------
;; MAKE-BOARD
;; ----------------------------------------------
;; Constructs and returns the initial game board.
;; ----------------------------------------------

(defun make-board ()
  (let
    (
      (result (make-array *board-size*))  ;; mancala game board 
    )
    (dotimes (i (length result))
      (setf (aref result i) *initial-stones-per-pit*)
    )
    (setf (aref result (mancala-location *white*)) 0)
    (setf (aref result (mancala-location *black*)) 0)
    result
  )
)

;; ----------------------------------------------
;; PRINT-BOARD
;; ----------------------------------------------
;; board: the mancala board
;; ----------------------------------------------
;; Prints a readable representation of the mancala
;; board.  The black player is on the top and the
;; white player is on the bottom.
;; ----------------------------------------------

(defun print-board (board)
  (format t "~%")
  (print-separator)
  (print-pits board (+ 1 (* 2 *pits-per-player*)) -1)
  (print-mancalas board)
  (print-pits board 1 1)
  (print-separator)
)

;; ----------------------------------------------
;; PRINT-MANCALAS
;; ----------------------------------------------
;; board: the mancala board
;; ----------------------------------------------
;; Prints the row with the mancalas.
;; ----------------------------------------------

(defun print-mancalas (board)
  (format t "| ~2a " (aref board 0))
  (dotimes (i *pits-per-player*)
    (format t "    ")
  )
  (format t " ~2a|~%" (aref board (+ 1 *pits-per-player*)))
)

;; ----------------------------------------------
;; PRINT-PITS
;; ----------------------------------------------
;; board: the mancala board
;; start: the starting pit 
;; increment: how to calculate the next pit
;; ----------------------------------------------
;; Prints a row with pits in it.
;; ----------------------------------------------

(defun print-pits (board start increment)
  (format t "|    ")
  (dotimes (i *pits-per-player*)
    (format t " ~2a " (aref board (+ start (* i increment))))
  )
  (format t "   |~%")
)

;; ----------------------------------------------
;; Print-Separator
;; ----------------------------------------------
;; Prints a separator row for the mancala board.
;; ----------------------------------------------

(defun print-separator ()
  (dotimes (i (+ 2 *pits-per-player*))
    (format t "+---")
  )
  (format t "+~%")
)