blackjack.el

;;; blackjack.el --- The game of Blackjack -*- lexical-binding: t; -*-

;; Copyright (C) 2022, 2023 Greg Donald
;; SPDX-License-Identifier: GPL-3.0-only
;; Author: Greg Donald <gdonald@gmail.com>
;; Version: 1.0.3
;; Package-Requires: ((emacs "26.2"))
;; Keywords: card game games blackjack 21
;; URL: https://github.com/gdonald/blackjack-el

;;; Commentary:
;; This package lets you play Blackjack in Emacs.

;;; Code:

(require 'cl-lib)
(require 'eieio)

(defconst blackjack--buffer-name "* Blackjack *"
  "The buffer name.")

(defgroup blackjack nil
  "Customization group for Blackjack."
  :group 'games)

(defcustom blackjack-stand-key "s"
  "Key to press to stand on current hand."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deal-double-key "d"
  "Key to press to deal or double a hand."
  :type '(string) :group 'blackjack)

(defcustom blackjack-bet-back-key "b"
  "Key to press to change bet or go back."
  :type '(string) :group 'blackjack)

(defcustom blackjack-quit-key "q"
  "Key to press to quit."
  :type '(string) :group 'blackjack)

(defcustom blackjack-options-key "o"
  "Key to press to view options menus."
  :type '(string) :group 'blackjack)

(defcustom blackjack-num-decks-no-insurance-key "n"
  "Key to press to decline insurance or change number of decks."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-type-key "t"
  "Key to press to change deck type."
  :type '(string) :group 'blackjack)

(defcustom blackjack-face-type-key "f"
  "Key to press to change face type."
  :type '(string) :group 'blackjack)

(defcustom blackjack-hit-key "h"
  "Key to press to hit a hand."
  :type '(string) :group 'blackjack)

(defcustom blackjack-split-key "p"
  "Key to press to split a hand."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-regular-key "1"
  "Key to press to switch to a regular deck."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-aces-key "2"
  "Key to press to switch to a deck of aces."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-jacks-key "3"
  "Key to press to switch to a deck of jacks."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-aces-jacks-key "4"
  "Key to press to switch to a deck of aces and jacks."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-sevens-key "5"
  "Key to press to switch to a deck of sevens."
  :type '(string) :group 'blackjack)

(defcustom blackjack-deck-eights-key "6"
  "Key to press to switch to a deck of eights."
  :type '(string) :group 'blackjack)

(defcustom blackjack-insurance-key "y"
  "Key to press to insure hand."
  :type '(string) :group 'blackjack)

(defcustom blackjack-face-type-regular-key "r"
  "Key to press to to choose regular face type."
  :type '(string) :group 'blackjack)

(defcustom blackjack-face-type-alternate-key "a"
  "Key to press to choose alternate face type."
  :type '(string) :group 'blackjack)

(defcustom blackjack-persist-file
  (file-name-concat user-emacs-directory "blackjack.txt")
  "File to persist blackjack game state to."
  :type '(file) :group 'blackjack)

(defcustom blackjack-currency "$"
  "Currency to display.

Can be a single-character currency symbol such as \"$\", \"€\" or \"£\", or a
3-character currency code as per ISO 4217."
  :type '(string)
  :group 'blackjack)

(defclass blackjack-card ()
  ((id :initarg :id :initform 0 :type integer)
   (value :initarg :value :initform 0 :type integer)
   (suit :initarg :suit :initform 0 :type integer)))

(defclass blackjack-hand ()
  ((cards :initarg :cards :initform '() :type list)
   (played :initarg :played :initform nil :type boolean)))

(defclass blackjack-player-hand (blackjack-hand)
  ((id :initarg :id :initform 0 :type integer)
   (bet :initarg :bet :initform 0 :type integer)
   (status :initarg :status :initform 'unknown :type symbol)
   (paid :initarg :paid :initform nil :type boolean)
   (stood :intiarg :stood :initform nil :type boolean)))

(defclass blackjack-dealer-hand (blackjack-hand)
  ((hide-down-card :initarg :hide-down-card :initform t :type boolean)))

(defclass blackjack-game ()
  ((id :initarg :id :initform 0 :type integer)
   (shoe :initarg :shoe :initform '() :type list)
   (dealer-hand :initarg :dealer-hand :initform nil :type atom)
   (player-hands :initarg :player-hands :initform '() :type list)
   (num-decks :initarg :num-decks :initform 1 :type integer)
   (deck-type :initarg :deck-type :initform 'regular :type symbol)
   (face-type :initarg :face-type :initform 'regular :type symbol)
   (money :initarg :money :initform 10000 :type integer)
   (current-bet :initarg :current-bet :initform 500 :type integer)
   (current-player-hand :initarg :current-player-hand :initform 0 :type integer)
   (current-menu :initarg :current-menu :initform 'game :type symbol)
   (faces-regular :initarg :faces :initform '[["A♠" "A♥" "A♣" "A♦"]
                                              ["2♠" "2♥" "2♣" "2♦"]
                                              ["3♠" "3♥" "3♣" "3♦"]
                                              ["4♠" "4♥" "4♣" "4♦"]
                                              ["5♠" "5♥" "5♣" "5♦"]
                                              ["6♠" "6♥" "6♣" "6♦"]
                                              ["7♠" "7♥" "7♣" "7♦"]
                                              ["8♠" "8♥" "8♣" "8♦"]
                                              ["9♠" "9♥" "9♣" "9♦"]
                                              ["T♠" "T♥" "T♣" "T♦"]
                                              ["J♠" "J♥" "J♣" "J♦"]
                                              ["Q♠" "Q♥" "Q♣" "Q♦"]
                                              ["K♠" "K♥" "K♣" "K♦"]
                                              ["??"]] :type array)
   (faces-alternate :initarg :faces2 :initform '[["🂡" "🂱" "🃁" "🃑"]
                                                 ["🂢" "🂲" "🃂" "🃒"]
                                                 ["🂣" "🂳" "🃃" "🃓"]
                                                 ["🂤" "🂴" "🃄" "🃔"]
                                                 ["🂥" "🂵" "🃅" "🃕"]
                                                 ["🂦" "🂶" "🃆" "🃖"]
                                                 ["🂧" "🂷" "🃇" "🃗"]
                                                 ["🂨" "🂸" "🃈" "🃘"]
                                                 ["🂩" "🂹" "🃉" "🃙"]
                                                 ["🂪" "🂺" "🃊" "🃚"]
                                                 ["🂫" "🂻" "🃋" "🃛"]
                                                 ["🂭" "🂽" "🃍" "🃝"]
                                                 ["🂮" "🂾" "🃎" "🃞"]
                                                 ["🂠"]] :type array)
   (shuffle-specs :initarg :shuffle-specs :initform '[80 81 82 84 86 89 92 95] :type array)
   (cards-per-deck :initarg :cards-per-deck :initform 52 :type integer)
   (min-bet :initarg :min-bet :initform 500 :type integer)
   (max-bet :initarg :max-bet :initform 100000000 :type integer)
   (max-player-hands :initarg :max-player-hands :initform 7 :type integer)
   (quitting :initarg :quitting :initform nil :type boolean)))

;; (cl-defmethod cl-print-object ((obj blackjack-card) stream)
;;   "Print OBJ to STREAM."
;;   (princ
;;    (format "#<%s id: %d value: %s suit: %s>"
;;            (eieio-class-name (eieio-object-class obj))
;;            (slot-value obj 'id)
;;            (slot-value obj 'value)
;;            (slot-value obj 'suit))
;;    stream))

;; (cl-defmethod cl-print-object ((obj blackjack-player-hand) stream)
;;   "Print OBJ to STREAM."
;;   (princ
;;    (format "#<%s id: %d cards: %s played: %s status: %s paid: %s stood: %s bet: %s>"
;;            (eieio-class-name (eieio-object-class obj))
;;            (slot-value obj 'id)
;;            (slot-value obj 'cards)
;;            (slot-value obj 'played)
;;            (slot-value obj 'status)
;;            (slot-value obj 'paid)
;;            (slot-value obj 'stood)
;;            (slot-value obj 'bet))
;;    stream))

;; (cl-defmethod cl-print-object ((obj blackjack-dealer-hand) stream)
;;   "Print OBJ to STREAM."
;;   (princ
;;    (format "#<%s cards: %s played: %s hide-down-card: %s>"
;;            (eieio-class-name (eieio-object-class obj))
;;            (slot-value obj 'cards)
;;            (slot-value obj 'played)
;;            (slot-value obj 'hide-down-card))
;;    stream))

(defun blackjack--deal-new-hand (game)
  "Deal new GAME hands."
  (interactive)
  (when (blackjack--valid-menu-action-p game 'game)
    (with-slots (current-bet player-hands current-player-hand current-menu) game
      (when (blackjack--need-to-shuffle-p game)
        (blackjack--shuffle game))
      (let (player-hand dealer-hand)
        (setf player-hands '())
        (setq player-hand (blackjack-player-hand :id (blackjack--next-id game) :bet current-bet))
        (setq dealer-hand (blackjack-dealer-hand))
        (dotimes (_x 2)
          (blackjack--deal-card game player-hand)
          (blackjack--deal-card game dealer-hand))
        (push player-hand player-hands)
        (setf current-player-hand 0)
        (setf (slot-value game 'dealer-hand) dealer-hand)
        (if (and
             (blackjack--dealer-upcard-is-ace-p dealer-hand)
             (not (blackjack--hand-is-blackjack-p (slot-value player-hand 'cards))))
            (progn
              (setf current-menu 'insurance)
              (blackjack--draw-hands game)
              (blackjack--ask-insurance-action game))
          (if (blackjack--player-hand-done-p game player-hand)
              (progn
                (setf (slot-value dealer-hand 'hide-down-card) nil)
                (blackjack--pay-hands game)
                (setf current-menu 'game)
                (blackjack--draw-hands game)
                (blackjack--ask-game-action game))
            (setf current-menu 'hand)
            (blackjack--draw-hands game)
            (blackjack--persist-state game)
            (blackjack--ask-hand-action game)))))))

(defun blackjack--deal-card (game hand)
  "Deal a card into HAND from GAME shoe."
  (interactive)
  (with-slots (shoe) game
    (with-slots (cards) hand
      (cl-callf append cards `(,(pop shoe))))))

(defun blackjack--next-id (game)
  "Return next GAME object id."
  (cl-incf (slot-value game 'id)))

(defun blackjack--pay-hands (game)
  "Pay player GAME hands."
  (with-slots (dealer-hand player-hands) game
    (let ((dealer-hand-value (blackjack--dealer-hand-value dealer-hand 'soft))
          (dealer-busted (blackjack--dealer-hand-is-busted-p dealer-hand)))
      (dolist (player-hand player-hands)
        (blackjack--pay-player-hand game player-hand dealer-hand-value dealer-busted))
      (blackjack--normalize-current-bet game)
      (blackjack--persist-state game))))

(defun blackjack--pay-player-hand (game player-hand dealer-hand-value dealer-hand-busted)
  "Pay GAME PLAYER-HAND based on DEALER-HAND-VALUE and DEALER-HAND-BUSTED."
  (with-slots (paid cards status) player-hand
    (unless paid
      (setf paid t)
      (let ((player-hand-value (blackjack--player-hand-value cards 'soft)))
        (if (blackjack--player-hand-won player-hand-value dealer-hand-value dealer-hand-busted)
            (blackjack--pay-won-hand game player-hand)
          (if (blackjack--player-hand-lost-p player-hand-value dealer-hand-value)
              (blackjack--collect-lost-hand game player-hand)
            (setf status 'push)))))))

(defun blackjack--collect-lost-hand (game player-hand)
  "Collect bet from losing GAME PLAYER-HAND."
  (with-slots (money) game
    (with-slots (bet status) player-hand
      (cl-decf money bet)
      (setf status 'lost))))

(defun blackjack--pay-won-hand (game player-hand)
  "Pay winning GAME PLAYER-HAND bet."
  (with-slots (bet cards status) player-hand
    (when (blackjack--hand-is-blackjack-p cards)
      (setf bet (truncate (* 1.5 bet))))
    (with-slots (money) game
      (cl-incf money bet)
      (setf status 'won))))

(defun blackjack--player-hand-lost-p (player-hand-value dealer-hand-value)
  "Return non-nil if PLAYER-HAND-VALUE < DEALER-HAND-VALUE."
  (< player-hand-value dealer-hand-value))

(defun blackjack--player-hand-won (player-hand-value dealer-hand-value dealer-hand-busted)
  "Return non-nil if PLAYER-HAND-VALUE > DEALER-HAND-VALUE && !DEALER-HAND-BUSTED."
  (or dealer-hand-busted
      (> player-hand-value dealer-hand-value)))

(defun blackjack--player-hand-done-p (game player-hand)
  "Return non-nil when GAME PLAYER-HAND is done."
  (when (blackjack--no-more-actions-p player-hand)
    (with-slots (played paid cards) player-hand
      (setf played t)
      (when (and (not paid)
                 (blackjack--player-hand-is-busted-p cards))
        (blackjack--collect-busted-hand game player-hand)))
    t))

(defun blackjack--collect-busted-hand (game player-hand)
  "Collect bet from GAME PLAYER-HAND."
  (with-slots (money) game
    (with-slots (paid status bet) player-hand
      (setf paid t
            status 'lost)
      (cl-decf money bet))))

(defun blackjack--no-more-actions-p (player-hand)
  "Return non-nil when PLAYER-HAND has no more actions."
  (with-slots (cards played stood) player-hand
    (or
     played
     stood
     (blackjack--hand-is-blackjack-p cards)
     (blackjack--player-hand-is-busted-p cards)
     (= 21 (blackjack--player-hand-value cards 'soft))
     (= 21 (blackjack--player-hand-value cards 'hard)))))

(defun blackjack--need-to-shuffle-p (game)
  "Return non-nil when GAME shoe is exhausted."
  (with-slots (shoe shuffle-specs num-decks) game
    (let ((cards-count (length shoe)))
      (if (> cards-count 0)
          (let ((used (- (blackjack--total-cards game) cards-count))
                (spec (aref shuffle-specs (1- num-decks))))
            (> (* 100 (/ (float used) cards-count)) spec))
        t))))

(defun blackjack--total-cards (game)
  "Return total number of cards per GAME shoe."
  (with-slots (cards-per-deck num-decks) game
    (* cards-per-deck num-decks)))

(defun blackjack--shuffle (game &optional card-values skip-shuffle)
  "Build a GAME shoe using CARD-VALUES if provided and shuffle unless SKIP-SHUFFLE."
  (let ((values (or card-values (blackjack--card-values game))))
    (with-slots (shoe) game
      (setf shoe (blackjack--build-cards game values))
      (unless skip-shuffle
        (setf shoe (blackjack--shuffle-loop shoe))))))

(defun blackjack--card-values (game)
  "Return card values from GAME deck-type."
  (pcase (slot-value game 'deck-type)
    ('regular (number-sequence 0 12))
    ('aces '(0))
    ('jacks '(10))
    ('aces-jacks '(0 10))
    ('sevens '(6))
    ('eights '(7))))

(defun blackjack--build-cards (game values)
  "Populate GAME shoe with card VALUES."
  (let ((total-cards (blackjack--total-cards game))
        (shoe '()))
    (while (< (length shoe) total-cards)
      (dotimes (suit 4)
        (dolist (value (reverse values))
          (when (< (length shoe) total-cards)
            (push
             (blackjack-card :id (blackjack--next-id game) :value value :suit suit)
             shoe)))))
    (setf (slot-value game 'shoe) (blackjack--shuffle-loop shoe))
    shoe))

(defun blackjack--shuffle-loop (shoe)
  "Shuffle SHOE."
  (dotimes (_x (* 7 (length shoe)))
    (setq shoe (blackjack--move-rand-card shoe)))
  shoe)

(defun blackjack--move-rand-card (shoe)
  "Move a random card to the top of the SHOE."
  (let ((card (seq-random-elt shoe)))
    (setq shoe (cl-remove card shoe :count 1))
    (push card shoe)
    shoe))

(defun blackjack--draw-hands (game)
  "Draw GAME dealer hand and player hands."
  (let ((inhibit-read-only t))
    (erase-buffer)
    (blackjack--update-header game)
    (insert "\n  Dealer:\n")
    (blackjack--draw-dealer-hand game)
    (insert "\n\n  Player:\n")
    (blackjack--draw-player-hands game)))

(defun blackjack--format-money (money)
  "Format MONEY."
  (format "%.2f" (/ money 100.0)))

(defun blackjack--more-hands-to-play-p (game)
  "Return non-nil when there are more split GAME hands to play."
  (with-slots (current-player-hand player-hands) game
    (< current-player-hand (1- (length player-hands)))))

(defun blackjack--play-more-hands (game)
  "Advance to next split GAME player hand."
  (with-slots (current-player-hand current-menu) game
    (let (player-hand)
      (cl-incf current-player-hand)
      (setq player-hand (blackjack--current-player-hand game))
      (blackjack--deal-card game player-hand)
      (if (blackjack--player-hand-done-p game player-hand)
          (blackjack--process game)
        (setf current-menu 'hand)
        (blackjack--draw-hands game)
        (blackjack--ask-hand-action game)))))

(defun blackjack--need-to-play-dealer-hand-p (game)
  "Return non-nil when playing the GAME dealer hand is required."
  (with-slots (player-hands) game
    (cl-dolist (player-hand player-hands)
      (with-slots (cards) player-hand
        (unless (or
                 (blackjack--player-hand-is-busted-p cards)
                 (blackjack--hand-is-blackjack-p cards))
          (cl-return t))))))

(defun blackjack--dealer-hand-counts (dealer-hand)
  "Return soft and hard counts for DEALER-HAND."
  (mapcar
   (apply-partially #'blackjack--dealer-hand-value dealer-hand) '(soft hard)))

(defun blackjack--deal-required-cards (game)
  "Deal GAME dealer-hand required cards."
  (with-slots (dealer-hand) game
    (while
        (let ((counts (blackjack--dealer-hand-counts dealer-hand)))
          (and
           (< (nth 0 counts) 18)
           (< (nth 1 counts) 17)))
      (blackjack--deal-card game dealer-hand))))

(defun blackjack--play-dealer-hand (game)
  "Player GAME dealer hand."
  (let ((playing (blackjack--need-to-play-dealer-hand-p game)))
    (with-slots (dealer-hand current-menu) game
      (with-slots (cards hide-down-card played) dealer-hand
        (when (or playing
                  (blackjack--hand-is-blackjack-p cards))
          (setf hide-down-card nil))
        (when playing
          (blackjack--deal-required-cards game))
        (setf played t)
        (blackjack--pay-hands game)
        (setf current-menu 'game)
        (blackjack--draw-hands game)
        (blackjack--ask-game-action game)))))

(defun blackjack--process (game)
  "Handle more split GAME hands to play."
  (if (blackjack--more-hands-to-play-p game)
      (blackjack--play-more-hands game)
    (blackjack--play-dealer-hand game)))

(defun blackjack--hit (game)
  "Deal a new card to the current GAME player hand."
  (let ((player-hand (blackjack--current-player-hand game)))
    (blackjack--deal-card game player-hand)
    (if (blackjack--player-hand-done-p game player-hand)
        (blackjack--process game)
      (setf (slot-value game 'current-menu) 'hand)
      (blackjack--draw-hands game)
      (blackjack--ask-hand-action game))))

(defun blackjack--double (game)
  "Double the current GAME player hand bet and deal a single card."
  (let ((player-hand (blackjack--current-player-hand game)))
    (blackjack--deal-card game player-hand)
    (with-slots (played bet) player-hand
      (setf played t)
      (cl-callf * bet 2))
    (if (blackjack--player-hand-done-p game player-hand)
        (blackjack--process game)
      (blackjack--ask-hand-action game))))

(defun blackjack--stand (game)
  "End the current GAME player hand."
  (with-slots (stood played) (blackjack--current-player-hand game)
    (setf stood t
          played t))
  (blackjack--process game))

(defun blackjack--split (game)
  "Split the current GAME player hand."
  (with-slots (player-hands current-bet current-player-hand current-menu) game
    (let ((player-hand)
          (card)
          (hand
           (blackjack-player-hand :id (blackjack--next-id game) :bet current-bet))
          (x))
      (cl-callf append player-hands `(,hand))
      (setq x (1- (length player-hands)))
      (while (> x current-player-hand)
        (setq player-hand (nth (1- x) player-hands))
        (setq hand (nth x player-hands))
        (setf (slot-value hand 'cards) (slot-value player-hand 'cards))
        (cl-decf x))
      (setq player-hand (nth current-player-hand player-hands))
      (setq hand (nth (1+ current-player-hand) player-hands))
      (with-slots ((hand-cards cards)) hand
        (with-slots ((player-hand-cards cards)) player-hand
          (setq card (nth 1 player-hand-cards))
          (setf hand-cards `(,card))
          (setf player-hand-cards (cl-remove card player-hand-cards :count 1))
          (blackjack--deal-card game player-hand)
          (if (blackjack--player-hand-done-p game player-hand)
              (blackjack--process game)
            (setf current-menu 'hand)
            (blackjack--draw-hands game)
            (blackjack--ask-hand-action game)))))))

(defun blackjack--valid-menu-action-p (game action)
  "Return non-nil if the GAME menu ACTION can be performed."
  (eq (slot-value game 'current-menu) action))

(defun blackjack--hand-can-hit-p (game)
  "Return non-nil if the GAME current hand can hit."
  (when (blackjack--valid-menu-action-p game 'hand)
    (let* ((player-hand (blackjack--current-player-hand game))
           (cards (slot-value player-hand 'cards)))
      (not
       (or
        (slot-value player-hand 'played)
        (slot-value player-hand 'stood)
        (= 21 (blackjack--player-hand-value cards 'hard))
        (blackjack--hand-is-blackjack-p cards)
        (blackjack--player-hand-is-busted-p cards))))))

(defun blackjack--hand-can-stand-p (game)
  "Return non-nil if the GAME current hand can stand."
  (when (blackjack--valid-menu-action-p game 'hand)
    (let* ((player-hand (blackjack--current-player-hand game))
           (cards (slot-value player-hand 'cards)))
      (not
       (or
        (slot-value player-hand 'stood)
        (blackjack--player-hand-is-busted-p cards)
        (blackjack--hand-is-blackjack-p cards))))))

(defun blackjack--hand-can-split-p (game)
  "Return non-nil if the GAME current hand can split."
  (when (blackjack--valid-menu-action-p game 'hand)
    (let* ((player-hand (blackjack--current-player-hand game))
           (cards (slot-value player-hand 'cards))
           (card-0 (nth 0 cards))
           (card-1 (nth 1 cards)))
      (and
       (not (slot-value player-hand 'stood))
       (< (length (slot-value game 'player-hands)) 7)
       (>= (slot-value game 'money) (+ (blackjack--all-bets game) (slot-value player-hand 'bet)))
       (eq (length cards) 2)
       (eq (slot-value card-0 'value) (slot-value card-1 'value))))))

(defun blackjack--hand-can-double-p (game)
  "Return non-nil if the GAME current hand can double."
  (when (blackjack--valid-menu-action-p game 'hand)
    (let* ((player-hand (blackjack--current-player-hand game))
           (cards (slot-value player-hand 'cards)))
      (and
       (>= (slot-value game 'money) (+ (blackjack--all-bets game) (slot-value player-hand 'bet)))
       (not
        (or
         (slot-value player-hand 'stood)
         (not (eq 2 (length cards)))
         (blackjack--hand-is-blackjack-p cards)))))))

(defun blackjack--current-player-hand (game)
  "Return current GAME player hand."
  (with-slots (current-player-hand player-hands) game
    (nth current-player-hand player-hands)))

(defun blackjack--all-bets (game)
  "Return the sum of all GAME player hand bets."
  (cl-reduce #'+
             (slot-value game 'player-hands)
             :key (lambda (player-hand) (slot-value player-hand 'bet))))

(defun blackjack--insure-hand (game)
  "Insure the current GAME player hand."
  (interactive)
  (when (blackjack--valid-menu-action-p game 'insurance)
    (with-slots (money current-menu) game
      (with-slots (bet played paid status) (blackjack--current-player-hand game)
        (cl-callf / bet 2)
        (setf played t
              paid t
              status 'lost)
        (cl-decf money bet))
      (setf current-menu 'game)
      (blackjack--draw-hands game)
      (blackjack--ask-game-action game))))

(defun blackjack--no-insurance (game)
  "Decline GAME player hand insurance."
  (interactive)
  (with-slots (dealer-hand current-menu) game
    (with-slots ((dealer-hand-cards cards) hide-down-card) dealer-hand
      (when (blackjack--valid-menu-action-p game 'insurance)
        (if (blackjack--hand-is-blackjack-p dealer-hand-cards)
            (progn
              (setf hide-down-card nil)
              (blackjack--pay-hands game)
              (setf current-menu 'game)
              (blackjack--draw-hands game)
              (blackjack--ask-game-action game))
          (let ((player-hand (blackjack--current-player-hand game)))
            (if (blackjack--player-hand-done-p game player-hand)
                (blackjack--play-dealer-hand game)
              (setf current-menu 'hand)
              (blackjack--draw-hands game)
              (blackjack--ask-hand-action game))))))))

(defun blackjack--ask-new-bet (game)
  "Update the current GAME player bet."
  (interactive)
  (when (blackjack--valid-menu-action-p game 'game)
    (let* ((answer (blackjack--new-bet-menu))
           (bet (* 100 (string-to-number answer))))
      (with-slots (current-bet current-menu) game
        (setf current-bet bet)
        (blackjack--normalize-current-bet game)
        (blackjack--persist-state game)
        (setf current-menu 'game)
        (blackjack--deal-new-hand game)))))

(defun blackjack--new-bet-menu ()
  "Get new bet."
  (read-string "Bet amount: "))

(defun blackjack--player-hand-is-busted-p (cards)
  "Return non-nil if CARDS value is more than 21."
  (> (blackjack--player-hand-value cards 'soft) 21))

(defun blackjack--dealer-hand-is-busted-p (dealer-hand)
  "Return non-nil if DEALER-HAND cards value is more than 21."
  (> (blackjack--dealer-hand-value dealer-hand 'soft) 21))

(defun blackjack--hand-is-blackjack-p (cards)
  "Return non-nil if hand CARDS is blackjack."
  (and (= 2 (length cards))
       (seq-some #'blackjack--is-ace-p cards)
       (seq-some #'blackjack--is-ten-p cards)))

(defun blackjack--dealer-upcard-is-ace-p (dealer-hand)
  "Return non-nil if DEALER-HAND up-card is an ace."
  (blackjack--is-ace-p (nth 1 (slot-value dealer-hand 'cards))))

(defconst blackjack--down-card '(13 0)
  "Hidden card location in faces array.")

(defun blackjack--dealer-hand-to-str (game)
  "Return GAME dealer-hand as a string."
  (let ((str "  "))
    (with-slots (dealer-hand) game
      (with-slots (hide-down-card cards) dealer-hand
        (seq-map-indexed
         (lambda (card index)
           (setq str (concat str
                             (apply #'blackjack--card-face game
                                    (if (and (= index 0) hide-down-card)
                                        blackjack--down-card
                                      (with-slots (value suit) card
                                        `(,value ,suit))))))
           (setq str (concat str " ")))
         cards))
      (setq str (concat str " ⇒  "))
      (setq str (concat str (number-to-string (blackjack--dealer-hand-value dealer-hand 'soft)))))
    str))

(defun blackjack--draw-dealer-hand (game)
  "Draw the GAME dealer-hand."
  (insert (blackjack--dealer-hand-to-str game)))

(defun blackjack--dealer-hand-value (dealer-hand count-method)
  "Calculates DEALER-HAND cards total value based on COUNT-METHOD."
  (let ((total 0))
    (with-slots (hide-down-card cards) dealer-hand
      (seq-map-indexed
       (lambda (card index)
         "Value one of the cards in the dealer's hand."
         (unless (and (= index 0) hide-down-card)
           (cl-incf total (blackjack--card-val card count-method total))))
       cards))
    (when (and (eq count-method 'soft) (> total 21))
      (setq total (blackjack--dealer-hand-value dealer-hand 'hard)))
    total))

(defun blackjack--draw-player-hands (game)
  "Draws GAME player hands."
  (seq-map-indexed
   (apply-partially #'blackjack--draw-player-hand game)
   (slot-value game 'player-hands)))

(defun blackjack--draw-player-hand (game player-hand index)
  "Draws a single GAME PLAYER-HAND using an INDEX."
  (insert (blackjack--player-hand-to-str game player-hand index)))

(defun blackjack--player-hand-to-str (game player-hand index)
  "Draw the GAME PLAYER-HAND using an INDEX."
  (concat (blackjack--player-hand-cards game player-hand)
          (blackjack--player-hand-money game player-hand index)
          (blackjack--player-hand-status player-hand)
          "\n\n"))

(defun blackjack--player-hand-cards (game player-hand)
  "Draw GAME PLAYER-HAND cards."
  (with-slots (cards) player-hand
    (format "  %s  ⇒  %s  "
            (mapconcat
             (lambda (card)
               "Present how CARD is to be drawn."
               (with-slots (value suit) card
                 (blackjack--card-face game value suit)))
             cards
             " ")
            (number-to-string (blackjack--player-hand-value cards 'soft)))))

(defun blackjack--player-hand-status (player-hand)
  "Return PLAYER-HAND status."
  (with-slots (cards status) player-hand
    (pcase status
      ('lost (if (blackjack--player-hand-is-busted-p cards)
                 "Busted!"
               "Lost!"))
      ('won (if (blackjack--hand-is-blackjack-p cards)
                "Blackjack!"
              "Won!"))
      ('push "Push")
      ('unknown ""))))

(defun blackjack--player-hand-money (game player-hand index)
  "Return GAME PLAYER-HAND money using an INDEX."
  (with-slots (current-player-hand) game
    (with-slots (played status bet) player-hand
      (concat
       (when (eq status 'lost) "-")
       (when (eq status 'won) "+")
       blackjack-currency
       (blackjack--format-money bet)
       (when (and
              (not played)
              (= index current-player-hand))
         " ⇐")
       "  "))))

(defun blackjack--player-hand-value (cards count-method)
  "Calculates CARDS total value based on COUNT-METHOD."
  (let ((total 0))
    (dolist (card cards)
      (cl-incf total (blackjack--card-val card count-method total)))
    (when (and (eq count-method 'soft) (> total 21))
      (setq total (blackjack--player-hand-value cards 'hard)))
    total))

(defun blackjack--card-val (card count-method total)
  "Calculates CARD value based on COUNT-METHOD and running hand TOTAL."
  (let ((value (1+ (slot-value card 'value))))
    (when (> value 9)
      (setq value 10))
    (when (and (eq count-method 'soft) (= value 1) (< total 11))
      (setq value 11))
    value))

(defun blackjack--card-face (game value suit)
  "Return GAME card face based on VALUE and SUIT."
  (let ((face
         (with-slots (face-type faces-alternate faces-regular) game
           (if (eq face-type 'alternate)
               faces-alternate
             faces-regular))))
    (aref (aref face value) suit)))

(defun blackjack--is-ace-p (card)
  "Return non-nil if CARD is an ace."
  (= 0 (slot-value card 'value)))

(defun blackjack--is-ten-p (card)
  "Return non-nil if CARD has a value of 10."
  (> (slot-value card 'value) 8))

(defun blackjack--normalize-current-bet (game)
  "Normalize current GAME player bet."
  (let ((min-bet (slot-value game 'min-bet))
        (max-bet (slot-value game 'max-bet))
        (current-bet (slot-value game 'current-bet))
        (money (slot-value game 'money)))
    (when (< current-bet min-bet)
      (setq current-bet min-bet))
    (when (> current-bet max-bet)
      (setq current-bet max-bet))
    (when (> current-bet money)
      (setq current-bet money))
    (setf (slot-value game 'current-bet) current-bet)))

(defun blackjack--persist-file-name ()
  "Resolve the persist file including all abbreviations and symlinks."
  (file-truename (expand-file-name blackjack-persist-file)))

(defun blackjack--persisted-state ()
  "Return saved game state as a string."
  (ignore-errors
    (with-temp-buffer
      (insert-file-contents-literally (blackjack--persist-file-name))
      (buffer-string))))

(defun blackjack--load-persisted-state (game)
  "Set GAME state."
  (let ((state (blackjack--persisted-state)))
    (when state
      (let ((parts (split-string state "|")))
        (when (= (length parts) 5)
          (setf (slot-value game 'num-decks) (string-to-number (nth 0 parts))
                (slot-value game 'deck-type) (intern (nth 1 parts))
                (slot-value game 'face-type) (intern (nth 2 parts))
                (slot-value game 'money) (string-to-number (nth 3 parts))
                (slot-value game 'current-bet) (string-to-number (nth 4 parts))))))))

(defun blackjack--persist-state (game)
  "Persist GAME state."
  (ignore-errors
    (with-temp-file (blackjack--persist-file-name)
      (insert
       (with-slots (num-decks deck-type face-type money current-bet) game
         (format "%s|%s|%s|%s|%s" num-decks deck-type face-type money current-bet))))))

(defun blackjack--quit (game)
  "Quit Blackjack GAME."
  (interactive)
  (when (blackjack--valid-menu-action-p game 'game)
    (setf (slot-value game 'quitting) t)
    (quit-window)))

(defun blackjack--header (game)
  "Return GAME header."
  (with-slots (money current-menu) game
    (format "  Blackjack %s%s  %s"
            blackjack-currency
            (blackjack--format-money money)
            (pcase current-menu
              ('game (blackjack--game-header-menu))
              ('hand (blackjack--hand-menu game))
              ('options (blackjack--options-header-menu))
              ('deck-type (blackjack--deck-type-header-menu))
              ('face-type (blackjack--face-type-header-menu))
              ('num-decks (blackjack--num-decks-header-menu))
              ('bet (blackjack--bet-menu))
              ('insurance (blackjack--insurance-header-menu))))))

(defun blackjack--update-header (game)
  "Update GAME header."
  (setq header-line-format (blackjack--header game)))

(defun blackjack--game-header-menu ()
  "Return game menu string."
  (format "(%s) deal new hand  (%s) change bet  (%s) options  (%s) quit"
          blackjack-deal-double-key
          blackjack-bet-back-key
          blackjack-options-key
          blackjack-quit-key))

(defun blackjack--ask-game-action (game)
  "Ask about next GAME action."
  (setf (slot-value game 'current-menu) 'game)
  (blackjack--update-header game)
  (pcase (blackjack-game-actions-menu)
    ("deal" nil)
    ("bet" (blackjack--ask-new-bet game))
    ("options" (blackjack--ask-game-options game))
    ("quit" (blackjack--quit game))))

(defun blackjack-game-actions-menu ()
  "Actions menu for GAME."
  (let ((read-answer-short t))
    (read-answer "Game Actions: "
                 `(("deal" ,blackjack-deal-double-key "deal new hand")
                   ("bet" ,blackjack-bet-back-key "change current bet")
                   ("options" ,blackjack-options-key "change game options")
                   ("quit" ,blackjack-quit-key "quit blackjack")
                   ("help" ?? "show help")))))

(defun blackjack--options-header-menu ()
  "Return option menu string."
  (format "(%s) number of decks  (%s) deck type  (%s) face type  (%s) go back"
          blackjack-num-decks-no-insurance-key
          blackjack-deck-type-key
          blackjack-face-type-key
          blackjack-bet-back-key))

(defun blackjack--ask-game-options (game)
  "Ask about which GAME option to update."
  (setf (slot-value game 'current-menu) 'options)
  (blackjack--update-header game)
  (let ((answer (blackjack--game-options-menu)))
    (pcase answer
      ("number-decks" (blackjack--ask-new-number-decks game))
      ("deck-type" (blackjack--ask-new-deck-type game))
      ("face-type" (blackjack--ask-new-face-type game))
      ("back" (blackjack--ask-game-action game)))))

(defun blackjack--game-options-menu ()
  "GAME options menu."
  (let ((read-answer-short t))
    (read-answer
     "Options: "
     `(("number-decks" ,blackjack-num-decks-no-insurance-key "change number of decks")
       ("deck-type" ,blackjack-deck-type-key "change the deck type")
       ("face-type" ,blackjack-face-type-key "change the card face type")
       ("back" ,blackjack-bet-back-key "go back to previous menu")
       ("help" ?? "show help")))))

(defun blackjack--deck-type-header-menu ()
  "Return deck type menu string."
  (format
   "(%s) regular  (%s) aces  (%s) jacks  (%s) aces & jacks  (%s) sevens  (%s) eights"
   blackjack-deck-regular-key
   blackjack-deck-aces-key
   blackjack-deck-jacks-key
   blackjack-deck-aces-jacks-key
   blackjack-deck-sevens-key
   blackjack-deck-eights-key))

(defun blackjack--ask-new-deck-type (game)
  "Ask for new GAME deck type."
  (with-slots (current-menu deck-type) game
    (setf current-menu 'deck-type)
    (blackjack--update-header game)
    (setf deck-type (intern (blackjack--deck-type-menu)))
    (blackjack--normalize-num-decks game)
    (blackjack--shuffle-save-deal-new-hand game)))

(defun blackjack--normalize-num-decks (game)
  "Normalize GAME num-decks."
  (with-slots (num-decks deck-type) game
    (when (and (< num-decks 2)
               (eq deck-type 'aces))
      (setf num-decks 2))
    (cl-callf max num-decks 1)
    (cl-callf min num-decks 8)))

(defun blackjack--deck-type-menu ()
  "New GAME deck type menu."
  (let ((read-answer-short t))
    (read-answer
     "Deck Type: "
     `(("regular" ,blackjack-deck-regular-key "regular deck")
       ("aces" ,blackjack-deck-aces-key "deck of aces")
       ("jacks" ,blackjack-deck-jacks-key "deck of jacks")
       ("aces-jacks" ,blackjack-deck-aces-jacks-key "deck of aces and jacks")
       ("sevens" ,blackjack-deck-sevens-key "deck of sevens")
       ("eights" ,blackjack-deck-eights-key "deck of eights")
       ("help" ?? "show help")))))

(defun blackjack--face-type-header-menu ()
  "Return face type menu string."
  (format "(%s) A♠ regular  (%s) 🂡 alternate"
          blackjack-face-type-regular-key
          blackjack-face-type-alternate-key))

(defun blackjack--ask-new-face-type (game)
  "Ask for new GAME face type."
  (with-slots (current-menu face-type) game
    (setf current-menu 'face-type)
    (blackjack--update-header game)
    (setf face-type (intern (blackjack--face-type-menu)))
    (blackjack--persist-state-deal-new-hand game)))

(defun blackjack--face-type-menu ()
  "New GAME face type menu."
  (let* ((read-answer-short t))
    (read-answer "Card Face Type: "
                 `(("regular" ,blackjack-face-type-regular-key "use regular face type")
		   ("alternate" ,blackjack-face-type-alternate-key "use alternate face type")
                   ("help" ?? "show help")))))

(defun blackjack--insurance-header-menu ()
  "Return insurance menu string."
  (format "(%s) insure hand  (%s) refuse insurance"
          blackjack-insurance-key
          blackjack-num-decks-no-insurance-key))

(defun blackjack--ask-insurance-action (game)
  "Ask about insuring GAME hand."
  (pcase (blackjack--ask-insurance-menu)
    ("yes" (blackjack--insure-hand game))
    ("no" (blackjack--no-insurance game))
    ("help" ?? "show help")))

(defun blackjack--ask-insurance-menu ()
  "Ask about insuring GAME hand."
  (let ((read-answer-short t))
    (read-answer
     "Hand Insurance: "
     `(("yes" ,blackjack-insurance-key "insure hand")
       ("no" ,blackjack-num-decks-no-insurance-key "refuse insurance")
       ("help" ?? "show help")))))

(defun blackjack--num-decks-header-menu ()
  "Return number of decks menu string."
  "Number of decks (1-8)")

(defun blackjack--bet-menu ()
  "Return bet menu string."
  "New bet")

(defun blackjack--new-number-decks-prompt ()
  "Get new number of decks value."
  (read-string "Enter number of decks: "))

(defun blackjack--hand-menu (game)
  "Return GAME hand menu string."
  (let ((options '()))
    (when (blackjack--hand-can-double-p game)
      (push (format "(%s) double" blackjack-deal-double-key) options))
    (when (blackjack--hand-can-split-p game)
      (push (format "(%s) split" blackjack-split-key) options))
    (when (blackjack--hand-can-stand-p game)
      (push (format "(%s) stand" blackjack-stand-key) options))
    (when (blackjack--hand-can-hit-p game)
      (push (format "(%s) hit" blackjack-hit-key) options))
    (mapconcat #'identity options "  ")))

(defun blackjack--ask-hand-action (game)
  "Ask hand action for GAME."
  (let ((answer (blackjack--hand-actions-menu game)))
    (pcase answer
      ("stand" (blackjack--stand game))
      ("hit" (blackjack--hit game))
      ("split" (blackjack--split game))
      ("double" (blackjack--double game)))))

(defun blackjack--hand-actions-menu (game)
  "Hand actions menu for GAME."
  (let ((read-answer-short t)
	(actions '(("help" ?? "show help"))))
    (when (blackjack--hand-can-double-p game)
      (push `("double" ,blackjack-deal-double-key "double bet, deal a new card, and end hand") actions))
    (when (blackjack--hand-can-split-p game)
      (push `("split" ,blackjack-split-key "split hand into two hands") actions))
    (when (blackjack--hand-can-stand-p game)
      (push `("stand" ,blackjack-stand-key "end current hand with no further actions") actions))
    (when (blackjack--hand-can-hit-p game)
      (push `("hit" ,blackjack-hit-key "deal a new card") actions))
    (read-answer "Hand Action " actions)))

(defun blackjack--show-options-menu (game)
  "Switch to GAME options menu."
  (interactive)
  (when (blackjack--valid-menu-action-p game 'game)
    (setf (slot-value game 'current-menu) 'options)
    (blackjack--update-header game)
    (blackjack--ask-game-options game)))

(defun blackjack--ask-new-number-decks (game)
  "Get new number of GAME decks."
  (with-slots (current-menu num-decks) game
    (setf current-menu 'num-decks)
    (blackjack--update-header game)
    (setf num-decks (string-to-number (blackjack--new-number-decks-prompt)))
    (blackjack--normalize-num-decks game)
    (blackjack--persist-state game)
    (blackjack--shuffle game)
    (setf current-menu 'game)
    (blackjack--deal-new-hand game)))

(defun blackjack--show-game-menu (game)
  "Switch to GAME menu."
  (interactive)
  (setf (slot-value game 'current-menu) 'game)
  (blackjack--update-header game))

(dolist (menu '(deck-type face-type))
  (let ((func-name (intern (format "blackjack--show-%s-menu" menu))))
    (fset func-name
          (lambda (game)
            (interactive)
            (when (blackjack--valid-menu-action-p game 'options)
              (setf (slot-value game 'current-menu) menu)
              (blackjack--update-header game)
              (funcall (intern (format "blackjack--ask-%s-action" menu))))))))

(defun blackjack--persist-state-deal-new-hand (game)
  "Save GAME and deal new hand."
  (blackjack--persist-state game)
  (setf (slot-value game 'current-menu) 'game)
  (blackjack--deal-new-hand game))

(defun blackjack--shuffle-save-deal-new-hand (game)
  "Shuffle, save, and deal new GAME hand."
  (blackjack--shuffle game)
  (blackjack--persist-state-deal-new-hand game))

(defvar blackjack-minor-mode-map
  (let ((map (make-sparse-keymap)))
    map)
  "Blackjack minor mode keymap.")

(define-minor-mode blackjack-minor-mode
  "Blackjack minor mode.

\\{blackjack-minor-mode-map}"
  :group 'blackjack
  :lighter " blackjack")

(define-derived-mode blackjack-mode special-mode "Blackjack"
  "Blackjack game mode."
  :group 'blackjack)

(defun blackjack--init ()
  "Initialize game state."
  (let ((game (blackjack-game)))
    (blackjack--load-persisted-state game)
    (blackjack--normalize-num-decks game)
    (while (not (slot-value game 'quitting))
      (blackjack--deal-new-hand game))))

;;;###autoload
(defun blackjack ()
  "Run Blackjack."
  (interactive)
  (let ((debug-on-error t))
    (get-buffer-create blackjack--buffer-name)
    (switch-to-buffer blackjack--buffer-name)
    (with-current-buffer blackjack--buffer-name
      (add-hook 'blackjack-mode-hook #'blackjack-minor-mode)
      (blackjack-mode)
      (blackjack--init))))

(provide 'blackjack)
;;; blackjack.el ends here