Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

132 lines (110 sloc) 3.573 kb
(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 'player-full-state-to-ml ()
(<div :class "blackjack-player"
(call-next-method)
(loop for h in (my hands)
do (output-object-to-ml h))))
Jump to Line
Something went wrong with that request. Please try again.