;;;; poker.lisp

(in-package #:poker)

(defvar *deck* nil)
(defvar *players* nil)
(defvar *community-cards* nil)
(defvar *small-blind-name* nil)
(defvar *large-blind-amount* 2)
(defvar *small-blind-amount* 1)
(defvar *last-to-act* nil)
(defvar *next-to-act* nil)
(defvar *game-small-blind-name* nil)
(defvar *game-active* nil)

(defun %game ()
 "Try test-run instead, or step through manually
  ; currently (round-active) never 'finishes'
  by itself, and (score-game) is unimplemented"

	(loop while (no-winner)
	 do (setup-game)
	 do (loop while (game-active)
	     do (setup-round)
	     do (loop while (round-active)
		 do (get-action))
	     do (reveal-shared))
	 do (score-game)))

(defun test-run ()
 "Step through likely usage relevant to 'game'
 ;;Setup
 (setf *players* nil)
 (dotimes (n 3) (add-player))
 ;;Tournament game loop condition
 (format t "No-winner: ~a is t~%" (no-winner))
 ;;Generate deck, deal hands.
 (setup-game)
 ;;Check players (hands, for examples)
 (format t "~{~a~%~}~%" *players*)
 ;;Check game-active 
 ;;- more than one player has money,
 ;;- and the river has not been played yet
 (format t "game-active: ~a is t~%" (game-active))
 ;;Setup round - bid blinds, set up action ..
 (setup-round)
 ;;Check players bids, who is active next
 (format t "~{~a~%~}~%" *players*)
 ;;round-active - there is more action in this round
 (format t "round-active: ~a is t%" (round-active))
				;bug in (round-active)
 ;;get-action - test calling works.
 (with-input-from-string (*standard-input* "call")
  (get-action))
 ;;Check players bids, who is active next
 (format t "~{~a~%~}~%" *players*)
 ;;Repeat that a bunch for standard gameplay

 ;;reveal-shared - advance *community-cards*
 (format t "~{~a~^ ~}~%" *community-cards*)
 (reveal-shared)
 (format t "~{~a~^ ~}~%" *community-cards*)
 ;; ... advances properly

 ;;Scoring - unimplemented
 (score-game))

(defun raise (player n)
 (let ((can-raise (min n (cdr (assoc 'balance player)))))
	(decf (cdr (assoc 'balance player)) can-raise)
	(incf (cdr (assoc 'in-for player)) can-raise)
	(values)))

(defun nrotate-players (&optional (name-to-front nil))
	(cond ((null name-to-front) (let ((player (pop *players*)))
					(nconc *players* (list player)))
		(values))
	      (name-to-front (if (eq (cdr (assoc 'name (car *players*)))
				     name-to-front)
				 (values)
				(let ((count -1)
					(max-tries (length *players*)))
				 (loop while (or (= (incf count) max-tries)
						(not (eq name-to-front
						 (cdr (assoc 'name 
							(car *players*))))))
					do (nrotate-players))
				 (values))))
	      (t (error "rotate failed"))))

(defun add-player (&optional (name (gensym)) (balance 500) (in-for 0) (folded nil) (hand nil))
 (let ((name `(name . ,name))
       (balance `(balance . ,balance))
       (in-for `(in-for . ,in-for))
       (folded `(folded . ,folded))
       (hand `(hand . ,hand)))
  (if (null *players*)
   (setf *players* (list (list name balance in-for folded hand)))
   (push (list name balance in-for folded hand) *players*))))

(defun fresh-deck ()
	(let ((deck nil)
	      (suits '(clubs spades diamonds hearts))
	      (ranks '(two three four five six seven
			eight nine ten jack queen king 
			ace)))
	 (loop for suit in suits
		do (loop for rank in ranks
			do (push (cons rank suit) deck)))
	 (alexandria:shuffle deck)))




(defun score-game () nil)

(defun reveal-shared ()
 (case (length *community-cards*)
  (0 (setf *community-cards* 
	   (list (pop *deck*) (pop *deck*) (pop *deck*))))
  (3 (nconc *community-cards* (list (pop *deck*))))
  (4 (nconc *community-cards* (list (pop *deck*))))
  (5 (setf *game-active* nil))))

(defun get-action ()
 (when (and (< 0 (cdr (assoc 'balance (car *players*))))
	(not (cdr (assoc 'folded (car *players*)))))
 (let* ((call-price (min (cdr (assoc 'balance (car *players*)))
			 (- (get-current-bid) 
			    (cdr (assoc 'in-for (car *players*))))))
	(min-raise (min (- (cdr (assoc 'balance (car *players*)))
			   call-price)
			(+ (get-current-bid) *large-blind-amount*))))
  (format t "Your cards are ~{~a~^ ~}~%" (cdr (assoc 'hand (car *players*))))
  (when *community-cards*
   (format t "Community cards are ~{~a~^ ~}~%" *community-cards*))
  (format t "You are current in for ~a~%" (cdr (assoc 'in-for (car *players*))))
  (format t "Your current balance is ~a~%" (cdr (assoc 'balance (car *players*))))
  (format t "You can call for ~a~%" call-price)
  (when (> min-raise 0) (format t "Your minimum raise is ~a~%" min-raise))
  (format t "You could always fold.~%~%")

  (format t "Please enter 'call', 'raise 123' or 'fold' and press return.~%")
  (format t "So to raise by five,
  ```
  raise 5
  ```
  allowing for your situation.")
  (format t "Specially,
  ```
  r
  ```
  will raise by ~a.~%" min-raise)
  (format t "If I can't understand you, I assume you mean to call.~%")
  (let ((input (read-line)))
   (cond 
    ((string= "fold" input)
     (setf (cdr (assoc 'folded (car *players*))) t))
    ((string= "r" input)
     (raise (car *players*) min-raise)
     (setf *last-to-act* (cdr (assoc 'name (car *players*)))))
    ((and
      (< 5 (length input))
      (string= "raise " (subseq input 0 6))
      (plusp min-raise)
      (integerp (ignore-errors (parse-integer (subseq input 6))))
      (>= (parse-integer (subseq input 6)) min-raise)
      (<= (parse-integer (subseq input 6))
	  (cdr (assoc 'balance (car *players*)))))
      (raise (car *players*) (parse-integer (subseq input 6)))
      (setf *last-to-act* (cdr (assoc 'name (car *players*)))))
    (t (raise (car *players*) call-price))))
    (nrotate-players)
    (setf *next-to-act* (cdr (assoc 'name (car *players*))))
    (values))))

(defun get-current-bid ()
 (reduce #'max (mapcan (lambda (x) (list (cdr (assoc 'in-for x)))) *players*)))

(defun round-active ()
 "There are players who didn't fold."
 (let ((hasnt-folded
	(mapcan (lambda (x) (and (null (cdr (assoc 'folded x)))
				 (< 0 (cdr (assoc 'balance x)))
				 (list x)))
		*players*)))
  (if (< 1 (length hasnt-folded)) t nil)))

(defun setup-round ()
 "Pay blinds, update next blind, set last and next active player"
 (nrotate-players *small-blind-name*)
 (raise (car *players*) *small-blind-amount*)
 (nrotate-players)
 (setf *small-blind-name* (cdr (assoc 'name (car *players*))))
 (raise (car *players*) *large-blind-amount*)
 (setf *last-to-act* (cdr (assoc 'name (car *players*))))
 (nrotate-players)
 (setf *next-to-act* (cdr (assoc 'name (car *players*))))
 (values))
 
(defun game-active ()
 "Actually just needs to check the game hasn't ended"
 (let ((has-money
	(mapcan (lambda (x) (and (< 0 (cdr (assoc 'balance x)))
				 (list x)))
		*players*)))
  (cond 
   ((= 1 (length has-money)) (format t "The winner is ~a~%" 
		(cdr (assoc 'name (car has-money))))
      (values))
   ((not *game-active*) ;; score
    (format t "Scoring game...~%")
    (values))
   (t (values t)))))

(defun setup-game ()
 (setf *deck* (fresh-deck))
 (dolist (player *players*)
	(dotimes (n 2) (push (pop *deck*) (cdr (assoc 'hand player)))))
 (select-game-small-blind)
 (setf *game-active* t))

(defun select-game-small-blind ()
 (if (null *game-small-blind-name*)
  (setf *game-small-blind-name* (cdr (assoc 'name (car *players*))))
  (progn (nrotate-players)
	 (setf *game-small-blind-name* (cdr (assoc 'name (car *players*))))))
 (setf *small-blind-name* *game-small-blind-name*)
 (when (= 0 (cdr (assoc 'balance (car *players*))))
  (select-game-small-blind)))

(defun no-winner ()
 "Checks if one person has won the tournament; 
 prints who in that case or else t"
 (let ((+ve-balances-on 
	(mapcan (lambda (x) (and (< 0 (cdr (assoc 'balance x)))
					 (list x)))
		*players*)))
  (case (length +ve-balances-on)
   (1 (format t "The winner is ~a~%" 
		(cdr (assoc 'name (car +ve-balances-on))))
      (values))
   (t (values t)))))