;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;                          Blackjack
;; 
;; The standard rules apply. Specifics:
;; 
;;   1 player (not counting the dealer)
;; 
;;   4 decks, reshuffled after 3/4 of the cards are used
;; 
;;   Dealer stands on soft 17s
;; 
;;   Splitting allowed only on the first two cards, and only if they
;;    are equal; 10 and the face cards are all considered equal for
;;    splitting
;; 
;;   Doubling allowed on all unsplit hands, not on split hands
;; 
;;   No blackjacks after splitting
;; 
;;   No surrender
;; 
;;   No insurance
;; 
;;   No maximum under-21 hand size
;; 
;;   Dealer's second card is not revealed if the player busts (or
;;     both halves of a split hand bust)
;; 
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module blackjack mzscheme
  (require (lib "cards.ss" "games" "cards")
	   (lib "mred.ss" "mred")
	   (lib "class.ss")
           (lib "unit.ss")
	   (lib "list.ss"))
  
  (provide game-unit)
  
  (define game-unit
    (unit
      (import)
      (export)
      
      ;; Number of decks to use
      (define DECK-COUNT 4)
      
      ;; Region layout constants
      (define MARGIN 10)
      (define SUBMARGIN 10)
      (define LABEL-H 15)
      
      ;; Randomize
      (random-seed (modulo (current-milliseconds) 10000))
      
      ;; Reshuffle when 3/4 of the deck is used
      (define min-deck-size (/ (* DECK-COUNT 52) 4))
      
      ;; Set up the table
      (define t (make-table "Blackjack" 6 3))
      (define status-pane (send t create-status-pane))
      (send t add-help-button status-pane '("games" "blackjack") "Blackjack Help" #f)
      (send t show #t)
      (send t set-double-click-action #f)
      (send t set-button-action 'left 'drag/one)
      (send t set-button-action 'middle 'drag/one)
      (send t set-button-action 'right 'drag/one)
      
      ;; Get table width & height
      (define w (send t table-width))
      (define h (send t table-height))
      
      ;; Build the deck
      (define deck 
        (let loop ([n DECK-COUNT])
          (if (zero? n)
              null
              (append (make-deck) (loop (sub1 n))))))
      
      ;; Card width & height
      (define cw (send (car deck) card-width))
      (define ch (send (car deck) card-height))
      
      ;; Size of buttons
      (define BUTTON-HEIGHT 16)
      (define BUTTON-WIDTH cw)
      
      ;; Cards are not movable
      (for-each
       (lambda (card)
         (send card user-can-move #f)
         (send card user-can-flip #f))
       deck)
      
      ;; Set up card regions
      (define deck-region 
        (make-region MARGIN MARGIN
                     cw ch #f #f))
      
      (define discard-region 
        (make-region (- w cw MARGIN) MARGIN
                     cw ch #f #f))
      
      (define dealer-region 
        (make-region (+ cw (* 2 MARGIN)) MARGIN
                     (- w (* 2 cw) (* 4 MARGIN)) ch 
                     #f #f))
      
      (define player-region 
        (make-region (+ cw (* 2 MARGIN)) (- h (* 2 MARGIN) ch BUTTON-HEIGHT)
                     (- w (* 2 cw) (* 4 MARGIN)) ch
                     #f #f))
      
      ;; In case of split, we need more regions
      (define ww (* 3/2 cw))
      (define player-2-region 
        (make-region MARGIN (region-y player-region)
                     (- w ww (* 3 MARGIN)) (region-h player-region)
                     #f #f))
      (define player-2-wait-region 
        (make-region (region-x player-2-region) (region-y player-2-region)
                     ww (region-h player-2-region)
                     #f #f))
      (define player-1-region 
        (make-region (- w MARGIN (region-w player-2-region)) (region-y player-2-region)
                     (region-w player-2-region) (region-h player-2-region)
                     #f #f))
      (define player-1-wait-region 
        (make-region (- (+ (region-x player-1-region) (region-w player-1-region)) ww)
                     (region-y player-1-region)
                     ww (region-h player-1-region)
                     #f #f))
      (define (make-border-region r)
        (define hm (/ MARGIN 2))
        (make-region (- (region-x r) hm) (- (region-y r) hm)
                     (+ (region-w r) MARGIN) (+ (region-h r) MARGIN) 
                     "" #f))
      (define player-1-border (make-border-region player-1-region))
      (define player-2-border (make-border-region player-2-region))
      
      ;; Player buttons
      (define (make-button title pos)
        (make-button-region (+ (/ (- w (* 4 BUTTON-WIDTH) (* 3 MARGIN)) 2)
                               (* pos (+ BUTTON-WIDTH MARGIN)))
                            (- h MARGIN BUTTON-HEIGHT)
                            BUTTON-WIDTH BUTTON-HEIGHT
                            title void))
      (define hit-button (make-button "Hit" 1))
      (define stand-button (make-button "Stand" 2))
      (define split-button (make-button "Split" 0))
      (define double-button (make-button "Double" 3))
      
      ;; Put the cards on the table
      (send t add-cards-to-region deck deck-region)
      
      ;; Function to compute the normal or minimum value of a card
      (define (min-card-value c)
        (let ([v (send c get-value)])
          (if (> v 10)
              10
              v)))
      
      ;; Function to compute the value of a hand, counting aces as 1 or 11
      ;;  to get the highest total possible under 21
      (define (best-total l)
        (let* ([ace? (lambda (is?) (lambda (c) (eq? is? (= (send c get-value) 1))))]
               [aces (filter (ace? #t) l)]
               [others (filter (ace? #f) l)]
               [base (apply + (map min-card-value others))])
          (let loop ([l aces][base base])
            (cond
              [(null? l) base]
              [(<= (+ base (* (length aces) 11)) 21)
               (+ base (* (length aces) 11))]
              [else (loop (cdr l) (add1 base))]))))
      
      ;; Function to test whether a hand is a bust
      (define (bust? p)
        (> (best-total p) 21))
      
      ;; Very simple betting...
      (define money 100)
      (define (update-money! d)
        (set! money (+ money d))
        (send t set-status (format "You have $~a. (Each bet is $2.)" money)))
      
      ;; Let's play!
      (let shuffle-loop ()
        ;; Shuffle the cards, none are discarded, yet
        (let* ([deck (shuffle-list deck 7)]
               [discard null]
               [deal (lambda (n)
                       (let deal ([n n])
                         (if (zero? n)
                             null
                             (let ([c (car deck)])
                               (set! deck (cdr deck))
                               (cons c (deal (sub1 n)))))))])
          ;; Put the shuffled deck in place
          (send t move-cards-to-region deck deck-region)
          (send t stack-cards deck)
          ;; Loop rounds over while there's enough cards in the deck
          (let loop ()
            ;; All bets are $2
            (update-money! -2)
            ;; Deal to player
            (let ([p (deal 2)]
                  [p2 null] ; in case of splitting
                  [double? #f]) ; in case of doubling (flag is needed to adjust money)
              ;; Move the player's cards into place and show them
              (send t move-cards-to-region p player-region)
              (send t cards-face-up p)
              ;; Deal to dealer
              (let ([d (deal 2)])
                ;; Move the dealer's cards into place and show one
                (send t move-cards-to-region d dealer-region)
                (send t card-face-up (car d))
                (let* ([continue (make-semaphore)]
                       ;; Make a button in the center to show results
                       [make-status
                        (lambda (title continue)
                          (let ([r (make-button-region 
                                    (/ (- w (* 2 cw)) 2) 
                                    (region-y hit-button)
                                    (* 2 cw) BUTTON-HEIGHT
                                    title #f)])
                            (set-region-callback! r (lambda () 
                                                      (send t remove-region r)
                                                      (semaphore-post continue)))
                            r))]
                       ;; Done with hand:
                       [done 
                        (lambda (title continue)
                          (send t remove-region hit-button)
                          (send t remove-region stand-button)
                          (send t add-region (make-status title continue)))]
                       ;; Compute winnings (not called for busts by the player)
                       [finish
                        (lambda (p blackjack?)
                          (let ([pt (best-total p)]
                                [dt (best-total d)]
                                [continue (make-semaphore)])
                            (cond
                              [(or (> dt 21) (> pt dt))
                               (update-money! (if blackjack? 5 (if double? 8 4)))
                               (done (if blackjack?
                                         "Blackjack"
                                         "You Win")
                                     continue)]
                              [(> dt pt) 
                               (done (if blackjack?
                                         "Dealer Blackjack"
                                         "You Lose")
                                     continue)]
                              [else (update-money! (if double? 4 2))
                                    (done "Push" continue)])
                            (yield continue)))]
                       ;; Done with the first hand of a split
                       [finish-split
                        (lambda (p player-region player-wait-region player-border)
                          (unless (bust? p)
                            (send t move-cards-to-region p player-region)
                            (send t add-region player-border)
                            (finish p #f)
                            (send t remove-region player-border)
                            (send t move-cards-to-region p player-wait-region)))]
                       ;; Player busts
                       [bust (lambda ()
                               (done "Bust" continue))]
                       ;; Bust in one hand of a split
                       [local-bust (lambda ()
                                     (let ([cont (make-semaphore)])
                                       (done "Bust" cont)
                                       (yield cont)))]
                       ;; Callback for the hit button; the button's callback
                       ;;  is changed for diferent modes: normal, split part 1, or split part 2
                       [make-hit-callback
                        (lambda (get-p set-p! player-region bust)
                          (lambda ()
                            (send t remove-region double-button)
                            (send t remove-region split-button)
                            (set-p! (append (deal 1) (get-p)))
                            (send t stack-cards (get-p))
                            (send t move-cards-to-region (get-p) player-region)
                            (send t cards-face-up (get-p))
                            ;; Check for bust
                            (when (bust? (get-p))
                              (bust))))])
                  ;; Blackjack by player or dealer?
                  (if (or (= 21 (best-total p))
                          (= 21 (best-total d)))
                      (begin
                        ;; Show the dealers cards...
                        (send t cards-face-up d)
                        ;; ... and compute the result
                        (finish p #t))
                      (begin
                        ;; Three basic actions are allowed:
                        (send t add-region hit-button)
                        (send t add-region stand-button)
                        (send t add-region double-button)
                        ;; Set the callbacks for normal (unsplit) hands
                        (set-region-callback! hit-button
                                              (make-hit-callback
                                               (lambda () p)
                                               (lambda (v) (set! p v))
                                               player-region
                                               bust))
                        (set-region-callback! stand-button
                                              (lambda ()
                                                (semaphore-post continue)))
                        (set-region-callback! double-button
                                              (lambda ()
                                                ;; Note the double for adjusting money on a win
                                                (set! double? #t)
                                                ;; Double the bet
                                                (update-money! -2)
                                                ;; Deal one more card
                                                ((region-callback hit-button))
                                                ;; No more cards or actions, but if the player busted, the hit 
                                                ;;  callback has already continued
                                                (unless (bust? p)
                                                  (semaphore-post continue))))
                        ;; Split allowed?
                        (when (= (min-card-value (car p)) (min-card-value (cadr p)))
                          ;; Yes, we can split. If the player hits the split button,
                          ;;  we have to split the cards, deal one more to each split
                          ;;  half and adjust the callbacks for hit and stand.
                          ;; (If aces are split, the round is over.)
                          (send t add-region split-button)
                          (set-region-callback! split-button
                                                (lambda ()
                                                  ;; Double our bet...
                                                  (update-money! -2)
                                                  ;; Split the hand
                                                  (set! p2 (list (cadr p)))
                                                  (set! p (list (car p)))
                                                  ;; Move the split halves to the "waiting" area. The
                                                  ;;  active area is reserved for hands that are being
                                                  ;;  played
                                                  (send t move-cards-to-region p player-1-wait-region)
                                                  (send t move-cards-to-region p2 player-2-wait-region)
                                                  ;; Deal one more card to each half and move them into place
                                                  (set! p (append (deal 1) p))
                                                  (set! p2 (append (deal 1) p2))
                                                  (send t stack-cards p)
                                                  (send t stack-cards p2)
                                                  (send t move-cards-to-region p player-1-wait-region)
                                                  (send t move-cards-to-region p2 player-2-wait-region)
                                                  ;; Show the newly dealt cards
                                                  (send t flip-cards (list (car p) (car p2)))
                                                  ;; No more splits, no doubling
                                                  (send t remove-region split-button)
                                                  (send t remove-region double-button)
                                                  ;;       Function called when the last split hand is done
                                                  (let* ([close-split
                                                          (lambda ()
                                                            ;; Unhilite the second hand
                                                            (send t remove-region player-2-border)
                                                            (send t move-cards-to-region p2 player-2-wait-region)
                                                            ;; Let the main loop finish up
                                                            (semaphore-post continue))]
                                                         ;; Callback to swicth from the first split hand to the second
                                                         [switch
                                                          (lambda ()
                                                            ;; Unhilite the first hand
                                                            (send t remove-region player-1-border)
                                                            (send t move-cards-to-region p player-1-wait-region)
                                                            ;; Hilite the second hand
                                                            (send t move-cards-to-region p2 player-2-region)
                                                            (send t add-region player-2-border)
                                                            ;; Adjust callbacks to operate on the second hand
                                                            (set-region-callback! 
                                                             hit-button
                                                             (make-hit-callback (lambda () p2)
                                                                                (lambda (v) (set! p2 v))
                                                                                player-2-region
                                                                                (lambda ()
                                                                                  (local-bust)
                                                                                  (close-split))))
                                                            (set-region-callback!
                                                             stand-button
                                                             close-split))])
                                                    ;; Did we split aces?
                                                    (if (= 1 (send (cadr p) get-value))
                                                        ;; Split aces; no more cards
                                                        (semaphore-post continue)
                                                        (begin
                                                          ;; The first of the split hands is ready to go
                                                          (send t move-cards-to-region p player-1-region)
                                                          ;; Hilite the first hand
                                                          (send t add-region player-1-border)
                                                          ;; Adjust callbacks to work on the first of a split hand
                                                          (set-region-callback!
                                                           hit-button
                                                           (make-hit-callback (lambda () p)
                                                                              (lambda (v) (set! p v))
                                                                              player-1-region
                                                                              (lambda ()
                                                                                (local-bust)
                                                                                (switch)
                                                                                (send t add-region hit-button)
                                                                                (send t add-region stand-button))))
                                                          (set-region-callback! 
                                                           stand-button
                                                           switch)))))))
                        ;; Wait until the player is done
                        (yield continue)
                        ;; No more player actions; get rid of the buttons
                        (send t remove-region hit-button)
                        (send t remove-region stand-button)
                        (send t remove-region double-button)
                        (send t remove-region split-button)
                        ;; If all the player's hards are bust, the dealer doesn't do anything
                        (unless (and (bust? p)
                                     (or (null? p2)
                                         (bust? p2)))
                          ;; Show the dealer's starting hand
                          (send t card-face-up (cadr d))
                          (let loop ()
                            ;; Hit on 16 or lower, stand on 17 and higher
                            (when (< (best-total d) 17)
                              ;; Hit the dealer
                              (set! d (append (deal 1) d))
                              (send t stack-cards d)
                              (send t move-cards-to-region d dealer-region)
                              (send t cards-face-up d)
                              (loop)))
                          (if (null? p2)
                              ;; Finish normal game (adjusts winnings)
                              (finish p #f)
                              ;; Finish split game (adjusts winnings for each hand)
                              (begin
                                (finish-split p player-1-region player-1-wait-region player-1-border)
                                (finish-split p2 player-2-region player-2-wait-region player-2-border))))))
                  ;; Move all the discarded cards to the back
                  (unless (null? discard)
                    (send t card-to-back (car discard))
                    (send t stack-cards discard))
                  ;; Discard all the cards we used
                  (set! discard (append p p2 d discard))
                  (send t cards-face-down discard)
                  (send t move-cards-to-region discard discard-region)
                  ;; Go again. Check whether we should reshuffle the deck or keep going with this one
                  (if (< (length deck) min-deck-size)
                      (begin
                        (send t move-cards-to-region deck discard-region)
                        (shuffle-loop))
                      (loop)))))))))))