add blackjack

src/blackjack/blackjack.lisp

@@ -0,0 +1,131 @@
+(in-package #:tpd2.game.blackjack)
+
+(defparameter +one-deck+ 
+   (loop for s in +suits+ append (loop for i below +cards-per-suit+ collect (make-card :suit s :value i))))
+
+(defparameter +decks-per-shoe+ 2)
+(defparameter +reshuffle-proportion+ 1/6)
+
+(defstruct hand
+  cards
+  (stake 0))
+
+(defgame blackjack (coin-game)
+  (shoe)
+  (defplayer ()
+      ((hands nil)))
+  (:game-name "Blackjack")
+  (:advertised nil))
+
+(my-defun blackjack reshuffle ()
+  (my announce :shuffle)
+  (setf (my shoe) (random-shuffle (loop repeat +decks-per-shoe+ append +one-deck+))))
+
+(my-defun blackjack take-card ()
+  (pop (my shoe)))
+
+(my-defun blackjack take-cards (&optional (num 2))
+  (loop repeat num collect (my take-card)))
+
+(defun cards-value (cards)
+  (loop for card in cards
+	for c = (card-value card)
+	summing (min 10 (1+ c))))
+
+(my-defun hand value ()
+  (cards-value (my cards)))
+
+(my-defun hand bust ()
+  (< 21
+     (my value)))
+
+(defun cards-best-value (cards)
+  (let ((other 0) (aces 0))
+    (loop for card in cards
+	  for c = (card-value card)
+	  do
+	  (if (zerop c)
+	      (incf aces)
+	      (incf other (min 10 (1+ c)))))
+    (loop for ac in
+	  (let ((min aces))
+	    (list* min (loop repeat aces collect (incf min 9))))
+	  for val = (+ ac other)
+	  when (>= 21 val)
+	  maximizing val)))
+
+(my-defun hand blackjack ()
+  (= 21 (cards-best-value (my cards))))
+
+(my-defun blackjack 'play ()
+  (with-its-type (p blackjack-player)
+    (with-game
+      (loop 
+
+      (when (> (* +reshuffle-proportion+ +decks-per-shoe+ +cards-per-suit+ (length +suits+)) (length (my shoe)))
+	(my reshuffle)
+	(my new-state))
+
+      (with-join-spawn/cc ()
+       (loop for p in (my players)
+	     do
+	     (let-current-values (p) 
+	       (spawn/cc ()
+			 (setf (its hands p) (list (make-hand :stake (my move :select-new-stake p `(:integer 0 ,(max 1 (its coins p)))))))))))
+
+      (loop for p in (my players)
+	    do (setf (its hands p) (delete-if (lambda (h) (zerop (hand-stake h))) (its hands p))))
+
+      (loop for p in (my players)
+	    do (loop for h in (its hands p) 
+		     do (setf (hand-cards h) (my take-cards 2))))
+
+      (loop for p in (my players)
+	    do (loop for h in (its hands p) do
+		     (loop 
+			   while (my move :hit p :boolean)
+			   do (push (my take-card) (hand-cards h))
+			   (when (hand-blackjack h)
+			     (my announce :blackjack :player p :hand h)
+			     (return))
+			   (when (hand-bust h)
+			     (my announce :bust :player p :hand h)
+			     (return)))))
+
+      (let (hand)
+	(loop while (> 17 (cards-value hand))
+	      do (let ((c (my take-card)))
+		   (debug-assert c (hand me (my shoe)))
+		   (push c hand)
+		   (my announce :dealer :card c)))
+	(let ((val (cards-best-value hand)))
+	  (loop for p in (my players)
+		do (loop for h in (its hands p)
+			 for pval = (cards-best-value (hand-cards h))
+			 do (its give-coins p
+				(cond ((or (zerop pval) (> val pval))
+				       (- (hand-stake h)))
+				      ((= pval val)
+				       0)
+				      ((= 21 pval)
+				       (* 3/2 (hand-stake h)))
+				      (t
+				       (hand-stake h))))))))))))
+
+(my-defun hand 'object-to-ml ()
+  (<div :class "blackjack-hand"
+	(loop for c in (my cards)
+	      do (output-object-to-ml c))
+	(<p :class "stake" (my stake))
+	(when (my cards)
+	  (<p :class "value" "Value " (cards-best-value (my cards)))
+	  (cond ((my bust)
+		 (<p :class "bust" "Bust."))
+		((my blackjack)
+		 (<p :class "blackjack" "Blackjack!"))))))
+
+(my-defun blackjack-player 'object-to-ml ()
+  (<div :class "blackjack-player"
+	(call-next-method)
+	(loop for h in (my hands)
+	      do (output-object-to-ml h))))