;; replace A by 1, J by 11, Q by 12, K by 13
(defun NumericalHand (hand)
  (let ((new-hand nil) (cardvals nil) (straight nil))
    (setf new-hand
	  (mapcar #'(lambda (x) 
		      (cond ((eq (first x) 'A) (list 1 (second x)))
			    ((eq (first x) 'J) (list 11 (second x)))
			    ((eq (first x) 'Q) (list 12 (second x)))
			    ((eq (first x) 'K) (list 13 (second x)))
			    (t x)))
		  hand))
    (setf cardvals (sort (mapcar #'(lambda (x) (first x)) new-hand) #'<))
    (setf straight (and (eq (first cardvals) 1) (eq (second cardvals) 2) (eq (third cardvals) 3)
			(eq (fourth cardvals) 4) (eq (fifth cardvals) 5)))
    (if straight (SortHand new-hand)   ;; keep A's as 1's - have straight
	(SortHand (mapcar #'(lambda (x) (if (eq (first x) 1) (list 14 (second x)) x)) new-hand)))))
	
;; Sort hand by card value
(defun SortHand (hand)
  (sort hand #'(lambda (x y) (< (first x) (first y)))))

;; check if all cards are different
(defun All-Diff (cardvals)
  (and (< (first cardvals) (second cardvals)) (< (second cardvals) (third cardvals))
       (< (third cardvals) (fourth cardvals)) (< (fourth cardvals) (fifth cardvals))))

;; Evaluate hand from strongest to weakest
;; Input: 5 card hand
;; Return value:
;;   ((RoyalFlush Suit) ;; have royal flush give suit, otherwise nil
;;    (StraightFlush HighCard Suit)  ;; high card value & suit, otherwise nil
;;    (FourOfAKind CardVal)
;;    (FullHouse HighCardVal LowCardVal)   ;; HighCardVal - three of a kind value, LowCard - pair value
;;    (Flush HighCard Suit)
;;    (Straight HighCard)
;;    (ThreeOfAKind CardVal)
;;    (TwoPair HighCardVal LowCardVal)
;;    (Pair CardVal)
;;    HighCardVal)
(defun EvaluateHand (hand)
  (let ((cardvals (mapcar #'(lambda (x) (first x)) hand)) 
	(suits (mapcar #'(lambda (x) (second x)) hand))
	(suits-equal nil)
	(ret-val (list nil nil nil nil nil nil nil nil nil 
		       (if (eq (first (first hand)) 1) 14 (first (fifth hand))))))
    (setf suits-equal (every #'(lambda (x) (eq x (first suits))) (rest suits)))
    ;; check for Royal Flush
    (if (and suits-equal (eq (first cardvals) 10) (eq (fifth cardvals) 14))
	(setf (first ret-val) (list 'RoyalFlush (first suits))))
    (if (first ret-val) (return-from EvaluateHand ret-val))

    ;; check for Straight Flush
    (if (and suits-equal (eq (fifth cardvals) (+ (first cardvals) 4)))
	(setf (second ret-val) (list 'StraightFlush (fifth cardvals) (first suits))))
    (if (second ret-val) (return-from EvaluateHand ret-val))

    ;; check for Four of a Kind
    (cond ((eq (first cardvals) (fourth cardvals)) 
	   (setf (third ret-val) (list 'FourOfAKind (first cardvals))))
	  ((eq (second cardvals) (fifth cardvals)) 
	   (setf (third ret-val) (list 'FourOfAKind (second cardvals))))
	  (t nil))
    (if (third ret-val) (return-from EvaluateHand ret-val))

    ;; check for Full House
    (cond ((and (eq (first cardvals) (third cardvals))
		(eq (fourth cardvals) (fifth cardvals)))
	   (setf (fourth ret-val) (list 'FullHouse (first cardvals) (fourth cardvals))))
	  ((and (eq (first cardvals) (second cardvals))
		(eq (third cardvals) (fifth cardvals)))
	   (setf (fourth ret-val) (list 'FullHouse (third cardvals) (first cardvals))))
	  (t nil))
    (if (fourth ret-val) (return-from EvaluateHand ret-val))

    ;; check for Flush
    (if suits-equal (setf (fifth ret-val) (list 'Flush (fifth cardvals) (first suits))))
    (if (fifth ret-val) (return-from EvaluateHand ret-val))

    ;; check for Straight;;    CHECK THIS CAREFULLY
    (if (and (all-diff cardvals) (eq (fifth cardvals) (+ (first cardvals) 4)))
	(setf (sixth ret-val) (list 'Straight (fifth cardvals))))
    (if (sixth ret-val) (return-from EvaluateHand ret-val))

    ;; check for Three of a Kind
    (if (or (eq (first cardvals) (third cardvals))
	    (eq (second cardvals) (fourth cardvals))
	    (eq (third cardvals) (fifth cardvals)))
	(setf (seventh ret-val) (list 'ThreeOfAKind (third cardvals))))
    (if (seventh ret-val) (return-from EvaluateHand ret-val))

    ;; check for Two Pair
    (if (or (and (eq (first cardvals) (second cardvals))
		 (or (eq (third cardvals) (fourth cardvals))
		     (eq (fourth cardvals) (fifth cardvals))))
	    (and (eq (second cardvals) (third cardvals))
		 (eq (fourth cardvals) (fifth cardvals))))
	(setf (eighth ret-val) (list 'TwoPair (fourth cardvals) (second cardvals))))
    (if (eighth ret-val) (return-from EvaluateHand ret-val))

    ;; check for a Pair
    (cond ((eq (first cardvals) (second cardvals)) 
	   (setf (ninth ret-val) (list 'Pair (first cardvals))))
	  ((eq (second cardvals) (third cardvals)) 
	   (setf (ninth ret-val) (list 'Pair (second cardvals))))
	  ((eq (third cardvals) (fourth cardvals)) 
	   (setf (ninth ret-val) (list 'Pair (third cardvals))))
	  ((eq (fourth cardvals) (fifth cardvals)) 
	   (setf (ninth ret-val) (list 'Pair (fourth cardvals))))
	  (t nil))
    (if (ninth ret-val) (return-from EvaluateHand ret-val))
    ret-val
    ))


;; function to break ties; compare two hands until one card is higher or done
;; return 1 if hand1 is better, -1 if hand2 is better and 0 otherwise
(defun BreakTies (cvals1 cvals2)
  ;; (format t "~% cvals1 = ~A    cvals2 = ~A ~%" cvals1 cvals2)  
  (cond ((or (null cvals1) (null cvals2)) 0)
	((> (first cvals1) (first cvals2)) 1)
	((< (first cvals1) (first cvals2)) -1)
	(t (BreakTies (rest cvals1) (rest cvals2))))
)

;; given two hands of five cards each, determine if hand1 is stronger than hand2 
;; there are three possible return values
;; 1: hand1 is better
;; -1: hand2 is better
;; 0: hands are equal
(defun CompareHands (hand1 hand2)
  (let ((nhand1 (NumericalHand hand1))
	(nhand2 (NumericalHand hand2)) (hs1 nil) (hs2 nil) (cvals1 nil) (cvals2))
    (setf hs1 (EvaluateHand nhand1))
    (setf hs2 (EvaluateHand nhand2))
    (setf cvals1 (reverse (mapcar #'(lambda(x) (first x)) nhand1)))
    (setf cvals2 (reverse (mapcar #'(lambda(x) (first x)) nhand2)))

    ;; (format t "~% nhand1 = ~A   cvals1 = ~A    hs1 = ~A" nhand1 cvals1 hs1)
    ;; (format t "~% nhand2 = ~A   cvals2 = ~A    hs2 = ~A" nhand2 cvals2 hs2)
    (cond ((or (first hs1) (first hs2))
	   ;; one player has a RoyalFlush
	   (cond ((null (first hs1)) -1)  ;; hand2 is better
		 ((null (first hs2))  1)  ;; hand1 is better
		 (t 0)))
	  ;; one player has a StraightFlush
	  ((or (second hs1) (second hs2))
	   (cond ((null (second hs1)) -1)   ;; player2 has SF
		 ((null (second hs2))  1)   ;; player1 has SF
		 ((> (second (second hs1)) (second (second hs2))) 1)  ;; higher card
		 ((< (second (second hs1)) (second (second hs2))) -1) ;; higher card
		 (t 0)))  ;; hands equal
	   ;; one player has Four of a Kind
	  ((or (third hs1) (third hs2))
	   (cond ((null (third hs1)) -1)   ;; player2 has FofaK
		 ((null (third hs2))  1)   ;; player1 has FofaK
		 ((> (second (third hs1)) (second (third hs2))) 1)  ;; higher card
		 ((< (second (third hs1)) (second (third hs2))) -1) ;; higher card
		 (t (BreakTies cvals1 cvals2)))) ;; break ties by finding the highest card that differs 
;;		 ((< (tenth hs1) (tenth hs2)) -1) ;; player 2 has the high card
;;		 ((> (tenth hs1) (tenth hs2)) 1)  ;; player 1 has a high card
		 ;; (t 0)))   ;; hands equal
	  ;; one player has Full House
	  ((or (fourth hs1) (fourth hs2))
	   (cond ((null (fourth hs1)) -1)   ;; player2 has FH
		 ((null (fourth hs2))  1)   ;; player1 has FH
		 ((> (second (fourth hs1)) (second (fourth hs2))) 1)  ;; higher card
		 ((< (second (fourth hs1)) (second (fourth hs2))) -1) ;; higher card
		 (t 0)))   ;; hands equal
	  ;; one player has Flush
	  ((or (fifth hs1) (fifth hs2))
	   (cond ((null (fifth hs1)) -1)   ;; player2 has F
		 ((null (fifth hs2))  1)   ;; player1 has F
		 (t (BreakTies cvals1 cvals2))))   ;; break ties by finding the highest card that differs
		 ;; ((> (second (fifth hs1)) (second (fifth hs2))) 1)  ;; higher card
		 ;; ((< (second (fifth hs1)) (second (fifth hs2))) -1) ;; higher card
		 ;; (t 0)))   ;; hands equal
	  ;; one player has Straight
	  ((or (sixth hs1) (sixth hs2))
	   (cond ((null (sixth hs1)) -1)   ;; player2 has S
		 ((null (sixth hs2))  1)   ;; player1 has S
		 ((> (second (sixth hs1)) (second (sixth hs2))) 1)  ;; higher card
		 ((< (second (sixth hs1)) (second (sixth hs2))) -1) ;; higher card
		 (t 0)))   ;; hands equal
	  ;; one player has Three of a Kind
	  ((or (seventh hs1) (seventh hs2))
	   ;; (format t "~% Three of a Kind!!!! ~A ~A~%" (seventh hs1) (seventh hs2))
	   (cond ((null (seventh hs1)) -1)   ;; player2 has TofaK
		 ((null (seventh hs2))  1)   ;; player1 has TofaK
		 ((> (second (seventh hs1)) (second (seventh hs2))) 1)  ;; higher card
		 ((< (second (seventh hs1)) (second (seventh hs2))) -1) ;; higher card
;;		 ((< (tenth hs1) (tenth hs2)) -1) ;; player 2 has the high card
;;		 ((> (tenth hs1) (tenth hs2)) 1)  ;; player 1 has a high card
		 (t (BreakTies cvals1 cvals2))))   ;; hands equal
	  ;; one player has TwoPair
	  ((or (eighth hs1) (eighth hs2))
	   (cond ((null (eighth hs1)) -1)   ;; player2 has TofaK
		 ((null (eighth hs2))  1)   ;; player1 has TofaK
		 ((> (second (eighth hs1)) (second (eighth hs2))) 1)  ;; higher hard card
		 ((< (second (eighth hs1)) (second (eighth hs2))) -1) ;; higher high card
		 ((> (third (eighth hs1)) (third (eighth hs2))) 1)  ;; higher low card
		 ((< (third (eighth hs1)) (third (eighth hs2))) -1) ;; higher low card
;;		 ((< (tenth hs1) (tenth hs2)) -1) ;; player 2 has the high card
;;		 ((> (tenth hs1) (tenth hs2)) 1)  ;; player 1 has a high card
		 (t (BreakTies cvals1 cvals2))))  ;; hands equal
	  ;; one player has a Pair
	  ((or (ninth hs1) (ninth hs2))
	   (cond ((null (ninth hs1)) -1)   ;; player2 has Pair
		 ((null (ninth hs2))  1)   ;; player1 has Pair
		 ((> (second (ninth hs1)) (second (ninth hs2))) 1)  ;; higher card
		 ((< (second (ninth hs1)) (second (ninth hs2))) -1) ;; higher card
;;		 ((< (tenth hs1) (tenth hs2)) -1) ;; player 2 has the high card
;;		 ((> (tenth hs1) (tenth hs2)) 1)  ;; player 1 has a high card
		 (t (BreakTies cvals1 cvals2))))  ;; hands equal

	  ;; the strongest card wins
	  (t (cond ((< (tenth hs1) (tenth hs2)) -1) ;; player 2 has the high card
		   ((> (tenth hs1) (tenth hs2)) 1)  ;; player 1 has a high card
		   (t (BreakTies (reverse cvals1) (reverse cvals2))))))))  ;; hands equal
	   


(defun Dealer (rd nplayers)
  (let ((hole-cards nil) (discards nil) (communal nil) (deck rd))
    (dotimes (ind nplayers)
      (setf hole-cards (append hole-cards (list (list (first deck)))))
      (setf deck (rest deck))
      )
    (dotimes (ind nplayers) ;; second round
      (setf (nth ind hole-cards) (cons (first deck) (nth ind hole-cards)))
      (setf deck (rest deck)))

    ;; discard 1
    (setf discards (cons (first deck) discards))
    (setf deck (rest deck))
    ;; communal cards (first three)
    (setf communal (list (first deck) (second deck) (third deck)))
    (setf deck (rest deck))
    (setf deck (rest deck))
    (setf deck (rest deck))
    ;; one more discard
    (setf discards (cons (first deck) discards))
    (setf deck (rest deck))
    ;; one more communal
    (setf communal (append communal (list (first deck))))
    (setf deck (rest deck))
    ;; one more discard
    (setf discards (cons (first deck) discards))
    (setf deck (rest deck))
    ;; one more communal
    (setf communal (append communal (list (first deck))))
    (setf deck (rest deck))

    (list hole-cards discards communal)))

(defun shuffle (l)
	(do ((oldl l) (newl nil) (i 0 (+ i 1)) (elt 0))
	    ((= i (length l)) newl)
	    (setf elt (random (length oldl)))
	    (setf newl (cons (nth elt oldl) newl))
	    (setf oldl (remove (nth elt oldl) oldl))))

(defun make-deck ()
  (let ((new-deck nil) (all-cards'(A 2 3 4 5 6 7 8 9 10 J Q K)) (all-suits '(S H C D))) ;; '(spades hearts clubs diamonds)))
    (setf new-deck (append (mapcar #'(lambda (x) (list x (first all-suits))) all-cards)
			   (mapcar #'(lambda (x) (list x (second all-suits))) all-cards)
			   (mapcar #'(lambda (x) (list x (third all-suits))) all-cards)
			   (mapcar #'(lambda (x) (list x (fourth all-suits))) all-cards)))
    new-deck))