Complete the rummy-family rules for 1.0: deep pickup, Hand & Foot

Rummy 500 gains the signature below-the-top discard pickup (T): take the
chosen card plus every card above it, melding or laying off the chosen
card at once.  New `deep-pickup' class slot keeps Basic Rummy top-only;
the AI takes a buried card when it completes a new meld; the pile renders
with 0=top depth indices.

Hand & Foot gains its three missing rules: pick up the discard pile (p)
by melding the top card with two matching naturals; red threes as bonus
cards (auto-collected with a replacement draw, +100 each / +200 all four);
and the round-by-round go-down minimum (50/90/120/150) enforced as one
atomic initial meld.

Add four ERT tests (suite 111->115); refresh the README and in-file
commentary; fix cg-rum500.el's truncated file footer.

README.org

@@ -69,10 +69,15 @@ with its command.
   cards off onto them; empty your hand to go out and score the cards left
   in the other hands.
 - ~cg-rum500~ -- Rummy 500.  As above, but you score the cards you lay
-  down and lose the cards left in your hand; first past 500 wins.
+  down and lose the cards left in your hand; first past 500 wins.  Take a
+  buried discard card with ~T~: you take it and every card above it, and
+  meld the chosen card at once.
 - ~cg-handfoot~ -- Hand & Foot.  A partnership Canasta cousin: play a hand
   and then a foot, build books of a rank with Twos and Jokers wild, and go
-  out once your side has completed two of them.
+  out once your side has completed two of them.  Each round opens with a
+  rising go-down minimum (50, 90, 120, 150); red threes are bonus cards;
+  and you can pick up the discard pile (~p~) by melding its top card with
+  two matching naturals.
 
 ** Matching
 - ~cg-go-fish~ -- Go Fish.  Ask another player for a rank you hold;

cg-bridge.el

@@ -490,15 +490,13 @@ vulnerability, and TRICKS the declarer side's trick count.  Keys:
   "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
   (cons (aref cg-bridge-ranks (cdr card)) (car card)))
 
-(cl-defun cg-bridge--svg-row (cards &key cursor hints)
-  "Return a one-image SVG row for CARDS with CURSOR and HINTS indices."
-  (propertize "*" 'display
-              (cg-svg-image
-               (cg-svg-hand-svg (mapcar #'cg-bridge--spec cards)
+(cl-defun cg-bridge--svg-row (cards &key cursor hints region-tag)
+  "Return a one-image SVG row for CARDS (clickable + sliderful when REGION-TAG)."
+  (cg-svg-hand-image (mapcar #'cg-bridge--spec cards)
                      :cursor cursor :hints hints
                      :overlap (if (> (length cards) 11)
-                                             (max 0 (- cg-svg-card-width 26)) 0))
-               (cg-scale))))
+                                  (max 0 (- cg-svg-card-width 26)) 0)
+                     :region-tag region-tag))
 
 (cl-defmethod cg-render ((game cg-bridge-game))
   "Return a propertized depiction of the Bridge GAME."
@@ -565,7 +563,7 @@ vulnerability, and TRICKS the declarer side's trick count.  Keys:
             (when (and (= (cg-get game :turn) act) (cg-bridge--legal-play-p game act c))
               (push i hi))
             (setq i (1+ i)))
-          (push (cg-bridge--svg-row hand :cursor cursor :hints hi) out)))
+          (push (cg-bridge--svg-row hand :cursor cursor :hints hi :region-tag 'hand) out)))
        ((eq phase 'play)
         (let ((i 0))
           (dolist (c hand)
@@ -580,8 +578,15 @@ vulnerability, and TRICKS the declarer side's trick count.  Keys:
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-bridge-game) action)
+  "Apply a click ACTION on the hand: select that card and play it."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i) (cg-bridge-play))
+    (_ (cl-call-next-method))))
+
 (defun cg-bridge--redisplay ()
   (let ((game cg-bridge--game) (inhibit-read-only t))
+    (setq cg-current-game game cg-redisplay-function #'cg-bridge--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -728,6 +733,11 @@ vulnerability, and TRICKS the declarer side's trick count.  Keys:
 
 (defvar cg-bridge-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-bridge-left)
     (define-key map (kbd "<right>") #'cg-bridge-right)
     (define-key map (kbd "<up>")    #'cg-bridge-up)

cg-core.el

@@ -44,6 +44,11 @@
   :group 'games
   :prefix "cg-")
 
+(defcustom cg-card-scale 1.0
+  "Card-size multiplier applied on top of any text scaling.
+Adjust with the card-size slider or the zoom keys (+/-/0)."
+  :type 'number :group 'card-games)
+
 
 ;;;; Engine base
 
@@ -94,7 +99,10 @@ and SPC as an action key.  Takes effect the next time a game starts."
 
 (defclass cg-renderer ()
   ((name :initarg :name :initform 'text :type symbol
-         :documentation "Symbol naming this treatment."))
+         :documentation "Symbol naming this treatment.")
+   (regions :initarg :regions :initform nil
+            :documentation "Click map from the last draw: list of (RECT . ACTION),
+RECT being (X Y W H) in unscaled image pixels."))
   "Abstract base class for a display treatment (a \"skin\")."
   :abstract t)
 
@@ -114,6 +122,26 @@ Return non-nil when the click was handled.")
   "Default method: treat the click as unhandled."
   nil)
 
+(defun cg-regions-hit (regions px py)
+  "Return the ACTION of the first region in REGIONS containing PX, PY.
+Each region is (RECT . ACTION) with RECT (X Y W H) in image pixels."
+  (cl-loop for (rect . action) in regions
+           for (x y w h) = rect
+           when (and (>= px x) (< px (+ x w)) (>= py y) (< py (+ y h)))
+           return action))
+
+(cl-defgeneric cg-render-apply (game action)
+  "Perform ACTION (returned by a renderer hit) on GAME.
+Card-size actions (scale/zoom) are handled here; games specialise this
+for their own actions and delegate the rest with `cl-call-next-method'."
+  (ignore game)
+  (pcase action
+    (`(scale . ,v) (setq cg-card-scale v) t)
+    ('zoom-in  (setq cg-card-scale (min 3.0 (+ cg-card-scale 0.15))) t)
+    ('zoom-out (setq cg-card-scale (max 0.4 (- cg-card-scale 0.15))) t)
+    ('zoom-reset (setq cg-card-scale 1.0) t)
+    (_ nil)))
+
 (defvar cg-renderers nil
   "Alist mapping a treatment name (a symbol) to a `cg-renderer' subclass.
 Populate it with `cg-register-renderer' and look entries up with
@@ -200,10 +228,53 @@ or batch), so callers always get a drawable colour string."
 
 (defun cg-scale ()
   "Return the SVG card scale factor for the current buffer.
-Tracks `text-scale-increase'/`text-scale-decrease' via the buffer-local
-`text-scale-mode-amount', so enlarging the text enlarges the cards."
+Combines `cg-card-scale' with `text-scale-mode-amount', so both the
+size slider and `text-scale-increase' enlarge the cards."
   (let ((amt (if (boundp 'text-scale-mode-amount) text-scale-mode-amount 0)))
-    (max 0.4 (min 4.0 (expt 1.15 amt)))))
+    (max 0.3 (min 4.0 (* cg-card-scale (expt 1.15 amt))))))
+
+(defvar-local cg-current-game nil
+  "The `cg-game' shown in the current buffer (for shared mouse/zoom).")
+
+(defvar-local cg-redisplay-function #'ignore
+  "Buffer-local function that redraws the current game's buffer.")
+
+(defun cg-card-refresh ()
+  "Redraw the current game buffer via `cg-redisplay-function'."
+  (funcall cg-redisplay-function))
+
+(defun cg-mouse-action (event)
+  "Return the action under mouse EVENT from the clicked image's region map.
+The clicked display string must carry a `cg-regions' text property."
+  (let* ((posn (event-start event)) (pt (posn-point posn))
+         (regions (and pt (get-text-property pt 'cg-regions))))
+    (when regions
+      (let ((xy (posn-object-x-y posn)) (sc (cg-scale)))
+        (and xy (cg-regions-hit regions
+                                (round (/ (car xy) sc)) (round (/ (cdr xy) sc))))))))
+
+(defun cg-card-click (event)
+  "Dispatch a mouse click on a card or control to the current game."
+  (interactive "e")
+  (let ((action (cg-mouse-action event)))
+    (when (and action cg-current-game)
+      (cg-render-apply cg-current-game action)
+      (cg-card-refresh))))
+
+(defun cg-card-zoom-in ()
+  "Make the cards larger."
+  (interactive)
+  (setq cg-card-scale (min 3.0 (+ cg-card-scale 0.15))) (cg-card-refresh))
+
+(defun cg-card-zoom-out ()
+  "Make the cards smaller."
+  (interactive)
+  (setq cg-card-scale (max 0.4 (- cg-card-scale 0.15))) (cg-card-refresh))
+
+(defun cg-card-zoom-reset ()
+  "Reset the card size."
+  (interactive)
+  (setq cg-card-scale 1.0) (cg-card-refresh))
 
 (provide 'cg-core)
 ;;; cg-core.el ends here

cg-cribbage.el

@@ -319,12 +319,19 @@ TOTAL is the running count after the play."
                         (mapconcat #'cg-rummy-card-string (cg-get game :crib) " ")) out))))
     (let* ((hand (if (eq phase 'play) (cg-crib--play game 0) (cg-crib--hand game 0))))
       (push (format "\n  Your %s:\n   " (if (eq phase 'play) "cards" "hand")) out)
-      (push (cg-rummy--render-cards hand cursor (cg-get game :marks)) out))
+      (push (cg-rummy--render-cards hand cursor (cg-get game :marks) nil 'hand) out))
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-cribbage-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-crib--redisplay ()
   (let ((game cg-crib--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-crib--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -406,6 +413,11 @@ TOTAL is the running count after the play."
 
 (defvar cg-cribbage-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-crib-left)
     (define-key map (kbd "<right>") #'cg-crib-right)
     (define-key map (kbd "SPC") #'cg-crib-mark)

cg-handfoot.el

@@ -36,10 +36,11 @@
 ;; computer opponents.  Mark cards with SPC, meld them with m, lay off onto
 ;; a book with l, and discard with RET.
 ;;
-;; This is a deliberately streamlined Hand & Foot: it omits picking up the
-;; discard pile, the red-three bonus, and round-by-round minimum-meld
-;; requirements, keeping the books, wilds, hand/foot, and partnership
-;; scoring that give the game its character.  Cards use the package cons
+;; This Hand & Foot includes the round-by-round go-down minimum (50, 90,
+;; 120, then 150), the red-three bonus (100 each, or 200 each for all four),
+;; and picking up the discard pile -- meld its top card with two matching
+;; naturals (`p') to take the top card plus several cards beneath it.
+;; Cards use the package cons
 ;; (SUIT . RANK), RANK 0 (Ace) .. 12 (King), with jokers as (joker . 0).
 
 ;;; Code:
@@ -53,6 +54,13 @@
   "Points a partnership needs to win Hand & Foot."
   :type 'integer :group 'card-games)
 
+(defcustom cg-handfoot-pickup-count 7
+  "Cards taken (top included) when picking up the discard pile."
+  :type 'integer :group 'card-games)
+
+(defconst cg-handfoot--minimums [50 90 120 150]
+  "Initial go-down minimum by round, the last value repeating thereafter.")
+
 (defconst cg-handfoot--names ["You" "West" "North" "East"]
   "Seat labels; North is your partner.")
 
@@ -70,6 +78,10 @@
   "Return non-nil when CARD is a three (never meldable)."
   (and (not (cg-rummy-joker-p card)) (= (cdr card) 2)))
 
+(defun cg-hf--red-three-p (card)
+  "Return non-nil when CARD is a red three (a bonus card)."
+  (and (not (cg-rummy-joker-p card)) (= (cdr card) 2) (cg-red-suit-p (car card))))
+
 (defun cg-hf-value (card)
   "Return the Hand & Foot point value of CARD."
   (cond ((cg-rummy-joker-p card) 50)
@@ -120,8 +132,12 @@
     (cg-put game :feet feet)
     (cg-put game :stage stage)
     (cg-put game :books (make-vector (cg-get game :nteams) nil))
+    (cg-put game :round (1+ (or (cg-get game :round) -1)))
+    (cg-put game :down (make-vector (cg-get game :nteams) nil))
+    (cg-put game :redthrees (make-vector (cg-get game :nteams) nil))
     (cg-put game :discard (list (pop deck)))
     (cg-put game :stock deck)
+    (dotimes (s n) (cg-hf--collect-red-threes game s))
     (cg-put game :turn 0)
     (cg-put game :step 'draw)
     (cg-put game :phase 'play)
@@ -133,6 +149,156 @@
 (defun cg-hf--books (game team) (aref (cg-get game :books) team))
 (defun cg-hf--set-books (game team v) (aset (cg-get game :books) team v))
 
+(defun cg-hf--down-p (game team)
+  "Return non-nil when TEAM has met this round's go-down minimum."
+  (aref (cg-get game :down) team))
+
+(defun cg-hf--min-for-round (game)
+  "Return the go-down minimum for GAME's current round."
+  (let ((r (or (cg-get game :round) 0)))
+    (aref cg-handfoot--minimums
+          (min r (1- (length cg-handfoot--minimums))))))
+
+(defun cg-hf--collect-red-threes (game s)
+  "Move seat S's red threes to its team pile, drawing replacements.
+Return the number collected."
+  (let ((team (cg-hf--team game s)) (moved 0) (again t))
+    (while again
+      (setq again nil)
+      (let ((rt (cl-find-if #'cg-hf--red-three-p (cg-rummy--hand game s))))
+        (when rt
+          (cg-rummy--set-hand game s (cg-rummy--remove1 rt (cg-rummy--hand game s)))
+          (aset (cg-get game :redthrees) team
+                (cons rt (aref (cg-get game :redthrees) team)))
+          (setq moved (1+ moved))
+          (let ((stock (cg-get game :stock)))
+            (when stock
+              (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                                          (cons (car stock) (cg-rummy--hand game s))))
+              (cg-put game :stock (cdr stock))))
+          (setq again t))))
+    moved))
+
+(defun cg-hf--take-foot (game s)
+  "Move seat S onto its foot, collecting any red threes it holds."
+  (aset (cg-get game :stage) s 1)
+  (cg-rummy--set-hand game s (aref (cg-get game :feet) s))
+  (cg-hf--collect-red-threes game s))
+
+(defun cg-hf--pickup-eligible (game s)
+  "Return non-nil when seat S may pick up the discard pile.
+That needs two natural cards in hand matching a meldable top discard."
+  (let ((top (cg-rummy--top game)))
+    (and top (not (cg-hf--wild-p top)) (not (cg-hf--three-p top))
+         (>= (cl-count-if (lambda (c) (and (not (cg-hf--wild-p c))
+                                           (= (cdr c) (cdr top))))
+                          (cg-rummy--hand game s))
+             2))))
+
+(defun cg-hf--pickup (game s)
+  "Seat S picks up the discard pile, melding its top card.
+Take the top card plus up to `cg-handfoot-pickup-count' - 1 cards beneath
+it into hand, melding the top with two matching naturals.  Return the top
+card, or nil if ineligible."
+  (when (cg-hf--pickup-eligible game s)
+    (let* ((pile (cg-get game :discard)) (top (car pile)) (rank (cdr top))
+           (team (cg-hf--team game s)) (books (cg-hf--books game team))
+           (nats (cl-remove-if-not
+                  (lambda (c) (and (not (cg-hf--wild-p c)) (= (cdr c) rank)))
+                  (cg-rummy--hand game s)))
+           (two (list (nth 0 nats) (nth 1 nats)))
+           (existing (cl-find-if
+                      (lambda (bk) (and (not (cg-hf--book-complete-p bk))
+                                        (equal (cg-hf--book-rank bk) rank)))
+                      books))
+           (rest (cdr pile))
+           (ntake (min (1- cg-handfoot-pickup-count) (length rest)))
+           (take (cl-subseq rest 0 ntake))
+           (remain (nthcdr ntake rest)))
+      (dolist (c two)
+        (cg-rummy--set-hand game s (cg-rummy--remove1 c (cg-rummy--hand game s))))
+      (if existing
+          (setcar (memq existing books)
+                  (cg-rummy-sort-hand (append (list top) two existing)))
+        (cg-hf--set-books game team
+                          (append books (list (cg-rummy-sort-hand (cons top two))))))
+      (cg-put game :discard remain)
+      (dolist (c take)
+        (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                                    (cons c (cg-rummy--hand game s)))))
+      (cg-hf--collect-red-threes game s)
+      top)))
+
+(defun cg-hf--partition-books (cards)
+  "Partition CARDS into valid books, or nil if they can't all be used.
+Naturals group by rank (each rank needs two), and wilds fill the groups."
+  (if (or (null cards) (cl-some #'cg-hf--three-p cards)) nil
+    (let ((wilds (cl-remove-if-not #'cg-hf--wild-p cards))
+          (byrank (make-hash-table :test 'eql)) (groups '()) (ok t))
+      (dolist (c cards)
+        (unless (cg-hf--wild-p c) (push c (gethash (cdr c) byrank))))
+      (maphash (lambda (_r cs) (push cs groups)) byrank)
+      (when (or (null groups) (cl-some (lambda (g) (< (length g) 2)) groups))
+        (setq ok nil))
+      (when ok
+        (let ((w (copy-sequence wilds)) (books '()))
+          (dolist (g (sort groups (lambda (a b) (< (length a) (length b)))))
+            (let ((bk (copy-sequence g)))
+              (while (and (< (length bk) 3) w) (push (pop w) bk))
+              (push bk books)))
+          (dolist (wcard w)
+            (let ((tgt (cl-find-if
+                        (lambda (bk)
+                          (and (< (length bk) 7)
+                               (< (cl-count-if #'cg-hf--wild-p bk) 3)
+                               (< (cl-count-if #'cg-hf--wild-p bk)
+                                  (cl-count-if-not #'cg-hf--wild-p bk))))
+                        books)))
+              (if tgt (setcar (memq tgt books) (cons wcard tgt)) (setq ok nil))))
+          (if (and ok (cl-every #'cg-hf--book-valid-p books)) books nil))))))
+
+(defun cg-hf--initial-meld (game s cards)
+  "Lay CARDS as seat S's initial meld, meeting the round minimum.
+Return non-nil when the team goes down."
+  (let* ((books (cg-hf--partition-books cards))
+         (team (cg-hf--team game s)))
+    (when (and books
+               (cl-subsetp cards (cg-rummy--hand game s) :test #'equal)
+               (>= (apply #'+ (mapcar #'cg-hf-value cards))
+                   (cg-hf--min-for-round game)))
+      (dolist (c cards)
+        (cg-rummy--set-hand game s (cg-rummy--remove1 c (cg-rummy--hand game s))))
+      (cg-hf--set-books game team
+                        (append (cg-hf--books game team)
+                                (mapcar #'cg-rummy-sort-hand books)))
+      (aset (cg-get game :down) team t)
+      t)))
+
+(defun cg-hf--ai-go-down (game s)
+  "Try to lay seat S's initial meld meeting the round minimum.
+Return non-nil when the team goes down."
+  (let* ((hand (cg-rummy--hand game s))
+         (byrank (make-hash-table :test 'eql))
+         (wilds (cl-remove-if-not #'cg-hf--wild-p hand)) (cards '()))
+    (dolist (c hand)
+      (unless (or (cg-hf--wild-p c) (cg-hf--three-p c))
+        (push c (gethash (cdr c) byrank))))
+    (let ((w (copy-sequence wilds)))
+      (maphash (lambda (_r cs)
+                 (cond ((>= (length cs) 3) (setq cards (append cs cards)))
+                       ((and (= (length cs) 2) w)
+                        (setq cards (append cs (list (pop w)) cards)))))
+               byrank))
+    (when (and cards (>= (apply #'+ (mapcar #'cg-hf-value cards))
+                         (cg-hf--min-for-round game)))
+      (cg-hf--initial-meld game s cards))))
+
+(defun cg-hf--ai-meld (game s)
+  "Meld for seat S, going down only when the round minimum is met."
+  (let ((team (cg-hf--team game s)))
+    (unless (cg-hf--down-p game team) (cg-hf--ai-go-down game s))
+    (when (cg-hf--down-p game team) (cg-hf--ai-extend game s))))
+
 ;;;; Engine
 
 (defun cg-hf--draw2 (game s)
@@ -182,8 +348,7 @@
   (let ((stage (cg-get game :stage)))
     (when (and (= (aref stage s) 0) (null (cg-rummy--hand game s)))
       ;; hand exhausted: pick up the foot
-      (aset stage s 1)
-      (cg-rummy--set-hand game s (aref (cg-get game :feet) s)))
+      (cg-hf--take-foot game s))
     (if (and (= (aref stage s) 1) (null (cg-rummy--hand game s))
              (cg-hf--can-go-out-p game (cg-hf--team game s)))
         (cg-hf--score-round game s)
@@ -211,6 +376,8 @@
             (setq pts (+ pts (if (cg-hf--book-clean-p bk) 500 300)))))
         (when (and outseat (= (cg-hf--team game outseat) team))
           (setq pts (+ pts 100)))         ; going-out bonus
+        (let ((k (length (aref (cg-get game :redthrees) team))))
+          (setq pts (+ pts (* k (if (>= k 4) 200 100)))))  ; red threes
         ;; subtract cards left in members' hands and feet
         (dotimes (s (cg-get game :nplayers))
           (when (= (cg-hf--team game s) team)
@@ -244,8 +411,8 @@
 
 ;;;; AI
 
-(defun cg-hf--ai-meld (game s)
-  "Lay down and extend books for seat S as far as is easy."
+(defun cg-hf--ai-extend (game s)
+  "Extend and add books for seat S once the team is down."
   ;; lay off naturals onto existing incomplete team books
   (let ((again t))
     (while again
@@ -312,19 +479,22 @@
 
 (cl-defmethod cg-hf--ai-turn ((game cg-handfoot-game) s)
   "Play seat S's whole turn."
-  (if (not (cg-hf--draw2 game s))
+  (let ((got (or (and (> (length (cg-get game :stock)) 30)
+                      (cg-hf--pickup-eligible game s)
+                      (cg-hf--pickup game s))
+                 (cg-hf--draw2 game s))))
+    (if (not got)
         (cg-hf--score-round game nil)
       (cg-hf--ai-meld game s)
       (when (eq (cg-get game :phase) 'play)
         ;; if the hand emptied through melding, pick up the foot and meld again
         (when (and (= (aref (cg-get game :stage) s) 0) (null (cg-rummy--hand game s)))
-        (aset (cg-get game :stage) s 1)
-        (cg-rummy--set-hand game s (aref (cg-get game :feet) s))
+          (cg-hf--take-foot game s)
           (cg-hf--ai-meld game s))
         (when (eq (cg-get game :phase) 'play)
           (if (cg-rummy--hand game s)
               (cg-hf--discard game s (cg-hf--ai-discard-card game s))
-          (cg-hf--advance game s))))))
+            (cg-hf--advance game s)))))))
 
 (defun cg-hf--run (game)
   "Advance AI seats until it is your turn or the round ends."
@@ -339,9 +509,15 @@
   "Return a propertized depiction of the Hand & Foot GAME."
   (let* ((out '()) (scores (cg-get game :scores))
          (hand (cg-rummy--hand game 0)) (cursor (cg-get game :cursor)))
-    (push (format "  Hand & Foot      target %d\n\n" cg-handfoot-target) out)
+    (push (format "  Hand & Foot   target %d   round %d  (go-down minimum %d)\n\n"
+                  cg-handfoot-target (1+ (or (cg-get game :round) 0))
+                  (cg-hf--min-for-round game)) out)
     (dotimes (team (cg-get game :nteams))
-      (push (format "  Team %d  (score %d):\n" team (aref scores team)) out)
+      (push (format "  Team %d  (score %d)%s%s:\n" team (aref scores team)
+                    (if (cg-hf--down-p game team) "  down"
+                      (format "  needs %d to go down" (cg-hf--min-for-round game)))
+                    (let ((k (length (aref (cg-get game :redthrees) team))))
+                      (if (> k 0) (format "  red3:%d" k) ""))) out)
       (let ((bks (cg-hf--books game team)))
         (if bks
             (dolist (bk bks)
@@ -359,20 +535,28 @@
                       (length (cg-rummy--hand game s))
                       (if (= (aref (cg-get game :stage) s) 1) " (on foot)" ""))
               out)))
-    (push (format "\n  Discard: %s     Stock: %d\n\n"
+    (push (format "\n  Discard: %s (pile %d)     Stock: %d\n\n"
                   (let ((cs (cg-rummy-card-string (cg-rummy--top game))) (tp (cg-rummy--top game)))
                     (if (and tp (not (cg-rummy-joker-p tp)) (cg-red-suit-p (car tp)))
                         (propertize cs 'face 'cg-red-suit) cs))
+                  (length (cg-get game :discard))
                   (length (cg-get game :stock)))
           out)
     (push (format "  Your %s:\n   " (if (= (aref (cg-get game :stage) 0) 1) "foot" "hand")) out)
-    (push (cg-rummy--render-cards hand cursor (cg-get game :marks)) out)
+    (push (cg-rummy--render-cards hand cursor (cg-get game :marks) nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-handfoot-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-hf--redisplay ()
   "Redraw the Hand & Foot buffer."
   (let ((game cg-hf--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-hf--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :step) (cg-get game :phase))))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@@ -413,23 +597,36 @@
     (mapcar (lambda (i) (nth i hand)) (sort (copy-sequence (cg-get g :marks)) #'<))))
 
 (defun cg-hf-meld ()
-  "Meld the marked cards as a new book."
+  "Meld the marked cards.
+Until your team is down you must mark a complete initial meld -- one or
+more valid books totalling at least the round minimum -- and lay it in one
+action.  After that, mark single books as usual."
   (interactive)
-  (let* ((g cg-hf--game) (cards (cg-hf--marked g)))
+  (let* ((g cg-hf--game) (cards (cg-hf--marked g)) (team (cg-hf--team g 0)))
     (cond
      ((not (cg-hf--my-turn-p g)) (cg-put g :message "Not your turn."))
      ((eq (cg-get g :step) 'draw) (cg-put g :message "Draw first (s)."))
+     ((not (cg-hf--down-p g team))
+      (if (cg-hf--initial-meld g 0 cards)
+          (progn
+            (cg-put g :marks nil) (cg-hf--clamp g)
+            (when (and (= (aref (cg-get g :stage) 0) 0) (null (cg-rummy--hand g 0)))
+              (cg-hf--take-foot g 0) (cg-hf--clamp g))
+            (cg-put g :message
+                    (format "You're down!  (met the %d minimum.)  Meld more, lay off, or discard."
+                            (cg-hf--min-for-round g))))
+        (cg-put g :message
+                (format "Initial meld must be valid books totalling >= %d; mark them all, then m."
+                        (cg-hf--min-for-round g)))))
      ((not (cg-hf--book-valid-p cards))
       (cg-put g :message "Not a legal book: 3+ of a rank, 2+ natural, wilds <= naturals."))
      ((cg-hf--meld g 0 cards)
       (cg-put g :marks nil) (cg-hf--clamp g)
-      (when (and (= (aref (cg-get g :stage) 0) 0) (null (cg-rummy--hand g 0)))
-        (aset (cg-get g :stage) 0 1)
-        (cg-rummy--set-hand g 0 (aref (cg-get g :feet) 0))
-        (cg-hf--clamp g)
+      (if (and (= (aref (cg-get g :stage) 0) 0) (null (cg-rummy--hand g 0)))
+          (progn (cg-hf--take-foot g 0) (cg-hf--clamp g)
                  (cg-put g :message "Hand cleared -- foot picked up!  Keep melding or discard (RET)."))
         (unless (and (= (aref (cg-get g :stage) 0) 1) (null (cg-rummy--hand g 0)))
-        (cg-put g :message "Booked.  Meld more, lay off (l), or discard (RET).")))
+          (cg-put g :message "Booked.  Meld more, lay off (l), or discard (RET)."))))
      (t (cg-put g :message "Could not meld those cards.")))
     (cg-hf--redisplay)))
 
@@ -455,11 +652,29 @@
      ((not (cg-hf--my-turn-p g)) (cg-put g :message "Not your turn."))
      ((not (eq (cg-get g :step) 'draw)) (cg-put g :message "You already drew."))
      ((cg-hf--draw2 g 0)
+      (cg-hf--collect-red-threes g 0)
       (cg-put g :step 'play) (cg-hf--clamp g)
       (cg-put g :message "Meld (m), lay off (l), then discard (RET)."))
      (t (cg-hf--score-round g nil)))
     (cg-hf--redisplay)))
 
+(defun cg-hf-pickup ()
+  "Pick up the discard pile by melding its top card (Hand & Foot)."
+  (interactive)
+  (let ((g cg-hf--game))
+    (cond
+     ((not (cg-hf--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((not (eq (cg-get g :step) 'draw)) (cg-put g :message "You already drew."))
+     ((not (cg-hf--pickup-eligible g 0))
+      (cg-put g :message
+              "Can't pick up: you need two natural cards matching the top discard."))
+     (t (let ((top (cg-hf--pickup g 0)))
+          (cg-put g :step 'play) (cg-hf--clamp g)
+          (cg-put g :message
+                  (format "Picked up the pile, melding %s.  Meld more, lay off, or discard."
+                          (cg-rummy-card-string top))))))
+    (cg-hf--redisplay)))
+
 (defun cg-hf-discard ()
   "Discard the cursor card and end your turn."
   (interactive)
@@ -480,7 +695,8 @@
   (interactive)
   (let ((g cg-hf--game))
     (when (eq (cg-get g :phase) 'game-over)
-      (cg-put g :scores (make-vector (cg-get g :nteams) 0)))
+      (cg-put g :scores (make-vector (cg-get g :nteams) 0))
+      (cg-put g :round -1))
     (cg-put g :reveal nil)
     (cg-hf--deal g)
     (cg-hf--run g)
@@ -491,16 +707,22 @@
 (defun cg-hf-help ()
   "Describe the Hand & Foot controls."
   (interactive)
-  (message "Arrows: choose  SPC: mark  m: meld  l: lay off  s: draw 2  RET: discard  n: new"))
+  (message "Arrows: choose  SPC: mark  m: meld  l: lay off  s: draw 2  p: pick up pile  RET: discard  n: new"))
 
 (defvar cg-handfoot-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-hf-left)
     (define-key map (kbd "<right>") #'cg-hf-right)
     (define-key map (kbd "SPC") #'cg-hf-mark)
     (define-key map "m" #'cg-hf-meld)
     (define-key map "l" #'cg-hf-layoff)
     (define-key map "s" #'cg-hf-draw)
+    (define-key map "p" #'cg-hf-pickup)
     (define-key map (kbd "RET") #'cg-hf-discard)
     (define-key map "n" #'cg-hf-new)
     (define-key map "g" #'cg-hf-redraw)

cg-match.el

@@ -208,12 +208,19 @@ Return non-nil when S can ask."
     (push (format "\n  Stock: %d        Your books: %d\n\n"
                   (length (cg-get game :stock)) (cg-gf--books game 0)) out)
     (push "  Your hand:\n   " out)
-    (push (cg-rummy--render-cards hand cursor nil) out)
+    (push (cg-rummy--render-cards hand cursor nil nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-go-fish-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-gf--redisplay ()
   (let ((game cg-gf--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-gf--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -257,6 +264,11 @@ Return non-nil when S can ask."
 
 (defvar cg-go-fish-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-gf-left)
     (define-key map (kbd "<right>") #'cg-gf-right)
     (dolist (k '("1" "2" "3" "4")) (define-key map k #'cg-gf-ask))

cg-render.el

@@ -94,5 +94,33 @@ The default treatment comes from `cg-render-resolve-treatment'."
   "Switch GAME to the treatment NAME and return its new renderer."
   (oset game renderer (cg-make-renderer name)))
 
+(cl-defgeneric cg-render-text (game)
+  "Return the plain-text display string for GAME.
+The default falls back to the game's `cg-render' method."
+  (cg-render game))
+
+(cl-defgeneric cg-render-svg (game)
+  "Return (DISPLAY-STRING . REGIONS) for GAME's SVG treatment.
+The default falls back to the `cg-render' string with no click regions."
+  (cons (cg-render game) nil))
+
+(cl-defmethod cg-renderer-draw ((r cg-text-renderer) (game cg-game))
+  "Draw GAME as plain text, clearing any click regions."
+  (oset r regions nil)
+  (insert (cg-render-text game)))
+
+(cl-defmethod cg-renderer-draw ((r cg-svg-renderer) (game cg-game))
+  "Draw GAME as SVG and record its click regions on R."
+  (let ((res (cg-render-svg game)))
+    (oset r regions (cdr res))
+    (insert (car res))))
+
+(cl-defmethod cg-renderer-hit ((r cg-svg-renderer) (game cg-game) position)
+  "Map POSITION to a game action via the regions recorded at the last draw."
+  (ignore game)
+  (let ((xy (posn-object-x-y position)) (sc (cg-scale)))
+    (and xy (cg-regions-hit (oref r regions)
+                            (round (/ (car xy) sc)) (round (/ (cdr xy) sc))))))
+
 (provide 'cg-render)
 ;;; cg-render.el ends here

cg-rum500.el

@@ -34,7 +34,9 @@
 ;;   `cg-rummy-basic' -- plain Rummy: the first player to meld their whole
 ;;     hand wins the deal and scores the cards left in the others' hands.
 ;;   `cg-rum500' -- Rummy 500: you score the cards you lay down and lose
-;;     the cards left in your hand; first past 500 wins.
+;;     the cards left in your hand; first past 500 wins.  In Rummy 500 you
+;;     may take a card from anywhere in the discard pile (T): you take that
+;;     card and everything above it, and the chosen card is melded at once.
 ;;
 ;; You are the South player (seat 0); the rest are simple AI.  To meld,
 ;; mark cards with SPC and press m; to lay a card off, put the cursor on
@@ -53,7 +55,8 @@
    (ace-15    :initarg :ace-15    :initform nil)
    (ace-high  :initarg :ace-high  :initform nil)
    (target    :initarg :target    :initform 100)
-   (score-style :initarg :score-style :initform 'go-out))
+   (score-style :initarg :score-style :initform 'go-out)
+   (deep-pickup :initarg :deep-pickup :initform nil))
   "Abstract base for table-meld rummy games (Basic Rummy, Rummy 500)."
   :abstract t)
 
@@ -84,6 +87,7 @@
 
 (defun cg-tm--ace-high (game) (oref game ace-high))
 (defun cg-tm--ace-15 (game) (oref game ace-15))
+(defun cg-tm--deep-pickup (game) (oref game deep-pickup))
 
 (defun cg-tm--draw (game s)
   "Move one stock card to seat S's hand; return it or nil if stock empty."
@@ -240,16 +244,72 @@ Return non-nil if any meld was laid."
       (let ((v (cg-rummy-value c (cg-tm--ace-15 game))))
         (when (> v bestv) (setq best c bestv v))))))
 
+(defun cg-tm--meld-for-target (game cards target)
+  "Return a minimal valid meld (card list) containing TARGET drawn from CARDS.
+Return nil when TARGET cannot join a set or run with the other CARDS."
+  (let* ((ace-high (cg-tm--ace-high game))
+         (pool (cons target cards))
+         (cands (cg-rummy--candidate-melds pool :ace-high ace-high))
+         (vec (vconcat pool))
+         (withtgt (cl-remove-if-not (lambda (m) (memq 0 m)) cands)))
+    (when withtgt
+      (setq withtgt (sort withtgt (lambda (a b) (< (length a) (length b)))))
+      (mapcar (lambda (i) (aref vec i)) (car withtgt)))))
+
+(defun cg-tm--take-deep (game s depth)
+  "Seat S takes the card DEPTH-deep in the discard pile, plus all above it.
+The chosen card is melded or laid off at once, as Rummy 500 requires; the
+rest enter the hand.  Return a status string, or nil when the move is not
+legal (the chosen card cannot be used immediately)."
+  (let* ((pile (cg-get game :discard)) (n (length pile)))
+    (when (and (cg-tm--deep-pickup game) (>= depth 0) (< depth n))
+      (let* ((target (nth depth pile))
+             (above (cl-subseq pile 0 depth))
+             (avail (append (cg-rummy--hand game s) above))
+             (lay (cl-find-if
+                   (lambda (r)
+                     (cg-rummy-meld-p (cons target (cdr r)) :min 3
+                                      :ace-high (cg-tm--ace-high game)))
+                   (cg-get game :table)))
+             (meld (unless lay (cg-tm--meld-for-target game avail target))))
+        (when (or lay meld)
+          (let ((taken (cl-subseq pile 0 (1+ depth))))
+            (cg-put game :discard (nthcdr (1+ depth) pile))
+            (dolist (c taken)
+              (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                                          (cons c (cg-rummy--hand game s))))))
+          (if lay (cg-tm--layoff game s target) (cg-tm--meld game s meld))
+          (format "Took %d card%s and used %s."
+                  (1+ depth) (if (= depth 0) "" "s")
+                  (cg-rummy-card-string target)))))))
+
+(defun cg-tm--ai-deep-pickup (game s)
+  "Try a worthwhile below-the-top discard pickup for seat S.
+Return non-nil when one was taken."
+  (when (cg-tm--deep-pickup game)
+    (let* ((pile (cg-get game :discard)) (n (length pile))
+           (limit (min n 7)) (hand (cg-rummy--hand game s)) (chosen nil))
+      (cl-loop for d from 1 below limit
+               for target = (nth d pile)
+               for above = (cl-subseq pile 0 d)
+               when (cg-tm--meld-for-target game (append hand above) target)
+               do (setq chosen d) (cl-return))
+      (when chosen (cg-tm--take-deep game s chosen)))))
+
 (cl-defmethod cg-tm--ai-turn ((game cg-tablemeld-game) s)
   "Play seat S's whole turn."
+  (let* ((deep (cg-tm--ai-deep-pickup game s))
+         (drew (if deep t
                  (let* ((hand (cg-rummy--hand game s))
                         (up (cg-rummy--top game))
-         (cur (cg-rummy-deadwood hand (cg-tm--ace-high game) (cg-tm--ace-15 game)))
-         (with (and up (cg-rummy-deadwood (cons up hand)
-                                          (cg-tm--ace-high game) (cg-tm--ace-15 game))))
-         (drew (if (and up with (< with cur))
+                        (cur (cg-rummy-deadwood hand (cg-tm--ace-high game)
+                                                (cg-tm--ace-15 game)))
+                        (with (and up (cg-rummy-deadwood
+                                       (cons up hand)
+                                       (cg-tm--ace-high game) (cg-tm--ace-15 game)))))
+                   (if (and up with (< with cur))
                        (cg-tm--take-top game s)
-                 (cg-tm--draw game s))))
+                     (cg-tm--draw game s))))))
     (if (not drew)
         (cg-tm--score-hand game nil)
       (cg-tm--ai-melds game s)
@@ -268,6 +328,22 @@ Return non-nil if any meld was laid."
 
 (defvar-local cg-tm--game nil "The table-meld game in the current buffer.")
 
+(defun cg-tm--discard-string (game)
+  "Return the discard-pile display line for GAME.
+Deep-pickup games show the whole pile with depth indices (0 = top)."
+  (cl-flet ((paint (c)
+              (let ((cs (cg-rummy-card-string c)))
+                (if (and c (not (cg-rummy-joker-p c)) (cg-red-suit-p (car c)))
+                    (propertize cs 'face 'cg-red-suit) cs))))
+    (let ((pile (cg-get game :discard)))
+      (if (and (cg-tm--deep-pickup game) (cdr pile))
+          (concat "Discard (0=top): "
+                  (let ((i -1))
+                    (mapconcat
+                     (lambda (c) (setq i (1+ i)) (format "%d:%s" i (paint c)))
+                     (cl-subseq pile 0 (min (length pile) 12)) " ")))
+        (concat "Discard: " (paint (cg-rummy--top game)))))))
+
 (defun cg-tm--layoff-hint (game)
   "Return a predicate marking cards that can be laid off in GAME now."
   (lambda (c)
@@ -295,9 +371,8 @@ Return non-nil if any meld was laid."
                         (mapconcat #'cg-rummy-card-string (cdr rec) " "))
                 out))
       (push "    (empty)\n" out))
-    (push (format "\n  Discard: %s     Stock: %d\n\n"
-                  (let ((cs (cg-rummy-card-string (cg-rummy--top game))) (tp (cg-rummy--top game)))
-                    (if (and tp (cg-red-suit-p (car tp))) (propertize cs 'face 'cg-red-suit) cs))
+    (push (format "\n  %s     Stock: %d\n\n"
+                  (cg-tm--discard-string game)
                   (length (cg-get game :stock)))
           out)
     (push (format "  Your hand%s:\n   "
@@ -306,14 +381,21 @@ Return non-nil if any meld was laid."
                     (format "  (score %d)" (aref scores 0))))
           out)
     (push (cg-rummy--render-cards hand cursor (cg-get game :marks)
-                                  (cg-tm--layoff-hint game))
+                                  (cg-tm--layoff-hint game) 'hand)
           out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-tablemeld-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-tm--redisplay ()
   "Redraw the table-meld buffer."
   (let ((game cg-tm--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-tm--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :step) (cg-get game :phase))))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@@ -408,6 +490,32 @@ Return non-nil if any meld was laid."
                                      (cg-rummy-card-string c))))))
     (cg-tm--redisplay)))
 
+(defun cg-tm-take-deep ()
+  "Take a card from below the top of the discard pile (Rummy 500).
+You take that card and every card lying on top of it; the chosen card is
+melded or laid off at once, the rest go into your hand."
+  (interactive)
+  (let* ((g cg-tm--game) (pile (cg-get g :discard)) (n (length pile)))
+    (cond
+     ((not (cg-tm--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((not (cg-tm--deep-pickup g))
+      (cg-put g :message "This game lets you take only the top discard (t)."))
+     ((not (eq (cg-get g :step) 'draw)) (cg-put g :message "You already drew."))
+     ((< n 1) (cg-put g :message "The discard pile is empty."))
+     (t (let ((depth (read-number
+                      (format "Take how deep?  0=top .. %d (you must meld that card): "
+                              (1- n)) 0)))
+          (if (and (integerp depth) (>= depth 0) (< depth n))
+              (let ((desc (cg-tm--take-deep g 0 depth)))
+                (if desc
+                    (progn (cg-put g :step 'play) (cg-tm--clamp-cursor g)
+                           (cg-put g :message
+                                   (concat desc "  Meld, lay off, or discard (RET).")))
+                  (cg-put g :message
+                          "You can't use that card right now -- choose another.")))
+            (cg-put g :message "No card at that depth.")))))
+    (cg-tm--redisplay)))
+
 (defun cg-tm-discard ()
   "Discard the cursor card and end your turn."
   (interactive)
@@ -439,10 +547,15 @@ Return non-nil if any meld was laid."
 (defun cg-tm-help ()
   "Describe the table-meld controls."
   (interactive)
-  (message "Arrows: choose  SPC: mark  m: meld  l: lay off  s: draw  t: take  RET: discard  n: new"))
+  (message "Arrows: choose  SPC: mark  m: meld  l: lay off  s: draw  t: take  T: deep take  RET: discard  n: new"))
 
 (defvar cg-tm-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-tm-left)
     (define-key map (kbd "<right>") #'cg-tm-right)
     (define-key map (kbd "SPC") #'cg-tm-mark)
@@ -450,6 +563,7 @@ Return non-nil if any meld was laid."
     (define-key map "l" #'cg-tm-layoff)
     (define-key map "s" #'cg-tm-draw-stock)
     (define-key map "t" #'cg-tm-take)
+    (define-key map "T" #'cg-tm-take-deep)
     (define-key map (kbd "RET") #'cg-tm-discard)
     (define-key map "n" #'cg-tm-new)
     (define-key map "g" #'cg-tm-redraw)
@@ -501,6 +615,7 @@ Return non-nil if any meld was laid."
    (score-style :initform 'meld-points)
    (ace-15 :initform t)
    (ace-high :initform t)
+   (deep-pickup :initform t)
    (target :initform 500))
   "A game of Rummy 500.")
 
@@ -516,4 +631,4 @@ Return non-nil if any meld was laid."
 (defalias 'cg-rummy-500 #'cg-rum500)
 
 (provide 'cg-rum500)
-;;; 
+;;; cg-rum500.el ends here

cg-rummy.el

@@ -289,27 +289,30 @@ Set to nil to force the plain-text card row everywhere."
   (if (cg-rummy-joker-p card) (cons "" 'joker)
     (cons (aref cg-rummy-ranks (cdr card)) (car card))))
 
-(defun cg-rummy--svg-row (cards cursor marks hint-fn)
-  "Return a one-image SVG row for CARDS with CURSOR, MARKS and HINT-FN."
-  (let* ((specs (mapcar #'cg-rummy--card-spec cards))
-         (hints (when hint-fn
+(defun cg-rummy--svg-row (cards cursor marks hint-fn &optional region-tag)
+  "Return a one-image SVG row for CARDS (clickable + sliderful when REGION-TAG).
+HINT-FN is an optional predicate marking playable cards."
+  (let ((hints (when hint-fn
                  (let ((hs '()) (i 0))
                    (dolist (c cards) (when (funcall hint-fn c) (push i hs))
                            (setq i (1+ i)))
-                    hs)))
-         (cur (and (integerp cursor) (>= cursor 0) cursor))
-         (overlap (if (> (length cards) 11) (max 0 (- cg-svg-card-width 24)) 0))
-         (svg (cg-svg-hand-svg specs :cursor cur :hints hints
-                               :marks marks :overlap overlap)))
-    (propertize "*" 'display (cg-svg-image svg (cg-scale)))))
+                   hs))))
+    (cg-svg-hand-image (mapcar #'cg-rummy--card-spec cards)
+                       :cursor (and (integerp cursor) (>= cursor 0) cursor)
+                       :marks marks :hints hints
+                       :overlap (if (> (length cards) 11)
+                                    (max 0 (- cg-svg-card-width 24)) 0)
+                       :region-tag region-tag)))
 
-(defun cg-rummy--render-cards (cards cursor marks &optional hint-fn)
+(defun cg-rummy--render-cards (cards cursor marks &optional hint-fn region-tag)
   "Return a propertized row of CARDS.
 CURSOR is the highlighted index, MARKS a list of marked indices, and
-HINT-FN an optional predicate marking playable cards.  Draws SVG cards on
-a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
+HINT-FN an optional predicate marking playable cards.  When REGION-TAG is
+non-nil the SVG row is clickable (each card mapped to (REGION-TAG . INDEX))
+and carries a card-size slider.  Draws SVG cards on a graphical display
+\(see `cg-rummy-svg-cards'), else a plain-text row."
   (if (and cg-rummy-svg-cards (display-graphic-p))
-      (cg-rummy--svg-row cards cursor marks hint-fn)
+      (cg-rummy--svg-row cards cursor marks hint-fn region-tag)
   (let ((i 0) (out '()))
     (dolist (c cards)
       (let ((cs (cg-rummy-card-string c)) (faces nil))
@@ -485,7 +488,7 @@ a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
           out)
     (push (format "  Your hand (deadwood %d, score %d):\n   "
                   (cg-gin--deadwood hand) (aref scores 0)) out)
-    (push (cg-rummy--render-cards hand cursor nil) out)
+    (push (cg-rummy--render-cards hand cursor nil nil 'hand) out)
     (when reveal
       (let ((p (cg-rummy-best-partition hand)))
         (push (format "\n    melds: %s\n    deadwood: %s"
@@ -495,9 +498,16 @@ a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-gin-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-gin--redisplay ()
   "Redraw the Gin Rummy buffer."
   (let ((game cg-gin--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-gin--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :step) (cg-get game :phase))))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@@ -610,6 +620,11 @@ a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
 
 (defvar cg-gin-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-gin-left)
     (define-key map (kbd "<right>") #'cg-gin-right)
     (define-key map "s" #'cg-gin-draw-stock)

cg-scopa.el

@@ -235,12 +235,20 @@ Only subsets of two or more cards are considered.  Return nil if none."
             "(empty)")
           out)
     (push "\n\n  Your hand:\n   " out)
-    (push (cg-rummy--render-cards (cg-fish--hand game 0) cursor nil) out)
+    (push (cg-rummy--render-cards (cg-fish--hand game 0) cursor nil nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-fish-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i)
+      (cg-fish-play))
+    (_ (cl-call-next-method))))
+
 (defun cg-fish--redisplay ()
   (let ((game cg-fish--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-fish--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -287,6 +295,11 @@ Only subsets of two or more cards are considered.  Return nil if none."
 
 (defvar cg-fish-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-fish-left)
     (define-key map (kbd "<right>") #'cg-fish-right)
     (define-key map (kbd "RET") #'cg-fish-play)

cg-solitaire.el

@@ -50,6 +50,7 @@
 (require 'eieio)
 (require 'cg-core)
 (require 'cg-svg)
+(require 'cg-render)
 
 ;;;; Cards
 
@@ -610,31 +611,34 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
   (and card (cons (aref cg-sol-ranks (cdr card)) (car card))))
 
 (defun cg-sol--svg (game)
-  "Return a propertized one-image SVG board for solitaire GAME."
+  "Return (DISPLAY . REGIONS) for an SVG board of solitaire GAME.
+DISPLAY is a propertized one-image string; REGIONS is a click map of
+\(RECT . SPOT) entries, RECT being (X Y W H) in unscaled image pixels."
   (let* ((w cg-svg-card-width) (h cg-svg-card-height)
          (pad 12) (gap cg-svg-card-gap) (colgap 8) (vdown 12) (vup 26)
          (ncols (oref game ncols))
          (cur-spot (cg-sol--cur-spot game))
          (sel (cg-get game :sel)) (sel-n (or (cg-get game :sel-n) 0))
          (lc (cg-color 'shadow :foreground "gray40"))
-         (slots '()))
+         (regions '()) (slots '()))
     (when (oref game has-stock)
       (push (list (format "Stock(%d)" (length (cg-get game :stock)))
-                  nil (and (cg-get game :stock) t) (equal cur-spot '(stock . 0))) slots))
+                  nil (and (cg-get game :stock) t) (equal cur-spot '(stock . 0))
+                  '(stock . 0)) slots))
     (when (oref game has-waste)
       (push (list "Waste" (cg-sol--spec (car (last (cg-get game :waste)))) nil
-                  (equal cur-spot '(waste . 0))) slots))
+                  (equal cur-spot '(waste . 0)) '(waste . 0)) slots))
     (when (oref game has-reserve)
       (push (list (format "Resv(%d)" (length (cg-get game :reserve)))
                   (cg-sol--spec (car (last (cg-get game :reserve)))) nil
-                  (equal cur-spot '(reserve . 0))) slots))
+                  (equal cur-spot '(reserve . 0)) '(reserve . 0)) slots))
     (dotimes (i (oref game nfree))
       (push (list (format "F%d" (1+ i)) (cg-sol--spec (aref (cg-get game :free) i)) nil
-                  (equal cur-spot (cons 'free i))) slots))
+                  (equal cur-spot (cons 'free i)) (cons 'free i)) slots))
     (dotimes (i (oref game nfound))
       (push (list (format "%d" (1+ i))
                   (cg-sol--spec (car (last (aref (cg-get game :found) i)))) nil
-                  (equal cur-spot (cons 'found i))) slots))
+                  (equal cur-spot (cons 'found i)) (cons 'found i)) slots))
     (setq slots (nreverse slots))
     (let* ((ntop (length slots))
            (topw (+ (* 2 pad) (* ntop (+ w gap))))
@@ -653,13 +657,14 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
            (svg (svg-create width height)))
       (let ((x pad))
         (dolist (sl slots)
-          (cl-destructuring-bind (label spec downp cursorp) sl
+          (cl-destructuring-bind (label spec downp cursorp spot) sl
             (svg-text svg label :x (+ x 1) :y (- top-y 3) :font-size 11 :fill lc
                       :font-family cg-svg-font-family)
             (cond (downp (cg-svg-card svg x top-y :down t :highlight cursorp))
                   (spec (cg-svg-card svg x top-y :rank (car spec) :suit (cdr spec)
                                      :highlight cursorp))
-                  (t (cg-svg-card svg x top-y :gap t :highlight cursorp))))
+                  (t (cg-svg-card svg x top-y :gap t :highlight cursorp)))
+            (push (cons (list x top-y w h) spot) regions))
           (setq x (+ x w gap))))
       (dotimes (c ncols)
         (let* ((x (+ pad (* c (+ w colgap)))) (col (aref tab c)) (len (length col))
@@ -667,6 +672,7 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
                (cursorp (equal cur-spot (cons 'col c))))
           (svg-text svg (format "%d" (1+ c)) :x (+ x 1) :y col-label-y
                     :font-size 11 :fill lc :font-family cg-svg-font-family)
+          (push (cons (list x col-y w maxext) (cons 'col c)) regions)
           (if (= len 0)
               (cg-svg-card svg x y :gap t :highlight cursorp)
             (dolist (card col)
@@ -677,14 +683,27 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
                                :suit (cdr (cg-sol--spec card))
                                :highlight (and top-card cursorp) :hint selp))
                 (setq y (+ y (if downp vdown vup)) r (1+ r)))))))
-      (propertize "*" 'display (cg-svg-image svg (cg-scale))))))
+      (cons (propertize "*" 'display (cg-svg-image svg (cg-scale)))
+            (nreverse regions)))))
 
 (cl-defmethod cg-render ((game cg-solitaire-game))
   "Return a propertized depiction of GAME (SVG on a graphical display)."
   (if (and cg-sol-svg-cards (display-graphic-p))
-      (cg-sol--svg game)
+      (car (cg-sol--svg game))
     (cg-sol--render-text game)))
 
+(cl-defmethod cg-render-text ((game cg-solitaire-game))
+  (cg-sol--render-text game))
+
+(cl-defmethod cg-render-svg ((game cg-solitaire-game))
+  (if cg-sol-svg-cards (cg-sol--svg game)
+    (cons (cg-sol--render-text game) nil)))
+
+(cl-defmethod cg-render-apply ((game cg-solitaire-game) action)
+  "Apply a click ACTION (a cursor spot) by selecting it and acting."
+  (let ((idx (cl-position action (cg-sol--spots game) :test #'equal)))
+    (when idx (cg-put game :cursor idx) (cg-sol-act))))
+
 (defun cg-sol--render-text (game)
   "Return a plain-text depiction of solitaire GAME."
   (let* ((spots (cg-sol--spots game))
@@ -763,13 +782,22 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
                                   (let ((s (cg-get game :sel)))
                                     (if s "carrying" "playing")))))
     (erase-buffer)
-    (insert (cg-render game))
+    (cg-render-game game)
     (goto-char (point-min))))
 
 ;;;; Mode and commands
 
+(defun cg-sol-mouse (event)
+  "Handle a mouse click on the solitaire board: select that pile and act."
+  (interactive "e")
+  (let* ((game cg-sol--game)
+         (r (and game (oref game renderer)))
+         (action (and r (cg-renderer-hit r game (event-start event)))))
+    (when action (cg-render-apply game action))))
+
 (defvar cg-sol-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-sol-mouse)
     (define-key map (kbd "<left>")  #'cg-sol-left)
     (define-key map (kbd "<right>") #'cg-sol-right)
     (define-key map (kbd "<up>")    #'cg-sol-up)

cg-spite.el

@@ -291,12 +291,20 @@
           out)
     (push (format "  Your discards: %s\n\n" (cg-spite--disc-string game 0)) out)
     (push "  Your hand:\n   " out)
-    (push (cg-rummy--render-cards (cg-spite--hand game 0) cursor nil) out)
+    (push (cg-rummy--render-cards (cg-spite--hand game 0) cursor nil nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-spite-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i)
+      (cg-spite-play))
+    (_ (cl-call-next-method))))
+
 (defun cg-spite--redisplay ()
   (let ((game cg-spite--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-spite--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -391,6 +399,11 @@
 
 (defvar cg-spite-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-spite-left)
     (define-key map (kbd "<right>") #'cg-spite-right)
     (define-key map (kbd "RET") #'cg-spite-play)

cg-svg.el

@@ -404,5 +404,65 @@ indices to ring as playable and as marked; OVERLAP fans the cards."
       (setq x (+ x step) i (1+ i)))
     svg))
 
+(defcustom cg-svg-slider-stops '(0.6 0.8 1.0 1.25 1.5 1.8 2.2)
+  "Card-size slider stops, as scale multipliers."
+  :type '(repeat number) :group 'card-games)
+
+(defun cg-svg-slider-width ()
+  "Return the pixel width of the card-size slider."
+  (+ 36 (* (length cg-svg-slider-stops) 24) 8))
+
+(defun cg-svg-slider-height ()
+  "Return the pixel height of the card-size slider."
+  24)
+
+(defun cg-svg-slider-draw (svg x y current)
+  "Draw a card-size slider into SVG at X, Y knobbed at CURRENT.
+Return its click regions as a list of (RECT . (scale . VALUE))."
+  (let* ((stops cg-svg-slider-stops) (segw 24) (regions '()) (i 0)
+         (cy (+ y 10)) (tx (+ x 36)))
+    (svg-text svg "size" :x x :y (+ y 14) :font-size 9 :fill "gray55"
+              :font-family cg-svg-font-family)
+    (svg-line svg tx cy (+ tx (* (length stops) segw)) cy
+              :stroke "gray60" :stroke-width 2)
+    (dolist (v stops)
+      (let* ((px (+ tx (* i segw) (/ segw 2)))
+             (near (< (abs (- v current)) 0.08)))
+        (svg-circle svg px cy (if near 7 4)
+                    :fill (if near (cg-svg--highlight) "white")
+                    :stroke "gray50" :stroke-width 1)
+        (push (cons (list (+ tx (* i segw)) y segw 22) (cons 'scale v)) regions))
+      (setq i (1+ i)))
+    (nreverse regions)))
+
+(cl-defun cg-svg-hand-image (specs &key cursor marks hints (overlap 0) region-tag)
+  "Return a propertized one-image string for a hand of card SPECS.
+CURSOR is the highlighted index; MARKS and HINTS are index lists.  With
+REGION-TAG non-nil, the image carries a `cg-regions' click map (each card
+as (REGION-TAG . INDEX)) and a card-size slider beneath the row."
+  (if (not region-tag)
+      (propertize "*" 'display
+                  (cg-svg-image (cg-svg-hand-svg specs :cursor cursor :hints hints
+                                                 :marks marks :overlap overlap)
+                                (cg-scale)))
+    (let* ((w cg-svg-card-width) (h cg-svg-card-height) (pad 8)
+           (step (max 1 (- (+ w cg-svg-card-gap) overlap)))
+           (n (length specs))
+           (cardw (if (> n 0) (+ (* (1- n) step) w) w))
+           (sh (cg-svg-slider-height))
+           (width (+ (* 2 pad) (max cardw (cg-svg-slider-width))))
+           (height (+ (* 2 pad) h 8 sh))
+           (svg (svg-create width height)) (regions '()) (x pad) (i 0))
+      (dolist (spec specs)
+        (cg-svg--draw-spec svg x pad spec (eql i cursor) (and (memq i hints) t))
+        (when (memq i marks)
+          (svg-rectangle svg (- x 3) (- pad 3) (+ w 6) (+ h 6)
+                         :rx 7 :fill "none" :stroke "#4a90d9" :stroke-width 3))
+        (push (cons (list x pad w h) (cons region-tag i)) regions)
+        (setq x (+ x step) i (1+ i)))
+      (setq regions (append (nreverse regions)
+                            (cg-svg-slider-draw svg pad (+ pad h 8) cg-card-scale)))
+      (propertize "*" 'display (cg-svg-image svg (cg-scale)) 'cg-regions regions))))
+
 (provide 'cg-svg)
 ;;; cg-svg.el ends here

cg-trick.el

@@ -537,15 +537,13 @@
   "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
   (cons (aref cg-trick-ranks (cdr card)) (car card)))
 
-(cl-defun cg-trick--svg-row (cards &key cursor marks hints)
-  "Return a one-image SVG row for CARDS with CURSOR, MARKS, HINTS indices."
-  (propertize "*" 'display
-              (cg-svg-image
-               (cg-svg-hand-svg (mapcar #'cg-trick--spec cards)
+(cl-defun cg-trick--svg-row (cards &key cursor marks hints region-tag)
+  "Return a one-image SVG row for CARDS (clickable + sliderful when REGION-TAG)."
+  (cg-svg-hand-image (mapcar #'cg-trick--spec cards)
                      :cursor cursor :marks marks :hints hints
                      :overlap (if (> (length cards) 11)
-                                             (max 0 (- cg-svg-card-width 24)) 0))
-               (cg-scale))))
+                                  (max 0 (- cg-svg-card-width 24)) 0)
+                     :region-tag region-tag))
 
 (cl-defmethod cg-render ((game cg-trick-game))
   "Return a propertized string depicting GAME for a text display."
@@ -584,7 +582,8 @@
             (when (member c marks) (push i mi))
             (when (and legalp (cg-trick--legal-p game 0 c)) (push i hi))
             (setq i (1+ i)))
-          (push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi) out))
+          (push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi
+                                  :region-tag 'hand) out))
       (let ((i 0))
         (dolist (c hand)
           (let* ((cs (cg-trick-card-string c))
@@ -597,9 +596,16 @@
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-trick-game) action)
+  "Apply a click ACTION on the hand: select that card and play it."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i) (cg-trick-act))
+    (_ (cl-call-next-method))))
+
 (defun cg-trick--redisplay ()
   "Redraw the current trick-game buffer."
   (let ((game cg-trick--game) (inhibit-read-only t))
+    (setq cg-current-game game cg-redisplay-function #'cg-trick--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :phase) "play")))
     (erase-buffer)
@@ -675,6 +681,11 @@
 
 (defvar cg-trick-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-trick-left)
     (define-key map (kbd "<right>") #'cg-trick-right)
     (define-key map (kbd "RET") #'cg-trick-act)

test/card-games-tests.el

@@ -1063,3 +1063,105 @@
         (should (memq (cg-get g :phase) '(scored passed-out)))
         (should (stringp (cg-render g)))))
     (should (> scored 0))))
+;;;; Renderer registry / region keystone
+
+(ert-deftest cgt-keystone-regions ()
+  (let* ((g (cg-sol--deal (make-instance 'cg-klondike-game)))
+         (res (cg-render-svg g)))
+    (should (stringp (car res)))
+    (should (>= (length (cdr res)) 13))           ; 6 top slots + 7 columns
+    (let* ((reg (cl-find '(col . 3) (cdr res) :key #'cdr :test #'equal))
+           (rect (car reg)))
+      (should reg)
+      (should (equal '(col . 3)
+                     (cg-regions-hit (cdr res)
+                                     (+ (nth 0 rect) (/ (nth 2 rect) 2))
+                                     (+ (nth 1 rect) 10)))))
+    (should (null (cg-regions-hit (cdr res) -5 -5))))
+  (with-temp-buffer
+    (setq cg-sol--game (cg-sol--deal (make-instance 'cg-klondike-game)))
+    (cg-render-game cg-sol--game)
+    (should (oref cg-sol--game renderer))
+    (should (> (buffer-size) 0))
+    (cg-render-apply cg-sol--game '(col . 5))
+    (should (= 11 (cg-get cg-sol--game :cursor)))))   ; spot index of (col . 5)
+;;;; Hand-cluster click regions + card-size slider
+
+(ert-deftest cgt-hand-regions ()
+  (let* ((cards '((0 . 0) (0 . 1) (1 . 5)))
+         (str (cg-rummy--svg-row cards 0 nil nil 'hand))
+         (regs (get-text-property 0 'cg-regions str)))
+    (should (= (+ 3 (length cg-svg-slider-stops)) (length regs)))   ; 3 cards + stops
+    (should (equal '(hand . 0) (cdr (car regs))))
+    (should (cl-find-if (lambda (r) (eq (car-safe (cdr r)) 'scale)) regs)))
+  (let ((g (cg-gin--deal (cg-gin-game))) (cg-card-scale 1.0))
+    (cg-render-apply g '(hand . 2))
+    (should (= 2 (cg-get g :cursor)))
+    (cg-render-apply g '(scale . 1.5))         ; base method handles scale
+    (should (= 1.5 cg-card-scale))
+    (cg-render-apply g 'zoom-reset)
+    (should (= 1.0 cg-card-scale))))
+
+;;;; Rummy 500 deep pickup and Hand & Foot rule completions
+
+(ert-deftest cgt-rum500-deep-pickup ()
+  "Taking a buried discard card melds it at once, keeping the cards above."
+  (let ((g (cg-rum500-game :nplayers 2 :hand-size 10)))
+    (cg-put g :nplayers 2) (cg-put g :scores (make-vector 2 0))
+    (cg-put g :hands (vector (list (cons 0 5) (cons 0 6)) nil)) ; 6S 7S
+    (cg-put g :discard (list (cons 1 9) (cons 0 4) (cons 2 3))) ; top 10C, buried 5S
+    (cg-put g :table nil) (cg-put g :laid (make-vector 2 0))
+    (cg-put g :turn 0) (cg-put g :step 'draw) (cg-put g :phase 'play)
+    (should (cg-tm--take-deep g 0 1))
+    (should (equal (cg-get g :table) '((0 (0 . 4) (0 . 5) (0 . 6)))))
+    (should (equal (cg-rummy--hand g 0) '((1 . 9))))
+    (should (= 1 (length (cg-get g :discard))))
+    ;; a card you cannot use immediately may not be taken
+    (cg-put g :hands (vector (list (cons 3 11)) nil))
+    (cg-put g :discard (list (cons 1 9) (cons 2 2)))
+    (should-not (cg-tm--take-deep g 0 1))))
+
+(ert-deftest cgt-handfoot-redthree ()
+  "Red threes leave the hand on deal and collect to the team pile."
+  (let ((g (cg-handfoot-game)))
+    (cg-put g :nplayers 4) (cg-put g :nteams 2) (cg-put g :scores (make-vector 2 0))
+    (cg-hf--deal g)
+    (dotimes (s 4)
+      (should (= 0 (cl-count-if #'cg-hf--red-three-p (cg-rummy--hand g s)))))
+    (cg-put g :redthrees (make-vector 2 nil))
+    (cg-rummy--set-hand g 0 (list (cons 2 2) (cons 0 5))) ; 3 of diamonds + 6S
+    (cg-put g :stock (list (cons 0 9)))
+    (should (= 1 (cg-hf--collect-red-threes g 0)))
+    (should (= 1 (length (aref (cg-get g :redthrees) (cg-hf--team g 0)))))
+    (should-not (cl-find-if #'cg-hf--red-three-p (cg-rummy--hand g 0)))))
+
+(ert-deftest cgt-handfoot-min-meld ()
+  "Initial meld must reach the round minimum; below it is refused."
+  (let ((g (cg-handfoot-game)))
+    (cg-put g :nplayers 4) (cg-put g :nteams 2) (cg-put g :scores (make-vector 2 0))
+    (cg-hf--deal g) (cg-put g :round 0)
+    (cg-put g :down (make-vector 2 nil)) (cg-put g :books (make-vector 2 nil))
+    (cg-put g :hands (vector (list (cons 0 3)(cons 1 3)(cons 2 3)) nil nil nil)) ; three 4s = 15
+    (should-not (cg-hf--initial-meld g 0 (cg-rummy--hand g 0)))
+    (should-not (cg-hf--down-p g 0))
+    (cg-put g :hands (vector (list (cons 0 0)(cons 1 0)(cons 2 0)) nil nil nil)) ; three aces = 60
+    (should (cg-hf--initial-meld g 0 (cg-rummy--hand g 0)))
+    (should (cg-hf--down-p g 0))
+    (should (= 1 (length (cg-hf--books g 0))))))
+
+(ert-deftest cgt-handfoot-pickup ()
+  "Picking up melds the top discard and rakes in the cards beneath it."
+  (let ((g (cg-handfoot-game)))
+    (cg-put g :nplayers 4) (cg-put g :nteams 2) (cg-put g :scores (make-vector 2 0))
+    (cg-hf--deal g)
+    (cg-put g :redthrees (make-vector 2 nil)) (cg-put g :books (make-vector 2 nil))
+    (cg-put g :hands (vector (list (cons 0 8)(cons 1 8)(cons 0 4)) nil nil nil)) ; two 9s + 5S
+    (cg-put g :discard (list (cons 2 8)(cons 3 5)(cons 0 6)(cons 1 7))) ; top 9D + 3 beneath
+    (cg-put g :stock nil)
+    (should (cg-hf--pickup-eligible g 0))
+    (let ((top (cg-hf--pickup g 0)))
+      (should (equal top (cons 2 8)))
+      (should (= 1 (length (cg-hf--books g 0))))
+      (should (cg-hf--book-valid-p (car (cg-hf--books g 0))))
+      (should (= 4 (length (cg-rummy--hand g 0))))
+      (should-not (cg-get g :discard)))))