(defconstant *picture-card-values* '((A 1) (J 10) (Q 10) (K 10)))

(defvar *threshold-score* 100)

(defvar *players*)
(defvar *scores*)
(defvar *round-counter*)

(defun reset-game ()
  (format t "Please enter list of player names: ")
  (let ((player-names (read)))
    (setf *players* player-names))
  (let ((zero-score (make-list (length *players*) :initial-element 0)))
    (setf *scores* (make-list 1 :initial-element zero-score)))
  (setf *round-counter* 0))

(defun current-score (player-name)
  (let ((playerno (position player-name *players*)))
    (reduce #'+
      (mapcar #'(lambda (score-rec) (elt score-rec playerno)) *scores*))))

(defun current-wild-card ()
  'none) ; not EQUALP to any card

(defun card-value (card)
  (if (equalp card (current-wild-card))
    20
    (if (not (numberp card))
      (cadr (assoc card *picture-card-values*))
      card)))

(defun outcome->leftovers (raw-outcome)
  (let ((outcome (if (listp raw-outcome) raw-outcome (list raw-outcome))))
    (reduce #'+ (mapcar #'card-value (remove 'out outcome)))))

"Assume the players are in order (A B). If player A goes out with A and
4 remaining, then his outcome is (OUT A 4). His opponent player B has
10 J K remaining. You would type ((OUT A 4) (10 J K)) at the prompt."

(defun leftovers->scores (knocker opponent)
  (let ((knocker-score 0)
        (opponent-score 0))
    (if (< knocker opponent)
      (setq knocker-score (+ (- opponent knocker)
			     (if (equal 0 knocker) 25 0))) ; gin bonus
      (setq opponent-score (+ (- knocker opponent) 25)))   ; undercut bonus
    (list knocker-score opponent-score)))

(defun went-out (raw-outcome) 
  (let ((outcome (if (listp raw-outcome) raw-outcome (list raw-outcome))))
    (member 'OUT outcome)))

(defun outcome-list->scores (outcome-list)
  (let* ((knockernum (position-if #'went-out outcome-list))
         (opponentnum (position-if-not #'went-out outcome-list))
         (scores (leftovers->scores
                   (outcome->leftovers (elt outcome-list knockernum))
                   (outcome->leftovers (elt outcome-list opponentnum))))
	 (results (make-list (length outcome-list))))
    (setf (elt results knockernum) (car scores))
    (setf (elt results opponentnum) (cadr scores))
    results))

(defun score-this-round (outcome-list)
  (let ((score-list (outcome-list->scores outcome-list)))
    (if (>= *round-counter* (length *scores*))
      (nconc *scores* (list score-list)) ; allow further rounds to be appended
      (setf (elt *scores* *round-counter*) score-list))))

(defun print-current-score-for-player (player-name)
  (format t "The current score for ~A is ~A~%"
    player-name
    (current-score player-name)))

(defun print-current-scores ()
  (mapcar #'print-current-score-for-player *players*))

(defun round-descriptor (round-num)
  round-num)

(defun num-winning-hands (player)
  (let ((playerpos (position player *players*))
	(opponentpos (position (first (remove player *players*)) *players*)))
    (count-if #'(lambda (round-scores)
		  (> (elt round-scores playerpos)
		     (elt round-scores opponentpos))) *scores*)))

(defun tally-final-scores ()
  (let* ((winner (winning-player-name))
         (opponent (first (remove winner *players*)))
	 (winner-finalscore (current-score winner))
	 (opponent-finalscore (current-score opponent)))
    ; First to reach 100 gets a bonus
    (format t "~A broke ~A first, earning a bonus of 100.~%" winner
     *threshold-score*)
    (incf winner-finalscore 100)
    ; If loser wins 0 hands then winner's score is doubled
    (let* ((winner-hands (num-winning-hands winner))
	   (opponent-hands (num-winning-hands opponent)))
      (if (zerop opponent-hands)
	  (progn
	    (format t "~A gets double score for a shutout!~%" winner)
	    (setf winner-finalscore (* 2 winner-finalscore))))
      ; Each player receives 25 points for each winning hand
      (let ((winner-line-bonus (* 25 winner-hands))
	    (opponent-line-bonus (* 25 opponent-hands)))
	(format t "Winning hands (line) bonuses: ~A: ~A, ~A: ~A~%"
		winner winner-line-bonus opponent opponent-line-bonus)
	(incf winner-finalscore winner-line-bonus)
	(incf opponent-finalscore opponent-line-bonus))
      ; Print final scores
      (format t "Final scores: ~A: ~A, ~A: ~A (difference of ~A)~%"
	      winner winner-finalscore opponent opponent-finalscore
	      (abs (- winner-finalscore opponent-finalscore))))))

(defun do-one-round ()
  (if (game-is-over)
    (error "The game is already over"))
  (format t "The current round is round ~A~%"
	(round-descriptor *round-counter*))
  (format t "Enter outcomes for this round in order ~A: " *players*)
  (let ((this-round-outcomes (read)))
	(score-this-round this-round-outcomes)
	(print-current-scores)
    (if (game-is-over) (tally-final-scores))))

(defun winning-player-name ()
  (find-if
   #'(lambda (player) (>= (current-score player) *threshold-score*))
   *players*))

(defun play-till (score)
  (setf *threshold-score* score)
  (format t "Ok, playing till ~A.~%" *threshold-score*))

(defun game-is-over ()
  (not (null (winning-player-name))))

(defun run-game ()
  (reset-game)
  (do ((*round-counter* 0 (1+ *round-counter*)))
      ((game-is-over))
    (do-one-round))
  (format t "Game over.~%"))