;;; -*- Mode: Scheme -*-

;;; This plays a simplified version of checkers (without kings).
;;; For use in 6.034 at MIT EECS (by tlp@mit.edu).

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CHECKERS-SPECIFIC FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define *BOARD-WIDTH* 8)		; Checkers, must be even...
(define *BOARD-SIZE* 32)		; Only black positions are used.
(define *BOTTOM-PLAYER* #f)		; Player with low-numbered rows

(define *CHECKER-VALUE* 100)		; for static score
(define *POS-MULTIPLIER* 1)		; for static score
(define *RANDOM-SCORE* 10)		; magnitude of random static score component

;;; index into board vector given coordinates, recall only black positions are used.
(define (BOARD-INDEX i j)
  (and (>= i 0) (>= j 0)
       (< i *board-width*) (< j *board-width*)
       (cond ((and (even? i) (even? j))
	      (+ (* i (/ *board-width* 2)) (/ j 2)))
	     ((and (odd? i) (odd? j))
	      (+ (* i (/ *board-width* 2)) (/ (- j 1) 2)))
	     (else #f))))

;;; The coordinates for an index, inverse of above (I hope).

(define (BOARD-COORDINATES index)
  (and (>= index 0)
       (< index *board-size*)
       (let ((row (quotient index (/ *board-width* 2))))
	 (list row
	       (if (even? row) 
		   (* 2 (remainder index (/ *board-width* 2)))
		   (+ 1 (* 2 (remainder index (/ *board-width* 2)))))))))
	     
;;; Place the initial checker positions, with player at the low numbered rows.

(define (INITIAL-POSITION player)
  (set! *bottom-player* player)
  (let* ((board (make-board))
	 (position (make-position player board)))
    (scan-squares
     (lambda (index)
       (cond ((< index *board-width*)	; bottom of board
	      (set-board-entry board index player))
	     ((> index (- *board-size* *board-width* 1)) ; top of board
	      (set-board-entry board index (other-player player))))))
    (if *WINDOW* (display-position&moves position '()))
    position
    ))

(define (WINNING-POSITION-FOR? position player)
  ;; None of the pieces belong to the other player...
  (= 0 (count-player (position-board position) (other-player player))))

;;; Count the pieces to decide on the final score, assuming no moves left
;;; (final-score position player)

(define FINAL-SCORE count-player)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CHECKERS-SPECIFIC FUNCTIONS - LEGAL MOVE GENERATOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Legal move function for CHECKERS, returns a list of all the legal
;;; MOVE's from a position (for next-player).

(define (LEGAL-MOVES position)
  (let ((next-player (position-next-player position))
	(player (position-player position))
	(board (position-board position))
	(neighbors '())
	(captures '()))
    ;; Examine each location and if next-player is there, accumulate
    ;; the moves.  There are two kinds of moves: neighbor moves and
    ;; capture moves.  Capture moves are forced, so if have a capture
    ;; possible, we have to do it.
    (scan-squares
     (lambda (index)
       (let* ((entry (board-entry board index)))
	 (cond ((and entry (eq? entry next-player))
		(set! captures		; captures
		      (append (capture-moves index position) captures))
		(if (null? captures)	; don't bother with neighbors if we have captures
		    (set! neighbors
			  (append (neighbor-moves index position) neighbors))))))))
    ;; Captures are forced, so only return them.
    (if (null? captures)
	neighbors
	captures)))

;;; This is a bit hairy because we have to consider multiple jumps.

(define (CAPTURE-MOVES index position)
  (let* ((next-player (position-next-player position))
	 (player (position-player position))
	 (board (position-board position))
	 (coords (board-coordinates index))
	 (row-increment			; we're doing next-player moves
	  (if (eq? next-player *bottom-player*) 1 -1))
	 (moves '()))

    ;; Compute captures for a given direction (column increment, either +1 or -1).
    (define (consider col-increment)
      (let ((next-index			; the neighbor position
	     (board-index (+ (first coords) row-increment)
			  (+ (second coords) col-increment)))
	    (jump-index			; target after jumping
	     (board-index (+ (first coords) (* 2 row-increment))
			  (+ (second coords) (* 2 col-increment)))))
	(if (and next-index		; legal neighbor
		 jump-index		; legal jump
		 (eq? (board-entry board next-index) player) ; an opponent neighbor
		 (not (board-entry board jump-index)) ; an empty jump target
		 )
	    (let* ((new-mspec (make-move-spec index jump-index (list next-index)))
		   (follow-on-moves 
		    ;; See if we can keep jumping
		    (extend-moves 
		     new-mspec
		     (capture-moves jump-index ; start here
				    ;; new position after this jump
				    (position-after-move
				     new-mspec position
				     ;; note that we don't switch player!!
				     (position-player position) )))))
	      (set! moves
		    (if (null? follow-on-moves)	; no other jumps
			;; add a single jump to list of moves
			(cons (make-move new-mspec
					 (position-after-move 
					  new-mspec position 
					  ;; here we do switch player!!
					  (position-next-player position) ))  
			      moves)
			;; add the follow on moves - note this assumes
			;; that we cannot stop after the first move,
			;; so we do not add the single jump move to
			;; the list if we can keep going.
			(append follow-on-moves moves)))))))

    ;; Consider both directions
    (consider -1)
    (consider 1)
    ;; return the moves
    moves
    ))

;;; The moves argument are follow-on moves, this combines the
;;; information on start square and captures from mspec (the current
;;; single-jump move).

(define (EXTEND-MOVES mspec moves)
  (map (lambda (move)
	 (make-move (make-move-spec
		     (move-spec-from mspec) ; FROM
		     (move-spec-to (move-spec move)) ; TO
		     (append		; combine captures
		      (move-spec-captures mspec)
		      (move-spec-captures (move-spec move))))
		    (move-position move)))
       moves))

;;; The "regular" non-capture moves.

(define (NEIGHBOR-MOVES index position)
  (let* ((next-player (position-next-player position))
	 (player (position-player position))
	 (board (position-board position))
	 (coords (board-coordinates index))
	 (row-increment			; we're doing next-player moves.
	  (if (eq? next-player *bottom-player*) 1 -1))
	 (moves '()))

    (define (consider col-increment)
      (let ((next-index
	     (board-index (+ (first coords) row-increment)
			  (+ (second coords) col-increment))))
	;; if next-index is on board and nobody there, then add move to list.
	(if (and next-index (not (board-entry board next-index)))
	    (let ((new-mspec (make-move-spec index next-index '())))
	      (set! moves 
		    (cons (make-move new-mspec
				     (position-after-move 
				      new-mspec
				      position
				      (position-next-player position)))
			  moves))))))
    ;; Consider both directions
    (consider -1)
    (consider 1)
    ;; return list of moves
    moves
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CHECKERS-SPECIFIC FUNCTIONS - STATIC EVALUATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; The score is based simply on:
;;; a) count of checkers
;;; b) position of checkers (closer to enemy territory is better)
;;; c) a random component

(define (CHECKERS-STATIC-EVALUATION-FN position)
  (let* ((next-player (position-next-player position))
	 (player (position-player position))
	 (board (position-board position))
	 (score 0))

    (define (checker-score row)
      (+ *CHECKER-VALUE* (* *POS-MULTIPLIER* row row)))

    ;; Scan the board for checkers
    (scan-squares
     (lambda (index)
       (let* ((coords (board-coordinates index))
	      (i (first coords))
	      (j (second coords))
	      (entry (board-entry board index))
	      ;; row, counting from appropriate starting row for player
	      (row (if (eq? next-player *bottom-player*) 
		       i (- *board-width* i 1)))
	      (opp-row (if (eq? next-player *bottom-player*) 
			   (- *board-width* i 1) i)))
	 ;; A checker is here, update score.  Do nothing otherwise.
	 (if entry
	     (cond ((eq? entry next-player)
		    ;; This is positive, increment score
		    (set! score (+ score (checker-score row))))
		   (else
		    ;; Opponent, decrement score
		    (set! score (- score (checker-score opp-row))))))
	 )))

    ;; Add a random score to introduce some variation in the game...
    (if (> *RANDOM-SCORE* 0)
	(set! score (+ score (- (random (* 2 *RANDOM-SCORE*)) *RANDOM-SCORE*))))

    score))

;;; if one changes the function above, remember to re-evaluate this!!
(define STATIC-EVALUATION-FN-AUX CHECKERS-STATIC-EVALUATION-FN)