Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

add blackjack

  • Loading branch information...
commit b79ab3577c67909e85b7b231e1541ead69abe2a3 1 parent 4e6a6f9
@vii authored
Showing with 131 additions and 0 deletions.
  1. +131 −0 src/blackjack/blackjack.lisp
View
131 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))))
Please sign in to comment.
Something went wrong with that request. Please try again.