Add Contract Bridge: auction, dummy play, and rubber scoring

New cg-bridge.el: a four-handed Bridge game (you are South, partnering
North against East and West) on the shared cg-game base.

* Auction: level/strain bids plus pass, double, and redouble, with the
  three-pass end rule, pass-outs, doubling state, and declarer
  determination (first of the side to name the strain).
* Play: follow-suit with the dummy exposed after the opening lead; the
  declarer plays both hands. Trick resolution honours trump and no-trump.
* Scoring: classic rubber -- trick points below the line toward game;
  overtricks, slam, insult, and undertrick penalties above; vulnerability
  and the rubber bonus. Verified against known results.
* A small natural bidding AI (openings, NT, raises with a fit, simple
  overcalls) that always terminates the auction, plus a greedy
  card-play AI.

Wire cg-bridge into the chooser, the Makefile, and the README, and add
two ERT tests (scoring math and a dozen full AI-driven deals). The suite
is now 109/109 and every file byte-compiles cleanly.

Makefile

@@ -3,7 +3,7 @@ EMACS   ?= emacs
 PKG      = card-games
 VERSION  = 1.0.60
 # Source files in dependency order (cg-core first).
-EL       = cg-core.el cg-svg.el cg-render.el cg-net.el cg-bid.el cg-gaps.el cg-bid-ui.el cg-bid-net.el cg-solitaire.el cg-trick.el cg-eights.el cg-patience.el cg-president.el card-games.el
+EL       = cg-core.el cg-svg.el cg-render.el cg-net.el cg-bid.el cg-gaps.el cg-bid-ui.el cg-bid-net.el cg-solitaire.el cg-trick.el cg-eights.el cg-patience.el cg-president.el cg-rummy.el cg-rum500.el cg-handfoot.el cg-match.el cg-cribbage.el cg-scopa.el cg-trick-ext.el cg-spite.el cg-bridge.el card-games.el
 ELC      = $(EL:.el=.elc)
 PKGDESC  = $(PKG)-pkg.el
 TARDIR   = $(PKG)-$(VERSION)

README.org

@@ -60,6 +60,57 @@ with its command.
   beat it or pass; first out rules, last out scrubs, and the roles trade
   cards on the next deal.
 
+** Rummy
+- ~cg-gin~ -- Gin Rummy.  A two-handed duel: draw or take the discard,
+  build sets and runs, and knock once your deadwood is ten or less, or go
+  gin with none; your opponent then lays off and may undercut you.  First
+  to 100 wins.
+- ~cg-rummy-basic~ -- Rummy.  Meld sets and runs onto the table and lay
+  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.
+- ~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.
+
+** Matching
+- ~cg-go-fish~ -- Go Fish.  Ask another player for a rank you hold;
+  collect all four to lay down a book, and make the most books.
+- ~cg-old-maid~ -- Old Maid.  One Queen is set aside; discard pairs and
+  draw blind from your neighbour, and do not be left with the odd Queen.
+
+** Pegging
+- ~cg-cribbage~ -- Cribbage.  Lay two cards to the crib, cut a starter,
+  peg toward 31, then count fifteens, pairs, runs, flushes, and his nobs.
+  Two-handed to 121.
+
+** Capturing
+- ~cg-scopa~ -- Scopa.  A 40-card deck; capture table cards by value and
+  sweep the board for a scopa.  Score cards, coins, the sette bello, and
+  primiera to 11.
+- ~cg-casino~ -- Casino.  The full deck; capture by pairs and sums and
+  score cards, spades, the casinos, and aces to 21.
+
+** More trick-taking
+- ~cg-euchre~ -- Euchre.  A 24-card deck with the two bowers; order up or
+  call trump and take three of five tricks.  Partnership to 10.
+- ~cg-pitch~ -- Auction Pitch.  Bid for the pitch; your first lead sets
+  trump.  Score High, Low, Jack, and Game; first to 7.
+- ~cg-briscola~ -- Briscola.  A fixed trump turned from the deal and no
+  obligation to follow suit; capture the Aces and Threes.  Partnership to
+  61 of the 120 points.
+
+** Climbing patience
+- ~cg-spite~ -- Spite & Malice.  Race the computer to empty your goal
+  pile onto shared centre piles that build Ace to Queen; Kings are wild.
+
+** Bridge
+- ~cg-bridge~ -- Contract Bridge.  A full auction (bids, pass, double,
+  redouble), play with the dummy exposed, and classic rubber scoring with
+  vulnerability.  You are South; when you declare you play the dummy too.
+  The bidding AI is a small natural system, sensible but no expert.
+
 * TODO
 - [X] make the suit symbols customizable (~cg-symbols~) and obey them
 - [ ] a Texinfo manual

card-games.el

@@ -49,6 +49,15 @@
 (require 'cg-eights)
 (require 'cg-patience)
 (require 'cg-president)
+(require 'cg-rummy)
+(require 'cg-rum500)
+(require 'cg-handfoot)
+(require 'cg-match)
+(require 'cg-cribbage)
+(require 'cg-scopa)
+(require 'cg-trick-ext)
+(require 'cg-spite)
+(require 'cg-bridge)
 
 (defvar card-games-list
   '(("500 (Bid)" cg-bid
@@ -88,7 +97,35 @@
     ("Oh Hell" cg-ohhell
      "Trick-taking: shrinking hands; bid the exact tricks you will take.")
     ("President" cg-president
-     "Climbing: shed your hand; first out rules, last out scrubs."))
+     "Climbing: shed your hand; first out rules, last out scrubs.")
+    ("Gin Rummy" cg-gin
+     "Rummy: form melds, knock with little deadwood; head to head to 100.")
+    ("Rummy" cg-rummy-basic
+     "Rummy: meld your whole hand to the table to go out.")
+    ("Rummy 500" cg-rum500
+     "Rummy: score the cards you lay down; race past 500.")
+    ("Hand & Foot" cg-handfoot
+     "Rummy: partnership Canasta cousin; build books from hand and foot.")
+    ("Go Fish" cg-go-fish
+     "Matching: ask for ranks and collect books of four.")
+    ("Old Maid" cg-old-maid
+     "Matching: shed pairs and avoid the leftover Queen.")
+    ("Cribbage" cg-cribbage
+     "Pegging and the show: fifteens, pairs, runs, and his nobs to 121.")
+    ("Scopa" cg-scopa
+     "Capturing: take table cards by value; sweep for a scopa.")
+    ("Casino" cg-casino
+     "Capturing: pairs and sums; big and little casino, aces, sweeps.")
+    ("Euchre" cg-euchre
+     "Trick-taking: 24 cards, bowers, order up; partnership to 10.")
+    ("Pitch" cg-pitch
+     "Trick-taking: bid, pitch to set trump, score High-Low-Jack-Game.")
+    ("Briscola" cg-briscola
+     "Trick-taking: fixed trump, no follow; capture the points to 61.")
+    ("Spite & Malice" cg-spite
+     "Climbing patience: race to empty your goal pile; Kings are wild.")
+    ("Bridge" cg-bridge
+     "Trick-taking: the auction, the dummy, and rubber scoring, to 121."))
   "Registry of playable games.
 Each entry is (NAME COMMAND DESCRIPTION); `card-game' lists them.")
 

cg-bridge.el

@@ -0,0 +1,730 @@
+;;; cg-bridge.el --- Contract Bridge with rubber scoring  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Contract Bridge: you are South, partnered with North, against East and
+;; West.  Each deal has an auction -- bids of a level (1-7) and a strain
+;; (clubs, diamonds, hearts, spades, or no-trump), plus Pass, Double, and
+;; Redouble -- followed by the play of thirteen tricks with the dummy (the
+;; declarer's partner) exposed.  Scoring is the classic rubber game: trick
+;; points below the line race toward game, and bonuses, overtricks, and
+;; penalties go above; two games win the rubber.
+;;
+;; When you are declarer you play both your own hand and the dummy; when
+;; you defend you play your own cards and the computer plays the rest.
+;;
+;; The bidding AI is a deliberately small natural system (it opens on
+;; about twelve points, raises to game with a fit, and overcalls a good
+;; long suit); it reaches sensible contracts but is no expert.  Cards use
+;; the package cons (SUIT . RANK), SUIT 0 spades, 1 clubs, 2 diamonds,
+;; 3 hearts, RANK 0 (Two) .. 12 (Ace).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+(defconst cg-bridge-ranks
+  ["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
+  "Rank labels indexed 0 (Two) .. 12 (Ace).")
+
+(defconst cg-bridge-strains ["♣" "♦" "♥" "♠" "NT"]
+  "Strain glyphs indexed 0 clubs, 1 diamonds, 2 hearts, 3 spades, 4 no-trump.")
+
+(defconst cg-bridge--strain-suit [1 2 3 0 nil]
+  "Map a strain index to its trump suit index (nil for no-trump).")
+
+(defconst cg-bridge--suit-strain [3 0 1 2]
+  "Map a suit index (0 S,1 C,2 D,3 H) to its strain index.")
+
+(defconst cg-bridge-seat-names ["South" "West" "North" "East"]
+  "Seat names indexed 0..3 clockwise from the human.")
+
+(defclass cg-bridge-game (cg-game)
+  ((vname :initform "Bridge"))
+  "A game of contract Bridge.")
+
+(defun cg-bridge-card-string (card)
+  "Return a short string for CARD."
+  (if (null card) "·"
+    (concat (aref cg-bridge-ranks (cdr card)) (cg-suit-glyph (car card)))))
+
+(defun cg-bridge--sort (cards)
+  "Return CARDS sorted by suit then rank (high first) for display."
+  (sort (copy-sequence cards)
+        (lambda (a b) (if (= (car a) (car b)) (> (cdr a) (cdr b)) (< (car a) (car b))))))
+
+(defun cg-bridge--deck ()
+  "Return a fresh shuffled 52-card deck."
+  (random t)
+  (cg-shuffle (cl-loop for s below 4 append
+                       (cl-loop for r below 13 collect (cons s r)))))
+
+;;;; Hand evaluation
+
+(defun cg-bridge--hcp (hand)
+  "Return the high-card points of HAND (A=4 K=3 Q=2 J=1)."
+  (let ((p 0))
+    (dolist (c hand p)
+      (setq p (+ p (pcase (cdr c) (12 4) (11 3) (10 2) (9 1) (_ 0)))))))
+
+(defun cg-bridge--suit-len (hand suit)
+  "Return how many cards of SUIT are in HAND."
+  (cl-count suit hand :key #'car))
+
+(defun cg-bridge--longest (hand)
+  "Return the suit index HAND holds most of (ties prefer majors, then spades)."
+  (let ((best 0) (bestn -1))
+    ;; check in order hearts, diamonds, clubs, spades so spades win ties last
+    (dolist (s '(3 2 1 0))
+      (let ((n (cg-bridge--suit-len hand s)))
+        (when (>= n bestn) (setq bestn n best s))))
+    best))
+
+(defun cg-bridge--balanced-p (hand)
+  "Return non-nil when HAND has a balanced shape (no void/singleton)."
+  (let ((doubletons 0) (ok t))
+    (dotimes (s 4)
+      (let ((n (cg-bridge--suit-len hand s)))
+        (when (< n 2) (setq ok nil))
+        (when (= n 2) (setq doubletons (1+ doubletons)))))
+    (and ok (<= doubletons 1))))
+
+;;;; Auction mechanics
+
+(defsubst cg-bridge--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-bridge--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-bridge--side (s) (mod s 2))
+
+(cl-defmethod cg-bridge--deal ((game cg-bridge-game))
+  "Deal a fresh Bridge hand into GAME, leaving it ready for the auction."
+  (let ((deck (cg-bridge--deck)) (hands (make-vector 4 nil)))
+    (dotimes (s 4)
+      (aset hands s (cg-bridge--sort (cl-loop repeat 13 collect (pop deck)))))
+    (cg-put game :hands hands)
+    (cg-put game :calls nil)            ; list of (SEAT . CALL), newest first
+    (cg-put game :contract nil)         ; (LEVEL . STRAIN)
+    (cg-put game :declarer nil)
+    (cg-put game :doubled 0)
+    (cg-put game :dealer (or (cg-get game :dealer) 0))
+    (cg-put game :bidder (cg-get game :dealer))
+    (cg-put game :phase 'auction)
+    (cg-put game :cursor 0)
+    (cg-put game :bid-level 1)          ; UI: level being composed
+    (cg-put game :bid-strain 0)
+    (cg-put game :trick nil)
+    (cg-put game :tricks 0)             ; declarer-side tricks won
+    (cg-put game :dummy nil)
+    (cg-put game :exposed nil)
+    (unless (cg-get game :below) (cg-put game :below (make-vector 2 0)))
+    (unless (cg-get game :above) (cg-put game :above (make-vector 2 0)))
+    (unless (cg-get game :games) (cg-put game :games (make-vector 2 0)))
+    (unless (cg-get game :vul) (cg-put game :vul (make-vector 2 nil)))
+    (cg-put game :message "Auction: compose a bid and press RET, or p/d to pass/double.")
+    game))
+
+(defun cg-bridge--high-bid (game)
+  "Return the highest (LEVEL . STRAIN) bid so far, or nil."
+  (cl-loop for (_s . call) in (cg-get game :calls)
+           when (consp call) return call))
+
+(defun cg-bridge--high-bidder (game)
+  "Return the seat that made the highest bid, or nil."
+  (cl-loop for (s . call) in (cg-get game :calls)
+           when (consp call) return s))
+
+(defun cg-bridge--call> (a b)
+  "Return non-nil when bid A is higher than bid B (each (LEVEL . STRAIN))."
+  (or (null b)
+      (> (car a) (car b))
+      (and (= (car a) (car b)) (> (cdr a) (cdr b)))))
+
+(defun cg-bridge--legal-call-p (game call)
+  "Return non-nil when CALL is legal now in GAME."
+  (let ((high (cg-bridge--high-bid game))
+        (hb (cg-bridge--high-bidder game)))
+    (pcase call
+      ('pass t)
+      ('double (and high (/= (cg-bridge--side hb) (cg-bridge--side (cg-get game :bidder)))
+                    (= (cg-get game :doubled) 0)))
+      ('redouble (and high (= (cg-bridge--side hb) (cg-bridge--side (cg-get game :bidder)))
+                      (= (cg-get game :doubled) 1)))
+      (_ (and (consp call) (>= (car call) 1) (<= (car call) 7)
+              (cg-bridge--call> call high))))))
+
+(defun cg-bridge--apply-call (game seat call)
+  "Record CALL by SEAT and update doubling state."
+  (cg-put game :calls (cons (cons seat call) (cg-get game :calls)))
+  (pcase call
+    ('double (cg-put game :doubled 1))
+    ('redouble (cg-put game :doubled 2))
+    ((pred consp) (cg-put game :doubled 0)))
+  (cg-put game :bidder (mod (1+ seat) 4)))
+
+(defun cg-bridge--auction-done-p (game)
+  "Return non-nil when the auction has ended.
+Sets up the contract (or a pass-out) as a side effect."
+  (let* ((calls (cg-get game :calls)) (n (length calls)))
+    (cond
+     ;; four passes with no bid: passed out
+     ((and (= n 4) (cl-every (lambda (c) (eq (cdr c) 'pass)) calls))
+      (cg-put game :phase 'passed-out) t)
+     ;; a bid then three passes
+     ((and (cg-bridge--high-bid game)
+           (>= n 3)
+           (cl-every (lambda (c) (eq (cdr c) 'pass))
+                     (cl-subseq calls 0 3)))
+      (cg-bridge--establish-contract game) t)
+     (t nil))))
+
+(defun cg-bridge--establish-contract (game)
+  "Set the contract, declarer, and start of play from the finished auction."
+  (let* ((bid (cg-bridge--high-bid game))
+         (side (cg-bridge--side (cg-bridge--high-bidder game)))
+         (strain (cdr bid))
+         (declarer
+          ;; first player of SIDE to have named STRAIN
+          (cl-loop for (s . call) in (reverse (cg-get game :calls))
+                   when (and (consp call) (= (cdr call) strain)
+                             (= (cg-bridge--side s) side))
+                   return s)))
+    (cg-put game :contract bid)
+    (cg-put game :declarer declarer)
+    (cg-put game :dummy (mod (+ declarer 2) 4))
+    (cg-put game :phase 'play)
+    (cg-put game :leader (mod (1+ declarer) 4))
+    (cg-put game :turn (mod (1+ declarer) 4))
+    (cg-put game :trick nil)
+    (cg-put game :tricks 0)
+    (cg-put game :cursor 0)
+    (cg-put game :message
+            (format "Contract: %s by %s.  %s leads."
+                    (cg-bridge--contract-string game)
+                    (aref cg-bridge-seat-names declarer)
+                    (aref cg-bridge-seat-names (cg-get game :leader))))))
+
+(defun cg-bridge--contract-string (game)
+  "Return a label for GAME's contract, e.g. \"4NT x\"."
+  (let ((c (cg-get game :contract)) (d (cg-get game :doubled)))
+    (if (null c) "passed out"
+      (format "%d%s%s" (car c) (aref cg-bridge-strains (cdr c))
+              (pcase d (1 " x") (2 " xx") (_ ""))))))
+
+;;;; Play mechanics
+
+(defun cg-bridge--trump (game)
+  "Return the trump suit index for GAME, or nil for no-trump."
+  (and (cg-get game :contract) (aref cg-bridge--strain-suit (cdr (cg-get game :contract)))))
+
+(defun cg-bridge--led-suit (game)
+  "Return the suit led to the current trick, or nil."
+  (let ((tr (cg-get game :trick)))
+    (and tr (car (cdr (car (last tr)))))))
+
+(defun cg-bridge--legal-play-p (game seat card)
+  "Return non-nil when SEAT may play CARD now (follow suit if able)."
+  (let ((hand (cg-bridge--hand game seat)) (led (cg-bridge--led-suit game)))
+    (and (member card hand)
+         (or (null led)
+             (= (car card) led)
+             (not (cl-some (lambda (c) (= (car c) led)) hand))))))
+
+(defun cg-bridge--legal-plays (game seat)
+  "Return SEAT's legal cards now."
+  (cl-remove-if-not (lambda (c) (cg-bridge--legal-play-p game seat c))
+                    (cg-bridge--hand game seat)))
+
+(defun cg-bridge--trick-winner (plays trump)
+  "Return the winning seat of complete PLAYS ((SEAT . CARD), play order)."
+  (let ((best (car plays)))
+    (dolist (p (cdr plays))
+      (let ((bc (cdr best)) (pc (cdr p)))
+        (cond
+         ((and trump (= (car pc) trump) (/= (car bc) trump)) (setq best p))
+         ((and (= (car pc) (car bc)) (> (cdr pc) (cdr bc))) (setq best p)))))
+    (car best)))
+
+(defun cg-bridge--play-card (game seat card)
+  "Have SEAT play CARD; resolve and score the trick when it completes."
+  (cg-bridge--set-hand game seat (remove card (cg-bridge--hand game seat)))
+  (cg-put game :trick (cons (cons seat card) (cg-get game :trick)))
+  ;; expose the dummy after the opening lead
+  (unless (cg-get game :exposed)
+    (cg-put game :exposed t))
+  (if (= 4 (length (cg-get game :trick)))
+      (let ((w (cg-bridge--trick-winner (reverse (cg-get game :trick))
+                                        (cg-bridge--trump game))))
+        (when (= (cg-bridge--side w) (cg-bridge--side (cg-get game :declarer)))
+          (cg-put game :tricks (1+ (cg-get game :tricks))))
+        (cg-put game :trick nil)
+        (cg-put game :leader w)
+        (cg-put game :turn w)
+        (cg-put game :last-winner w)
+        (when (cl-every #'null (append (cg-get game :hands) nil))
+          (cg-bridge--score-deal game))
+        w)
+    (cg-put game :turn (mod (1+ seat) 4))
+    nil))
+
+;;;; Scoring (rubber)
+
+(defun cg-bridge--undertrick-points (n doubled vul)
+  "Return defender points for N undertricks at DOUBLED level and VUL state."
+  (cond
+   ((= doubled 0) (* n (if vul 100 50)))
+   (t (let ((mult (if (= doubled 2) 2 1)) (sum 0))
+        (dotimes (i n)
+          (setq sum (+ sum (* mult (if vul (if (= i 0) 200 300)
+                                     (cond ((= i 0) 100) ((< i 3) 200) (t 300)))))))
+        sum))))
+
+(defun cg-bridge--deal-score (level strain doubled vul tricks)
+  "Return a plist scoring a contract result.
+LEVEL/STRAIN/DOUBLED describe the contract, VUL the declarer's
+vulnerability, and TRICKS the declarer side's trick count.  Keys:
+:below contracted points, :datk declarer bonus points above the line,
+:defend defender points, :result tricks over/under the contract."
+  (let* ((need (+ 6 level)) (result (- tricks need))
+         (mult (pcase doubled (0 1) (1 2) (2 4)))
+         (below 0) (datk 0) (defend 0))
+    (if (>= result 0)
+        (progn
+          (setq below (* mult (if (= strain 4) (+ 40 (* 30 (1- level)))
+                                (* (if (<= strain 1) 20 30) level))))
+          (when (> result 0)
+            (setq datk (+ datk (if (= doubled 0)
+                                   (* result (if (= strain 4) 30 (if (<= strain 1) 20 30)))
+                                 (* result (* (if (= doubled 2) 2 1) (if vul 200 100)))))))
+          (when (> doubled 0) (setq datk (+ datk (if (= doubled 2) 100 50))))
+          (cond ((= level 6) (setq datk (+ datk (if vul 750 500))))
+                ((= level 7) (setq datk (+ datk (if vul 1500 1000))))))
+      (setq defend (cg-bridge--undertrick-points (- result) doubled vul)))
+    (list :below below :datk datk :defend defend :result result)))
+
+(defun cg-bridge--score-deal (game)
+  "Score the finished deal into GAME's rubber state."
+  (let* ((c (cg-get game :contract)) (level (car c)) (strain (cdr c))
+         (decl (cg-get game :declarer)) (side (cg-bridge--side decl))
+         (opp (- 1 side)) (doubled (cg-get game :doubled))
+         (vul (aref (cg-get game :vul) side))
+         (sc (cg-bridge--deal-score level strain doubled vul (cg-get game :tricks)))
+         (below (cg-get game :below)) (above (cg-get game :above)))
+    (aset below side (+ (aref below side) (plist-get sc :below)))
+    (aset above side (+ (aref above side) (plist-get sc :datk)))
+    (aset above opp (+ (aref above opp) (plist-get sc :defend)))
+    (cg-put game :deal-result sc)
+    ;; game / rubber bookkeeping
+    (when (>= (aref below side) 100)
+      (let ((games (cg-get game :games)))
+        (aset games side (1+ (aref games side)))
+        (aset (cg-get game :vul) side t)
+        (aset below 0 0) (aset below 1 0)
+        (when (>= (aref games side) 2)
+          (aset above side (+ (aref above side)
+                              (if (>= (aref games opp) 1) 500 700)))
+          (cg-put game :rubber-winner side))))
+    (cg-put game :phase 'scored)
+    (cg-put game :message
+            (format "%s: %s.  %s"
+                    (cg-bridge--contract-string game)
+                    (let ((r (plist-get sc :result)))
+                      (cond ((>= r 0) (format "made +%d" r))
+                            (t (format "down %d" (- r)))))
+                    (if (cg-get game :rubber-winner)
+                        (format "%s win the rubber!  (n: new rubber)"
+                                (if (= side 0) "You and North" "East and West"))
+                      "(n: next deal)")))))
+
+;;;; AI -- bidding
+
+(cl-defmethod cg-bridge--ai-call ((game cg-bridge-game) seat)
+  "Return a call for AI SEAT from a small natural system."
+  (let* ((hand (cg-bridge--hand game seat)) (hcp (cg-bridge--hcp hand))
+         (high (cg-bridge--high-bid game)) (hb (cg-bridge--high-bidder game))
+         (ours (and high (= (cg-bridge--side hb) (cg-bridge--side seat)))))
+    (cond
+     ((null high)                       ; opening
+      (cond ((and (cg-bridge--balanced-p hand) (>= hcp 15) (<= hcp 17)) (cons 1 4))
+            ((and (cg-bridge--balanced-p hand) (>= hcp 20) (<= hcp 21)) (cons 2 4))
+            ((>= hcp 12)
+             (let ((suit (cg-bridge--longest hand)))
+               (cons 1 (aref cg-bridge--suit-strain suit))))
+            (t 'pass)))
+     (ours                              ; partner has the contract
+      (let* ((est (+ hcp 13)) (hl (car high)) (hs (cdr high))
+             (fit (or (= hs 4)
+                      (>= (cg-bridge--suit-len
+                           hand (aref cg-bridge--strain-suit hs)) 3))))
+        (if (and fit (>= est 26) (< hl 4)
+                 (cg-bridge--legal-call-p
+                  game (cond ((= hs 4) (cons 3 4))
+                             ((>= hs 2) (cons 4 hs))
+                             (t (cons 5 hs)))))
+            (cond ((= hs 4) (cons 3 4)) ((>= hs 2) (cons 4 hs)) (t (cons 5 hs)))
+          'pass)))
+     (t                                 ; opponents have the contract
+      (let* ((suit (cg-bridge--longest hand))
+             (len (cg-bridge--suit-len hand suit))
+             (st (aref cg-bridge--suit-strain suit))
+             (cand (if (> st (cdr high)) (cons (car high) st)
+                     (cons (1+ (car high)) st))))
+        (if (and (>= hcp 11) (>= len 5) (<= (car cand) 3)
+                 (cg-bridge--legal-call-p game cand))
+            cand 'pass))))))
+
+;;;; AI -- play
+
+(cl-defmethod cg-bridge--ai-play ((game cg-bridge-game) seat)
+  "Return a card for AI SEAT: win cheaply or shed low."
+  (let* ((legal (cg-bridge--legal-plays game seat))
+         (trump (cg-bridge--trump game)) (trick (cg-get game :trick)))
+    (if (null trick)
+        ;; leading: low from the longest non-trump suit, else lowest
+        (car (sort (copy-sequence legal)
+                   (lambda (a b) (< (cdr a) (cdr b)))))
+      (let* ((order (reverse trick))
+             (cur (cg-bridge--trick-winner order trump))
+             (partner (= (cg-bridge--side cur) (cg-bridge--side seat)))
+             (winners (cl-remove-if-not
+                       (lambda (c) (= seat (cg-bridge--trick-winner
+                                            (append order (list (cons seat c))) trump)))
+                       legal)))
+        (cond
+         ;; partner already winning: throw the lowest card
+         ((and partner (>= (length trick) 1))
+          (car (sort (copy-sequence legal) (lambda (a b) (< (cdr a) (cdr b))))))
+         ;; can win: take it with the cheapest winner
+         (winners (car (sort winners (lambda (a b) (< (cdr a) (cdr b))))))
+         ;; cannot win: discard lowest
+         (t (car (sort (copy-sequence legal) (lambda (a b) (< (cdr a) (cdr b)))))))))))
+
+(defun cg-bridge--controls (game)
+  "Return the list of seats the human controls during play."
+  (let ((decl (cg-get game :declarer)))
+    (cond ((null decl) nil)
+          ((= decl 0) '(0 2))           ; South declares: play hand + dummy
+          ((= decl 2) nil)              ; North declares: AI plays both
+          (t '(0)))))                   ; South defends
+
+(defun cg-bridge--auto-seat-p (game seat)
+  "Return non-nil when SEAT is played automatically (by AI) in GAME."
+  (not (memq seat (cg-bridge--controls game))))
+
+(defun cg-bridge--run-play (game)
+  "Advance AI plays until a human-controlled seat must act or the deal ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play)
+                (cg-bridge--auto-seat-p game (cg-get game :turn))
+                (< guard 60))
+      (setq guard (1+ guard))
+      (cg-bridge--play-card game (cg-get game :turn)
+                            (cg-bridge--ai-play game (cg-get game :turn))))))
+
+(defun cg-bridge--run-auction (game)
+  "Advance the auction through AI seats until South must call or it ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'auction) (/= (cg-get game :bidder) 0)
+                (< guard 40))
+      (setq guard (1+ guard))
+      (let* ((s (cg-get game :bidder)) (call (cg-bridge--ai-call game s)))
+        (unless (cg-bridge--legal-call-p game call) (setq call 'pass))
+        (cg-bridge--apply-call game s call)
+        (cg-bridge--auction-done-p game)))
+    (when (eq (cg-get game :phase) 'play) (cg-bridge--run-play game))))
+
+;;;; UI
+
+(defvar-local cg-bridge--game nil "The Bridge game in the current buffer.")
+
+(defun cg-bridge--hand-by-suit (cards)
+  "Return CARDS grouped into four lines by suit, as a string."
+  (let ((out '()))
+    (dolist (s '(0 3 2 1))              ; S H D C
+      (let ((in (cg-bridge--sort (cl-remove-if-not (lambda (c) (= (car c) s)) cards))))
+        (push (format "    %s %s\n" (cg-suit-glyph s)
+                      (if in (mapconcat (lambda (c) (aref cg-bridge-ranks (cdr c))) in " ")
+                        "--"))
+              out)))
+    (apply #'concat (nreverse out))))
+
+(defun cg-bridge--auction-string (game)
+  "Return a compact record of the auction so far."
+  (let ((calls (reverse (cg-get game :calls))) (out '()))
+    (dolist (sc calls)
+      (push (format "%s:%s" (aref cg-bridge-seat-names (car sc))
+                    (pcase (cdr sc)
+                      ('pass "pass") ('double "X") ('redouble "XX")
+                      (c (format "%d%s" (car c) (aref cg-bridge-strains (cdr c))))))
+            out))
+    (if out (mapconcat #'identity (nreverse out) "  ") "(no calls yet)")))
+
+(cl-defmethod cg-render ((game cg-bridge-game))
+  "Return a propertized depiction of the Bridge GAME."
+  (let* ((out '()) (phase (cg-get game :phase)) (cursor (cg-get game :cursor)))
+    (push "  Bridge\n" out)
+    (push (format "  Rubber:  You/North games %d  East/West games %d%s\n"
+                  (aref (cg-get game :games) 0) (aref (cg-get game :games) 1)
+                  (let ((v (cg-get game :vul)))
+                    (format "   (vul: %s)"
+                            (cond ((and (aref v 0) (aref v 1)) "both")
+                                  ((aref v 0) "N-S") ((aref v 1) "E-W") (t "none")))))
+          out)
+    (push (format "  Below: You/N %d  E/W %d    Above: You/N %d  E/W %d\n\n"
+                  (aref (cg-get game :below) 0) (aref (cg-get game :below) 1)
+                  (aref (cg-get game :above) 0) (aref (cg-get game :above) 1))
+          out)
+    (pcase phase
+      ('auction
+       (push (format "  Auction so far: %s\n\n" (cg-bridge--auction-string game)) out)
+       (push (format "  Compose:  %d %s   (Up/Down level, Left/Right strain)\n\n"
+                     (cg-get game :bid-level)
+                     (aref cg-bridge-strains (cg-get game :bid-strain)))
+             out))
+      ((or 'play 'scored 'passed-out)
+       (push (format "  Contract: %s by %s    Declarer tricks: %d\n"
+                     (cg-bridge--contract-string game)
+                     (if (cg-get game :declarer)
+                         (aref cg-bridge-seat-names (cg-get game :declarer)) "--")
+                     (cg-get game :tricks))
+             out)
+       (when (and (cg-get game :exposed) (cg-get game :dummy))
+         (push (format "\n  Dummy (%s):\n%s"
+                       (aref cg-bridge-seat-names (cg-get game :dummy))
+                       (cg-bridge--hand-by-suit (cg-bridge--hand game (cg-get game :dummy))))
+               out))
+       (push "\n  Trick: " out)
+       (if (cg-get game :trick)
+           (dolist (p (reverse (cg-get game :trick)))
+             (push (format "%s:%s  " (aref cg-bridge-seat-names (car p))
+                           (cg-bridge-card-string (cdr p))) out))
+         (push "(empty)" out))
+       (push "\n" out)))
+    ;; the human's hand (South), or the seat being played from when it is dummy
+    (let* ((act (if (and (eq phase 'play) (memq (cg-get game :turn)
+                                                (cg-bridge--controls game)))
+                    (cg-get game :turn) 0))
+           (hand (cg-bridge--sort (cg-bridge--hand game act))))
+      (push (format "\n  %s%s:\n   "
+                    (aref cg-bridge-seat-names act)
+                    (cond ((eq phase 'auction) " (you)")
+                          ((= act 0) " (you)")
+                          (t " (dummy, you play)")))
+            out)
+      (if (eq phase 'play)
+          (let ((i 0))
+            (dolist (c hand)
+              (let ((cs (cg-bridge-card-string c)) (faces nil))
+                (when (cg-red-suit-p (car c)) (push 'cg-red-suit faces))
+                (when (and (= (cg-get game :turn) act)
+                           (cg-bridge--legal-play-p game act c)) (push 'cg-hint faces))
+                (when (= i cursor) (push 'cg-cursor faces))
+                (push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
+              (setq i (1+ i))))
+        (push (cg-bridge--hand-by-suit hand) out)))
+    (push (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-bridge--redisplay ()
+  (let ((game cg-bridge--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+;;;; Auction commands
+
+(defun cg-bridge-bid-level-up ()
+  "Raise the level being composed."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (cg-put g :bid-level (min 7 (1+ (cg-get g :bid-level))))
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-bid-level-down ()
+  "Lower the level being composed."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (cg-put g :bid-level (max 1 (1- (cg-get g :bid-level))))
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-bid-strain-left ()
+  "Move the composed strain down (toward clubs)."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (cg-put g :bid-strain (max 0 (1- (cg-get g :bid-strain))))
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-bid-strain-right ()
+  "Move the composed strain up (toward no-trump)."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (cg-put g :bid-strain (min 4 (1+ (cg-get g :bid-strain))))
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge--after-call (g)
+  "Resolve end-of-auction and run AI after South calls in G."
+  (unless (cg-bridge--auction-done-p g)
+    (cg-bridge--run-auction g))
+  (when (eq (cg-get g :phase) 'play) (cg-bridge--run-play g))
+  (cg-bridge--redisplay))
+
+(defun cg-bridge-bid ()
+  "Make the composed bid."
+  (interactive)
+  (let* ((g cg-bridge--game)
+         (call (cons (cg-get g :bid-level) (cg-get g :bid-strain))))
+    (cond
+     ((not (eq (cg-get g :phase) 'auction)) (cg-put g :message "Not bidding now."))
+     ((/= (cg-get g :bidder) 0) (cg-put g :message "Not your turn."))
+     ((not (cg-bridge--legal-call-p g call))
+      (cg-put g :message "That bid is too low."))
+     (t (cg-bridge--apply-call g 0 call) (cg-bridge--after-call g)))
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-pass ()
+  "Pass in the auction."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (if (and (eq (cg-get g :phase) 'auction) (= (cg-get g :bidder) 0))
+        (progn (cg-bridge--apply-call g 0 'pass) (cg-bridge--after-call g))
+      (cg-put g :message "Nothing to pass on."))
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-double ()
+  "Double (or redouble) in the auction."
+  (interactive)
+  (let* ((g cg-bridge--game)
+         (call (if (= (cg-get g :doubled) 1) 'redouble 'double)))
+    (if (and (eq (cg-get g :phase) 'auction) (= (cg-get g :bidder) 0)
+             (cg-bridge--legal-call-p g call))
+        (progn (cg-bridge--apply-call g 0 call) (cg-bridge--after-call g))
+      (cg-put g :message "You cannot double now."))
+    (cg-bridge--redisplay)))
+
+;;;; Play commands
+
+(defun cg-bridge--act-hand (g)
+  "Return the hand the cursor currently indexes (the seat to act)."
+  (let ((act (if (memq (cg-get g :turn) (cg-bridge--controls g)) (cg-get g :turn) 0)))
+    (cg-bridge--sort (cg-bridge--hand g act))))
+
+(defun cg-bridge-left ()
+  "Move the cursor left."
+  (interactive)
+  (let* ((g cg-bridge--game) (n (length (cg-bridge--act-hand g))))
+    (cond ((eq (cg-get g :phase) 'auction) (cg-bridge-bid-strain-left))
+          (t (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+             (cg-bridge--redisplay)))))
+
+(defun cg-bridge-right ()
+  "Move the cursor right."
+  (interactive)
+  (let* ((g cg-bridge--game) (n (length (cg-bridge--act-hand g))))
+    (cond ((eq (cg-get g :phase) 'auction) (cg-bridge-bid-strain-right))
+          (t (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+             (cg-bridge--redisplay)))))
+
+(defun cg-bridge-up ()
+  "Raise the bid level (auction only)."
+  (interactive)
+  (if (eq (cg-get cg-bridge--game :phase) 'auction) (cg-bridge-bid-level-up)
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-down ()
+  "Lower the bid level (auction only)."
+  (interactive)
+  (if (eq (cg-get cg-bridge--game :phase) 'auction) (cg-bridge-bid-level-down)
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-play ()
+  "Play the cursor card, or make the composed bid during the auction."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (if (eq (cg-get g :phase) 'auction)
+        (cg-bridge-bid)
+      (let* ((turn (cg-get g :turn)))
+        (cond
+         ((not (eq (cg-get g :phase) 'play)) (cg-put g :message "Press n to continue."))
+         ((not (memq turn (cg-bridge--controls g)))
+          (cg-put g :message "Wait for your turn."))
+         (t (let ((card (nth (cg-get g :cursor) (cg-bridge--sort (cg-bridge--hand g turn)))))
+              (if (or (null card) (not (cg-bridge--legal-play-p g turn card)))
+                  (cg-put g :message "You must follow suit.")
+                (cg-bridge--play-card g turn card)
+                (cg-put g :cursor 0)
+                (when (eq (cg-get g :phase) 'play) (cg-bridge--run-play g))))))
+        (cg-bridge--redisplay)))))
+
+(defun cg-bridge-new ()
+  "Deal the next hand, or a fresh rubber when one is over."
+  (interactive)
+  (let ((g cg-bridge--game))
+    (when (or (cg-get g :rubber-winner))
+      (cg-put g :below (make-vector 2 0)) (cg-put g :above (make-vector 2 0))
+      (cg-put g :games (make-vector 2 0)) (cg-put g :vul (make-vector 2 nil))
+      (cg-put g :rubber-winner nil))
+    (cg-put g :dealer (mod (1+ (or (cg-get g :dealer) 0)) 4))
+    (cg-bridge--deal g)
+    (cg-bridge--run-auction g)
+    (cg-bridge--redisplay)))
+
+(defun cg-bridge-redraw () "Redraw." (interactive) (cg-bridge--redisplay))
+(defun cg-bridge-help () "Describe the controls." (interactive)
+       (message "Auction: Up/Down level, Left/Right strain, RET bid, p pass, d double.  Play: arrows + RET.  n: next"))
+
+(defvar cg-bridge-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-bridge-left)
+    (define-key map (kbd "<right>") #'cg-bridge-right)
+    (define-key map (kbd "<up>")    #'cg-bridge-up)
+    (define-key map (kbd "<down>")  #'cg-bridge-down)
+    (define-key map (kbd "RET") #'cg-bridge-play)
+    (define-key map "p" #'cg-bridge-pass)
+    (define-key map "d" #'cg-bridge-double)
+    (define-key map "n" #'cg-bridge-new)
+    (define-key map "g" #'cg-bridge-redraw)
+    (define-key map "?" #'cg-bridge-help)
+    map)
+  "Keymap for `cg-bridge-mode'.")
+
+(define-derived-mode cg-bridge-mode special-mode "Bridge"
+  "Major mode for contract Bridge."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-bridge ()
+  "Play contract Bridge against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Bridge*")))
+    (with-current-buffer buf
+      (cg-bridge-mode)
+      (setq cg-bridge--game (cg-bridge-game))
+      (cg-put cg-bridge--game :dealer 0)
+      (cg-bridge--deal cg-bridge--game)
+      (cg-bridge--run-auction cg-bridge--game)
+      (cg-bridge--redisplay))
+    (switch-to-buffer buf)))
+
+(provide 'cg-bridge)
+;;; cg-bridge.el ends here

cg-cribbage.el

@@ -0,0 +1,437 @@
+;;; cg-cribbage.el --- Cribbage, with pegging and the show  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Two-handed Cribbage to 121, against the computer.
+;;
+;; Each deal you lay two cards away to the crib (which belongs to the
+;; dealer), cut a starter, then play the pegging round -- adding cards
+;; toward 31 and scoring fifteens, pairs, runs, and the go.  Then comes
+;; the show, where both hands and the crib are counted for fifteens,
+;; pairs, runs, flushes, and his nobs.  The deal alternates.
+;;
+;; Cards use the package cons (SUIT . RANK), RANK 0 (Ace) .. 12 (King);
+;; for counting, an Ace is one, face cards ten, the rest their pip value.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-rummy)
+
+(defcustom cg-cribbage-target 121
+  "Points needed to win a game of Cribbage."
+  :type 'integer :group 'card-games)
+
+(defclass cg-cribbage-game (cg-game)
+  ((vname :initform "Cribbage"))
+  "A two-handed game of Cribbage.")
+
+;;;; Scoring primitives
+
+(defun cg-crib--val (card)
+  "Return CARD's counting value (Ace 1, faces 10, else pip)."
+  (let ((r (cdr card))) (if (<= r 8) (1+ r) 10)))
+
+(defun cg-crib--count-15s (cards)
+  "Return points for all subsets of CARDS summing to fifteen."
+  (let ((n (length cards)) (vec (vconcat cards)) (count 0))
+    (dotimes (mask (ash 1 n))
+      (let ((sum 0))
+        (dotimes (i n)
+          (when (/= 0 (logand mask (ash 1 i)))
+            (setq sum (+ sum (cg-crib--val (aref vec i))))))
+        (when (= sum 15) (setq count (+ count 2)))))
+    count))
+
+(defun cg-crib--count-pairs (cards)
+  "Return points for all pairs in CARDS."
+  (let ((cnt (make-vector 13 0)) (tot 0))
+    (dolist (c cards) (aset cnt (cdr c) (1+ (aref cnt (cdr c)))))
+    (dotimes (r 13)
+      (let ((k (aref cnt r))) (setq tot (+ tot (* k (1- k))))))  ; 2*C(k,2)=k*(k-1)
+    tot))
+
+(defun cg-crib--count-runs (cards)
+  "Return points for all runs of three or more in CARDS (with multiplicity)."
+  (let ((cnt (make-vector 13 0)) (total 0) (r 0))
+    (dolist (c cards) (aset cnt (cdr c) (1+ (aref cnt (cdr c)))))
+    (while (< r 13)
+      (if (= 0 (aref cnt r)) (setq r (1+ r))
+        (let ((len 0) (mult 1))
+          (while (and (< r 13) (> (aref cnt r) 0))
+            (setq len (1+ len) mult (* mult (aref cnt r)) r (1+ r)))
+          (when (>= len 3) (setq total (+ total (* len mult)))))))
+    total))
+
+(defun cg-crib--flush (hand starter is-crib)
+  "Return flush points for the four-card HAND with STARTER.
+A crib (IS-CRIB) flush must include the starter."
+  (let ((s (car (car hand))))
+    (cond ((not (cl-every (lambda (c) (= (car c) s)) hand)) 0)
+          ((= (car starter) s) 5)
+          (is-crib 0)
+          (t 4))))
+
+(defun cg-crib--nobs (hand starter)
+  "Return 1 when HAND holds the Jack of the STARTER's suit, else 0."
+  (if (cl-find-if (lambda (c) (and (= (cdr c) 10) (= (car c) (car starter)))) hand)
+      1 0))
+
+(defun cg-crib--score-show (hand starter &optional is-crib)
+  "Return the show score of the four-card HAND with STARTER.
+IS-CRIB applies the stricter crib flush rule."
+  (let ((all (cons starter hand)))
+    (+ (cg-crib--count-15s all)
+       (cg-crib--count-pairs all)
+       (cg-crib--count-runs all)
+       (cg-crib--flush hand starter is-crib)
+       (cg-crib--nobs hand starter))))
+
+(defun cg-crib--peg-score (seq total)
+  "Return pegging points for the play whose sequence is SEQ (newest first).
+TOTAL is the running count after the play."
+  (let ((pts 0))
+    (when (= total 15) (setq pts (+ pts 2)))
+    (when (= total 31) (setq pts (+ pts 2)))
+    ;; pairs: leading same-rank run in SEQ
+    (let ((r (cdr (car seq))) (m 0) (lst seq) (stop nil))
+      (while (and lst (not stop))
+        (if (= (cdr (car lst)) r) (setq m (1+ m) lst (cdr lst)) (setq stop t)))
+      (setq pts (+ pts (pcase m (2 2) (3 6) (4 12) (_ 0)))))
+    ;; runs: largest k>=3 whose last k cards form a consecutive run
+    (let ((best 0) (k (length seq)))
+      (while (>= k 3)
+        (let* ((lastk (cl-subseq seq 0 k))
+               (ranks (sort (mapcar #'cdr lastk) #'<)))
+          (when (and (= (length ranks) (length (delete-dups (copy-sequence ranks))))
+                     (= (- (car (last ranks)) (car ranks)) (1- k)))
+            (setq best (max best k))))
+        (setq k (1- k)))
+      (setq pts (+ pts best)))
+    pts))
+
+;;;; Setup and flow
+
+(defsubst cg-crib--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-crib--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-crib--play (game s) (aref (cg-get game :play) s))
+(defsubst cg-crib--set-play (game s v) (aset (cg-get game :play) s v))
+
+(defun cg-crib--who (s) (if (= s 0) "You" "Computer"))
+
+(cl-defmethod cg-crib--deal ((game cg-cribbage-game))
+  "Deal a fresh Cribbage hand into GAME."
+  (let ((deck (cg-rummy-deck)) (hands (make-vector 2 nil)))
+    (dotimes (s 2)
+      (aset hands s (cg-rummy-sort-hand (cl-loop repeat 6 collect (pop deck)))))
+    (cg-put game :hands hands)
+    (cg-put game :deck deck)
+    (cg-put game :crib nil)
+    (cg-put game :starter nil)
+    (cg-put game :phase 'discard)
+    (cg-put game :cursor 0)
+    (cg-put game :marks nil)
+    (unless (cg-get game :scores) (cg-put game :scores (make-vector 2 0)))
+    (unless (integerp (cg-get game :dealer)) (cg-put game :dealer 1))
+    (cg-put game :message "Discard two cards to the crib: SPC marks, m confirms.")
+    game))
+
+(defun cg-crib--add (game s pts)
+  "Add PTS to seat S and end the game if it reaches the target."
+  (when (> pts 0)
+    (aset (cg-get game :scores) s (+ (aref (cg-get game :scores) s) pts))
+    (when (>= (aref (cg-get game :scores) s) cg-cribbage-target)
+      (cg-put game :phase 'game-over)
+      (cg-put game :winner s))))
+
+(defun cg-crib--ai-discard (game s)
+  "Return the two cards seat S should lay away (keep the best four)."
+  (let* ((hand (cg-crib--hand game s)) (best nil) (bestv -1))
+    (dolist (combo (cg-rummy--combinations hand 4))
+      (let ((v (cg-crib--score-show combo '(0 . 0))))   ; rough: no starter
+        (when (> v bestv) (setq bestv v best combo))))
+    (cl-set-difference hand best :test #'equal)))
+
+(cl-defmethod cg-crib--start-play ((game cg-cribbage-game))
+  "Cut the starter and begin the pegging round."
+  (let* ((deck (cg-get game :deck))
+         (starter (nth (random (length deck)) deck))
+         (dealer (cg-get game :dealer)))
+    (cg-put game :starter starter)
+    (when (= (cdr starter) 10)            ; his heels: starter is a Jack
+      (cg-crib--add game dealer 2))
+    (cg-put game :play (vector (cg-crib--hand game 0) (cg-crib--hand game 1)))
+    (cg-put game :seq nil)
+    (cg-put game :total 0)
+    (cg-put game :go nil)
+    (cg-put game :last-player nil)
+    (cg-put game :pturn (- 1 dealer))     ; non-dealer leads
+    (cg-put game :phase (if (eq (cg-get game :phase) 'game-over) 'game-over 'play))
+    (cg-put game :cursor 0)
+    (cg-put game :message
+            (format "Pegging: %s leads.  Starter is %s."
+                    (cg-crib--who (- 1 dealer)) (cg-rummy-card-string starter)))))
+
+(defun cg-crib--legal (game s)
+  "Return seat S's play-cards that fit under 31."
+  (cl-remove-if (lambda (c) (> (cg-crib--val c) (- 31 (cg-get game :total))))
+                (cg-crib--play game s)))
+
+(defun cg-crib--peg-play (game s card)
+  "Seat S plays CARD into the pegging round and pegs any points."
+  (cg-crib--set-play game s (cl-remove card (cg-crib--play game s) :test #'equal :count 1))
+  (cg-put game :seq (cons card (cg-get game :seq)))
+  (cg-put game :total (+ (cg-get game :total) (cg-crib--val card)))
+  (cg-put game :last-player s)
+  (cg-put game :go nil)
+  (let ((pts (cg-crib--peg-score (cg-get game :seq) (cg-get game :total))))
+    (cg-crib--add game s pts)
+    (cg-put game :message
+            (format "%s played %s (count %d)%s."
+                    (cg-crib--who s) (cg-rummy-card-string card) (cg-get game :total)
+                    (if (> pts 0) (format " for %d" pts) ""))))
+  (if (= (cg-get game :total) 31)
+      (cg-crib--peg-reset game)
+    (cg-put game :pturn (- 1 s))))
+
+(defun cg-crib--peg-reset (game)
+  "Reset the running count; the player after the last to play leads."
+  (cg-put game :seq nil)
+  (cg-put game :total 0)
+  (cg-put game :go nil)
+  (cg-put game :pturn (- 1 (cg-get game :last-player))))
+
+(defun cg-crib--peg-over-p (game)
+  "Return non-nil when both players have played out their cards."
+  (and (null (cg-crib--play game 0)) (null (cg-crib--play game 1))))
+
+(defun cg-crib--peg-go (game s)
+  "Handle seat S being unable to play (a go)."
+  (let ((other (- 1 s)))
+    (if (cg-crib--legal game other)
+        (cg-put game :pturn other)          ; opponent plays on
+      ;; neither can play: last player pegs one for the go, then reset
+      (when (cg-get game :last-player)
+        (cg-crib--add game (cg-get game :last-player) 1)
+        (cg-put game :message
+                (format "%s pegs 1 for the go." (cg-crib--who (cg-get game :last-player)))))
+      (cg-crib--peg-reset game))))
+
+(cl-defmethod cg-crib--ai-play ((game cg-cribbage-game) s)
+  "Have AI seat S either play its best pegging card or declare a go."
+  (let ((legal (cg-crib--legal game s)))
+    (if (null legal) (cg-crib--peg-go game s)
+      (let ((best (car legal)) (bestv -1))
+        (dolist (c legal)
+          (let* ((seq (cons c (cg-get game :seq)))
+                 (tot (+ (cg-get game :total) (cg-crib--val c)))
+                 (v (cg-crib--peg-score seq tot)))
+            ;; prefer points; tie-break toward keeping count off 5 and 21
+            (when (or (> v bestv)
+                      (and (= v bestv) (> (cg-crib--val c) (cg-crib--val best))))
+              (setq best c bestv v))))
+        (cg-crib--peg-play game s best)))))
+
+(defun cg-crib--peg-advance (game)
+  "Run AI pegging turns until it is your turn or the round ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play) (not (cg-crib--peg-over-p game))
+                (/= (cg-get game :pturn) 0) (< guard 200))
+      (setq guard (1+ guard))
+      (cg-crib--ai-play game (cg-get game :pturn))))
+  ;; if it is your turn but you have no legal play, auto-go
+  (when (and (eq (cg-get game :phase) 'play) (not (cg-crib--peg-over-p game))
+             (= (cg-get game :pturn) 0) (null (cg-crib--legal game 0)))
+    (cg-crib--peg-go game 0)
+    (cg-crib--peg-advance game))
+  (when (and (eq (cg-get game :phase) 'play) (cg-crib--peg-over-p game))
+    (cg-crib--show game)))
+
+(cl-defmethod cg-crib--show ((game cg-cribbage-game))
+  "Count the hands and the crib, then set up the next deal."
+  (let* ((starter (cg-get game :starter))
+         (dealer (cg-get game :dealer)) (pone (- 1 dealer))
+         (h-pone (cg-crib--hand game pone)) (h-dealer (cg-crib--hand game dealer))
+         (crib (cg-get game :crib))
+         (s-pone (cg-crib--score-show h-pone starter))
+         (s-dealer (cg-crib--score-show h-dealer starter))
+         (s-crib (cg-crib--score-show crib starter t)))
+    ;; count in order: non-dealer, dealer, crib (a player may win mid-count)
+    (cg-crib--add game pone s-pone)
+    (when (not (eq (cg-get game :phase) 'game-over)) (cg-crib--add game dealer s-dealer))
+    (when (not (eq (cg-get game :phase) 'game-over)) (cg-crib--add game dealer s-crib))
+    (cg-put game :show (list :pone s-pone :dealer s-dealer :crib s-crib))
+    (unless (eq (cg-get game :phase) 'game-over) (cg-put game :phase 'show))
+    (cg-put game :message
+            (format "Show: %s %d, %s %d, crib %d.  %s"
+                    (cg-crib--who pone) s-pone (cg-crib--who dealer) s-dealer s-crib
+                    (if (eq (cg-get game :phase) 'game-over)
+                        (format "%s wins!  (n: new game)" (cg-crib--who (cg-get game :winner)))
+                      "(n: next deal)")))))
+
+;;;; UI
+
+(defvar-local cg-crib--game nil "The Cribbage game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-cribbage-game))
+  "Return a propertized depiction of the Cribbage GAME."
+  (let* ((out '()) (scores (cg-get game :scores)) (phase (cg-get game :phase))
+         (cursor (cg-get game :cursor)))
+    (push (format "  Cribbage      to %d\n\n" cg-cribbage-target) out)
+    (push (format "  You %d        Computer %d        %s deals\n\n"
+                  (aref scores 0) (aref scores 1) (cg-crib--who (cg-get game :dealer)))
+          out)
+    (when (cg-get game :starter)
+      (push (format "  Starter: %s\n" (cg-rummy-card-string (cg-get game :starter))) out))
+    (when (eq phase 'play)
+      (push (format "  Count: %d\n  Played: %s\n" (cg-get game :total)
+                    (mapconcat #'cg-rummy-card-string (reverse (cg-get game :seq)) " "))
+            out))
+    (when (memq phase '(show game-over))
+      (let ((sh (cg-get game :show)))
+        (when sh
+          (push (format "  Crib (%s): %s\n"
+                        (cg-crib--who (cg-get game :dealer))
+                        (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 (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-crib--redisplay ()
+  (let ((game cg-crib--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+(defun cg-crib--cur-list (g)
+  (if (eq (cg-get g :phase) 'play) (cg-crib--play g 0) (cg-crib--hand g 0)))
+
+(defun cg-crib-left ()
+  "Move the cursor left."
+  (interactive)
+  (let* ((g cg-crib--game) (n (length (cg-crib--cur-list g))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-crib--redisplay)))
+
+(defun cg-crib-right ()
+  "Move the cursor right."
+  (interactive)
+  (let* ((g cg-crib--game) (n (length (cg-crib--cur-list g))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-crib--redisplay)))
+
+(defun cg-crib-mark ()
+  "Toggle a discard mark on the cursor card (discard phase)."
+  (interactive)
+  (let* ((g cg-crib--game) (i (cg-get g :cursor)) (marks (cg-get g :marks)))
+    (when (eq (cg-get g :phase) 'discard)
+      (cg-put g :marks (if (memq i marks) (delq i marks)
+                         (if (>= (length marks) 2) marks (cons i marks)))))
+    (cg-crib--redisplay)))
+
+(defun cg-crib-confirm ()
+  "Confirm your two crib discards and start play."
+  (interactive)
+  (let* ((g cg-crib--game) (hand (cg-crib--hand g 0))
+         (marks (cg-get g :marks)))
+    (if (or (not (eq (cg-get g :phase) 'discard)) (/= (length marks) 2))
+        (progn (cg-put g :message "Mark exactly two cards (SPC), then m.")
+               (cg-crib--redisplay))
+      (let ((mine (mapcar (lambda (i) (nth i hand)) marks))
+            (ai (cg-crib--ai-discard g 1)))
+        (cg-crib--set-hand g 0 (cl-set-difference hand mine :test #'equal))
+        (cg-crib--set-hand g 1 (cl-set-difference (cg-crib--hand g 1) ai :test #'equal))
+        (cg-put g :crib (append mine ai))
+        (cg-put g :marks nil) (cg-put g :cursor 0)
+        (cg-crib--start-play g)
+        (cg-crib--peg-advance g)
+        (cg-crib--redisplay)))))
+
+(defun cg-crib-play ()
+  "Play the cursor card in pegging, or declare a go if you cannot."
+  (interactive)
+  (let* ((g cg-crib--game))
+    (cond
+     ((not (eq (cg-get g :phase) 'play)) (cg-put g :message "Not the pegging round."))
+     ((/= (cg-get g :pturn) 0) (cg-put g :message "Not your turn."))
+     ((null (cg-crib--legal g 0))
+      (cg-crib--peg-go g 0) (cg-crib--peg-advance g))
+     (t (let ((card (nth (cg-get g :cursor) (cg-crib--play g 0))))
+          (if (or (null card) (> (cg-crib--val card) (- 31 (cg-get g :total))))
+              (cg-put g :message "That card would go over 31 -- choose another.")
+            (cg-crib--peg-play g 0 card)
+            (cg-put g :cursor 0)
+            (cg-crib--peg-advance g)))))
+    (cg-crib--redisplay)))
+
+(defun cg-crib-new ()
+  "Start the next deal, or a new game when one is over."
+  (interactive)
+  (let ((g cg-crib--game))
+    (when (eq (cg-get g :phase) 'game-over)
+      (cg-put g :scores (make-vector 2 0)) (cg-put g :dealer 1))
+    (cg-put g :dealer (- 1 (cg-get g :dealer)))   ; alternate the deal
+    (cg-put g :show nil)
+    (cg-crib--deal g)
+    (cg-crib--redisplay)))
+
+(defun cg-crib-redraw () "Redraw." (interactive) (cg-crib--redisplay))
+(defun cg-crib-help () "Describe the controls." (interactive)
+       (message "Arrows: choose  SPC: mark (discard)  m: confirm crib  RET: play/go  n: next  g: redraw"))
+
+(defvar cg-cribbage-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-crib-left)
+    (define-key map (kbd "<right>") #'cg-crib-right)
+    (define-key map (kbd "SPC") #'cg-crib-mark)
+    (define-key map "m" #'cg-crib-confirm)
+    (define-key map (kbd "RET") #'cg-crib-play)
+    (define-key map "n" #'cg-crib-new)
+    (define-key map "g" #'cg-crib-redraw)
+    (define-key map "?" #'cg-crib-help)
+    map)
+  "Keymap for `cg-cribbage-mode'.")
+
+(define-derived-mode cg-cribbage-mode special-mode "Cribbage"
+  "Major mode for Cribbage."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-cribbage ()
+  "Play two-handed Cribbage against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Cribbage*")))
+    (with-current-buffer buf
+      (cg-cribbage-mode)
+      (setq cg-crib--game (cg-cribbage-game))
+      (cg-crib--deal cg-crib--game)
+      (cg-crib--redisplay))
+    (switch-to-buffer buf)))
+
+(provide 'cg-cribbage)
+;;; cg-cribbage.el ends here

cg-handfoot.el

@@ -0,0 +1,535 @@
+;;; cg-handfoot.el --- Hand and Foot, a partnership rummy  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Hand & Foot, a Canasta cousin played in partnerships.  Each player is
+;; dealt two packets: a "hand" played first and a "foot" taken up once the
+;; hand is gone.  Partners build *books* -- three or more cards of one
+;; rank, suits ignored -- on the table; a book of seven is complete (a
+;; "pile"), clean if it holds no wild card and dirty if it does.  Twos and
+;; Jokers are wild.  You go out, ending the round, once your side owns at
+;; least two complete books and you can empty your foot.
+;;
+;; You partner the North player against East and West, all three of them
+;; 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
+;; (SUIT . RANK), RANK 0 (Ace) .. 12 (King), with jokers as (joker . 0).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-rummy)
+
+(defcustom cg-handfoot-target 5000
+  "Points a partnership needs to win Hand & Foot."
+  :type 'integer :group 'card-games)
+
+(defconst cg-handfoot--names ["You" "West" "North" "East"]
+  "Seat labels; North is your partner.")
+
+(defclass cg-handfoot-game (cg-rummy-game)
+  ((vname :initform "Hand & Foot"))
+  "A game of Hand & Foot.")
+
+;;;; Cards
+
+(defun cg-hf--wild-p (card)
+  "Return non-nil when CARD is wild (a Joker or a Two)."
+  (or (cg-rummy-joker-p card) (= (cdr card) 1)))
+
+(defun cg-hf--three-p (card)
+  "Return non-nil when CARD is a three (never meldable)."
+  (and (not (cg-rummy-joker-p card)) (= (cdr card) 2)))
+
+(defun cg-hf-value (card)
+  "Return the Hand & Foot point value of CARD."
+  (cond ((cg-rummy-joker-p card) 50)
+        (t (let ((r (cdr card)))
+             (cond ((= r 1) 20)        ; Two (wild)
+                   ((= r 0) 20)        ; Ace
+                   ((= r 2) 5)         ; Three
+                   ((<= r 6) 5)        ; 4 5 6 7
+                   (t 10))))))         ; 8 9 10 J Q K
+
+(defun cg-hf--book-rank (cards)
+  "Return the natural rank shared by CARDS, or nil if invalid."
+  (let ((nats (cl-remove-if #'cg-hf--wild-p cards)))
+    (and nats
+         (let ((r (cdr (car nats))))
+           (and (cl-every (lambda (c) (= (cdr c) r)) nats)
+                (/= r 2)
+                r)))))
+
+(defun cg-hf--book-valid-p (cards)
+  "Return non-nil when CARDS form a legal book."
+  (let* ((nats (cl-remove-if #'cg-hf--wild-p cards))
+         (wilds (cl-remove-if-not #'cg-hf--wild-p cards)))
+    (and (>= (length cards) 3)
+         (cg-hf--book-rank cards)
+         (>= (length nats) 2)
+         (<= (length wilds) 3)
+         (<= (length wilds) (length nats)))))
+
+(defun cg-hf--book-complete-p (cards) (>= (length cards) 7))
+(defun cg-hf--book-clean-p (cards) (not (cl-some #'cg-hf--wild-p cards)))
+
+;;;; Setup
+
+(defun cg-hf--team (game s) (mod s (cg-get game :nteams)))
+
+(cl-defmethod cg-hf--deal ((game cg-handfoot-game))
+  "Deal a fresh round into GAME."
+  (let* ((n (cg-get game :nplayers))
+         (decks (1+ n))
+         (deck (cg-rummy-deck decks 2))
+         (hands (make-vector n nil)) (feet (make-vector n nil))
+         (stage (make-vector n 0)))
+    (dotimes (s n)
+      (aset hands s (cg-rummy-sort-hand (cl-loop repeat 11 collect (pop deck))))
+      (aset feet s (cg-rummy-sort-hand (cl-loop repeat 11 collect (pop deck)))))
+    (cg-put game :hands hands)
+    (cg-put game :feet feet)
+    (cg-put game :stage stage)
+    (cg-put game :books (make-vector (cg-get game :nteams) nil))
+    (cg-put game :discard (list (pop deck)))
+    (cg-put game :stock deck)
+    (cg-put game :turn 0)
+    (cg-put game :step 'draw)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (cg-put game :marks nil)
+    (cg-put game :message "Your turn: s draws two cards.")
+    game))
+
+(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))
+
+;;;; Engine
+
+(defun cg-hf--draw2 (game s)
+  "Draw two stock cards into seat S's hand.  Return nil if stock runs out."
+  (let ((ok t))
+    (dotimes (_ 2)
+      (let ((stock (cg-get game :stock)))
+        (if (null stock) (setq ok nil)
+          (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                                      (cons (car stock) (cg-rummy--hand game s))))
+          (cg-put game :stock (cdr stock)))))
+    ok))
+
+(defun cg-hf--meld (game s cards)
+  "Have seat S lay CARDS as a new book for their team.  Return non-nil on win."
+  (when (and (cg-hf--book-valid-p cards)
+             (cl-subsetp cards (cg-rummy--hand game s) :test #'equal))
+    (let ((team (cg-hf--team game s)))
+      (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)
+                                (list (cg-rummy-sort-hand (copy-sequence cards)))))
+      t)))
+
+(defun cg-rummy--remove1 (card list)
+  "Return LIST with one copy of CARD (an `equal' match) removed."
+  (let ((seen nil))
+    (cl-remove-if (lambda (c) (and (not seen) (equal c card) (setq seen t))) list)))
+
+(defun cg-hf--layoff (game s card)
+  "Lay CARD off onto a team book it fits.  Return non-nil on success."
+  (let* ((team (cg-hf--team game s)) (books (cg-hf--books game team)) (done nil))
+    (catch 'hit
+      (dolist (bk books)
+        (unless (cg-hf--book-complete-p bk)
+          (let ((cand (cons card bk)))
+            (when (cg-hf--book-valid-p cand)
+              (cg-rummy--set-hand game s (cg-rummy--remove1 card (cg-rummy--hand game s)))
+              (setcar (memq bk books) (cg-rummy-sort-hand cand))
+              (setq done t)
+              (throw 'hit t))))))
+    done))
+
+(defun cg-hf--advance (game s)
+  "After a play, take up the foot or finish, then pass the turn."
+  (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)))
+    (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)
+      (cg-put game :turn (mod (1+ s) (cg-get game :nplayers)))
+      (cg-put game :step 'draw))))
+
+(defun cg-hf--can-go-out-p (game team)
+  "Return non-nil when TEAM owns at least two complete books."
+  (>= (cl-count-if #'cg-hf--book-complete-p (cg-hf--books game team)) 2))
+
+(defun cg-hf--discard (game s card)
+  "Discard CARD from seat S and end the play portion of the turn."
+  (cg-rummy--set-hand game s (cg-rummy--remove1 card (cg-rummy--hand game s)))
+  (cg-put game :discard (cons card (cg-get game :discard)))
+  (cg-hf--advance game s))
+
+(cl-defmethod cg-hf--score-round ((game cg-handfoot-game) outseat)
+  "Score the round (OUTSEAT went out, or nil if the stock ran dry)."
+  (let* ((nt (cg-get game :nteams)) (scores (cg-get game :scores)))
+    (dotimes (team nt)
+      (let ((pts 0))
+        (dolist (bk (cg-hf--books game team))
+          (dolist (c bk) (setq pts (+ pts (cg-hf-value c))))
+          (when (cg-hf--book-complete-p bk)
+            (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
+        ;; subtract cards left in members' hands and feet
+        (dotimes (s (cg-get game :nplayers))
+          (when (= (cg-hf--team game s) team)
+            (dolist (c (cg-rummy--hand game s)) (setq pts (- pts (cg-hf-value c))))
+            (when (= (aref (cg-get game :stage) s) 0)
+              (dolist (c (aref (cg-get game :feet) s))
+                (setq pts (- pts (cg-hf-value c)))))))
+        (aset scores team (+ (aref scores team) pts))))
+    (let ((win nil) (best most-negative-fixnum))
+      (dotimes (team nt)
+        (when (and (>= (aref scores team) cg-handfoot-target)
+                   (> (aref scores team) best))
+          (setq win team best (aref scores team))))
+      (cg-put game :phase (if win 'game-over 'round-over))
+      (cg-put game :winner (or win (and outseat (cg-hf--team game outseat))))
+      (cg-put game :reveal t)
+      (cg-put game :message
+              (concat
+               (if outseat (format "%s goes out!  " (aref cg-handfoot--names outseat))
+                 "Stock exhausted.  ")
+               (if win (format "Team %d wins the game!  (n: new game)" win)
+                 (format "Round over.  Scores: %s.  (n: next round)"
+                         (cg-hf--scores-string game))))))))
+
+(defun cg-hf--scores-string (game)
+  "Return a compact per-team score line for GAME."
+  (let ((scores (cg-get game :scores)) (parts '()))
+    (dotimes (team (cg-get game :nteams))
+      (push (format "Team %d %d" team (aref scores team)) parts))
+    (mapconcat #'identity (nreverse parts) " · ")))
+
+;;;; AI
+
+(defun cg-hf--ai-meld (game s)
+  "Lay down and extend books for seat S as far as is easy."
+  ;; lay off naturals onto existing incomplete team books
+  (let ((again t))
+    (while again
+      (setq again nil)
+      (let ((card (cl-find-if
+                   (lambda (c)
+                     (and (not (cg-hf--wild-p c)) (not (cg-hf--three-p c))
+                          (cl-find-if
+                           (lambda (bk) (and (not (cg-hf--book-complete-p bk))
+                                             (equal (cg-hf--book-rank bk) (cdr c))))
+                           (cg-hf--books game (cg-hf--team game s)))))
+                   (cg-rummy--hand game s))))
+        (when card (cg-hf--layoff game s card) (setq again t)))))
+  ;; start new books from ranks with >=3 naturals in hand
+  (let ((again t))
+    (while again
+      (setq again nil)
+      (let* ((hand (cg-rummy--hand game s))
+             (byrank (make-hash-table :test 'eql)) (target nil))
+        (dolist (c hand)
+          (unless (or (cg-hf--wild-p c) (cg-hf--three-p c))
+            (push c (gethash (cdr c) byrank))))
+        (maphash (lambda (_r cs) (when (and (not target) (>= (length cs) 3))
+                                   (setq target cs)))
+                 byrank)
+        (when target
+          (cg-hf--meld game s (cl-subseq target 0 (min 7 (length target))))
+          (setq again t)))))
+  ;; push a nearly-complete book to seven with a spare wild
+  (let ((again t))
+    (while again
+      (setq again nil)
+      (let ((wild (cl-find-if #'cg-hf--wild-p (cg-rummy--hand game s)))
+            (team (cg-hf--team game s)))
+        (when wild
+          (let ((bk (cl-find-if
+                     (lambda (b)
+                       (and (not (cg-hf--book-complete-p b))
+                            (>= (length b) 5)
+                            (> (cl-count-if-not #'cg-hf--wild-p b)
+                               (cl-count-if #'cg-hf--wild-p b))
+                            (< (cl-count-if #'cg-hf--wild-p b) 3)))
+                     (cg-hf--books game team))))
+            (when bk
+              (cg-rummy--set-hand game s (cg-rummy--remove1 wild (cg-rummy--hand game s)))
+              (setcar (memq bk (cg-hf--books game team))
+                      (cg-rummy-sort-hand (cons wild bk)))
+              (setq again t))))))))
+
+(defun cg-hf--ai-discard-card (game s)
+  "Return the card seat S should discard."
+  (let ((hand (cg-rummy--hand game s)))
+    (or (cl-find-if #'cg-hf--three-p hand)
+        ;; a high singleton, else the first card
+        (let ((byrank (make-hash-table :test 'eql)) (best (car hand)) (bestv -1))
+          (dolist (c hand) (unless (cg-hf--wild-p c)
+                             (push c (gethash (cdr c) byrank))))
+          (maphash (lambda (_r cs)
+                     (when (= (length cs) 1)
+                       (let ((v (cg-hf-value (car cs))))
+                         (when (> v bestv) (setq best (car cs) bestv v)))))
+                   byrank)
+          best))))
+
+(cl-defmethod cg-hf--ai-turn ((game cg-handfoot-game) s)
+  "Play seat S's whole turn."
+  (if (not (cg-hf--draw2 game s))
+      (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--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))))))
+
+(defun cg-hf--run (game)
+  "Advance AI seats until it is your turn or the round ends."
+  (while (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0))
+    (cg-hf--ai-turn game (cg-get game :turn))))
+
+;;;; UI
+
+(defvar-local cg-hf--game nil "The Hand & Foot game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-handfoot-game))
+  "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)
+    (dotimes (team (cg-get game :nteams))
+      (push (format "  Team %d  (score %d):\n" team (aref scores team)) out)
+      (let ((bks (cg-hf--books game team)))
+        (if bks
+            (dolist (bk bks)
+              (push (format "    %s%s\n"
+                            (mapconcat #'cg-rummy-card-string bk " ")
+                            (cond ((cg-hf--book-complete-p bk)
+                                   (if (cg-hf--book-clean-p bk) "  [clean pile]" "  [dirty pile]"))
+                                  (t "")))
+                    out))
+          (push "    (no books yet)\n" out))))
+    (push "\n" out)
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s 0)
+        (push (format "  %-6s %d in hand%s\n" (aref cg-handfoot--names s)
+                      (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"
+                  (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 :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 (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-hf--redisplay ()
+  "Redraw the Hand & Foot buffer."
+  (let ((game cg-hf--game) (inhibit-read-only t))
+    (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))))
+
+(defun cg-hf--clamp (g)
+  "Keep G's cursor in range and drop stale marks."
+  (let ((n (length (cg-rummy--hand g 0))))
+    (cg-put g :cursor (if (> n 0) (min (cg-get g :cursor) (1- n)) 0))
+    (cg-put g :marks (cl-remove-if (lambda (i) (>= i n)) (cg-get g :marks)))))
+
+(defun cg-hf--my-turn-p (g)
+  (and (eq (cg-get g :phase) 'play) (= (cg-get g :turn) 0)))
+
+(defun cg-hf-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((g cg-hf--game) (n (length (cg-rummy--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-hf--redisplay)))
+
+(defun cg-hf-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((g cg-hf--game) (n (length (cg-rummy--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-hf--redisplay)))
+
+(defun cg-hf-mark ()
+  "Toggle a mark on the card under the cursor."
+  (interactive)
+  (let* ((g cg-hf--game) (i (cg-get g :cursor)) (marks (cg-get g :marks)))
+    (cg-put g :marks (if (memq i marks) (delq i marks) (cons i marks)))
+    (cg-hf--redisplay)))
+
+(defun cg-hf--marked (g)
+  "Return the marked cards in G's hand."
+  (let ((hand (cg-rummy--hand g 0)))
+    (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."
+  (interactive)
+  (let* ((g cg-hf--game) (cards (cg-hf--marked g)))
+    (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--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)
+        (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).")))
+     (t (cg-put g :message "Could not meld those cards.")))
+    (cg-hf--redisplay)))
+
+(defun cg-hf-layoff ()
+  "Lay the cursor card (or marked cards) off onto a team book."
+  (interactive)
+  (let* ((g cg-hf--game) (marks (cg-hf--marked g)))
+    (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)."))
+     (t (let ((cards (or marks (list (nth (cg-get g :cursor) (cg-rummy--hand g 0)))))
+              (any nil))
+          (dolist (c cards) (when (and c (cg-hf--layoff g 0 c)) (setq any t)))
+          (cg-put g :marks nil) (cg-hf--clamp g)
+          (cg-put g :message (if any "Laid off." "That card fits none of your books.")))))
+    (cg-hf--redisplay)))
+
+(defun cg-hf-draw ()
+  "Draw two cards from the stock."
+  (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."))
+     ((cg-hf--draw2 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-discard ()
+  "Discard the cursor card and end your turn."
+  (interactive)
+  (let* ((g cg-hf--game) (card (nth (cg-get g :cursor) (cg-rummy--hand 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)."))
+     ((null card) (cg-put g :message "No card selected."))
+     (t (cg-hf--discard g 0 card)
+        (cg-put g :marks nil)
+        (when (memq (cg-get g :phase) '(play))
+          (cg-put g :message "You discarded.")
+          (cg-hf--run g))))
+    (cg-hf--redisplay)))
+
+(defun cg-hf-new ()
+  "Deal a fresh round, or a new game when one is over."
+  (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 :reveal nil)
+    (cg-hf--deal g)
+    (cg-hf--run g)
+    (cg-hf--redisplay)))
+
+(defun cg-hf-redraw () "Redraw the board." (interactive) (cg-hf--redisplay))
+
+(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"))
+
+(defvar cg-handfoot-mode-map
+  (let ((map (make-sparse-keymap)))
+    (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 (kbd "RET") #'cg-hf-discard)
+    (define-key map "n" #'cg-hf-new)
+    (define-key map "g" #'cg-hf-redraw)
+    (define-key map "?" #'cg-hf-help)
+    map)
+  "Keymap for `cg-handfoot-mode'.")
+
+(define-derived-mode cg-handfoot-mode special-mode "Hand&Foot"
+  "Major mode for Hand & Foot."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-handfoot ()
+  "Play Hand & Foot, partnering North against two AI opponents."
+  (interactive)
+  (let ((buf (get-buffer-create "*Hand & Foot*")))
+    (with-current-buffer buf
+      (cg-handfoot-mode)
+      (setq cg-hf--game (cg-handfoot-game))
+      (cg-put cg-hf--game :nplayers 4)
+      (cg-put cg-hf--game :nteams 2)
+      (cg-put cg-hf--game :scores (make-vector 2 0))
+      (cg-hf--deal cg-hf--game)
+      (cg-hf--run cg-hf--game)
+      (cg-hf--redisplay))
+    (switch-to-buffer buf)))
+
+;;;###autoload
+(defalias 'cg-hand-and-foot #'cg-handfoot)
+
+(provide 'cg-handfoot)
+;;; cg-handfoot.el ends here

cg-match.el

@@ -0,0 +1,481 @@
+;;; cg-match.el --- Go Fish and Old Maid  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Two children's classics that turn on matching ranks rather than melding.
+;;
+;;   `cg-go-fish' -- Go Fish.  On your turn ask another player for a rank
+;;     you already hold; collect all four of a rank to lay down a book.
+;;     Whoever lays down the most books wins.
+;;   `cg-old-maid' -- Old Maid.  One Queen is removed, so one stays
+;;     unpaired.  Discard pairs, then draw blind from your neighbour; do
+;;     not be the one left holding the odd Queen.
+;;
+;; You are the first player; the rest are computer opponents.  Cards use
+;; the package cons (SUIT . RANK), RANK 0 (Ace) .. 12 (King).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-rummy)
+
+;;;; Go Fish
+
+(defcustom cg-go-fish-players 3
+  "Number of players in Go Fish, including you (2-5)."
+  :type '(choice (const 2) (const 3) (const 4) (const 5)) :group 'card-games)
+
+(defclass cg-go-fish-game (cg-game)
+  ((vname :initform "Go Fish"))
+  "A game of Go Fish.")
+
+(defsubst cg-gf--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-gf--set-hand (game s v) (aset (cg-get game :hands) s v))
+
+(defun cg-gf--books (game s) (aref (cg-get game :books) s))
+
+(defun cg-gf--rank-count (hand rank)
+  "Return how many cards of RANK are in HAND."
+  (cl-count rank hand :key #'cdr))
+
+(defun cg-gf--check-books (game s)
+  "Lay down any completed four-of-a-kind books from seat S's hand."
+  (dotimes (r 13)
+    (when (>= (cg-gf--rank-count (cg-gf--hand game s) r) 4)
+      (cg-gf--set-hand game s (cl-remove r (cg-gf--hand game s) :key #'cdr))
+      (aset (cg-get game :books) s (1+ (aref (cg-get game :books) s))))))
+
+(cl-defmethod cg-gf--deal ((game cg-go-fish-game))
+  "Deal a fresh Go Fish game into GAME."
+  (let* ((n (max 2 (min 5 cg-go-fish-players)))
+         (deck (cg-rummy-deck)) (per (if (<= n 3) 7 5))
+         (hands (make-vector n nil)))
+    (dotimes (s n) (aset hands s (cl-loop repeat per collect (pop deck))))
+    (cg-put game :hands hands)
+    (cg-put game :books (make-vector n 0))
+    (cg-put game :nplayers n)
+    (cg-put game :stock deck)
+    (cg-put game :turn 0)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (dotimes (s n)
+      (cg-gf--set-hand game s (cg-rummy-sort-hand (cg-gf--hand game s)))
+      (cg-gf--check-books game s))
+    (cg-put game :message "Pick a card, then press 1-4 to ask that player for its rank.")
+    game))
+
+(defun cg-gf--draw (game s)
+  "Draw one stock card into seat S's hand.  Return it, or nil if empty."
+  (let ((stock (cg-get game :stock)))
+    (when stock
+      (cg-gf--set-hand game s (cg-rummy-sort-hand (cons (car stock) (cg-gf--hand game s))))
+      (cg-put game :stock (cdr stock))
+      (car stock))))
+
+(defun cg-gf--total-books (game)
+  (let ((sum 0)) (dotimes (s (cg-get game :nplayers))
+                   (setq sum (+ sum (cg-gf--books game s))))
+       sum))
+
+(defun cg-gf--maybe-over (game)
+  "End the game when all thirteen books are made."
+  (when (>= (cg-gf--total-books game) 13)
+    (let ((best 0))
+      (dotimes (s (cg-get game :nplayers))
+        (when (> (cg-gf--books game s) (cg-gf--books game best)) (setq best s)))
+      (cg-put game :phase 'game-over)
+      (cg-put game :winner best)
+      (cg-put game :message
+              (format "Game over.  %s wins with %d books!  (n: new game)"
+                      (cg-gf--who best) (cg-gf--books game best))))))
+
+(defun cg-gf--who (s) (if (= s 0) "You" (format "Player %d" s)))
+
+(cl-defmethod cg-gf--ask ((game cg-go-fish-game) asker target rank)
+  "ASKER asks TARGET for RANK.  Return non-nil if ASKER keeps the turn."
+  (let* ((got (cl-remove-if-not (lambda (c) (= (cdr c) rank)) (cg-gf--hand game target)))
+         (keep nil))
+    (if got
+        (progn
+          (cg-gf--set-hand game target (cl-remove rank (cg-gf--hand game target) :key #'cdr))
+          (cg-gf--set-hand game asker
+                           (cg-rummy-sort-hand (append got (cg-gf--hand game asker))))
+          (cg-put game :message
+                  (format "%s took %d %s%s from %s."
+                          (cg-gf--who asker) (length got)
+                          (aref cg-rummy-ranks rank) (if (> (length got) 1) "s" "")
+                          (cg-gf--who target)))
+          (setq keep t))
+      ;; go fish
+      (let ((drawn (cg-gf--draw game asker)))
+        (cg-put game :message
+                (format "%s asked %s for %ss -- go fish!%s"
+                        (cg-gf--who asker) (cg-gf--who target) (aref cg-rummy-ranks rank)
+                        (cond ((null drawn) "  (stock empty)")
+                              ((= (cdr drawn) rank) "  Fished it -- go again!")
+                              (t ""))))
+        (when (and drawn (= (cdr drawn) rank)) (setq keep t))))
+    (cg-gf--check-books game asker)
+    ;; refill an empty hand from the stock if possible
+    (when (and (null (cg-gf--hand game asker)) (cg-get game :stock))
+      (cg-gf--draw game asker))
+    (cg-gf--maybe-over game)
+    (when (and (eq (cg-get game :phase) 'play) (not keep))
+      (cg-put game :turn (cg-gf--next game asker)))
+    keep))
+
+(defun cg-gf--next (game s)
+  "Return the next seat after S that still has cards (or stock to draw)."
+  (let ((n (cg-get game :nplayers)) (i (mod (1+ s) (cg-get game :nplayers))) (tries 0))
+    (while (and (< tries n) (null (cg-gf--hand game i)) (null (cg-get game :stock)))
+      (setq i (mod (1+ i) n) tries (1+ tries)))
+    i))
+
+(defun cg-gf--start-turn (game s)
+  "Ready seat S to act: draw up if empty; pass the turn if it cannot ask.
+Return non-nil when S can ask."
+  (when (and (null (cg-gf--hand game s)) (cg-get game :stock))
+    (cg-gf--draw game s))
+  (cg-gf--maybe-over game)
+  (cond ((not (eq (cg-get game :phase) 'play)) nil)
+        ((cg-gf--hand game s) t)
+        (t (cg-put game :turn (cg-gf--next game s)) nil)))
+
+(cl-defmethod cg-gf--ai-turn ((game cg-go-fish-game) s)
+  "Take seat S's whole AI turn (it may keep asking)."
+  (when (cg-gf--start-turn game s)
+    (let ((guard 0))
+      (while (and (= (cg-get game :turn) s) (eq (cg-get game :phase) 'play)
+                  (cg-gf--hand game s) (< guard 40))
+        (setq guard (1+ guard))
+        (let* ((hand (cg-gf--hand game s))
+               (counts (make-vector 13 0)) (rank (cdr (car hand))))
+          (dolist (c hand) (aset counts (cdr c) (1+ (aref counts (cdr c)))))
+          (dotimes (r 13) (when (> (aref counts r) (aref counts rank)) (setq rank r)))
+          (let* ((others (cl-loop for o below (cg-get game :nplayers)
+                                  unless (= o s) when (cg-gf--hand game o) collect o))
+                 (target (and others (nth (random (length others)) others))))
+            (if target (cg-gf--ask game s target rank)
+              (cg-put game :turn (cg-gf--next game s)))))))))
+
+(defun cg-gf--run (game)
+  "Advance AI seats until it is your turn or the game ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0) (< guard 1000))
+      (setq guard (1+ guard))
+      (cg-gf--ai-turn game (cg-get game :turn))))
+  (when (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0))
+    (unless (cg-gf--start-turn game 0)
+      (when (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0))
+        (cg-gf--run game)))))
+
+;;;; Go Fish UI
+
+(defvar-local cg-gf--game nil "The Go Fish game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-go-fish-game))
+  "Return a propertized depiction of the Go Fish GAME."
+  (let* ((out '()) (hand (cg-gf--hand game 0)) (cursor (cg-get game :cursor)))
+    (push "  Go Fish\n\n" out)
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s 0)
+        (push (format "  Player %d: %d cards   books %d\n"
+                      s (length (cg-gf--hand game s)) (cg-gf--books game s)) out)))
+    (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 (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-gf--redisplay ()
+  (let ((game cg-gf--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+(defun cg-gf-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((g cg-gf--game) (n (length (cg-gf--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-gf--redisplay)))
+
+(defun cg-gf-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((g cg-gf--game) (n (length (cg-gf--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-gf--redisplay)))
+
+(defun cg-gf-ask ()
+  "Ask the player whose number you pressed for the cursor card's rank."
+  (interactive)
+  (let* ((g cg-gf--game)
+         (target (- last-command-event ?0))
+         (card (nth (cg-get g :cursor) (cg-gf--hand g 0))))
+    (cond
+     ((not (eq (cg-get g :phase) 'play)) (cg-put g :message "Press n for a new game."))
+     ((/= (cg-get g :turn) 0) (cg-put g :message "Not your turn."))
+     ((null card) (cg-put g :message "Pick a card first."))
+     ((or (< target 1) (>= target (cg-get g :nplayers)))
+      (cg-put g :message "No such player to ask."))
+     ((null (cg-gf--hand g target)) (cg-put g :message "That player has no cards."))
+     (t (cg-gf--ask g 0 target (cdr card))
+        (cg-put g :cursor 0)
+        (unless (= (cg-get g :turn) 0) (cg-gf--run g))))
+    (cg-gf--redisplay)))
+
+(defun cg-gf-new () "Deal a new Go Fish game." (interactive)
+       (cg-gf--deal cg-gf--game) (cg-gf--redisplay))
+(defun cg-gf-redraw () "Redraw." (interactive) (cg-gf--redisplay))
+(defun cg-gf-help () "Describe the controls." (interactive)
+       (message "Arrows: choose a rank  1-4: ask that player  n: new  g: redraw"))
+
+(defvar cg-go-fish-mode-map
+  (let ((map (make-sparse-keymap)))
+    (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))
+    (define-key map "n" #'cg-gf-new)
+    (define-key map "g" #'cg-gf-redraw)
+    (define-key map "?" #'cg-gf-help)
+    map)
+  "Keymap for `cg-go-fish-mode'.")
+
+(define-derived-mode cg-go-fish-mode special-mode "GoFish"
+  "Major mode for Go Fish."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-go-fish ()
+  "Play Go Fish against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Go Fish*")))
+    (with-current-buffer buf
+      (cg-go-fish-mode)
+      (setq cg-gf--game (cg-go-fish-game))
+      (cg-gf--deal cg-gf--game)
+      (cg-gf--redisplay))
+    (switch-to-buffer buf)))
+
+
+;;;; Old Maid
+
+(defcustom cg-old-maid-players 3
+  "Number of players in Old Maid, including you (2-5)."
+  :type '(choice (const 2) (const 3) (const 4) (const 5)) :group 'card-games)
+
+(defclass cg-old-maid-game (cg-game)
+  ((vname :initform "Old Maid"))
+  "A game of Old Maid.")
+
+(defsubst cg-om--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-om--set-hand (game s v) (aset (cg-get game :hands) s v))
+
+(defun cg-om--discard-pairs (hand)
+  "Return HAND with every matched pair of ranks removed."
+  (let ((out '()) (byrank (make-hash-table :test 'eql)))
+    (dolist (c hand) (push c (gethash (cdr c) byrank)))
+    (maphash (lambda (_r cs)
+               (when (cl-oddp (length cs)) (push (car cs) out)))
+             byrank)
+    (cg-rummy-sort-hand out)))
+
+(cl-defmethod cg-om--deal ((game cg-old-maid-game))
+  "Deal a fresh Old Maid game into GAME (one Queen removed)."
+  (let* ((n (max 2 (min 5 cg-old-maid-players)))
+         (deck (cl-remove (cons 0 11) (cg-rummy-deck) :test #'equal :count 1))
+         (hands (make-vector n nil)) (i 0))
+    (dolist (c deck)
+      (aset hands i (cons c (aref hands i)))
+      (setq i (mod (1+ i) n)))
+    (dotimes (s n) (aset hands s (cg-om--discard-pairs (aref hands s))))
+    (cg-put game :hands hands)
+    (cg-put game :nplayers n)
+    (cg-put game :turn 0)
+    (cg-put game :phase 'play)
+    (cg-put game :pick 0)
+    (cg-put game :message "Draw a card from the next player: arrows pick, RET draws.")
+    (cg-om--skip-empty game)
+    game))
+
+(defun cg-om--active (game)
+  "Return the list of seats still holding cards."
+  (cl-loop for s below (cg-get game :nplayers)
+           when (cg-om--hand game s) collect s))
+
+(defun cg-om--target (game s)
+  "Return the next active seat after S to draw from."
+  (let ((n (cg-get game :nplayers)) (i (mod (1+ s) (cg-get game :nplayers))) (tries 0))
+    (while (and (< tries n) (or (= i s) (null (cg-om--hand game i))))
+      (setq i (mod (1+ i) n) tries (1+ tries)))
+    (and (cg-om--hand game i) i)))
+
+(defun cg-om--skip-empty (game)
+  "Advance the turn past any seat that has run out of cards."
+  (let ((n (cg-get game :nplayers)) (tries 0))
+    (while (and (< tries n) (null (cg-om--hand game (cg-get game :turn))))
+      (cg-put game :turn (mod (1+ (cg-get game :turn)) n))
+      (setq tries (1+ tries)))))
+
+(defun cg-om--total (game)
+  (let ((sum 0)) (dotimes (s (cg-get game :nplayers))
+                   (setq sum (+ sum (length (cg-om--hand game s)))))
+       sum))
+
+(cl-defmethod cg-om--draw ((game cg-old-maid-game) drawer idx)
+  "DRAWER takes card IDX from the next active hand, then discards a pair."
+  (let ((target (cg-om--target game drawer)))
+    (when target
+      (let* ((thand (cg-om--hand game target))
+             (card (nth (min idx (1- (length thand))) thand)))
+        (cg-om--set-hand game target (cl-remove card thand :test #'equal :count 1))
+        (cg-om--set-hand game drawer
+                         (cg-om--discard-pairs (cons card (cg-om--hand game drawer))))
+        (cg-put game :message
+                (format "%s drew from %s."
+                        (if (= drawer 0) "You" (format "Player %d" drawer))
+                        (if (= target 0) "you" (format "Player %d" target))))))
+    (if (<= (cg-om--total game) 1)
+        (cg-om--finish game)
+      (cg-put game :turn (mod (1+ drawer) (cg-get game :nplayers)))
+      (cg-put game :pick 0)
+      (cg-om--skip-empty game))))
+
+(cl-defmethod cg-om--finish ((game cg-old-maid-game))
+  "End the game; whoever holds the last card is the Old Maid."
+  (let ((loser (car (cg-om--active game))))
+    (cg-put game :phase 'game-over)
+    (cg-put game :winner loser)
+    (cg-put game :message
+            (if loser
+                (format "%s is left holding the Old Maid!  (n: new game)"
+                        (if (= loser 0) "You are" (format "Player %d is" loser)))
+              "All paired off -- a draw!  (n: new game)"))))
+
+(defun cg-om--ai-turn (game s)
+  "Take seat S's AI turn: draw a random card from the next hand."
+  (let ((target (cg-om--target game s)))
+    (if (null target) (cg-om--finish game)
+      (cg-om--draw game s (random (length (cg-om--hand game target)))))))
+
+(defun cg-om--run (game)
+  "Advance AI seats until it is your turn or the game ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0) (< guard 500))
+      (setq guard (1+ guard))
+      (cg-om--ai-turn game (cg-get game :turn)))))
+
+;;;; Old Maid UI
+
+(defvar-local cg-om--game nil "The Old Maid game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-old-maid-game))
+  "Return a propertized depiction of the Old Maid GAME."
+  (let* ((out '()) (target (cg-om--target game 0)))
+    (push "  Old Maid\n\n" out)
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s 0)
+        (push (format "  Player %d: %d cards%s\n" s (length (cg-om--hand game s))
+                      (if (eql s target) "   <- you draw from here" "")) out)))
+    (when (and target (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0))
+      (push (format "\n  Player %d's cards (pick one to draw):\n   " target) out)
+      (let ((np (length (cg-om--hand game target))) (pk (cg-get game :pick)))
+        (dotimes (i np)
+          (push (propertize " ##" 'face (if (= i pk) 'cg-cursor 'cg-gap)) out))))
+    (push "\n\n  Your hand:\n   " out)
+    (push (cg-rummy--render-cards (cg-om--hand game 0) -1 nil) out)
+    (push (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-om--redisplay ()
+  (let ((game cg-om--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+(defun cg-om-left ()
+  "Move the pick cursor left over the target's cards."
+  (interactive)
+  (let* ((g cg-om--game) (target (cg-om--target g 0))
+         (np (and target (length (cg-om--hand g target)))))
+    (when (and np (> np 0)) (cg-put g :pick (mod (1- (cg-get g :pick)) np)))
+    (cg-om--redisplay)))
+
+(defun cg-om-right ()
+  "Move the pick cursor right over the target's cards."
+  (interactive)
+  (let* ((g cg-om--game) (target (cg-om--target g 0))
+         (np (and target (length (cg-om--hand g target)))))
+    (when (and np (> np 0)) (cg-put g :pick (mod (1+ (cg-get g :pick)) np)))
+    (cg-om--redisplay)))
+
+(defun cg-om-draw ()
+  "Draw the selected card from the next player."
+  (interactive)
+  (let ((g cg-om--game))
+    (cond
+     ((not (eq (cg-get g :phase) 'play)) (cg-put g :message "Press n for a new game."))
+     ((/= (cg-get g :turn) 0) (cg-put g :message "Not your turn."))
+     (t (cg-om--draw g 0 (cg-get g :pick))
+        (unless (= (cg-get g :turn) 0) (cg-om--run g))))
+    (cg-om--redisplay)))
+
+(defun cg-om-new () "Deal a new Old Maid game." (interactive)
+       (cg-om--deal cg-om--game) (cg-om--redisplay))
+(defun cg-om-redraw () "Redraw." (interactive) (cg-om--redisplay))
+(defun cg-om-help () "Describe the controls." (interactive)
+       (message "Arrows: pick a card from the next player  RET: draw it  n: new  g: redraw"))
+
+(defvar cg-old-maid-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-om-left)
+    (define-key map (kbd "<right>") #'cg-om-right)
+    (define-key map (kbd "RET") #'cg-om-draw)
+    (define-key map "n" #'cg-om-new)
+    (define-key map "g" #'cg-om-redraw)
+    (define-key map "?" #'cg-om-help)
+    map)
+  "Keymap for `cg-old-maid-mode'.")
+
+(define-derived-mode cg-old-maid-mode special-mode "OldMaid"
+  "Major mode for Old Maid."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-old-maid ()
+  "Play Old Maid against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Old Maid*")))
+    (with-current-buffer buf
+      (cg-old-maid-mode)
+      (setq cg-om--game (cg-old-maid-game))
+      (cg-om--deal cg-om--game)
+      (cg-om--redisplay))
+    (switch-to-buffer buf)))
+
+(provide 'cg-match)
+;;; cg-match.el ends here

cg-rum500.el

@@ -0,0 +1,519 @@
+;;; cg-rum500.el --- Basic Rummy and Rummy 500  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Two table-meld rummy games sharing one engine, built on the meld
+;; finder in cg-rummy.el.
+;;
+;; In a table-meld game you draw a card, lay melds face-up on the table,
+;; lay single cards off onto melds already there, and end your turn by
+;; discarding.  Empty your hand to go out.
+;;
+;;   `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.
+;;
+;; 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
+;; it and press l.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-rummy)
+
+(defclass cg-tablemeld-game (cg-rummy-game)
+  ((nplayers  :initarg :nplayers  :initform 2)
+   (hand-size :initarg :hand-size :initform 10)
+   (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))
+  "Abstract base for table-meld rummy games (Basic Rummy, Rummy 500)."
+  :abstract t)
+
+;;;; Engine
+
+(cl-defmethod cg-tm--deal ((game cg-tablemeld-game))
+  "Deal a fresh hand into GAME."
+  (let* ((n (oref game nplayers))
+         (deck (cg-rummy-deck))
+         (per (oref game hand-size))
+         (hands (make-vector n nil)))
+    (dotimes (s n)
+      (aset hands s (cg-rummy-sort-hand (cl-loop repeat per collect (pop deck)))))
+    (cg-put game :hands hands)
+    (cg-put game :nplayers n)
+    (cg-put game :discard (list (pop deck)))
+    (cg-put game :stock deck)
+    (cg-put game :table nil)
+    (cg-put game :laid (make-vector n 0))
+    (cg-put game :turn 0)
+    (cg-put game :step 'draw)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (cg-put game :marks nil)
+    (unless (cg-get game :scores) (cg-put game :scores (make-vector n 0)))
+    (cg-put game :message "Your turn: s draws from stock, t takes the discard.")
+    game))
+
+(defun cg-tm--ace-high (game) (oref game ace-high))
+(defun cg-tm--ace-15 (game) (oref game ace-15))
+
+(defun cg-tm--draw (game s)
+  "Move one stock card to seat S's hand; return it or nil if stock empty."
+  (let ((stock (cg-get game :stock)))
+    (when stock
+      (let ((c (pop stock)))
+        (cg-put game :stock stock)
+        (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                                    (cons c (cg-rummy--hand game s))))
+        c))))
+
+(defun cg-tm--take-top (game s)
+  "Move the discard top to seat S's hand and return it."
+  (let ((c (cg-rummy--top game)))
+    (when c
+      (cg-put game :discard (cdr (cg-get game :discard)))
+      (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                                  (cons c (cg-rummy--hand game s))))
+      c)))
+
+(defun cg-tm--meld-value (game cards)
+  "Return the total point value of CARDS for GAME's scoring."
+  (apply #'+ (mapcar (lambda (c) (cg-rummy-value c (cg-tm--ace-15 game))) cards)))
+
+(cl-defmethod cg-tm--meld ((game cg-tablemeld-game) s cards)
+  "Have seat S meld CARDS onto the table.  Return non-nil on success."
+  (when (cg-rummy-meld-p cards :min 3 :ace-high (cg-tm--ace-high game)
+                         :distinct-suits t)
+    (dolist (c cards) (cg-rummy--set-hand game s (remove c (cg-rummy--hand game s))))
+    (cg-put game :table (append (cg-get game :table)
+                                (list (cons s (copy-sequence cards)))))
+    (let ((laid (cg-get game :laid)))
+      (aset laid s (+ (aref laid s) (cg-tm--meld-value game cards))))
+    t))
+
+(cl-defmethod cg-tm--layoff ((game cg-tablemeld-game) s card)
+  "Have seat S lay CARD off onto a matching table meld.  Return non-nil on success."
+  (let ((rec (cl-find-if
+              (lambda (r) (cg-rummy-meld-p (cons card (cdr r)) :min 3
+                                           :ace-high (cg-tm--ace-high game)))
+              (cg-get game :table))))
+    (when rec
+      (cg-rummy--set-hand game s (remove card (cg-rummy--hand game s)))
+      (setcdr rec (cg-rummy-sort-hand (cons card (cdr rec))))
+      (let ((laid (cg-get game :laid)))
+        (aset laid s (+ (aref laid s) (cg-rummy-value card (cg-tm--ace-15 game)))))
+      t)))
+
+(cl-defmethod cg-tm--score-hand ((game cg-tablemeld-game) outseat)
+  "Score the hand ended by OUTSEAT (or nil for a washed-out hand)."
+  (let* ((n (cg-get game :nplayers)) (scores (cg-get game :scores))
+         (style (oref game score-style)))
+    (cond
+     ((eq style 'go-out)
+      (when outseat
+        (let ((sum 0))
+          (dotimes (s n)
+            (unless (= s outseat)
+              (dolist (c (cg-rummy--hand game s))
+                (setq sum (+ sum (cg-rummy-value c))))))
+          (aset scores outseat (+ (aref scores outseat) sum)))))
+     ((eq style 'meld-points)
+      (let ((laid (cg-get game :laid)))
+        (dotimes (s n)
+          (let ((rem (apply #'+ (mapcar (lambda (c)
+                                          (cg-rummy-value c (cg-tm--ace-15 game)))
+                                        (cg-rummy--hand game s)))))
+            (aset scores s (+ (aref scores s) (- (aref laid s) rem))))))))
+    ;; decide if the game is over
+    (let ((win nil) (best most-negative-fixnum))
+      (dotimes (s n)
+        (when (and (>= (aref scores s) (oref game target))
+                   (> (aref scores s) best))
+          (setq win s best (aref scores s))))
+      (cg-put game :phase (if win 'game-over 'hand-over))
+      (cg-put game :winner (or win outseat))
+      (cg-put game :reveal t)
+      (cg-put game :message
+              (if win
+                  (format "%s wins the game with %d!  (n: new game)"
+                          (cg-tm--who win) (aref scores win))
+                (concat (if outseat (format "%s goes out.  " (cg-tm--who outseat))
+                          "Stock exhausted.  ")
+                        (format "Scores: %s.  (n: next hand)"
+                                (cg-tm--scores-string game))))))))
+
+(defun cg-tm--who (s) (if (= s 0) "You" (format "Player %d" s)))
+
+(defun cg-tm--scores-string (game)
+  "Return a compact \"You N · P1 N ...\" score line for GAME."
+  (let ((scores (cg-get game :scores)) (parts '()))
+    (dotimes (s (cg-get game :nplayers))
+      (push (format "%s %d" (if (= s 0) "You" (format "P%d" s)) (aref scores s))
+            parts))
+    (mapconcat #'identity (nreverse parts) " · ")))
+
+(cl-defmethod cg-tm--end-turn ((game cg-tablemeld-game) s)
+  "Finish seat S's turn: go out if the hand is empty, else advance."
+  (if (null (cg-rummy--hand game s))
+      (cg-tm--score-hand game s)
+    (cg-put game :turn (mod (1+ s) (cg-get game :nplayers)))
+    (cg-put game :step 'draw)))
+
+(cl-defmethod cg-tm--discard ((game cg-tablemeld-game) s card)
+  "Discard CARD from seat S and finish the turn."
+  (cg-rummy--set-hand game s (remove card (cg-rummy--hand game s)))
+  (cg-put game :discard (cons card (cg-get game :discard)))
+  (cg-tm--end-turn game s))
+
+;;;; AI
+
+(defun cg-tm--ai-melds (game s)
+  "Lay down every meld seat S can, keeping a card back to discard.
+Return non-nil if any meld was laid."
+  (let ((did nil) (again t))
+    (while again
+      (setq again nil)
+      (let* ((hand (cg-rummy--hand game s))
+             (p (cg-rummy-best-partition hand :ace-high (cg-tm--ace-high game)
+                                         :ace-15 (cg-tm--ace-15 game)))
+             (melds (plist-get p :melds))
+             ;; keep one card to discard: skip a meld if it would empty the hand
+             (melded (apply #'+ (mapcar #'length melds))))
+        (when (and melds (= melded (length hand)))
+          (setq melds (cdr (sort melds (lambda (a b) (< (length a) (length b)))))))
+        (when melds
+          (cg-tm--meld game s (car melds))
+          (setq did t again t))))
+    did))
+
+(defun cg-tm--ai-layoffs (game s)
+  "Lay off every fitting card from seat S, keeping a card back to discard."
+  (let ((again t))
+    (while again
+      (setq again nil)
+      (when (> (length (cg-rummy--hand game s)) 1)
+        (let ((card (cl-find-if
+                     (lambda (c)
+                       (cl-find-if
+                        (lambda (r) (cg-rummy-meld-p (cons c (cdr r)) :min 3
+                                                     :ace-high (cg-tm--ace-high game)))
+                        (cg-get game :table)))
+                     (cg-rummy--hand game s))))
+          (when card (cg-tm--layoff game s card) (setq again t)))))))
+
+(defun cg-tm--ai-discard-card (game s)
+  "Return the best card for seat S to discard (highest deadwood)."
+  (let* ((hand (cg-rummy--hand game s))
+         (p (cg-rummy-best-partition hand :ace-high (cg-tm--ace-high game)
+                                     :ace-15 (cg-tm--ace-15 game)))
+         (dead (or (plist-get p :deadwood) hand))
+         (best (car dead)) (bestv -1))
+    (dolist (c dead best)
+      (let ((v (cg-rummy-value c (cg-tm--ace-15 game))))
+        (when (> v bestv) (setq best c bestv v))))))
+
+(cl-defmethod cg-tm--ai-turn ((game cg-tablemeld-game) s)
+  "Play seat S's whole turn."
+  (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))
+                   (cg-tm--take-top game s)
+                 (cg-tm--draw game s))))
+    (if (not drew)
+        (cg-tm--score-hand game nil)
+      (cg-tm--ai-melds game s)
+      (cg-tm--ai-layoffs game s)
+      (when (eq (cg-get game :phase) 'play)
+        (if (null (cg-rummy--hand game s))
+            (cg-tm--end-turn game s)          ; melded out, no discard needed
+          (cg-tm--discard game s (cg-tm--ai-discard-card game s)))))))
+
+(defun cg-tm--run (game)
+  "Advance AI seats until it is the human's turn or the hand ends."
+  (while (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0))
+    (cg-tm--ai-turn game (cg-get game :turn))))
+
+;;;; UI
+
+(defvar-local cg-tm--game nil "The table-meld game in the current buffer.")
+
+(defun cg-tm--layoff-hint (game)
+  "Return a predicate marking cards that can be laid off in GAME now."
+  (lambda (c)
+    (cl-find-if (lambda (r) (cg-rummy-meld-p (cons c (cdr r)) :min 3
+                                             :ace-high (cg-tm--ace-high game)))
+                (cg-get game :table))))
+
+(cl-defmethod cg-render ((game cg-tablemeld-game))
+  "Return a propertized depiction of the table-meld GAME."
+  (let* ((out '()) (scores (cg-get game :scores))
+         (laid (cg-get game :laid)) (meldp (oref game score-style))
+         (hand (cg-rummy--hand game 0)) (cursor (cg-get game :cursor)))
+    (push (format "  %s        target %d\n\n" (oref game vname) (oref game target)) out)
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s 0)
+        (push (format "  Player %d: %d cards   score %d%s\n"
+                      s (length (cg-rummy--hand game s)) (aref scores s)
+                      (if (eq meldp 'meld-points)
+                          (format "  (laid %d)" (aref laid s)) ""))
+              out)))
+    (push "\n  Table:\n" out)
+    (if (cg-get game :table)
+        (dolist (rec (cg-get game :table))
+          (push (format "    [%s] %s\n" (if (= (car rec) 0) "you" (format "P%d" (car rec)))
+                        (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))
+                  (length (cg-get game :stock)))
+          out)
+    (push (format "  Your hand%s:\n   "
+                  (if (eq meldp 'meld-points) (format "  (laid %d, score %d)"
+                                                       (aref laid 0) (aref scores 0))
+                    (format "  (score %d)" (aref scores 0))))
+          out)
+    (push (cg-rummy--render-cards hand cursor (cg-get game :marks)
+                                  (cg-tm--layoff-hint game))
+          out)
+    (push (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-tm--redisplay ()
+  "Redraw the table-meld buffer."
+  (let ((game cg-tm--game) (inhibit-read-only t))
+    (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))))
+
+(defun cg-tm--clamp-cursor (g)
+  "Keep G's cursor within the hand and drop stale marks."
+  (let ((n (length (cg-rummy--hand g 0))))
+    (cg-put g :cursor (if (> n 0) (min (cg-get g :cursor) (1- n)) 0))
+    (cg-put g :marks (cl-remove-if (lambda (i) (>= i n)) (cg-get g :marks)))))
+
+(defun cg-tm--my-turn-p (g)
+  (and (eq (cg-get g :phase) 'play) (= (cg-get g :turn) 0)))
+
+(defun cg-tm-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((g cg-tm--game) (n (length (cg-rummy--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((g cg-tm--game) (n (length (cg-rummy--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-mark ()
+  "Toggle a mark on the card under the cursor (for melding)."
+  (interactive)
+  (let* ((g cg-tm--game) (i (cg-get g :cursor)) (marks (cg-get g :marks)))
+    (cg-put g :marks (if (memq i marks) (delq i marks) (cons i marks)))
+    (cg-tm--redisplay)))
+
+(defun cg-tm--marked-cards (g)
+  "Return the cards currently marked in G's hand."
+  (let ((hand (cg-rummy--hand g 0)))
+    (mapcar (lambda (i) (nth i hand)) (sort (copy-sequence (cg-get g :marks)) #'<))))
+
+(defun cg-tm-meld ()
+  "Meld the marked cards onto the table."
+  (interactive)
+  (let* ((g cg-tm--game) (cards (cg-tm--marked-cards g)))
+    (cond
+     ((not (cg-tm--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((eq (cg-get g :step) 'draw) (cg-put g :message "Draw first (s or t)."))
+     ((< (length cards) 3) (cg-put g :message "Mark at least three cards (SPC), then m."))
+     ((cg-tm--meld g 0 cards)
+      (cg-put g :marks nil) (cg-tm--clamp-cursor g)
+      (cg-put g :message "Melded.  Lay off with l, meld more, or discard (RET)."))
+     (t (cg-put g :message "Those cards are not a valid set or run.")))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-layoff ()
+  "Lay the cursor card (or marked cards) off onto a table meld."
+  (interactive)
+  (let* ((g cg-tm--game) (marks (cg-tm--marked-cards g)))
+    (cond
+     ((not (cg-tm--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((eq (cg-get g :step) 'draw) (cg-put g :message "Draw first (s or t)."))
+     (t (let ((cards (or marks (list (nth (cg-get g :cursor) (cg-rummy--hand g 0)))))
+              (any nil))
+          (dolist (c cards) (when (and c (cg-tm--layoff g 0 c)) (setq any t)))
+          (cg-put g :marks nil) (cg-tm--clamp-cursor g)
+          (cg-put g :message (if any "Laid off." "That card fits no meld on the table.")))))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-draw-stock ()
+  "Draw the top stock card."
+  (interactive)
+  (let ((g cg-tm--game))
+    (cond
+     ((not (cg-tm--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-tm--draw g 0)
+      (cg-put g :step 'play) (cg-tm--clamp-cursor g)
+      (cg-put g :message "Meld (m), lay off (l), then discard (RET)."))
+     (t (cg-tm--score-hand g nil)))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-take ()
+  "Take the discard top into your hand."
+  (interactive)
+  (let ((g cg-tm--game))
+    (cond
+     ((not (cg-tm--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."))
+     ((null (cg-rummy--top g)) (cg-put g :message "The discard pile is empty."))
+     (t (let ((c (cg-tm--take-top g 0)))
+          (cg-put g :step 'play) (cg-tm--clamp-cursor g)
+          (cg-put g :message (format "Took %s.  Meld (m), lay off (l), discard (RET)."
+                                     (cg-rummy-card-string c))))))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-discard ()
+  "Discard the cursor card and end your turn."
+  (interactive)
+  (let* ((g cg-tm--game) (card (nth (cg-get g :cursor) (cg-rummy--hand g 0))))
+    (cond
+     ((not (cg-tm--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((eq (cg-get g :step) 'draw) (cg-put g :message "Draw first (s or t)."))
+     ((null card) (cg-put g :message "No card selected."))
+     (t (cg-tm--discard g 0 card)
+        (cg-put g :marks nil)
+        (when (eq (cg-get g :phase) 'play)
+          (cg-put g :message "You discarded.")
+          (cg-tm--run g))))
+    (cg-tm--redisplay)))
+
+(defun cg-tm-new ()
+  "Deal a fresh hand, or a new game when one is over."
+  (interactive)
+  (let ((g cg-tm--game))
+    (when (eq (cg-get g :phase) 'game-over)
+      (cg-put g :scores (make-vector (oref g nplayers) 0)))
+    (cg-put g :reveal nil)
+    (cg-tm--deal g)
+    (cg-tm--run g)
+    (cg-tm--redisplay)))
+
+(defun cg-tm-redraw () "Redraw the board." (interactive) (cg-tm--redisplay))
+
+(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"))
+
+(defvar cg-tm-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-tm-left)
+    (define-key map (kbd "<right>") #'cg-tm-right)
+    (define-key map (kbd "SPC") #'cg-tm-mark)
+    (define-key map "m" #'cg-tm-meld)
+    (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 (kbd "RET") #'cg-tm-discard)
+    (define-key map "n" #'cg-tm-new)
+    (define-key map "g" #'cg-tm-redraw)
+    (define-key map "?" #'cg-tm-help)
+    map)
+  "Keymap for `cg-tm-mode'.")
+
+(define-derived-mode cg-tm-mode special-mode "Rummy"
+  "Major mode for the table-meld rummy games."
+  (setq-local truncate-lines t))
+
+(defun cg-tm--start (game buffer-name)
+  "Start GAME in a buffer named BUFFER-NAME."
+  (let ((buf (get-buffer-create buffer-name)))
+    (with-current-buffer buf
+      (cg-tm-mode)
+      (setq cg-tm--game game)
+      (cg-tm--deal game)
+      (cg-tm--run game)
+      (cg-tm--redisplay))
+    (switch-to-buffer buf)))
+
+;;;; The two games
+
+(defcustom cg-rummy-basic-players 2
+  "Number of players in Basic Rummy, including you (2-4)."
+  :type '(choice (const 2) (const 3) (const 4)) :group 'card-games)
+
+(defclass cg-rummy-basic-game (cg-tablemeld-game)
+  ((vname :initform "Rummy")
+   (score-style :initform 'go-out)
+   (target :initform 100))
+  "A game of plain Rummy.")
+
+;;;###autoload
+(defun cg-rummy-basic ()
+  "Play Basic Rummy against the computer."
+  (interactive)
+  (let ((n (max 2 (min 4 cg-rummy-basic-players))))
+    (cg-tm--start (cg-rummy-basic-game :nplayers n :hand-size (if (= n 2) 10 7))
+                  "*Rummy*")))
+
+(defcustom cg-rum500-players 3
+  "Number of players in Rummy 500, including you (2-4)."
+  :type '(choice (const 2) (const 3) (const 4)) :group 'card-games)
+
+(defclass cg-rum500-game (cg-tablemeld-game)
+  ((vname :initform "Rummy 500")
+   (score-style :initform 'meld-points)
+   (ace-15 :initform t)
+   (ace-high :initform t)
+   (target :initform 500))
+  "A game of Rummy 500.")
+
+;;;###autoload
+(defun cg-rum500 ()
+  "Play Rummy 500 against the computer."
+  (interactive)
+  (let ((n (max 2 (min 4 cg-rum500-players))))
+    (cg-tm--start (cg-rum500-game :nplayers n :hand-size (if (= n 2) 13 7))
+                  "*Rummy 500*")))
+
+;;;###autoload
+(defalias 'cg-rummy-500 #'cg-rum500)
+
+(provide 'cg-rum500)
+;;; 

cg-rummy.el

@@ -0,0 +1,617 @@
+;;; cg-rummy.el --- Rummy meld engine and Gin Rummy  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The shared meld engine for the rummy family, plus Gin Rummy.
+;;
+;; A "meld" is a list of cards that is either a *set* (three or four cards
+;; of the same rank) or a *run* (three or more cards of the same suit in
+;; consecutive rank).  The engine validates melds, enumerates the melds
+;; latent in a hand, and -- the hard part -- finds the layout that leaves
+;; the least deadwood, which drives both knock detection and the AI.
+;;
+;; Cards use the package-standard cons (SUIT . RANK) with SUIT 0 spades,
+;; 1 clubs, 2 diamonds, 3 hearts, and RANK 0 (Ace) .. 12 (King).  A joker,
+;; used only by Hand & Foot, is the cons (joker . 0).
+;;
+;; Gin Rummy: a two-handed game of ten-card hands.  Draw from the stock or
+;; take the discard, then discard one card.  Knock when your deadwood is
+;; ten or less, or go gin with none; your opponent then lays off onto your
+;; melds.  First to 100 points wins.  This file also provides the abstract
+;; `cg-rummy-game' base and the rendering helpers reused by the other
+;; rummy games (cg-rum500.el, cg-handfoot.el).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+(defconst cg-rummy-ranks
+  ["A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"]
+  "Rank labels indexed 0 (Ace) .. 12 (King).")
+
+(defface cg-rummy-mark '((t :background "steelblue" :foreground "white"))
+  "Face for a card the player has marked toward a meld."
+  :group 'card-games)
+
+(defun cg-rummy-card-string (card)
+  "Return a short label for CARD, or a dot for nil."
+  (cond ((null card) "·")
+        ((eq (car card) 'joker) (cg-suit-glyph 'joker))
+        (t (concat (aref cg-rummy-ranks (cdr card)) (cg-suit-glyph (car card))))))
+
+(defun cg-rummy-joker-p (card)
+  "Return non-nil when CARD is a joker."
+  (and card (eq (car card) 'joker)))
+
+(defun cg-rummy-value (card &optional ace-15)
+  "Return the point value of CARD.
+Faces and tens are 10, an Ace is 1 (or 15 when ACE-15 is non-nil), and
+other cards their pip value.  A joker is worth 0 here; games that use
+jokers value them separately."
+  (cond ((or (null card) (cg-rummy-joker-p card)) 0)
+        (t (let ((r (cdr card)))
+             (cond ((= r 0) (if ace-15 15 1))
+                   ((<= r 8) (1+ r))
+                   (t 10))))))
+
+
+;;;; Meld predicates
+
+(defun cg-rummy--consec-p (ranks)
+  "Return non-nil when sorted RANKS rise by exactly one with no repeats."
+  (let ((ok t) (prev nil))
+    (dolist (r ranks ok)
+      (when (and prev (/= r (1+ prev))) (setq ok nil))
+      (setq prev r))))
+
+(cl-defun cg-rummy-set-p (cards &key (min 3) distinct-suits)
+  "Return non-nil when CARDS form a set (>= MIN cards of one rank).
+With DISTINCT-SUITS, every suit must differ (a single-deck rule)."
+  (and (>= (length cards) min)
+       (not (cl-some #'cg-rummy-joker-p cards))
+       (let ((r (cdr (car cards))))
+         (cl-every (lambda (c) (= (cdr c) r)) cards))
+       (or (not distinct-suits)
+           (let ((suits (mapcar #'car cards)))
+             (= (length suits)
+                (length (delete-dups (copy-sequence suits))))))))
+
+(cl-defun cg-rummy-run-p (cards &key (min 3) ace-high)
+  "Return non-nil when CARDS form a run (>= MIN cards, one suit, in sequence).
+With ACE-HIGH, an Ace may sit above the King (Q-K-A)."
+  (and (>= (length cards) min)
+       (not (cl-some #'cg-rummy-joker-p cards))
+       (let ((suit (car (car cards)))
+             (ranks (sort (mapcar #'cdr cards) #'<)))
+         (and (cl-every (lambda (c) (= (car c) suit)) cards)
+              (= (length ranks) (length (delete-dups (copy-sequence ranks))))
+              (or (cg-rummy--consec-p ranks)
+                  (and ace-high (eql (car ranks) 0)
+                       (cg-rummy--consec-p (sort (cons 13 (cdr ranks)) #'<))))))))
+
+(cl-defun cg-rummy-meld-p (cards &key (min 3) ace-high distinct-suits)
+  "Return non-nil when CARDS form a valid set or run.
+MIN, ACE-HIGH and DISTINCT-SUITS are passed through to the predicates."
+  (or (cg-rummy-set-p cards :min min :distinct-suits distinct-suits)
+      (cg-rummy-run-p cards :min min :ace-high ace-high)))
+
+
+;;;; Candidate melds and best partition
+
+(defun cg-rummy--combinations (lst k)
+  "Return all K-element combinations of LST, each as a list."
+  (cond ((= k 0) (list nil))
+        ((null lst) nil)
+        (t (append
+            (mapcar (lambda (c) (cons (car lst) c))
+                    (cg-rummy--combinations (cdr lst) (1- k)))
+            (cg-rummy--combinations (cdr lst) k)))))
+
+(defun cg-rummy--runs-in (pairs)
+  "Return index-lists of runs (length >= 3) within PAIRS.
+PAIRS is a list of (RANK . INDEX) sorted ascending by RANK."
+  (let ((res '()) (vec (vconcat pairs)))
+    (let ((n (length vec)))
+      (dotimes (i n)
+        (let ((idxs (list (cdr (aref vec i))))
+              (last (car (aref vec i)))
+              (j (1+ i)))
+          (while (and (< j n) (= (car (aref vec j)) (1+ last)))
+            (setq last (car (aref vec j)))
+            (setq idxs (cons (cdr (aref vec j)) idxs))
+            (when (>= (length idxs) 3)
+              (push (reverse idxs) res))
+            (setq j (1+ j))))))
+    res))
+
+(cl-defun cg-rummy--candidate-melds (cards &key ace-high)
+  "Return candidate melds for CARDS as a list of index-lists.
+Each index-list refers to positions in CARDS.  With ACE-HIGH, high runs
+ending in an Ace are also generated."
+  (let* ((vec (vconcat cards)) (n (length vec)) (melds '()))
+    ;; sets, grouped by rank
+    (let ((byrank (make-hash-table :test 'eql)))
+      (dotimes (i n)
+        (let ((c (aref vec i)))
+          (unless (cg-rummy-joker-p c)
+            (push i (gethash (cdr c) byrank)))))
+      (maphash
+       (lambda (_r idxs)
+         (when (>= (length idxs) 3)
+           (dolist (k '(3 4))
+             (dolist (combo (cg-rummy--combinations idxs k))
+               (when (cg-rummy-set-p (mapcar (lambda (i) (aref vec i)) combo)
+                                     :distinct-suits t)
+                 (push (sort (copy-sequence combo) #'<) melds))))))
+       byrank))
+    ;; runs, grouped by suit
+    (let ((bysuit (make-hash-table :test 'eql)))
+      (dotimes (i n)
+        (let ((c (aref vec i)))
+          (unless (cg-rummy-joker-p c)
+            (push (cons (cdr c) i) (gethash (car c) bysuit)))))
+      (maphash
+       (lambda (_s pairs)
+         (let ((sorted (sort (copy-sequence pairs)
+                             (lambda (a b) (< (car a) (car b))))))
+           (dolist (m (cg-rummy--runs-in sorted)) (push (sort m #'<) melds)))
+         (when (and ace-high (assq 0 pairs))
+           (let* ((hi (mapcar (lambda (p) (if (= (car p) 0) (cons 13 (cdr p)) p))
+                              pairs))
+                  (sh (sort hi (lambda (a b) (< (car a) (car b))))))
+             (dolist (m (cg-rummy--runs-in sh)) (push (sort m #'<) melds)))))
+       bysuit))
+    (delete-dups melds)))
+
+(cl-defun cg-rummy-best-partition (cards &key ace-high ace-15)
+  "Return the lowest-deadwood layout of CARDS.
+The result is a plist (:melds MELDS :deadwood CARDS :count N) where MELDS
+is a list of card-lists, DEADWOOD the unmelded cards and N their value
+sum.  ACE-HIGH allows Q-K-A runs; ACE-15 scores Aces at 15."
+  (let* ((vec (vconcat cards)) (n (length vec))
+         (cand (cg-rummy--candidate-melds cards :ace-high ace-high))
+         (mmasks (mapcar (lambda (m)
+                           (let ((b 0)) (dolist (i m) (setq b (logior b (ash 1 i))))
+                                b))
+                         cand))
+         (memo (make-hash-table :test 'eql))
+         (full (1- (ash 1 n))))
+    (cl-labels
+        ((cval (i) (cg-rummy-value (aref vec i) ace-15))
+         (lowbit (avail)
+           (let ((i 0)) (while (zerop (logand avail (ash 1 i))) (setq i (1+ i))) i))
+         (solve (avail)
+           (if (zerop avail) (cons 0 '())
+             (or (gethash avail memo)
+                 (let* ((i (lowbit avail))
+                        (ibit (ash 1 i))
+                        (sub0 (solve (logxor avail ibit)))
+                        (best (cons (+ (cval i) (car sub0)) (cdr sub0))))
+                   (dolist (mask mmasks)
+                     (when (and (/= 0 (logand mask ibit))
+                                (= mask (logand mask avail)))
+                       (let ((sub (solve (logand avail (lognot mask)))))
+                         (when (< (car sub) (car best))
+                           (setq best (cons (car sub) (cons mask (cdr sub))))))))
+                   (puthash avail best memo)
+                   best)))))
+      (let* ((res (solve full)) (maskmelds (cdr res)) (used 0))
+        (dolist (m maskmelds) (setq used (logior used m)))
+        (list :melds
+              (mapcar (lambda (mask)
+                        (let ((cl '()))
+                          (dotimes (i n)
+                            (when (/= 0 (logand mask (ash 1 i)))
+                              (push (aref vec i) cl)))
+                          (nreverse cl)))
+                      maskmelds)
+              :deadwood
+              (let ((dl '()))
+                (dotimes (i n)
+                  (when (= 0 (logand used (ash 1 i))) (push (aref vec i) dl)))
+                (nreverse dl))
+              :count (car res))))))
+
+(defun cg-rummy-deadwood (cards &optional ace-high ace-15)
+  "Return the minimum deadwood value of CARDS.
+ACE-HIGH and ACE-15 are passed to `cg-rummy-best-partition'."
+  (plist-get (cg-rummy-best-partition cards :ace-high ace-high :ace-15 ace-15)
+             :count))
+
+(defun cg-rummy-layoff-p (card melds &optional ace-high)
+  "Return the first meld in MELDS that CARD extends, or nil.
+ACE-HIGH allows extending a run with a high Ace."
+  (cl-find-if (lambda (m)
+                (cg-rummy-meld-p (cons card m) :min 3 :ace-high ace-high))
+              melds))
+
+
+;;;; Shared deck and base game
+
+(defun cg-rummy-deck (&optional ndecks jokers)
+  "Return a shuffled deck of NDECKS standard packs plus JOKERS jokers each.
+NDECKS defaults to 1 and JOKERS to 0."
+  (random t)
+  (let ((cards '()))
+    (dotimes (_ (or ndecks 1))
+      (dotimes (s 4) (dotimes (r 13) (push (cons s r) cards)))
+      (dotimes (_ (or jokers 0)) (push (cons 'joker 0) cards)))
+    (cg-shuffle cards)))
+
+(defclass cg-rummy-game (cg-game) ()
+  "Abstract base for rummy-style draw-and-discard games."
+  :abstract t)
+
+(defsubst cg-rummy--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-rummy--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-rummy--top (game) (car (cg-get game :discard)))
+
+(defun cg-rummy-sort-hand (cards)
+  "Return CARDS sorted by suit then rank for display, jokers last."
+  (sort (copy-sequence cards)
+        (lambda (a b)
+          (let ((sa (if (cg-rummy-joker-p a) 99 (car a)))
+                (sb (if (cg-rummy-joker-p b) 99 (car b))))
+            (if (= sa sb) (< (cdr a) (cdr b)) (< sa sb))))))
+
+(defun cg-rummy--render-cards (cards cursor marks &optional hint-fn)
+  "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."
+  (let ((i 0) (out '()))
+    (dolist (c cards)
+      (let ((cs (cg-rummy-card-string c)) (faces nil))
+        (when (and (not (cg-rummy-joker-p c)) (cg-red-suit-p (car c)))
+          (push 'cg-red-suit faces))
+        (when (and hint-fn (funcall hint-fn c)) (push 'cg-hint faces))
+        (when (memq i marks) (push 'cg-rummy-mark faces))
+        (when (eql i cursor) (push 'cg-cursor faces))
+        (push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
+      (setq i (1+ i)))
+    (apply #'concat (nreverse out))))
+
+(defun cg-rummy--melds-string (melds)
+  "Return a one-line depiction of MELDS (a list of card-lists)."
+  (mapconcat (lambda (m) (mapconcat #'cg-rummy-card-string m " "))
+             melds "  |  "))
+
+
+;;;; Gin Rummy
+
+(defcustom cg-gin-target 100
+  "Points needed to win a game of Gin Rummy."
+  :type 'integer :group 'card-games)
+
+(defclass cg-gin-game (cg-rummy-game)
+  ((vname :initform "Gin Rummy"))
+  "A two-handed game of Gin Rummy.")
+
+(cl-defmethod cg-gin--deal ((game cg-gin-game))
+  "Deal a fresh Gin hand into GAME."
+  (let ((deck (cg-rummy-deck)) (hands (make-vector 2 nil)))
+    (dotimes (s 2)
+      (aset hands s (cg-rummy-sort-hand (cl-loop repeat 10 collect (pop deck)))))
+    (cg-put game :hands hands)
+    (cg-put game :discard (list (pop deck)))
+    (cg-put game :stock deck)
+    (cg-put game :turn 0)
+    (cg-put game :step 'draw)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (unless (cg-get game :scores) (cg-put game :scores (make-vector 2 0)))
+    (cg-put game :message
+            "Your turn: s draws from stock, t takes the discard.")
+    game))
+
+(defun cg-gin--deadwood (cards) (cg-rummy-deadwood cards))
+
+(defun cg-gin--draw (game s)
+  "Move one stock card to seat S's hand; return it or nil if stock empty."
+  (let ((stock (cg-get game :stock)))
+    (when stock
+      (let ((c (pop stock)))
+        (cg-put game :stock stock)
+        (cg-rummy--set-hand game s (cons c (cg-rummy--hand game s)))
+        c))))
+
+(defun cg-gin--take (game s)
+  "Move the discard top to seat S's hand and return it."
+  (let ((c (cg-rummy--top game)))
+    (cg-put game :discard (cdr (cg-get game :discard)))
+    (cg-rummy--set-hand game s (cons c (cg-rummy--hand game s)))
+    c))
+
+(defun cg-gin--discard (game s card)
+  "Discard CARD from seat S's hand onto the pile."
+  (cg-rummy--set-hand game s (cg-rummy-sort-hand
+                              (remove card (cg-rummy--hand game s))))
+  (cg-put game :discard (cons card (cg-get game :discard))))
+
+(defun cg-gin--ai-best-discard (game s)
+  "Return the card seat S should discard to minimise its deadwood."
+  (let ((hand (cg-rummy--hand game s)) (best nil) (bestv most-positive-fixnum))
+    (dolist (c hand best)
+      (let ((d (cg-gin--deadwood (remove c hand))))
+        (when (or (< d bestv)
+                  (and (= d bestv) best
+                       (> (cg-rummy-value c) (cg-rummy-value best))))
+          (setq best c bestv d))))))
+
+(cl-defmethod cg-gin--ai-turn ((game cg-gin-game) s)
+  "Play seat S's whole turn, then hand control back."
+  (let* ((hand (cg-rummy--hand game s))
+         (cur (cg-gin--deadwood hand))
+         (up (cg-rummy--top game))
+         (with (and up (cg-gin--deadwood (cons up hand))))
+         ;; take the discard only when it strictly helps
+         (drew (if (and up with (< with cur))
+                   (cg-gin--take game s)
+                 (cg-gin--draw game s))))
+    (if (not drew)
+        (cg-gin--exhaust game)               ; stock exhausted: wash the hand
+      (let ((card (cg-gin--ai-best-discard game s)))
+        (cg-gin--discard game s card)
+        (let ((dw (cg-gin--deadwood (cg-rummy--hand game s))))
+          (if (<= dw 10)
+              (cg-gin--knock game s)
+            (cg-put game :turn 0)
+            (cg-put game :step 'draw)
+            (cg-put game :message
+                    (format "Opponent discarded %s.  s draws, t takes."
+                            (cg-rummy-card-string card)))))))))
+
+(cl-defmethod cg-gin--knock ((game cg-gin-game) knocker)
+  "Resolve the hand when KNOCKER knocks; score and end the hand."
+  (let* ((kpart (cg-rummy-best-partition (cg-rummy--hand game knocker)))
+         (kmelds (plist-get kpart :melds))
+         (kdw (plist-get kpart :count))
+         (opp (- 1 knocker))
+         (opart (cg-rummy-best-partition (cg-rummy--hand game opp)))
+         (odead (plist-get opart :deadwood))
+         (gin (= kdw 0)))
+    ;; opponent lays off onto the knocker's melds (not allowed on gin)
+    (unless gin
+      (let (remaining)
+        (dolist (c odead)
+          (let ((m (cg-rummy-layoff-p c kmelds)))
+            (if m (setcdr (last m) (list c))   ; extend that meld in place
+              (push c remaining))))
+        (setq odead (nreverse remaining))))
+    (let* ((odw (apply #'+ (mapcar #'cg-rummy-value odead)))
+           (scores (cg-get game :scores))
+           (winner knocker) (pts 0) (note ""))
+      (cond
+       (gin (setq pts (+ 25  odw) note "Gin!"))
+       ((< kdw odw) (setq pts (- odw kdw) note "Knock."))
+       (t ;; undercut: defender wins
+        (setq winner opp pts (+ 25 (- kdw odw)) note "Undercut!")))
+      (aset scores winner (+ (aref scores winner) pts))
+      (cg-put game :phase 'hand-over)
+      (cg-put game :reveal t)
+      (cg-put game :winner winner)
+      (cg-put game :message
+              (format "%s %s scores %d.  %s  (n: next hand)"
+                      note
+                      (if (= winner 0) "You" "Opponent") pts
+                      (if (>= (aref scores winner) cg-gin-target)
+                          (progn (cg-put game :phase 'game-over)
+                                 (format "%s wins the game!"
+                                         (if (= winner 0) "You" "Opponent")))
+                        (format "Score %d-%d."
+                                (aref scores 0) (aref scores 1))))))))
+
+(cl-defmethod cg-gin--exhaust ((game cg-gin-game))
+  "End a hand washed out because the stock ran dry."
+  (cg-put game :phase 'hand-over)
+  (cg-put game :reveal t)
+  (cg-put game :message "Stock exhausted -- the hand is a wash.  n: next hand."))
+
+;;;; Gin UI
+
+(defvar-local cg-gin--game nil "The Gin Rummy game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-gin-game))
+  "Return a propertized depiction of the Gin GAME for a text display."
+  (let* ((out '()) (scores (cg-get game :scores))
+         (reveal (cg-get game :reveal))
+         (hand (cg-rummy--hand game 0)) (cursor (cg-get game :cursor)))
+    (push (format "  Gin Rummy        first to %d\n\n" cg-gin-target) out)
+    (push (format "  Opponent: %d cards    score %d\n"
+                  (length (cg-rummy--hand game 1)) (aref scores 1)) out)
+    (when reveal
+      (let ((p (cg-rummy-best-partition (cg-rummy--hand game 1))))
+        (push (format "    melds: %s\n    deadwood: %s (%d)\n"
+                      (cg-rummy--melds-string (plist-get p :melds))
+                      (mapconcat #'cg-rummy-card-string (plist-get p :deadwood) " ")
+                      (plist-get p :count))
+              out)))
+    (push (format "\n  Discard: %s     Stock: %d\n\n"
+                  (let ((cs (cg-rummy-card-string (cg-rummy--top game))))
+                    (if (and (cg-rummy--top game) (cg-red-suit-p (car (cg-rummy--top game))))
+                        (propertize cs 'face 'cg-red-suit) cs))
+                  (length (cg-get game :stock)))
+          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)
+    (when reveal
+      (let ((p (cg-rummy-best-partition hand)))
+        (push (format "\n    melds: %s\n    deadwood: %s"
+                      (cg-rummy--melds-string (plist-get p :melds))
+                      (mapconcat #'cg-rummy-card-string (plist-get p :deadwood) " "))
+              out)))
+    (push (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-gin--redisplay ()
+  "Redraw the Gin Rummy buffer."
+  (let ((game cg-gin--game) (inhibit-read-only t))
+    (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))))
+
+(defun cg-gin--cursor-card ()
+  "Return the card under the cursor in your hand."
+  (nth (cg-get cg-gin--game :cursor) (cg-rummy--hand cg-gin--game 0)))
+
+(defun cg-gin-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((g cg-gin--game) (n (length (cg-rummy--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-gin--redisplay)))
+
+(defun cg-gin-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((g cg-gin--game) (n (length (cg-rummy--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-gin--redisplay)))
+
+(defun cg-gin--my-turn-p (g)
+  "Return non-nil when it is your turn to act in G."
+  (and (eq (cg-get g :phase) 'play) (= (cg-get g :turn) 0)))
+
+(defun cg-gin-draw-stock ()
+  "Draw the top stock card into your hand."
+  (interactive)
+  (let ((g cg-gin--game))
+    (cond
+     ((not (cg-gin--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((not (eq (cg-get g :step) 'draw)) (cg-put g :message "Discard first (RET)."))
+     ((cg-gin--draw g 0)
+      (cg-put g :step 'discard)
+      (cg-put g :cursor 0)
+      (cg-put g :message "Choose a card and discard with RET, or knock with k."))
+     (t (cg-gin--exhaust g)))
+    (cg-gin--redisplay)))
+
+(defun cg-gin-take-discard ()
+  "Take the discard top into your hand."
+  (interactive)
+  (let ((g cg-gin--game))
+    (cond
+     ((not (cg-gin--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((not (eq (cg-get g :step) 'draw)) (cg-put g :message "Discard first (RET)."))
+     ((null (cg-rummy--top g)) (cg-put g :message "The discard pile is empty."))
+     (t (let ((c (cg-gin--take g 0)))
+          (cg-put g :step 'discard)
+          (cg-put g :cursor 0)
+          (cg-put g :message
+                  (format "Took %s.  Discard with RET, or knock with k."
+                          (cg-rummy-card-string c))))))
+    (cg-gin--redisplay)))
+
+(defun cg-gin--after-discard (g)
+  "Hand control to the opponent after you discard in G."
+  (cg-put g :turn 1)
+  (cg-put g :step 'draw)
+  (cg-gin--ai-turn g 1)
+  (cg-gin--redisplay))
+
+(defun cg-gin-discard ()
+  "Discard the selected card and end your turn."
+  (interactive)
+  (let* ((g cg-gin--game) (card (cg-gin--cursor-card)))
+    (cond
+     ((not (cg-gin--my-turn-p g)) (cg-put g :message "Not your turn.")
+      (cg-gin--redisplay))
+     ((not (eq (cg-get g :step) 'discard))
+      (cg-put g :message "Draw first (s or t).") (cg-gin--redisplay))
+     ((null card) (cg-put g :message "No card selected.") (cg-gin--redisplay))
+     (t (cg-gin--discard g 0 card)
+        (cg-put g :message (format "You discarded %s." (cg-rummy-card-string card)))
+        (cg-gin--after-discard g)))))
+
+(defun cg-gin-knock ()
+  "Knock, discarding the selected card, if your deadwood allows."
+  (interactive)
+  (let* ((g cg-gin--game) (card (cg-gin--cursor-card)))
+    (cond
+     ((not (cg-gin--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((not (eq (cg-get g :step) 'discard))
+      (cg-put g :message "Draw first (s or t)."))
+     ((null card) (cg-put g :message "No card selected."))
+     (t (let ((dw (cg-gin--deadwood (remove card (cg-rummy--hand g 0)))))
+          (if (> dw 10)
+              (cg-put g :message
+                      (format "Can't knock: that leaves %d deadwood (need <= 10)." dw))
+            (cg-gin--discard g 0 card)
+            (cg-gin--knock g 0)))))
+    (cg-gin--redisplay)))
+
+(defun cg-gin-new ()
+  "Deal a fresh hand (or a new game when one is over)."
+  (interactive)
+  (let ((g cg-gin--game))
+    (when (eq (cg-get g :phase) 'game-over) (cg-put g :scores (make-vector 2 0)))
+    (cg-put g :reveal nil)
+    (cg-gin--deal g)
+    (cg-gin--redisplay)))
+
+(defun cg-gin-redraw () "Redraw the board." (interactive) (cg-gin--redisplay))
+
+(defun cg-gin-help ()
+  "Describe the Gin Rummy controls."
+  (interactive)
+  (message "Arrows: choose  s: draw stock  t: take discard  RET: discard  k: knock  n: new  g: redraw"))
+
+(defvar cg-gin-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-gin-left)
+    (define-key map (kbd "<right>") #'cg-gin-right)
+    (define-key map "s" #'cg-gin-draw-stock)
+    (define-key map "t" #'cg-gin-take-discard)
+    (define-key map (kbd "RET") #'cg-gin-discard)
+    (define-key map "k" #'cg-gin-knock)
+    (define-key map "n" #'cg-gin-new)
+    (define-key map "g" #'cg-gin-redraw)
+    (define-key map "?" #'cg-gin-help)
+    map)
+  "Keymap for `cg-gin-mode'.")
+
+(define-derived-mode cg-gin-mode special-mode "Gin"
+  "Major mode for Gin Rummy."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-gin ()
+  "Play Gin Rummy against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Gin Rummy*")))
+    (with-current-buffer buf
+      (cg-gin-mode)
+      (setq cg-gin--game (cg-gin-game))
+      (cg-gin--deal cg-gin--game)
+      (cg-gin--redisplay))
+    (switch-to-buffer buf)))
+
+;;;###autoload
+(defalias 'cg-gin-rummy #'cg-gin)
+
+(provide 'cg-rummy)
+;;; cg-rummy.el ends here

cg-scopa.el

@@ -0,0 +1,404 @@
+;;; cg-scopa.el --- Scopa and Casino, capturing games  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Two capturing ("fishing") games on a shared engine.  You play a card
+;; from your hand to capture cards from the table: either a single card of
+;; equal value or a combination that sums to it.  Clear the whole table
+;; for a sweep.
+;;
+;;   `cg-scopa' -- Scopa.  The Italian classic on a 40-card deck; score
+;;     for cards, coins (diamonds), the sette bello (seven of diamonds),
+;;     primiera, and each sweep ("scopa").  Game to 11.
+;;   `cg-casino' -- Casino.  The English cousin on the full deck; score for
+;;     cards, spades, big casino (ten of diamonds), little casino (two of
+;;     spades), each ace, and each sweep.  Game to 21.
+;;
+;; You are the first player against the computer.  Captures are resolved
+;; automatically (a single equal card if there is one, otherwise the
+;; combination taking the most cards).  This Casino omits builds and
+;; multiple captures from a single card.  Cards use the package cons
+;; (SUIT . RANK), RANK 0 (Ace) .. 12 (King); suit 2 is diamonds.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-rummy)
+
+(defclass cg-fish-game (cg-game)
+  ((nplayers  :initarg :nplayers  :initform 2)
+   (hand-size :initarg :hand-size :initform 3)
+   (target    :initarg :target    :initform 11))
+  "Abstract base for the capturing games Scopa and Casino."
+  :abstract t)
+
+(cl-defgeneric cg-fish--value (game card)
+  "Return CARD's capture value in GAME, or nil if it captures only by rank.")
+(cl-defgeneric cg-fish--deck (game)
+  "Return a fresh shuffled deck for GAME.")
+(cl-defgeneric cg-fish--face-pair-p (game card)
+  "Return non-nil when CARD captures only equal-rank cards (no sums).")
+(cl-defmethod cg-fish--face-pair-p ((_game cg-fish-game) _card) nil)
+(cl-defgeneric cg-fish--score-round (game)
+  "Add this round's points to GAME's running scores.")
+
+(defsubst cg-fish--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-fish--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-fish--captured (game s) (aref (cg-get game :captured) s))
+
+(defun cg-fish--who (s) (if (= s 0) "You" "Computer"))
+
+;;;; Capture search
+
+(defun cg-fish--best-subset (cards target valfn)
+  "Return the largest subset of CARDS whose values (via VALFN) sum to TARGET.
+Only subsets of two or more cards are considered.  Return nil if none."
+  (let ((best nil) (vec (vconcat cards)) (n (length cards)))
+    (dotimes (mask (ash 1 n))
+      (let ((sum 0) (sub '()) (cnt 0))
+        (dotimes (i n)
+          (when (/= 0 (logand mask (ash 1 i)))
+            (let ((v (funcall valfn (aref vec i))))
+              (when v (setq sum (+ sum v) sub (cons (aref vec i) sub) cnt (1+ cnt))))))
+        (when (and (>= cnt 2) (= sum target) (> cnt (length best)))
+          (setq best sub))))
+    best))
+
+(defun cg-fish--capture (game card)
+  "Return the table cards CARD would capture in GAME, or nil."
+  (let ((table (cg-get game :table)))
+    (if (cg-fish--face-pair-p game card)
+        (let ((same (cl-remove-if-not (lambda (c) (= (cdr c) (cdr card))) table)))
+          (and same (list (car same))))
+      (let ((v (cg-fish--value game card)))
+        (and v (let ((single (cl-find-if (lambda (c) (eql (cg-fish--value game c) v))
+                                         table)))
+                 (if single (list single)
+                   (cg-fish--best-subset table v
+                                         (lambda (c) (cg-fish--value game c))))))))))
+
+;;;; Flow
+
+(cl-defmethod cg-fish--deal-round ((game cg-fish-game))
+  "Start a fresh round: shuffle, deal the table and the first hands."
+  (let* ((n (oref game nplayers)) (deck (cg-fish--deck game))
+         (hands (make-vector n nil)) (table '()))
+    (dotimes (_ 4) (push (pop deck) table))
+    (dotimes (s n)
+      (aset hands s (cg-rummy-sort-hand (cl-loop repeat (oref game hand-size)
+                                                 collect (pop deck)))))
+    (cg-put game :hands hands)
+    (cg-put game :table table)
+    (cg-put game :deck deck)
+    (cg-put game :captured (make-vector n nil))
+    (cg-put game :sweeps (make-vector n 0))
+    (cg-put game :nplayers n)
+    (cg-put game :turn 0)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (cg-put game :last-capturer nil)
+    (unless (cg-get game :scores) (cg-put game :scores (make-vector n 0)))
+    (cg-put game :message "Play a card to capture by value, or trail it on the table.")
+    game))
+
+(defun cg-fish--refill (game)
+  "Deal fresh hands from the deck when every hand is empty."
+  (when (and (cl-every #'null (append (cg-get game :hands) nil)) (cg-get game :deck))
+    (let ((deck (cg-get game :deck)))
+      (dotimes (s (cg-get game :nplayers))
+        (cg-fish--set-hand game s
+                           (cg-rummy-sort-hand
+                            (cl-loop repeat (oref game hand-size)
+                                     while deck collect (pop deck)))))
+      (cg-put game :deck deck))))
+
+(defun cg-fish--round-over-p (game)
+  (and (null (cg-get game :deck))
+       (cl-every #'null (append (cg-get game :hands) nil))))
+
+(cl-defmethod cg-fish--play ((game cg-fish-game) s card)
+  "Seat S plays CARD: capture if possible, else trail it on the table."
+  (cg-fish--set-hand game s (cl-remove card (cg-fish--hand game s) :test #'equal :count 1))
+  (let ((cap (cg-fish--capture game card)))
+    (if cap
+        (progn
+          (dolist (c cap)
+            (cg-put game :table (cl-remove c (cg-get game :table) :test #'equal :count 1)))
+          (aset (cg-get game :captured) s (append (cons card cap) (cg-fish--captured game s)))
+          (cg-put game :last-capturer s)
+          (when (and (null (cg-get game :table)) (not (cg-fish--round-over-p game)))
+            (aset (cg-get game :sweeps) s (1+ (aref (cg-get game :sweeps) s))))
+          (cg-put game :message
+                  (format "%s captured %d card%s with %s.%s" (cg-fish--who s)
+                          (length cap) (if (> (length cap) 1) "s" "")
+                          (cg-rummy-card-string card)
+                          (if (null (cg-get game :table)) "  Sweep!" ""))))
+      (cg-put game :table (cons card (cg-get game :table)))
+      (cg-put game :message (format "%s trailed %s." (cg-fish--who s)
+                                    (cg-rummy-card-string card))))
+    (cg-put game :turn (mod (1+ s) (cg-get game :nplayers)))
+    (cg-fish--refill game)
+    (when (cg-fish--round-over-p game) (cg-fish--finish-round game))))
+
+(cl-defmethod cg-fish--finish-round ((game cg-fish-game))
+  "Award leftover table cards to the last capturer and score the round."
+  (when (and (cg-get game :table) (cg-get game :last-capturer))
+    (let ((s (cg-get game :last-capturer)))
+      (aset (cg-get game :captured) s
+            (append (cg-get game :table) (cg-fish--captured game s)))
+      (cg-put game :table nil)))
+  (cg-fish--score-round game)
+  (let ((win nil) (n (cg-get game :nplayers)) (best most-negative-fixnum))
+    (dotimes (s n)
+      (when (and (>= (aref (cg-get game :scores) s) (oref game target))
+                 (> (aref (cg-get game :scores) s) best))
+        (setq win s best (aref (cg-get game :scores) s))))
+    (cg-put game :phase (if win 'game-over 'round-over))
+    (cg-put game :winner win)
+    (cg-put game :message
+            (format "Round over.  Scores: You %d, Computer %d.  %s"
+                    (aref (cg-get game :scores) 0) (aref (cg-get game :scores) 1)
+                    (if win (format "%s wins!  (n: new game)" (cg-fish--who win))
+                      "(n: next round)")))))
+
+(defun cg-fish--award-most (game suit-pred pts)
+  "Give PTS to whoever captured more cards satisfying SUIT-PRED."
+  (let ((c0 (cl-count-if suit-pred (cg-fish--captured game 0)))
+        (c1 (cl-count-if suit-pred (cg-fish--captured game 1))))
+    (cond ((> c0 c1) (aset (cg-get game :scores) 0 (+ (aref (cg-get game :scores) 0) pts)))
+          ((> c1 c0) (aset (cg-get game :scores) 1 (+ (aref (cg-get game :scores) 1) pts))))))
+
+(cl-defmethod cg-fish--ai-play ((game cg-fish-game) s)
+  "Have AI seat S capture the most it can, else trail its lowest card."
+  (let ((hand (cg-fish--hand game s)) (best nil) (bestn -1) (sweep nil))
+    (dolist (c hand)
+      (let* ((cap (cg-fish--capture game c))
+             (nn (length cap))
+             (sw (and cap (= nn (length (cg-get game :table))))))
+        (when (or (and sw (not sweep))
+                  (and (eq (and sw t) (and sweep t)) (> nn bestn)))
+          (setq best c bestn nn sweep sw))))
+    (unless best   ; nothing captures: trail the lowest-value card
+      (setq best (car (sort (copy-sequence hand)
+                            (lambda (a b) (< (or (cg-fish--value game a) 99)
+                                             (or (cg-fish--value game b) 99)))))))
+    (cg-fish--play game s best)))
+
+(defun cg-fish--run (game)
+  "Advance AI seats until it is your turn or the round ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0) (< guard 200))
+      (setq guard (1+ guard))
+      (cg-fish--ai-play game (cg-get game :turn)))))
+
+;;;; UI
+
+(defvar-local cg-fish--game nil "The fishing game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-fish-game))
+  "Return a propertized depiction of the fishing GAME."
+  (let* ((out '()) (cursor (cg-get game :cursor)))
+    (push (format "  %s      to %d\n\n" (oref game vname) (oref game target)) out)
+    (push (format "  Computer: %d cards   captured %d   (score %d)\n"
+                  (length (cg-fish--hand game 1)) (length (cg-fish--captured game 1))
+                  (aref (cg-get game :scores) 1)) out)
+    (push (format "  Deck: %d        Your captured: %d   (score %d)\n\n"
+                  (length (cg-get game :deck)) (length (cg-fish--captured game 0))
+                  (aref (cg-get game :scores) 0)) out)
+    (push "  Table:\n   " out)
+    (push (if (cg-get game :table)
+              (cg-rummy--render-cards (cg-rummy-sort-hand (cg-get game :table)) -1 nil)
+            "(empty)")
+          out)
+    (push "\n\n  Your hand:\n   " out)
+    (push (cg-rummy--render-cards (cg-fish--hand game 0) cursor nil) out)
+    (push (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-fish--redisplay ()
+  (let ((game cg-fish--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+(defun cg-fish-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((g cg-fish--game) (n (length (cg-fish--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-fish--redisplay)))
+
+(defun cg-fish-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((g cg-fish--game) (n (length (cg-fish--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-fish--redisplay)))
+
+(defun cg-fish-play ()
+  "Play the card under the cursor."
+  (interactive)
+  (let* ((g cg-fish--game) (card (nth (cg-get g :cursor) (cg-fish--hand g 0))))
+    (cond
+     ((not (eq (cg-get g :phase) 'play)) (cg-put g :message "Press n to continue."))
+     ((/= (cg-get g :turn) 0) (cg-put g :message "Not your turn."))
+     ((null card) (cg-put g :message "No card selected."))
+     (t (cg-fish--play g 0 card)
+        (cg-put g :cursor 0)
+        (when (eq (cg-get g :phase) 'play) (cg-fish--run g))))
+    (cg-fish--redisplay)))
+
+(defun cg-fish-new ()
+  "Start the next round, or a new game when one is over."
+  (interactive)
+  (let ((g cg-fish--game))
+    (when (eq (cg-get g :phase) 'game-over)
+      (cg-put g :scores (make-vector (oref g nplayers) 0)))
+    (cg-fish--deal-round g)
+    (cg-fish--run g)
+    (cg-fish--redisplay)))
+
+(defun cg-fish-redraw () "Redraw." (interactive) (cg-fish--redisplay))
+(defun cg-fish-help () "Describe the controls." (interactive)
+       (message "Arrows: choose  RET: play the card  n: next round / new game  g: redraw"))
+
+(defvar cg-fish-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-fish-left)
+    (define-key map (kbd "<right>") #'cg-fish-right)
+    (define-key map (kbd "RET") #'cg-fish-play)
+    (define-key map "n" #'cg-fish-new)
+    (define-key map "g" #'cg-fish-redraw)
+    (define-key map "?" #'cg-fish-help)
+    map)
+  "Keymap for `cg-fish-mode'.")
+
+(define-derived-mode cg-fish-mode special-mode "Fish"
+  "Major mode for the capturing games Scopa and Casino."
+  (setq-local truncate-lines t))
+
+(defun cg-fish--start (game buffer-name)
+  "Start GAME in a buffer named BUFFER-NAME."
+  (let ((buf (get-buffer-create buffer-name)))
+    (with-current-buffer buf
+      (cg-fish-mode)
+      (setq cg-fish--game game)
+      (cg-fish--deal-round game)
+      (cg-fish--run game)
+      (cg-fish--redisplay))
+    (switch-to-buffer buf)))
+
+;;;; Scopa
+
+(defclass cg-scopa-game (cg-fish-game)
+  ((vname :initform "Scopa") (hand-size :initform 3) (target :initform 11))
+  "A game of Scopa.")
+
+(cl-defmethod cg-fish--value ((_game cg-scopa-game) card)
+  "Return CARD's Scopa value (Ace 1 .. 7, Jack 8, Queen 9, King 10)."
+  (let ((r (cdr card)))
+    (cond ((<= r 6) (1+ r)) ((= r 10) 8) ((= r 11) 9) ((= r 12) 10))))
+
+(cl-defmethod cg-fish--deck ((_game cg-scopa-game))
+  "Return a shuffled 40-card Scopa deck (no eights, nines, or tens)."
+  (random t)
+  (cg-shuffle (cl-loop for s below 4 append
+                       (cl-loop for r below 13
+                                unless (memq r '(7 8 9)) collect (cons s r)))))
+
+(defun cg-scopa--prime (card)
+  "Return the primiera prime value of CARD."
+  (pcase (cdr card)
+    (6 21) (5 18) (0 16) (4 15) (3 14) (2 13) (1 12) (_ 10)))
+
+(cl-defmethod cg-fish--score-round ((game cg-scopa-game))
+  "Score a Scopa round: cards, coins, sette bello, primiera, sweeps."
+  (let ((scores (cg-get game :scores)))
+    (cg-fish--award-most game (lambda (_c) t) 1)                 ; most cards
+    (cg-fish--award-most game (lambda (c) (= (car c) 2)) 1)      ; most coins (diamonds)
+    ;; sette bello: 7 of diamonds
+    (dotimes (s 2)
+      (when (cl-find '(2 . 6) (cg-fish--captured game s) :test #'equal)
+        (aset scores s (1+ (aref scores s)))))
+    ;; primiera: best prime total across suits
+    (let ((p (vector 0 0)))
+      (dotimes (s 2)
+        (let ((bysuit (make-vector 4 0)))
+          (dolist (c (cg-fish--captured game s))
+            (aset bysuit (car c) (max (aref bysuit (car c)) (cg-scopa--prime c))))
+          (aset p s (apply #'+ (append bysuit nil)))))
+      (cond ((> (aref p 0) (aref p 1)) (aset scores 0 (1+ (aref scores 0))))
+            ((> (aref p 1) (aref p 0)) (aset scores 1 (1+ (aref scores 1))))))
+    ;; sweeps
+    (dotimes (s 2) (aset scores s (+ (aref scores s) (aref (cg-get game :sweeps) s))))))
+
+;;;###autoload
+(defun cg-scopa ()
+  "Play Scopa against the computer."
+  (interactive)
+  (cg-fish--start (cg-scopa-game) "*Scopa*"))
+
+;;;; Casino
+
+(defclass cg-casino-game (cg-fish-game)
+  ((vname :initform "Casino") (hand-size :initform 4) (target :initform 21))
+  "A game of Casino.")
+
+(cl-defmethod cg-fish--value ((_game cg-casino-game) card)
+  "Return CARD's Casino value (Ace 1, pips 2-10, faces nil)."
+  (let ((r (cdr card)))
+    (cond ((= r 0) 1) ((<= r 9) (1+ r)) (t nil))))
+
+(cl-defmethod cg-fish--face-pair-p ((_game cg-casino-game) card)
+  "Return non-nil when CARD is a face card (captures only by matching rank)."
+  (>= (cdr card) 10))
+
+(cl-defmethod cg-fish--deck ((_game cg-casino-game))
+  "Return a shuffled 52-card deck for Casino."
+  (cg-rummy-deck))
+
+(cl-defmethod cg-fish--score-round ((game cg-casino-game))
+  "Score a Casino round: cards, spades, casinos, aces, sweeps."
+  (let ((scores (cg-get game :scores)))
+    (cg-fish--award-most game (lambda (_c) t) 3)                 ; most cards
+    (cg-fish--award-most game (lambda (c) (= (car c) 0)) 1)      ; most spades
+    (dotimes (s 2)
+      (let ((caps (cg-fish--captured game s)))
+        (when (cl-find '(2 . 9) caps :test #'equal)             ; big casino 10D
+          (aset scores s (+ (aref scores s) 2)))
+        (when (cl-find '(0 . 1) caps :test #'equal)             ; little casino 2S
+          (aset scores s (+ (aref scores s) 1)))
+        (aset scores s (+ (aref scores s) (cl-count 0 caps :key #'cdr)))  ; aces
+        (aset scores s (+ (aref scores s) (aref (cg-get game :sweeps) s)))))))
+
+;;;###autoload
+(defun cg-casino ()
+  "Play Casino against the computer."
+  (interactive)
+  (cg-fish--start (cg-casino-game) "*Casino*"))
+
+(provide 'cg-scopa)
+;;; cg-scopa.el ends here

cg-spite.el

@@ -0,0 +1,426 @@
+;;; cg-spite.el --- Spite and Malice, a competitive patience  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Spite & Malice (also called Cat & Mouse): a race between you and the
+;; computer to empty a face-down goal pile.  Play cards onto up to four
+;; shared centre piles, which build up from Ace to Queen regardless of
+;; suit; a pile that reaches a Queen is cleared away.  Kings are wild and
+;; stand for whatever rank a pile needs next.
+;;
+;; On your turn, draw your hand up to five, then play from the top of your
+;; goal pile, your hand, or the tops of your four discard piles.  Playing
+;; your goal card is how you win, so take every chance to.  End your turn
+;; by discarding one card to a discard pile.
+;;
+;; Targets are chosen automatically (the first centre pile a card fits).
+;; Cards use the package cons (SUIT . RANK), RANK 0 (Ace) .. 12 (King);
+;; the build order runs Ace(0) up to Queen(11), and the King(12) is wild.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-rummy)
+
+(defcustom cg-spite-goal-size 20
+  "Number of cards in each player's goal pile."
+  :type 'integer :group 'card-games)
+
+(defclass cg-spite-game (cg-game)
+  ((vname :initform "Spite & Malice"))
+  "A game of Spite & Malice.")
+
+(defun cg-spite--wild-p (card) "Return non-nil when CARD (a King) is wild."
+  (= (cdr card) 12))
+
+(defun cg-spite--nat (card) "Return CARD's natural build rank, or nil if wild."
+  (if (cg-spite--wild-p card) nil (cdr card)))
+
+(defun cg-spite--deck ()
+  "Return two shuffled standard decks (104 cards)."
+  (random t)
+  (cg-shuffle (cl-loop repeat 2 append
+                       (cl-loop for s below 4 append
+                                (cl-loop for r below 13 collect (cons s r))))))
+
+;;;; Accessors
+
+(defsubst cg-spite--goal (game s) (aref (cg-get game :goal) s))
+(defsubst cg-spite--set-goal (game s v) (aset (cg-get game :goal) s v))
+(defsubst cg-spite--hand (game s) (aref (cg-get game :hand) s))
+(defsubst cg-spite--set-hand (game s v) (aset (cg-get game :hand) s v))
+(defsubst cg-spite--disc (game s) (aref (cg-get game :disc) s))   ; vector of 4 lists
+
+(defun cg-spite--who (s) (if (= s 0) "You" "Computer"))
+
+(cl-defmethod cg-spite--deal ((game cg-spite-game))
+  "Deal a fresh Spite & Malice game into GAME."
+  (let ((deck (cg-spite--deck)) (goal (make-vector 2 nil))
+        (hand (make-vector 2 nil)) (disc (vector nil nil)))
+    (dotimes (s 2)
+      (aset goal s (cl-loop repeat cg-spite-goal-size collect (pop deck)))
+      (aset hand s (cg-rummy-sort-hand (cl-loop repeat 5 collect (pop deck))))
+      (aset disc s (make-vector 4 nil)))
+    (cg-put game :goal goal)
+    (cg-put game :hand hand)
+    (cg-put game :disc disc)
+    (cg-put game :center (make-vector 4 nil))   ; each nil or (TOPRANK . CARDS)
+    (cg-put game :muck nil)
+    (cg-put game :stock deck)
+    (cg-put game :turn 0)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (cg-put game :message "Your turn.  RET plays a hand card; G plays your goal card.")
+    game))
+
+;;;; Stock and centre piles
+
+(defun cg-spite--draw-stock (game)
+  "Pop one card from the stock, recycling the muck when the stock is empty."
+  (when (and (null (cg-get game :stock)) (cg-get game :muck))
+    (cg-put game :stock (cg-shuffle (cg-get game :muck)))
+    (cg-put game :muck nil))
+  (let ((stock (cg-get game :stock)))
+    (when stock (cg-put game :stock (cdr stock)) (car stock))))
+
+(defun cg-spite--refill (game s)
+  "Draw seat S's hand back up to five cards."
+  (while (and (< (length (cg-spite--hand game s)) 5) (or (cg-get game :stock)
+                                                         (cg-get game :muck)))
+    (let ((c (cg-spite--draw-stock game)))
+      (when c (cg-spite--set-hand game s (cg-rummy-sort-hand
+                                          (cons c (cg-spite--hand game s))))))))
+
+(defun cg-spite--needed (game i)
+  "Return the rank the centre pile I needs next (0 for an empty slot)."
+  (let ((p (aref (cg-get game :center) i)))
+    (if p (1+ (car p)) 0)))
+
+(defun cg-spite--legal-center (game card)
+  "Return the index of the first centre pile CARD may be played on, or nil."
+  (let ((found nil))
+    (dotimes (i 4)
+      (let ((need (cg-spite--needed game i)))
+        (when (and (null found) (<= need 11)
+                   (or (cg-spite--wild-p card) (eql (cg-spite--nat card) need)))
+          (setq found i))))
+    found))
+
+(defun cg-spite--put-center (game card i)
+  "Place CARD on centre pile I; clear the pile if it reaches a Queen."
+  (let* ((need (cg-spite--needed game i))
+         (p (aref (cg-get game :center) i))
+         (cards (cons card (and p (cdr p)))))
+    (if (= need 11)                        ; completed Ace..Queen
+        (progn (cg-put game :muck (append cards (cg-get game :muck)))
+               (aset (cg-get game :center) i nil))
+      (aset (cg-get game :center) i (cons need cards)))))
+
+;;;; Plays
+
+(defun cg-spite--play-hand (game s card i)
+  "Seat S plays hand CARD onto centre pile I."
+  (cg-spite--set-hand game s (cl-remove card (cg-spite--hand game s) :test #'equal :count 1))
+  (cg-spite--put-center game card i)
+  (when (null (cg-spite--hand game s)) (cg-spite--refill game s)))
+
+(defun cg-spite--play-goal (game s i)
+  "Seat S plays the top of their goal pile onto centre pile I."
+  (let ((card (car (cg-spite--goal game s))))
+    (cg-spite--set-goal game s (cdr (cg-spite--goal game s)))
+    (cg-spite--put-center game card i)
+    (when (null (cg-spite--goal game s))
+      (cg-put game :phase 'game-over) (cg-put game :winner s))))
+
+(defun cg-spite--play-disc (game s d i)
+  "Seat S plays the top of discard pile D onto centre pile I."
+  (let* ((pile (aref (cg-spite--disc game s) d)) (card (car pile)))
+    (aset (cg-spite--disc game s) d (cdr pile))
+    (cg-spite--put-center game card i)))
+
+(defun cg-spite--discard (game s card d)
+  "Seat S discards CARD from hand onto discard pile D, ending the turn."
+  (cg-spite--set-hand game s (cl-remove card (cg-spite--hand game s) :test #'equal :count 1))
+  (aset (cg-spite--disc game s) d (cons card (aref (cg-spite--disc game s) d)))
+  (cg-put game :turn (- 1 s)))
+
+;;;; AI
+
+(defun cg-spite--ai-one (game s)
+  "Make one beneficial play for seat S; return non-nil if a play was made."
+  (let ((goal (car (cg-spite--goal game s))) (done nil))
+    (cond
+     ;; 1. advance the goal card (a wild goal card plays anywhere)
+     ((and goal (cg-spite--legal-center game goal))
+      (cg-spite--play-goal game s (cg-spite--legal-center game goal)) (setq done t))
+     ;; 2. a non-wild hand card that fits
+     ((cl-find-if (lambda (c) (and (not (cg-spite--wild-p c))
+                                   (cg-spite--legal-center game c)))
+                  (cg-spite--hand game s))
+      (let ((card (cl-find-if (lambda (c) (and (not (cg-spite--wild-p c))
+                                               (cg-spite--legal-center game c)))
+                              (cg-spite--hand game s))))
+        (cg-spite--play-hand game s card (cg-spite--legal-center game card))
+        (setq done t)))
+     (t
+      ;; 3. a non-wild discard top that fits
+      (catch 'hit
+        (dotimes (d 4)
+          (let ((top (car (aref (cg-spite--disc game s) d))))
+            (when (and top (not (cg-spite--wild-p top)) (cg-spite--legal-center game top))
+              (cg-spite--play-disc game s d (cg-spite--legal-center game top))
+              (setq done t) (throw 'hit t))))
+        ;; 4. use a wild King: bridge to the goal card if possible, else
+        ;;    advance the most-built pile to keep cards flowing
+        (let ((king (cl-find-if #'cg-spite--wild-p (cg-spite--hand game s))))
+          (when king
+            (let* ((gr (and goal (cg-spite--nat goal))) (target nil))
+              (when gr
+                (dotimes (i 4)
+                  (let ((need (cg-spite--needed game i)))
+                    (when (and (null target) (<= need 11) (= need (1- gr)))
+                      (setq target i)))))
+              (unless target
+                (let ((bestneed -1))
+                  (dotimes (i 4)
+                    (let ((need (cg-spite--needed game i)))
+                      (when (and (<= need 11) (> need bestneed))
+                        (setq bestneed need target i))))))
+              (when target
+                (cg-spite--play-hand game s king target) (setq done t))))))))
+    done))
+
+(defun cg-spite--ai-turn (game s)
+  "Take seat S's whole AI turn: play what helps, then discard."
+  (cg-spite--refill game s)
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play) (< guard 300)
+                (cg-spite--ai-one game s))
+      (setq guard (1+ guard))))
+  (when (eq (cg-get game :phase) 'play)
+    (let ((hand (cg-spite--hand game s)))
+      (if (null hand)
+          (cg-put game :turn (- 1 s))       ; played out, nothing to discard
+        ;; discard the highest non-wild card; keep Kings (wild)
+        (let* ((nonk (cl-remove-if #'cg-spite--wild-p hand))
+               (card (car (sort (copy-sequence (or nonk hand))
+                                (lambda (a b) (> (cdr a) (cdr b))))))
+               (d (cg-spite--ai-disc-pile game s card)))
+          (cg-spite--discard game s card d))))))
+
+(defun cg-spite--ai-disc-pile (game s card)
+  "Choose a discard pile for CARD: an empty one, else the one topped just above."
+  (let ((disc (cg-spite--disc game s)) (empty nil) (best nil) (bestv 99))
+    (dotimes (d 4)
+      (let ((top (car (aref disc d))))
+        (cond ((null top) (unless empty (setq empty d)))
+              ((and (not (cg-spite--wild-p top)) (>= (cdr top) (cdr card))
+                    (< (- (cdr top) (cdr card)) bestv))
+               (setq best d bestv (- (cdr top) (cdr card)))))))
+    (or best empty 0)))
+
+(defun cg-spite--run (game)
+  "Let the computer (seat 1) take its turns until it is your turn or the game ends."
+  (let ((guard 0))
+    (while (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 1) (< guard 200))
+      (setq guard (1+ guard))
+      (cg-spite--ai-turn game 1))))
+
+;;;; UI
+
+(defvar-local cg-spite--game nil "The Spite & Malice game in the current buffer.")
+
+(defun cg-spite--center-string (game)
+  "Return a one-line depiction of the centre piles."
+  (let ((parts '()))
+    (dotimes (i 4)
+      (let ((p (aref (cg-get game :center) i)))
+        (push (if p (format "[%s->%s]" (length (cdr p))
+                            (aref cg-rummy-ranks (car p)))
+                "[ -- ]")
+              parts)))
+    (mapconcat #'identity (nreverse parts) "  ")))
+
+(defun cg-spite--disc-string (game s)
+  "Return a depiction of seat S's four discard-pile tops."
+  (let ((parts '()))
+    (dotimes (d 4)
+      (let ((top (car (aref (cg-spite--disc game s) d))))
+        (push (format "%d:%s" (1+ d) (if top (cg-rummy-card-string top) "--")) parts)))
+    (mapconcat #'identity (nreverse parts) "  ")))
+
+(cl-defmethod cg-render ((game cg-spite-game))
+  "Return a propertized depiction of the Spite & Malice GAME."
+  (let* ((out '()) (cursor (cg-get game :cursor)))
+    (push "  Spite & Malice\n\n" out)
+    (push (format "  Computer goal: %d left    hand: %d    discards: %s\n\n"
+                  (length (cg-spite--goal game 1)) (length (cg-spite--hand game 1))
+                  (cg-spite--disc-string game 1))
+          out)
+    (push (format "  Centre:  %s\n" (cg-spite--center-string game)) out)
+    (push (format "  Stock: %d   Muck: %d\n\n"
+                  (length (cg-get game :stock)) (length (cg-get game :muck))) out)
+    (push (format "  Your goal: %s  (%d left)\n"
+                  (let ((g (car (cg-spite--goal game 0))))
+                    (if g (cg-rummy-card-string g) "--"))
+                  (length (cg-spite--goal game 0)))
+          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 (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-spite--redisplay ()
+  (let ((game cg-spite--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+(defun cg-spite--my-turn-p (g)
+  (and (eq (cg-get g :phase) 'play) (= (cg-get g :turn) 0)))
+
+(defun cg-spite-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((g cg-spite--game) (n (length (cg-spite--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n)))
+    (cg-spite--redisplay)))
+
+(defun cg-spite-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((g cg-spite--game) (n (length (cg-spite--hand g 0))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n)))
+    (cg-spite--redisplay)))
+
+(defun cg-spite--ensure-hand (g)
+  "Draw your hand up to five at the start of your turn."
+  (cg-spite--refill g 0))
+
+(defun cg-spite-play ()
+  "Play the cursor hand card onto the first centre pile it fits."
+  (interactive)
+  (let* ((g cg-spite--game) (card (nth (cg-get g :cursor) (cg-spite--hand g 0))))
+    (cond
+     ((not (cg-spite--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((null card) (cg-put g :message "No card selected."))
+     (t (let ((i (cg-spite--legal-center g card)))
+          (if (null i) (cg-put g :message "That card fits no centre pile.")
+            (cg-spite--play-hand g 0 card i)
+            (cg-put g :cursor 0)
+            (cg-put g :message "Played.  Keep going, or d to discard and end turn.")))))
+    (cg-spite--redisplay)))
+
+(defun cg-spite-goal ()
+  "Play your goal-pile top onto the first centre pile it fits."
+  (interactive)
+  (let* ((g cg-spite--game) (card (car (cg-spite--goal g 0))))
+    (cond
+     ((not (cg-spite--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((null card) (cg-put g :message "Your goal pile is empty."))
+     (t (let ((i (cg-spite--legal-center g card)))
+          (if (null i) (cg-put g :message "Your goal card fits no centre pile.")
+            (cg-spite--play-goal g 0 i)
+            (if (eq (cg-get g :phase) 'game-over)
+                (cg-put g :message "You emptied your goal -- you win!  (n: new game)")
+              (cg-put g :message "Goal card played!"))))))
+    (cg-spite--redisplay)))
+
+(defun cg-spite-play-disc ()
+  "Play the top of the discard pile whose number you pressed."
+  (interactive)
+  (let* ((g cg-spite--game) (d (- last-command-event ?1))
+         (top (and (>= d 0) (< d 4) (car (aref (cg-spite--disc g 0) d)))))
+    (cond
+     ((not (cg-spite--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((null top) (cg-put g :message "That discard pile is empty."))
+     (t (let ((i (cg-spite--legal-center g top)))
+          (if (null i) (cg-put g :message "That card fits no centre pile.")
+            (cg-spite--play-disc g 0 d i)
+            (cg-put g :message "Played from a discard pile.")))))
+    (cg-spite--redisplay)))
+
+(defun cg-spite-discard ()
+  "Discard the cursor card to a discard pile and end your turn."
+  (interactive)
+  (let* ((g cg-spite--game) (card (nth (cg-get g :cursor) (cg-spite--hand g 0))))
+    (cond
+     ((not (cg-spite--my-turn-p g)) (cg-put g :message "Not your turn."))
+     ((null card) (cg-put g :message "No card to discard."))
+     (t (cg-spite--discard g 0 card (cg-spite--ai-disc-pile g 0 card))
+        (cg-put g :cursor 0)
+        (cg-spite--run g)
+        (when (eq (cg-get g :phase) 'play)
+          (cg-spite--ensure-hand g)
+          (cg-put g :message "Your turn."))))
+    (cg-spite--redisplay)))
+
+(defun cg-spite-new ()
+  "Deal a fresh game."
+  (interactive)
+  (cg-spite--deal cg-spite--game)
+  (cg-spite--redisplay))
+
+(defun cg-spite-redraw () "Redraw." (interactive) (cg-spite--redisplay))
+(defun cg-spite-help () "Describe the controls." (interactive)
+       (message "Arrows: choose  RET: play hand card  G: play goal  1-4: play discard top  d: discard/end  n: new"))
+
+(defvar cg-spite-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-spite-left)
+    (define-key map (kbd "<right>") #'cg-spite-right)
+    (define-key map (kbd "RET") #'cg-spite-play)
+    (define-key map "G" #'cg-spite-goal)
+    (dolist (k '("1" "2" "3" "4")) (define-key map k #'cg-spite-play-disc))
+    (define-key map "d" #'cg-spite-discard)
+    (define-key map "n" #'cg-spite-new)
+    (define-key map "g" #'cg-spite-redraw)
+    (define-key map "?" #'cg-spite-help)
+    map)
+  "Keymap for `cg-spite-mode'.")
+
+(define-derived-mode cg-spite-mode special-mode "Spite"
+  "Major mode for Spite & Malice."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-spite ()
+  "Play Spite & Malice against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Spite & Malice*")))
+    (with-current-buffer buf
+      (cg-spite-mode)
+      (setq cg-spite--game (cg-spite-game))
+      (cg-spite--deal cg-spite--game)
+      (cg-spite--redisplay))
+    (switch-to-buffer buf)))
+
+;;;###autoload
+(defalias 'cg-cat-and-mouse #'cg-spite)
+
+(provide 'cg-spite)
+;;; cg-spite.el ends here

cg-trick-ext.el

@@ -0,0 +1,501 @@
+;;; cg-trick-ext.el --- Euchre, Pitch and Briscola  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026  Corwin Brust
+
+;; Author: Corwin Brust <corwin@bru.st>
+;; Maintainer: Corwin Brust <corwin@bru.st>
+;; Version: 1.0.60
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: games
+;; URL: https://code.bru.st/corwin/card-game.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Three more trick-taking games built on the engine in cg-trick.el, each
+;; a four-handed game against three AI opponents (you are South).
+;;
+;;   `cg-euchre' -- Euchre.  A 24-card deck, the Jack of trump (right
+;;     bower) and its same-colour Jack (left bower) outranking everything;
+;;     order up or call trump, then take three tricks.  Partnership to 10.
+;;   `cg-pitch' -- Auction Pitch (All Fours).  Bid for the privilege of
+;;     pitching; the first card led sets trump.  Score High, Low, Jack and
+;;     Game.  First to 7.
+;;   `cg-briscola' -- Briscola.  A 40-card deck, a fixed trump turned from
+;;     the deal, and no need to follow suit; capture the Aces and Threes.
+;;     Partnership race to 61 of the 120 points.
+;;
+;; Cards use the package cons (SUIT . RANK), RANK 0 (Two) .. 12 (Ace) as
+;; in cg-trick.el.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+(require 'cg-trick)
+
+;;;; Shared helpers
+
+(defun cg-tx--deck (ranks)
+  "Return a shuffled deck holding only the RANKS (a list of rank indices)."
+  (random t)
+  (cg-shuffle (cl-loop for s below 4 append
+                       (cl-loop for r in ranks collect (cons s r)))))
+
+(defun cg-tx--deal (game deck hs)
+  "Deal HS cards each from DECK into GAME, in the cg-trick layout."
+  (let ((hands (make-vector 4 nil)) (last nil) (d deck))
+    (dotimes (s 4)
+      (let ((h nil))
+        (dotimes (_ hs) (setq last (pop d)) (push last h))
+        (aset hands s (cg-trick--sort h))))
+    (cg-put game :hands hands)
+    (cg-put game :deck d)
+    (cg-put game :last-card last)
+    (cg-put game :trick nil)
+    (cg-put game :tricks (make-vector 4 0))
+    (cg-put game :taken (make-vector 4 nil))
+    (cg-put game :broken t)
+    (cg-put game :trick-no 0)
+    game))
+
+(defun cg-tx--winner (plays trump powerfn ledfn)
+  "Return the winning seat of PLAYS (a list of (SEAT . CARD), play order).
+TRUMP is the trump suit; POWERFN and LEDFN rank cards for this game."
+  (let* ((led (funcall ledfn (cdr (car plays)) trump))
+         (best (car plays))
+         (bestp (funcall powerfn (cdr (car plays)) trump led)))
+    (dolist (p (cdr plays))
+      (let ((pp (funcall powerfn (cdr p) trump led)))
+        (when (> pp bestp) (setq best p bestp pp))))
+    (car best)))
+
+(defun cg-tx--ai (game seat powerfn ledfn valuefn)
+  "Pick a card for SEAT: win cheaply if leading, else shed the cheapest.
+POWERFN, LEDFN rank cards; VALUEFN gives a card's point worth."
+  (let* ((legal (cg-trick--legal-moves game seat))
+         (trick (cg-get game :trick)) (trump (oref game trump)))
+    (if (null trick)
+        (car (sort (copy-sequence legal)
+                   (lambda (a b) (< (funcall valuefn a) (funcall valuefn b)))))
+      (let* ((order (reverse trick))
+             (led (funcall ledfn (cdr (car order)) trump))
+             (winners '()) (losers '()))
+        (dolist (c legal)
+          (if (= seat (cg-tx--winner (append order (list (cons seat c)))
+                                     trump powerfn ledfn))
+              (push c winners) (push c losers)))
+        (if winners
+            (car (sort winners (lambda (a b) (< (funcall powerfn a trump led)
+                                                (funcall powerfn b trump led)))))
+          (car (sort (or losers legal)
+                     (lambda (a b) (< (funcall valuefn a) (funcall valuefn b))))))))))
+
+(defun cg-tx--plain-led (card _trump) (car card))
+
+
+;;;; Briscola
+
+(defconst cg-briscola--ranks '(0 1 2 3 4 5 9 10 11 12)
+  "Rank indices in a 40-card Briscola deck (no 8, 9, or 10).")
+
+(defclass cg-briscola-game (cg-trick-game)
+  ((trump :initform nil) (target :initform 61) (hand-size :initform 10)
+   (vname :initform "Briscola"))
+  "Briscola: fixed trump, no follow, capture the points.")
+
+(defun cg-bris--power (card _trump _led)
+  "Return CARD's rank power within its suit for Briscola."
+  (- 10 (or (cl-position (cdr card) '(12 1 11 10 9 5 4 3 2 0)) 10)))
+
+(defun cg-bris--points (card)
+  "Return CARD's Briscola point value."
+  (pcase (cdr card) (12 11) (1 10) (11 4) (10 3) (9 2) (_ 0)))
+
+(defun cg-bris--win-power (card trump led)
+  "Power with trump dominance, for resolving a Briscola trick."
+  (cond ((= (car card) trump) (+ 200 (cg-bris--power card trump led)))
+        ((= (car card) led) (+ 100 (cg-bris--power card trump led)))
+        (t 0)))
+
+(cl-defmethod cg-trick--legal-p ((game cg-briscola-game) seat card)
+  "Briscola has no obligation to follow suit."
+  (and (member card (cg-trick--hand game seat)) t))
+
+(cl-defmethod cg-trick--winner ((game cg-briscola-game))
+  (cg-tx--winner (reverse (cg-get game :trick)) (oref game trump)
+                 #'cg-bris--win-power #'cg-tx--plain-led))
+
+(cl-defmethod cg-trick--ai-play ((game cg-briscola-game) seat)
+  (cg-tx--ai game seat #'cg-bris--win-power #'cg-tx--plain-led #'cg-bris--points))
+
+(cl-defmethod cg-trick--begin-hand ((game cg-briscola-game))
+  (cg-tx--deal game (cg-tx--deck cg-briscola--ranks) 10)
+  (cg-put game :dealer (mod (1+ (or (cg-get game :dealer) 3)) 4))
+  (oset game trump (car (cg-get game :last-card)))
+  (cg-put game :cursor 0)
+  (let ((lead (mod (1+ (cg-get game :dealer)) 4)))
+    (cg-put game :leader lead) (cg-put game :turn lead))
+  (cg-put game :phase 'play)
+  (cg-put game :message
+          (format "Trump is %s.  No need to follow suit."
+                  (cg-suit-glyph (oref game trump))))
+  (cg-trick--run game))
+
+(cl-defmethod cg-trick--score-hand ((game cg-briscola-game))
+  (let ((scores (cg-get game :scores)) (tp (make-vector 2 0)))
+    (dotimes (s 4)
+      (aset tp (cg-trick--team s)
+            (+ (aref tp (cg-trick--team s))
+               (apply #'+ (mapcar #'cg-bris--points (aref (cg-get game :taken) s))))))
+    (dotimes (s 4) (aset scores s (+ (aref scores s) (aref tp (cg-trick--team s)))))))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-briscola-game))
+  (or (>= (aref (cg-get game :scores) 0) (oref game target))
+      (>= (aref (cg-get game :scores) 1) (oref game target))))
+
+(cl-defmethod cg-trick--winner-seat ((game cg-briscola-game))
+  (if (>= (aref (cg-get game :scores) 0) (aref (cg-get game :scores) 1)) 0 1))
+
+(cl-defmethod cg-trick--result-string ((game cg-briscola-game))
+  (let ((w (cg-trick--winner-seat game)))
+    (format "%s win (%d points)" (if (= w 0) "You and North" "West and East")
+            (aref (cg-get game :scores) w))))
+
+;;;###autoload
+(defun cg-briscola ()
+  "Play Briscola against three AI opponents."
+  (interactive)
+  (cg-trick--play-game 'cg-briscola-game))
+
+
+;;;; Auction Pitch
+
+(defclass cg-pitch-game (cg-trick-game)
+  ((trump :initform nil) (target :initform 7) (hand-size :initform 6)
+   (vname :initform "Pitch"))
+  "Auction Pitch: bid, pitch to set trump, score High/Low/Jack/Game.")
+
+(defun cg-pitch--pip (rank)
+  "Return the Game-point pip value of RANK."
+  (pcase rank (12 4) (11 3) (10 2) (9 1) (8 10) (_ 0)))
+
+(defun cg-pitch--power (card trump led)
+  "Rank CARD for a Pitch trick under TRUMP given the LED suit."
+  (cond ((and trump (= (car card) trump)) (+ 100 (cdr card)))
+        ((= (car card) led) (+ 50 (cdr card)))
+        (t (cdr card))))
+
+(cl-defmethod cg-trick--legal-p ((game cg-pitch-game) seat card)
+  "Pitch: follow the led suit if able, but you may always trump."
+  (let ((hand (cg-trick--hand game seat)) (trick (cg-get game :trick))
+        (trump (oref game trump)))
+    (and (member card hand)
+         (or (null trick)
+             (let ((led (cg-trick--led-suit game)))
+               (cond ((= (car card) led) t)
+                     ((and trump (= (car card) trump)) t)
+                     ((cl-some (lambda (c) (= (car c) led)) hand) nil)
+                     (t t)))))))
+
+(cl-defmethod cg-trick--play ((game cg-pitch-game) seat card)
+  "Set trump from the pitcher's first lead, then play normally."
+  (when (and (null (oref game trump)) (null (cg-get game :trick)))
+    (oset game trump (car card))
+    (cg-put game :message
+            (format "%s leads %s -- %s is trump."
+                    (aref cg-trick-seat-names seat) (cg-trick-card-string card)
+                    (cg-suit-glyph (car card)))))
+  (cl-call-next-method))
+
+(cl-defmethod cg-trick--ai-play ((game cg-pitch-game) seat)
+  (if (and (null (oref game trump)) (= seat (cg-get game :leader)))
+      ;; pitcher's opening lead: lead high from the strongest suit
+      (let ((best nil) (bestv -1))
+        (dotimes (s 4)
+          (let ((v (cg-pitch--suit-strength game seat s)))
+            (when (> v bestv) (setq bestv v best s))))
+        (car (sort (cl-remove-if-not (lambda (c) (= (car c) best))
+                                     (cg-trick--hand game seat))
+                   (lambda (a b) (> (cdr a) (cdr b))))))
+    (cg-tx--ai game seat #'cg-pitch--power #'cg-tx--plain-led
+               (lambda (c) (cg-pitch--pip (cdr c))))))
+
+(defun cg-pitch--suit-strength (game seat suit)
+  "Estimate SEAT's strength if SUIT were trump."
+  (let ((v 0))
+    (dolist (c (cg-trick--hand game seat))
+      (when (= (car c) suit)
+        (setq v (+ v 2 (pcase (cdr c) (12 4) (11 3) (9 3) (_ 1))))))
+    v))
+
+(cl-defmethod cg-trick--ai-bid ((game cg-pitch-game) seat)
+  "Return SEAT's Pitch bid (0 to pass, else 2..4), bidding only what is makeable."
+  (let ((bid 0))
+    (dotimes (s 4)
+      (let* ((cards (cl-remove-if-not (lambda (c) (= (car c) s))
+                                      (cg-trick--hand game seat)))
+             (n (length cards))
+             (hasa (cl-find 12 cards :key #'cdr))
+             (hask (cl-find 11 cards :key #'cdr))
+             (hasj (cl-find 9 cards :key #'cdr))
+             (b (cond ((and (>= n 4) hasa hasj) 4)
+                      ((and (>= n 3) hasa (or hask hasj)) 3)
+                      ((and (>= n 3) hasa) 2)
+                      ((and (>= n 2) hasa hask) 2)
+                      (t 0))))
+        (setq bid (max bid b))))
+    bid))
+
+(defun cg-pitch--read-bid (game high)
+  "Prompt you for a Pitch bid that must beat HIGH (or 0 to pass)."
+  (let ((sug (cg-trick--ai-bid game 0)))
+    (max 0 (min 4 (read-number
+                   (format "Your bid (0 pass, else %d-4) [suggest %d]: "
+                           (max 2 (1+ high)) sug)
+                   sug)))))
+
+(cl-defmethod cg-trick--begin-hand ((game cg-pitch-game))
+  (cg-tx--deal game (cg-tx--deck (number-sequence 0 12)) 6)
+  (oset game trump nil)
+  (cg-put game :dealer (mod (1+ (or (cg-get game :dealer) 3)) 4))
+  (cg-put game :cursor 0)
+  (let ((high 0) (bidder nil))
+    (dotimes (k 4)
+      (let* ((s (mod (+ (cg-get game :dealer) 1 k) 4))
+             (b (if (= s 0)
+                    (if noninteractive (cg-trick--ai-bid game 0) (cg-pitch--read-bid game high))
+                  (cg-trick--ai-bid game s))))
+        (when (and (>= b 2) (> b high)) (setq high b bidder s))))
+    (unless bidder (setq bidder (cg-get game :dealer) high 2)) ; stuck dealer pitches 2
+    (cg-put game :bidder bidder) (cg-put game :bid high)
+    (cg-put game :leader bidder) (cg-put game :turn bidder)
+    (cg-put game :phase 'play)
+    (cg-put game :message
+            (format "%s pitches (bid %d).  Their first card sets trump."
+                    (aref cg-trick-seat-names bidder) high))
+    (cg-trick--run game)))
+
+(cl-defmethod cg-trick--score-hand ((game cg-pitch-game))
+  (let* ((trump (oref game trump)) (scores (cg-get game :scores))
+         (earned (make-vector 4 0)) (game-pts (make-vector 4 0))
+         (bidder (cg-get game :bidder)) (bid (cg-get game :bid))
+         (hi nil) (hiseat nil) (lo nil) (loseat nil) (jackseat nil))
+    (dotimes (s 4)
+      (dolist (c (aref (cg-get game :taken) s))
+        (when (= (car c) trump)
+          (when (or (null hi) (> (cdr c) hi)) (setq hi (cdr c) hiseat s))
+          (when (or (null lo) (< (cdr c) lo)) (setq lo (cdr c) loseat s))
+          (when (= (cdr c) 9) (setq jackseat s)))
+        (aset game-pts s (+ (aref game-pts s) (cg-pitch--pip (cdr c))))))
+    (when hiseat (aset earned hiseat (1+ (aref earned hiseat))))
+    (when loseat (aset earned loseat (1+ (aref earned loseat))))
+    (when jackseat (aset earned jackseat (1+ (aref earned jackseat))))
+    (let ((best -1) (bs nil) (tie nil))
+      (dotimes (s 4)
+        (cond ((> (aref game-pts s) best) (setq best (aref game-pts s) bs s tie nil))
+              ((= (aref game-pts s) best) (setq tie t))))
+      (when (and bs (not tie) (> best 0)) (aset earned bs (1+ (aref earned bs)))))
+    (dotimes (s 4)
+      (if (= s bidder)
+          (if (>= (aref earned s) bid)
+              (aset scores s (+ (aref scores s) (aref earned s)))
+            (aset scores s (- (aref scores s) bid)))
+        (aset scores s (+ (aref scores s) (aref earned s)))))
+    (cg-put game :last-earned earned)))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-pitch-game))
+  (cl-some (lambda (s) (>= s (oref game target))) (append (cg-get game :scores) nil)))
+
+(cl-defmethod cg-trick--winner-seat ((game cg-pitch-game))
+  (let ((best 0)) (dotimes (s 4)
+                    (when (> (aref (cg-get game :scores) s)
+                             (aref (cg-get game :scores) best)) (setq best s)))
+       best))
+
+(cl-defmethod cg-trick--result-string ((game cg-pitch-game))
+  (format "%s wins" (aref cg-trick-seat-names (cg-trick--winner-seat game))))
+
+;;;###autoload
+(defun cg-pitch ()
+  "Play Auction Pitch against three AI opponents."
+  (interactive)
+  (cg-trick--play-game 'cg-pitch-game))
+
+
+;;;; Euchre
+
+(defclass cg-euchre-game (cg-trick-game)
+  ((trump :initform nil) (target :initform 10) (hand-size :initform 5)
+   (vname :initform "Euchre"))
+  "Euchre: 24 cards, bowers, order up or call trump, partnership to 10.")
+
+(defun cg-euchre--right-bower-p (card trump)
+  (and (= (cdr card) 9) (= (car card) trump)))
+
+(defun cg-euchre--left-bower-p (card trump)
+  (and (= (cdr card) 9) (= (car card) (cg-sister-suit trump))))
+
+(defun cg-euchre--eff-suit (card trump)
+  "Return CARD's effective suit (the left bower belongs to TRUMP)."
+  (if (cg-euchre--left-bower-p card trump) trump (car card)))
+
+(defun cg-euchre--power (card trump led)
+  "Rank CARD for a Euchre trick under TRUMP given the effective LED suit."
+  (cond ((cg-euchre--right-bower-p card trump) 1000)
+        ((cg-euchre--left-bower-p card trump) 999)
+        ((= (cg-euchre--eff-suit card trump) trump) (+ 900 (cdr card)))
+        ((= (cg-euchre--eff-suit card trump) led) (+ 100 (cdr card)))
+        (t (cdr card))))
+
+(defun cg-euchre--eff-led (card trump) (cg-euchre--eff-suit card trump))
+
+(cl-defmethod cg-trick--legal-p ((game cg-euchre-game) seat card)
+  "Euchre: follow the effective led suit if able (left bower is trump)."
+  (let ((hand (cg-trick--hand game seat)) (trick (cg-get game :trick))
+        (trump (oref game trump)))
+    (and (member card hand)
+         (or (null trick)
+             (let ((led (cg-euchre--eff-suit (cdr (cg-trick--first-play game)) trump)))
+               (if (cl-some (lambda (c) (= (cg-euchre--eff-suit c trump) led)) hand)
+                   (= (cg-euchre--eff-suit card trump) led)
+                 t))))))
+
+(cl-defmethod cg-trick--winner ((game cg-euchre-game))
+  (cg-tx--winner (reverse (cg-get game :trick)) (oref game trump)
+                 #'cg-euchre--power #'cg-euchre--eff-led))
+
+(cl-defmethod cg-trick--ai-play ((game cg-euchre-game) seat)
+  (cg-tx--ai game seat #'cg-euchre--power #'cg-euchre--eff-led
+             (lambda (c) (cg-euchre--power c (oref game trump) -1))))
+
+(defun cg-euchre--strength (game seat suit)
+  "Estimate SEAT's trump strength if SUIT were trump."
+  (let ((v 0))
+    (dolist (c (cg-trick--hand game seat))
+      (cond ((cg-euchre--right-bower-p c suit) (setq v (+ v 4)))
+            ((cg-euchre--left-bower-p c suit) (setq v (+ v 3)))
+            ((= (cg-euchre--eff-suit c suit) suit) (setq v (+ v 2)))
+            ((= (cdr c) 12) (setq v (+ v 1)))))   ; off-ace
+    v))
+
+(defun cg-euchre--ai-order (game seat upsuit)
+  "Return non-nil if SEAT orders up the UPSUIT."
+  (>= (cg-euchre--strength game seat upsuit) 6))
+
+(defun cg-euchre--ai-call (game seat upsuit)
+  "Return a suit SEAT calls in round two, or nil to pass."
+  (let ((best nil) (bestv 0))
+    (dotimes (s 4)
+      (unless (= s upsuit)
+        (let ((v (cg-euchre--strength game seat s)))
+          (when (> v bestv) (setq bestv v best s)))))
+    (and (>= bestv 6) best)))
+
+(defun cg-euchre--best-suit (game seat upsuit)
+  "Return SEAT's strongest suit other than UPSUIT (for a stuck dealer)."
+  (let ((best (mod (1+ upsuit) 4)) (bestv -1))
+    (dotimes (s 4)
+      (unless (= s upsuit)
+        (let ((v (cg-euchre--strength game seat s)))
+          (when (> v bestv) (setq bestv v best s)))))
+    best))
+
+(defun cg-euchre--dealer-pickup (game up)
+  "Dealer takes the UP card and discards their weakest card."
+  (let* ((d (cg-get game :dealer)) (trump (car up))
+         (hand (cons up (cg-trick--hand game d)))
+         (worst (car (sort (copy-sequence hand)
+                           (lambda (a b) (< (cg-euchre--power a trump -1)
+                                            (cg-euchre--power b trump -1)))))))
+    (cg-trick--set-hand game d (cg-trick--sort (remove worst hand)))))
+
+(cl-defmethod cg-trick--begin-hand ((game cg-euchre-game))
+  (cg-tx--deal game (cg-tx--deck '(7 8 9 10 11 12)) 5)
+  (oset game trump nil)
+  (cg-put game :dealer (mod (1+ (or (cg-get game :dealer) 3)) 4))
+  (cg-put game :cursor 0)
+  (let* ((up (car (cg-get game :deck))) (upsuit (car up))
+         (dealer (cg-get game :dealer)) (maker nil) (chosen nil))
+    (cg-put game :up up)
+    (cl-block bid
+      (dotimes (k 4)
+        (let ((s (mod (+ dealer 1 k) 4)))
+          (when (if (= s 0)
+                    (if noninteractive (cg-euchre--ai-order game 0 upsuit)
+                      (y-or-n-p (format "Order up %s as trump? " (cg-suit-glyph upsuit))))
+                  (cg-euchre--ai-order game s upsuit))
+            (setq maker s chosen upsuit)
+            (cg-euchre--dealer-pickup game up)
+            (cl-return-from bid))))
+      (dotimes (k 4)
+        (let* ((s (mod (+ dealer 1 k) 4))
+               (suit (if (= s 0)
+                         (if noninteractive (cg-euchre--ai-call game 0 upsuit)
+                           (cg-euchre--human-call upsuit))
+                       (cg-euchre--ai-call game s upsuit))))
+          (when suit (setq maker s chosen suit) (cl-return-from bid)))))
+    (unless chosen
+      (setq maker dealer chosen (cg-euchre--best-suit game dealer upsuit)))
+    (oset game trump chosen)
+    (cg-put game :maker maker)
+    (let ((lead (mod (1+ dealer) 4)))
+      (cg-put game :leader lead) (cg-put game :turn lead))
+    (cg-put game :phase 'play)
+    (cg-put game :message
+            (format "%s makes %s trump." (aref cg-trick-seat-names maker)
+                    (cg-suit-glyph chosen)))
+    (cg-trick--run game)))
+
+(defun cg-euchre--human-call (upsuit)
+  "Prompt you to name a trump suit other than UPSUIT, or pass."
+  (let* ((choices (cl-loop for s below 4 unless (= s upsuit)
+                           collect (cons (aref cg-suit-names s) s)))
+         (pick (completing-read "Call trump (or RET to pass): "
+                                (mapcar #'car choices) nil t)))
+    (cdr (assoc pick choices))))
+
+(cl-defmethod cg-trick--score-hand ((game cg-euchre-game))
+  (let* ((scores (cg-get game :scores))
+         (mteam (cg-trick--team (cg-get game :maker)))
+         (mt (+ (aref (cg-get game :tricks) mteam)
+                (aref (cg-get game :tricks) (+ mteam 2))))
+         (oteam (- 1 mteam)))
+    (cl-flet ((award (team n) (dolist (s (list team (+ team 2)))
+                                (aset scores s (+ (aref scores s) n)))))
+      (cond ((>= mt 5) (award mteam 2))
+            ((>= mt 3) (award mteam 1))
+            (t (award oteam 2))))))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-euchre-game))
+  (or (>= (aref (cg-get game :scores) 0) (oref game target))
+      (>= (aref (cg-get game :scores) 1) (oref game target))))
+
+(cl-defmethod cg-trick--winner-seat ((game cg-euchre-game))
+  (if (>= (aref (cg-get game :scores) 0) (aref (cg-get game :scores) 1)) 0 1))
+
+(cl-defmethod cg-trick--result-string ((game cg-euchre-game))
+  (let ((w (cg-trick--winner-seat game)))
+    (format "%s win" (if (= w 0) "You and North" "West and East"))))
+
+;;;###autoload
+(defun cg-euchre ()
+  "Play Euchre against three AI opponents."
+  (interactive)
+  (cg-trick--play-game 'cg-euchre-game))
+
+(provide 'cg-trick-ext)
+;;; cg-trick-ext.el ends here

runemacs.sh

@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+# Load the card-games package from this directory and open the launcher.
+dir="$(cd "$(dirname "$0")" && pwd)"
+exec emacs -L "$dir" -l card-games -f card-game "$@"

test/card-games-tests.el

@@ -828,3 +828,238 @@
 
 (ert-deftest cgt-pres-render ()
   (let ((g (cg-pres--deal (cg-president-game)))) (should (stringp (cg-render g)))))
+;;;; Rummy family
+
+(ert-deftest cgt-rummy-set-run ()
+  (should (cg-rummy-set-p '((0 . 5) (1 . 5) (2 . 5)) :distinct-suits t))
+  (should-not (cg-rummy-set-p '((0 . 5) (0 . 5) (2 . 5)) :distinct-suits t))
+  (should (cg-rummy-run-p '((0 . 3) (0 . 4) (0 . 5))))
+  (should-not (cg-rummy-run-p '((0 . 3) (1 . 4) (0 . 5))))
+  (should (cg-rummy-run-p '((0 . 10) (0 . 11) (0 . 12) (0 . 0)) :ace-high t))
+  (should-not (cg-rummy-run-p '((0 . 11) (0 . 12) (0 . 0))))
+  (should (cg-rummy-run-p '((0 . 0) (0 . 1) (0 . 2)))))
+
+(ert-deftest cgt-rummy-best-partition ()
+  (let* ((hand '((0 . 2)(0 . 3)(0 . 4) (0 . 6)(1 . 6)(2 . 6)
+                 (3 . 8)(3 . 9)(3 . 10) (3 . 12)))
+         (p (cg-rummy-best-partition hand)))
+    (should (= 3 (length (plist-get p :melds))))
+    (should (= 10 (plist-get p :count))))
+  (should (= 0 (cg-rummy-deadwood
+                '((0 . 0)(0 . 1)(0 . 2) (1 . 4)(1 . 5)(1 . 6)
+                  (2 . 8)(2 . 9)(2 . 10)(2 . 11))))))
+
+(ert-deftest cgt-rummy-layoff ()
+  (should (cg-rummy-layoff-p '(3 . 11) '(((3 . 8)(3 . 9)(3 . 10)))))
+  (should-not (cg-rummy-layoff-p '(0 . 4) '(((3 . 8)(3 . 9)(3 . 10))))))
+
+(ert-deftest cgt-gin-full-game ()
+  (let ((g (cg-gin-game)) (turns 0))
+    (cg-gin--deal g)
+    (while (and (not (eq (cg-get g :phase) 'game-over)) (< turns 100000))
+      (if (eq (cg-get g :phase) 'hand-over)
+          (progn (cg-put g :reveal nil) (cg-gin--deal g))
+        (cg-gin--ai-turn g (cg-get g :turn)) (cl-incf turns)))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (>= (apply #'max (append (cg-get g :scores) nil)) cg-gin-target))))
+
+(ert-deftest cgt-gin-render () (let ((g (cg-gin--deal (cg-gin-game))))
+                                 (should (stringp (cg-render g)))))
+
+(ert-deftest cgt-tablemeld-games ()
+  (dolist (mk (list (lambda () (cg-rummy-basic-game :nplayers 3 :hand-size 7))
+                    (lambda () (cg-rum500-game :nplayers 3 :hand-size 7))))
+    (let ((g (funcall mk)) (turns 0))
+      (cg-tm--deal g)
+      (while (and (not (eq (cg-get g :phase) 'game-over)) (< turns 200000))
+        (if (eq (cg-get g :phase) 'hand-over)
+            (progn (cg-put g :reveal nil) (cg-tm--deal g))
+          (cg-tm--ai-turn g (cg-get g :turn)) (cl-incf turns)))
+      (should (eq (cg-get g :phase) 'game-over))
+      (should (stringp (cg-render g))))))
+
+(ert-deftest cgt-tablemeld-conservation ()
+  (let ((g (cg-rum500-game :nplayers 3 :hand-size 7)))
+    (cg-tm--deal g)
+    (dotimes (_ 30) (when (eq (cg-get g :phase) 'play)
+                      (cg-tm--ai-turn g (cg-get g :turn))))
+    (let ((tot (+ (length (cg-get g :stock)) (length (cg-get g :discard))
+                  (apply #'+ (mapcar (lambda (r) (length (cdr r))) (cg-get g :table))))))
+      (dotimes (s 3) (setq tot (+ tot (length (cg-rummy--hand g s)))))
+      (should (= tot 52)))))
+
+(ert-deftest cgt-handfoot-book ()
+  (should (cg-hf--book-valid-p '((0 . 7)(1 . 7)(2 . 7))))
+  (should (cg-hf--book-valid-p '((0 . 7)(1 . 7)(joker . 0))))      ; dirty
+  (should-not (cg-hf--book-valid-p '((0 . 7)(joker . 0)(joker . 0)))) ; wilds > nats
+  (should-not (cg-hf--book-valid-p '((0 . 2)(1 . 2)(2 . 2))))      ; threes
+  (should (cg-hf--book-complete-p '(a b c d e f g)))
+  (should (cg-hf--book-clean-p '((0 . 7)(1 . 7)(2 . 7))))
+  (should-not (cg-hf--book-clean-p '((0 . 7)(1 . 7)(joker . 0)))))
+
+(ert-deftest cgt-handfoot-full-game ()
+  (let ((g (cg-handfoot-game)) (rounds 0) (turns 0) (expect (* 5 54)))
+    (cg-put g :nplayers 4) (cg-put g :nteams 2) (cg-put g :scores (make-vector 2 0))
+    (cg-hf--deal g)
+    (while (and (not (eq (cg-get g :phase) 'game-over)) (< rounds 60))
+      (cond ((eq (cg-get g :phase) 'round-over)
+             (cg-put g :reveal nil) (cg-hf--deal g) (cl-incf rounds))
+            (t (cg-hf--ai-turn g (cg-get g :turn)) (cl-incf turns)
+               (when (> turns 500000) (error "runaway")))))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (stringp (cg-render g)))))
+;;;; Matching games (Go Fish, Old Maid)
+
+(ert-deftest cgt-gofish-full ()
+  (let ((cg-go-fish-players 4) (g (cg-go-fish-game)) (guard 0))
+    (cg-gf--deal g)
+    (while (and (not (eq (cg-get g :phase) 'game-over)) (< guard 20000))
+      (cg-gf--ai-turn g (cg-get g :turn)) (cl-incf guard))
+    (should (eq (cg-get g :phase) 'game-over))
+    (let ((tot 0)) (dotimes (s 4) (cl-incf tot (cg-gf--books g s)))
+      (should (= tot 13)))
+    (should (stringp (cg-render g)))))
+
+(ert-deftest cgt-oldmaid-full ()
+  (let ((cg-old-maid-players 4) (g (cg-old-maid-game)) (guard 0))
+    (cg-om--deal g)
+    (while (and (not (eq (cg-get g :phase) 'game-over)) (< guard 20000))
+      (cg-om--ai-turn g (cg-get g :turn)) (cl-incf guard))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (= 1 (cg-om--total g)))
+    (should (stringp (cg-render g)))))
+
+;;;; Cribbage
+
+(ert-deftest cgt-cribbage-scorer ()
+  (should (= 29 (cg-crib--score-show '((0 . 4)(1 . 4)(3 . 4)(2 . 10)) '(2 . 4))))
+  (should (= 12 (cg-crib--count-pairs '((0 . 4)(1 . 4)(2 . 4)(3 . 4)))))
+  (should (= 5 (cg-crib--count-runs '((0 . 1)(0 . 2)(0 . 3)(0 . 4)(0 . 5)))))
+  (should (= 2 (cg-crib--peg-score '((0 . 10)(0 . 4)) 15)))
+  (should (= 3 (cg-crib--peg-score '((0 . 2)(0 . 3)(0 . 4)) 12)))
+  (should (= 6 (cg-crib--peg-score '((0 . 6)(1 . 6)(2 . 6)) 21))))
+
+(ert-deftest cgt-cribbage-full ()
+  (let ((g (cg-cribbage-game)) (deals 0))
+    (cg-put g :dealer 1)
+    (cl-flet ((ai-deal (g)
+                (cg-crib--deal g)
+                (let ((d0 (cg-crib--ai-discard g 0)) (d1 (cg-crib--ai-discard g 1)))
+                  (cg-crib--set-hand g 0 (cl-set-difference (cg-crib--hand g 0) d0 :test #'equal))
+                  (cg-crib--set-hand g 1 (cl-set-difference (cg-crib--hand g 1) d1 :test #'equal))
+                  (cg-put g :crib (append d0 d1)))
+                (cg-crib--start-play g)
+                (let ((guard 0))
+                  (while (and (eq (cg-get g :phase) 'play) (not (cg-crib--peg-over-p g))
+                              (< guard 400))
+                    (cl-incf guard)
+                    (let ((s (cg-get g :pturn)))
+                      (if (cg-crib--legal g s) (cg-crib--ai-play g s) (cg-crib--peg-go g s)))))
+                (when (and (eq (cg-get g :phase) 'play) (cg-crib--peg-over-p g))
+                  (cg-crib--show g))))
+      (while (and (not (eq (cg-get g :phase) 'game-over)) (< deals 300))
+        (cg-put g :dealer (- 1 (cg-get g :dealer)))
+        (ai-deal g) (cl-incf deals)))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (stringp (cg-render g)))))
+
+;;;; Fishing games (Scopa, Casino)
+
+(ert-deftest cgt-fish-capture ()
+  (let ((g (cg-scopa-game)))
+    (cg-put g :table '((0 . 0)(1 . 1)(2 . 3)))
+    (should (equal (sort (mapcar #'cdr (cg-fish--capture g '(3 . 4))) #'<) '(0 3))))
+  (let ((g (cg-casino-game)))
+    (cg-put g :table '((0 . 12)(1 . 12)(2 . 5)))
+    (should (= 1 (length (cg-fish--capture g '(3 . 12)))))))
+
+(ert-deftest cgt-fish-full ()
+  (dolist (mk (list #'cg-scopa-game #'cg-casino-game))
+    (let ((g (funcall mk)) (rounds 0))
+      (cg-fish--deal-round g)
+      (while (and (not (eq (cg-get g :phase) 'game-over)) (< rounds 200))
+        (if (eq (cg-get g :phase) 'round-over)
+            (cg-fish--deal-round g)
+          (cg-fish--ai-play g (cg-get g :turn)) (cl-incf rounds)))
+      (should (eq (cg-get g :phase) 'game-over))
+      (should (stringp (cg-render g))))))
+
+;;;; Trick extensions (Euchre, Pitch, Briscola)
+
+(ert-deftest cgt-euchre-bowers ()
+  (should (> (cg-euchre--power '(0 . 9) 0 0) (cg-euchre--power '(1 . 9) 0 0)))
+  (should (> (cg-euchre--power '(1 . 9) 0 0) (cg-euchre--power '(0 . 12) 0 0)))
+  (should (= 120 (let ((s 0)) (dolist (su '(0 1 2 3))
+                                (dolist (r cg-briscola--ranks)
+                                  (setq s (+ s (cg-bris--points (cons su r)))))) s))))
+
+(ert-deftest cgt-trick-ext-full ()
+  (dolist (class '(cg-briscola-game cg-pitch-game cg-euchre-game))
+    (let ((g (make-instance class)) (guard 0))
+      (cg-trick--new g)
+      (while (and (not (eq (cg-get g :phase) 'game-over)) (< guard 50000))
+        (cl-incf guard)
+        (if (cg-trick--hand-over-p g)
+            (cg-trick--finish-hand g)
+          (let ((s (cg-get g :turn)))
+            (cg-trick--play g s (cg-trick--ai-play g s)))))
+      (should (eq (cg-get g :phase) 'game-over))
+      (should (stringp (cg-render g))))))
+
+;;;; Spite & Malice
+
+(ert-deftest cgt-spite-legal ()
+  (let ((g (cg-spite-game)))
+    (cg-spite--deal g) (cg-put g :center (make-vector 4 nil))
+    (should (eql 0 (cg-spite--legal-center g '(0 . 0))))   ; Ace starts a pile
+    (should (null (cg-spite--legal-center g '(0 . 1))))    ; a Two cannot
+    (should (eql 0 (cg-spite--legal-center g '(0 . 12))))  ; King is wild
+    (cg-spite--put-center g '(0 . 0) 0)
+    (should (= 1 (cg-spite--needed g 0)))))
+
+(ert-deftest cgt-spite-full ()
+  (let ((cg-spite-goal-size 10) (g (cg-spite-game)) (turns 0))
+    (cg-spite--deal g)
+    (while (and (eq (cg-get g :phase) 'play) (< turns 6000))
+      (cl-incf turns) (cg-spite--ai-turn g (cg-get g :turn)))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (stringp (cg-render g)))))
+;;;; Bridge
+
+(ert-deftest cgt-bridge-score ()
+  (cl-flet ((b (l s d v tk) (plist-get (cg-bridge--deal-score l s d v tk) :below))
+            (a (l s d v tk) (plist-get (cg-bridge--deal-score l s d v tk) :datk))
+            (f (l s d v tk) (plist-get (cg-bridge--deal-score l s d v tk) :defend)))
+    (should (= 100 (b 3 4 0 nil 9)))     ; 3NT made
+    (should (= 120 (b 4 3 0 nil 10)))    ; 4 spades made
+    (should (= 180 (b 6 2 0 nil 12)))    ; 6 hearts made
+    (should (= 500 (a 6 2 0 nil 12)))    ; small slam bonus
+    (should (= 50  (a 1 4 1 nil 7)))     ; 1NT doubled, insult
+    (should (= 100 (f 4 3 0 nil 8)))     ; down two undoubled
+    (should (= 500 (f 4 3 1 t 8))))      ; down two doubled vulnerable
+  (should (= 1 (cg-bridge--trick-winner
+                '((0 . (0 . 12)) (1 . (3 . 0)) (2 . (0 . 2)) (3 . (0 . 5))) 3))))
+
+(ert-deftest cgt-bridge-full ()
+  (let ((scored 0) (passed 0))
+    (dotimes (i 12)
+      (let ((g (cg-bridge-game)) (guard 0))
+        (cg-put g :dealer (mod i 4))
+        (cg-bridge--deal g)
+        (while (and (eq (cg-get g :phase) 'auction) (< guard 60))
+          (cl-incf guard)
+          (let* ((s (cg-get g :bidder)) (call (cg-bridge--ai-call g s)))
+            (unless (cg-bridge--legal-call-p g call) (setq call 'pass))
+            (cg-bridge--apply-call g s call)
+            (cg-bridge--auction-done-p g)))
+        (if (eq (cg-get g :phase) 'passed-out) (cl-incf passed)
+          (let ((p 0))
+            (while (and (eq (cg-get g :phase) 'play) (< p 60))
+              (cl-incf p)
+              (cg-bridge--play-card g (cg-get g :turn) (cg-bridge--ai-play g (cg-get g :turn)))))
+          (when (eq (cg-get g :phase) 'scored)
+            (cl-incf scored)
+            (should (cl-every #'null (append (cg-get g :hands) nil)))))
+        (should (memq (cg-get g :phase) '(scored passed-out)))
+        (should (stringp (cg-render g)))))
+    (should (> scored 0))))