Add 16 games and known-games research; bump to 1.0.60

Console UNICODE games on the cg-core EIEIO engine, all ERT-tested (88/88):
- Tableau solitaire (cg-solitaire.el): Klondike, FreeCell, Spider, Yukon,
  Canfield, Forty Thieves, Scorpion.
- Pile solitaire (cg-patience.el): Golf, TriPeaks, Pyramid.
- Trick-taking (cg-trick.el): Hearts, Spades, Whist, Oh Hell.
- Shedding/climbing: Crazy Eights (cg-eights.el), President (cg-president.el).

Wire all into the card-game chooser, Makefile, and README; add
known-games.org research collation; bump every file to 1.0.60.

Makefile

@@ -1,9 +1,9 @@
 # Makefile for card-games -- byte-compile, test, and package.
 EMACS   ?= emacs
 PKG      = card-games
-VERSION  = 1.0.50
+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 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 card-games.el
 ELC      = $(EL:.el=.elc)
 PKGDESC  = $(PKG)-pkg.el
 TARDIR   = $(PKG)-$(VERSION)

README.org

@@ -8,21 +8,57 @@ available.  The default (UNICODE) symbols maybe customized by
 configuring ~card-game-symbols~.
 
 * Games
-- *500 (Bid)* -- the four-handed partnership trick-taking game, against
-  three computer opponents (~M-x cg-bid~).
-- *Gaps / Hell's Half-Acre* -- solitaire; sort each row into one suit
-  running 2..K (~M-x cg-gaps~).
 
 To open the game menu type ~M-x card-game~, or start a game directly
-with its command:
+with its command.
+
+** Trick-taking
+- ~cg-bid~ -- 500 (Bid).  Win the auction, name the trump suit, then take
+  tricks with your partner to reach 500 points before the opposing pair.
+  Also playable live over the network (~M-x cg-bid-host~ / ~cg-bid-join~).
+- ~cg-hearts~ -- Hearts.  Avoid taking hearts and the Queen of Spades, or
+  take them all to "shoot the moon"; lowest score loses.
+- ~cg-spades~ -- Spades.  Partnership bidding to 500; spades are always
+  trump.  Make your side's combined bid, mind the bags, dare a nil.
+- ~cg-whist~ -- Whist.  Trump is the turned card, there is no bidding;
+  score one point for each trick past the book of six.
+- ~cg-ohhell~ -- Oh Hell.  The hand shrinks each round; bid the exact
+  number of tricks you will take, no more and no fewer.
+
+** Solitaire
 - ~cg-montana~ -- Montana (also called Gaps).  Each row is anchored by a
   Two and built upward in one suit, 2 through King; slide cards into the
   gaps until all four rows are sorted.
 - ~cg-gaps~ -- an alias for ~cg-montana~.
 - ~cg-hells-half-acre~ -- the build-down variant: each row is anchored by
   a King and built downward, King through 2.
-- ~cg-bid~ -- 500 (Bid).  Win the auction, name the trump suit, then take
+- ~cg-klondike~ -- Klondike, the classic "Solitaire": build the four
-  tricks with your partner to reach 500 points before the opposing pair.
+  foundations up by suit from the Ace.
+- ~cg-freecell~ -- FreeCell: every card in view, four free cells, a game
+  of nearly pure skill.
+- ~cg-spider~ -- Spider (two decks): build down regardless of suit, but
+  only same-suit runs move; clear eight King-to-Ace runs.
+- ~cg-yukon~ -- Yukon: Klondike's layout dealt mostly face up, with any
+  buried group movable and no stock.
+- ~cg-canfield~ -- Canfield: a 13-card reserve and a foundation base rank
+  set by the deal; foundations wrap King to Ace.
+- ~cg-forty-thieves~ -- Forty Thieves: two decks, ten columns, eight
+  foundations, build down by suit, and no second pass through the stock.
+- ~cg-scorpion~ -- Scorpion: build down by suit and free any buried group
+  to assemble four King-to-Ace runs.
+- ~cg-golf~ -- Golf: clear the layout by playing exposed cards one rank
+  above or below the waste top.
+- ~cg-tripeaks~ -- TriPeaks: the same, on three overlapping peaks, with
+  Ace-King wrapping for long chains.
+- ~cg-pyramid~ -- Pyramid: remove pairs of exposed cards whose ranks sum
+  to thirteen; Kings go alone.
+
+** Shedding and climbing
+- ~cg-eights~ -- Crazy Eights.  Match the suit or rank of the discard;
+  eights are wild and let you name the next suit.
+- ~cg-president~ -- President (Scum).  Climb: play one to four of a rank,
+  beat it or pass; first out rules, last out scrubs, and the roles trade
+  cards on the next deal.
 
 * TODO
 - [X] make the suit symbols customizable (~cg-symbols~) and obey them
@@ -35,9 +71,9 @@ with its command:
 * Install
 ** From the package tarball
 #+begin_src
-make package           # builds card-games-1.0.50.tar
+make package           # builds card-games-1.0.60.tar
 #+end_src
-Then in Emacs: ~M-x package-install-file RET card-games-1.0.50.tar~.
+Then in Emacs: ~M-x package-install-file RET card-games-1.0.60.tar~.
 
 ** From a local ELPA archive
 #+begin_src
@@ -61,6 +97,14 @@ graphical display.
   ~n~ next hand / new game, ~?~ help.
 - Gaps: arrows to move (or ~hjkl~ when ~cg-keys~ is ~classic~), ~RET~ to
   fill a gap (or click it), ~r~ redeal, ~u~ undo, ~n~ new, ~?~ help.
+- Klondike / FreeCell / Spider / Yukon: arrows move between piles, ~RET~
+  picks up a movable run and drops it, ~f~ sends a card to a foundation,
+  ~a~ auto-plays everything it can, ~u~ undo, ~n~ new, ~?~ help.  On the
+  stock pile, ~RET~ deals or recycles.
+- Hearts / Spades: arrows choose a card, ~RET~ plays it (in Hearts, ~RET~
+  marks a card to pass and ~p~ sends the three), ~n~ new match, ~?~ help.
+- Crazy Eights: arrows choose, ~RET~ plays, ~d~ draws, ~x~ passes, ~n~
+  new deal, ~?~ help.
 
 On a graphical display, ~v~ toggles the full-window SVG table and
 ~+~ / ~-~ / ~0~ (Emacs ~text-scale-adjust~) resize the cards.

card-games-pkg.el

@@ -1,5 +1,5 @@
 ;;; card-games-pkg.el --- Package metadata  -*- no-byte-compile: t; -*-
-(define-package "card-games" "1.0.50"
+(define-package "card-games" "1.0.60"
   "Play card games in Emacs (console UNICODE and graphical SVG)."
   '((emacs "26.1"))
   :keywords '("games")

card-games.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el
@@ -44,6 +44,11 @@
 (require 'cg-gaps)
 (require 'cg-bid-ui)
 (require 'cg-bid-net)
+(require 'cg-solitaire)
+(require 'cg-trick)
+(require 'cg-eights)
+(require 'cg-patience)
+(require 'cg-president)
 
 (defvar card-games-list
   '(("500 (Bid)" cg-bid
@@ -51,7 +56,39 @@
     ("Gaps  (Montana)" cg-montana
      "Solitaire: a Two anchors each row; build up 2 through King.")
     ("Hell's Half-Acre" cg-hells-half-acre
-     "Solitaire: a King anchors each row; build down King through 2."))
+     "Solitaire: a King anchors each row; build down King through 2.")
+    ("Klondike" cg-klondike
+     "Solitaire: the classic; build the foundations up by suit from the Ace.")
+    ("FreeCell" cg-freecell
+     "Solitaire: every card in view, four free cells, a game of skill.")
+    ("Spider" cg-spider
+     "Solitaire: two decks; build down and clear eight same-suit runs.")
+    ("Yukon" cg-yukon
+     "Solitaire: Klondike's layout, all face up; move any buried group.")
+    ("Hearts" cg-hearts
+     "Trick-taking: dodge every heart and the Queen of Spades.")
+    ("Spades" cg-spades
+     "Trick-taking: partnership bidding to 500; spades are always trump.")
+    ("Crazy Eights" cg-eights
+     "Shedding: match the suit or rank; eights are wild.")
+    ("Canfield" cg-canfield
+     "Solitaire: a 13-card reserve and a shifting foundation base rank.")
+    ("Forty Thieves" cg-forty-thieves
+     "Solitaire: two decks, ten columns, eight foundations, no redeal.")
+    ("Scorpion" cg-scorpion
+     "Solitaire: build down by suit and free four buried King-to-Ace runs.")
+    ("Golf" cg-golf
+     "Solitaire: clear the layout one rank at a time onto the waste.")
+    ("TriPeaks" cg-tripeaks
+     "Solitaire: clear three peaks with Ace-King wrapping chains.")
+    ("Pyramid" cg-pyramid
+     "Solitaire: remove pairs of cards that sum to thirteen.")
+    ("Whist" cg-whist
+     "Trick-taking: fixed trump, no bidding, race past the book of six.")
+    ("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."))
   "Registry of playable games.
 Each entry is (NAME COMMAND DESCRIPTION); `card-game' lists them.")
 

cg-bid-net.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-bid-ui.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-bid.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-core.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-eights.el

@@ -0,0 +1,352 @@
+;;; cg-eights.el --- Crazy Eights, a shedding card game  -*- 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:
+
+;; Crazy Eights: shed your whole hand by matching the suit or rank of the
+;; card on top of the discard pile.  Eights are wild -- play one any time
+;; and name the suit that must follow.  If you cannot play, draw a card.
+;; You are the South player; the others are simple AI.  This is the direct
+;; ancestor of UNO, and the shedding engine generalises to climbing games
+;; such as President.
+;;
+;; Cards are the package-standard cons (SUIT . RANK) with SUIT 0 spades,
+;; 1 clubs, 2 diamonds, 3 hearts and RANK 0 (the Two) .. 12 (the Ace).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+(defconst cg-eights-ranks
+  ["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
+  "Rank labels indexed 0 (Two) .. 12 (Ace).")
+
+(defconst cg-eights--wild 6 "Rank index of the wild Eight.")
+
+(defcustom cg-eights-players 3
+  "Number of players in Crazy Eights, including you (2-4)."
+  :type '(choice (const 2) (const 3) (const 4)) :group 'card-games)
+
+(defun cg-eights-card-string (card)
+  "Return a short string for CARD."
+  (if (null card) "·"
+    (concat (aref cg-eights-ranks (cdr card)) (cg-suit-glyph (car card)))))
+
+(defsubst cg-eights-red-p (card) (and card (cg-red-suit-p (car card))))
+
+(defun cg-eights--value (card)
+  "Return the scoring value of CARD held at the end of a hand."
+  (cond ((= (cdr card) cg-eights--wild) 50)
+        ((>= (cdr card) 9) 10)            ; J Q K
+        ((= (cdr card) 12) 1)             ; (Ace handled above by >=9? no) 
+        (t (+ 2 (cdr card)))))
+
+(defun cg-eights--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)))))
+
+(defclass cg-eights-game (cg-game)
+  ((vname :initform "Crazy Eights"))
+  "A game of Crazy Eights.")
+
+(defsubst cg-eights--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-eights--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-eights--top (game) (car (cg-get game :discard)))
+
+(cl-defmethod cg-eights--deal ((game cg-eights-game))
+  "Deal a fresh Crazy Eights hand into GAME."
+  (let* ((n (max 2 (min 4 cg-eights-players)))
+         (deck (cg-eights--deck))
+         (per (if (= n 2) 7 5))
+         (hands (make-vector n nil)))
+    (dotimes (s n)
+      (aset hands s (cl-loop repeat per collect (pop deck))))
+    ;; turn up a starter that is not an eight
+    (let ((start (pop deck)))
+      (while (= (cdr start) cg-eights--wild)
+        (setq deck (append deck (list start)) start (pop deck)))
+      (cg-put game :discard (list start))
+      (cg-put game :suit (car start)))
+    (cg-put game :stock deck)
+    (cg-put game :hands hands)
+    (cg-put game :nplayers n)
+    (cg-put game :turn 0)
+    (cg-put game :phase 'play)
+    (cg-put game :passes 0)
+    (cg-put game :cursor 0)
+    (unless (cg-get game :scores) (cg-put game :scores (make-vector n 0)))
+    (cg-put game :message "Match the suit or rank; eights are wild.  d draws.")
+    game))
+
+(cl-defmethod cg-eights--legal-p ((game cg-eights-game) card)
+  "Return non-nil when CARD may be played onto the discard now."
+  (or (= (cdr card) cg-eights--wild)
+      (= (car card) (cg-get game :suit))
+      (= (cdr card) (cdr (cg-eights--top game)))))
+
+(defun cg-eights--legal-moves (game s)
+  "Return the cards in seat S's hand that may be played now."
+  (cl-remove-if-not (lambda (c) (cg-eights--legal-p game c))
+                    (cg-eights--hand game s)))
+
+(defun cg-eights--best-suit (game s)
+  "Return the suit seat S holds most of (ignoring eights)."
+  (let ((counts (make-vector 4 0)))
+    (dolist (c (cg-eights--hand game s))
+      (unless (= (cdr c) cg-eights--wild)
+        (aset counts (car c) (1+ (aref counts (car c))))))
+    (let ((best 0))
+      (dotimes (i 4) (when (> (aref counts i) (aref counts best)) (setq best i)))
+      best)))
+
+(cl-defmethod cg-eights--play ((game cg-eights-game) s card &optional suit)
+  "Have seat S play CARD; SUIT names the next suit for a wild eight."
+  (cg-eights--set-hand game s (remove card (cg-eights--hand game s)))
+  (cg-put game :discard (cons card (cg-get game :discard)))
+  (cg-put game :suit (if (= (cdr card) cg-eights--wild)
+                         (or suit (cg-eights--best-suit game s))
+                       (car card)))
+  (cg-put game :passes 0)
+  (if (null (cg-eights--hand game s))
+      (cg-eights--finish game s)
+    (cg-put game :turn (mod (1+ s) (cg-get game :nplayers)))))
+
+(defun cg-eights--draw-card (game s)
+  "Move one card from the stock to seat S's hand, recycling if needed.
+Return the drawn card, or nil when none is available."
+  (when (and (null (cg-get game :stock)) (cdr (cg-get game :discard)))
+    (let ((top (car (cg-get game :discard))))
+      (cg-put game :stock (cg-shuffle (cdr (cg-get game :discard))))
+      (cg-put game :discard (list top))))
+  (let ((stock (cg-get game :stock)))
+    (when stock
+      (let ((card (car stock)))
+        (cg-put game :stock (cdr stock))
+        (cg-eights--set-hand game s (cons card (cg-eights--hand game s)))
+        card))))
+
+(cl-defmethod cg-eights--finish ((game cg-eights-game) winner)
+  "Record WINNER going out and score the other hands against them."
+  (let ((sum 0))
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s winner)
+        (dolist (c (cg-eights--hand game s))
+          (setq sum (+ sum (cg-eights--value c))))))
+    (aset (cg-get game :scores) winner (+ (aref (cg-get game :scores) winner) sum))
+    (cg-put game :phase 'game-over)
+    (cg-put game :winner winner)
+    (cg-put game :message
+            (format "%s goes out and scores %d.  Press n for a new deal."
+                    (if (= winner 0) "You" (format "Player %d" winner)) sum))))
+
+(cl-defmethod cg-eights--ai-turn ((game cg-eights-game) s)
+  "Take seat S's whole turn: play if able, otherwise draw then play or pass."
+  (let ((moves (cg-eights--legal-moves game s)))
+    (unless moves
+      ;; draw up to a small limit looking for a play
+      (let ((tries 0))
+        (while (and (not moves) (< tries 60) (cg-eights--draw-card game s))
+          (setq moves (cg-eights--legal-moves game s) tries (1+ tries)))))
+    (if moves
+        ;; prefer a non-eight of lowest value; keep eights for later
+        (let* ((non (cl-remove-if (lambda (c) (= (cdr c) cg-eights--wild)) moves))
+               (pick (car (sort (copy-sequence (or non moves))
+                                (lambda (a b) (< (cg-eights--value a)
+                                                 (cg-eights--value b)))))))
+          (cg-eights--play game s pick))
+      ;; truly stuck: pass
+      (cg-put game :passes (1+ (cg-get game :passes)))
+      (cg-put game :turn (mod (1+ s) (cg-get game :nplayers))))))
+
+(defun cg-eights--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-get game :passes) (cg-get game :nplayers)))
+    (cg-eights--ai-turn game (cg-get game :turn)))
+  (when (>= (cg-get game :passes) (cg-get game :nplayers))
+    (cg-eights--deadlock game)))
+
+(cl-defmethod cg-eights--deadlock ((game cg-eights-game))
+  "End a hand in which everyone passed; lowest hand value wins."
+  (let ((best 0) (bestv most-positive-fixnum))
+    (dotimes (s (cg-get game :nplayers))
+      (let ((v (apply #'+ (mapcar #'cg-eights--value (cg-eights--hand game s)))))
+        (when (< v bestv) (setq bestv v best s))))
+    (cg-eights--finish game best)))
+
+;;;; UI
+
+(defvar-local cg-eights--game nil "The Crazy Eights game in the current buffer.")
+
+(cl-defmethod cg-render ((game cg-eights-game))
+  "Return a propertized string depicting GAME for a text display."
+  (let* ((out (list)) (top (cg-eights--top game))
+         (hand (cg-eights--hand game 0)) (cursor (cg-get game :cursor)))
+    (push (format "  Crazy Eights\n\n") out)
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s 0)
+        (push (format "  Player %d: %d cards   (score %d)\n"
+                      s (length (cg-eights--hand game s))
+                      (aref (cg-get game :scores) s)) out)))
+    (push (format "\n  Discard top: %s    Suit in play: %s    Stock: %d\n\n"
+                  (let ((cs (cg-eights-card-string top)))
+                    (if (cg-eights-red-p top) (propertize cs 'face 'cg-red-suit) cs))
+                  (cg-suit-glyph (cg-get game :suit))
+                  (length (cg-get game :stock)))
+          out)
+    (push (format "  Your hand (score %d):\n   " (aref (cg-get game :scores) 0)) out)
+    (let ((i 0))
+      (dolist (c hand)
+        (let ((cs (cg-eights-card-string c)) (faces nil))
+          (when (cg-eights-red-p c) (push 'cg-red-suit faces))
+          (when (cg-eights--legal-p game 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 (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-eights--redisplay ()
+  "Redraw the Crazy Eights buffer."
+  (let ((game cg-eights--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-eights--cursor-card (game)
+  (nth (cg-get game :cursor) (cg-eights--hand game 0)))
+
+(defun cg-eights-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((game cg-eights--game) (n (length (cg-eights--hand game 0))))
+    (when (> n 0) (cg-put game :cursor (mod (1- (cg-get game :cursor)) n)))
+    (cg-eights--redisplay)))
+
+(defun cg-eights-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((game cg-eights--game) (n (length (cg-eights--hand game 0))))
+    (when (> n 0) (cg-put game :cursor (mod (1+ (cg-get game :cursor)) n)))
+    (cg-eights--redisplay)))
+
+(defun cg-eights--choose-suit (game)
+  "Return a suit the human names for a wild eight."
+  (if noninteractive (cg-eights--best-suit game 0)
+    (let* ((names (mapcar (lambda (i) (cons (aref cg-suit-names i) i)) '(0 1 2 3)))
+           (pick (completing-read "Name the suit: " (mapcar #'car names) nil t)))
+      (cdr (assoc pick names)))))
+
+(defun cg-eights-act ()
+  "Play the selected card if it is legal."
+  (interactive)
+  (let* ((game cg-eights--game) (card (cg-eights--cursor-card game)))
+    (cond
+     ((not (eq (cg-get game :phase) 'play)) (cg-put game :message "Press n for a new deal."))
+     ((/= (cg-get game :turn) 0) (cg-put game :message "Not your turn."))
+     ((null card) (cg-put game :message "No card selected."))
+     ((not (cg-eights--legal-p game card))
+      (cg-put game :message "That card does not match — draw with d if stuck."))
+     (t (let ((suit (and (= (cdr card) cg-eights--wild) (cg-eights--choose-suit game))))
+          (cg-eights--play game 0 card suit)
+          (cg-put game :cursor 0)
+          (cg-eights--run game))))
+    (cg-eights--redisplay)))
+
+(defun cg-eights-draw ()
+  "Draw a card; if the stock cannot help, pass your turn."
+  (interactive)
+  (let ((game cg-eights--game))
+    (when (eq (cg-get game :phase) 'play)
+      (if (= (cg-get game :turn) 0)
+          (let ((card (cg-eights--draw-card game 0)))
+            (if card
+                (cg-put game :message (format "You drew %s." (cg-eights-card-string card)))
+              (cg-put game :passes (1+ (cg-get game :passes)))
+              (cg-put game :turn (mod 1 (cg-get game :nplayers)))
+              (cg-put game :message "Nothing to draw — you pass.")
+              (cg-eights--run game)))
+        (cg-put game :message "Not your turn.")))
+    (cg-eights--redisplay)))
+
+(defun cg-eights-pass ()
+  "Pass your turn (only sensible after drawing with an empty stock)."
+  (interactive)
+  (let ((game cg-eights--game))
+    (when (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0))
+      (cg-put game :passes (1+ (cg-get game :passes)))
+      (cg-put game :turn (mod 1 (cg-get game :nplayers)))
+      (cg-eights--run game))
+    (cg-eights--redisplay)))
+
+(defun cg-eights-new ()
+  "Deal a fresh hand."
+  (interactive)
+  (cg-eights--deal cg-eights--game)
+  (cg-eights--run cg-eights--game)
+  (cg-eights--redisplay))
+
+(defun cg-eights-redraw () "Redraw." (interactive) (cg-eights--redisplay))
+(defun cg-eights-help ()
+  "Describe the controls."
+  (interactive)
+  (message "Arrows: choose  RET: play  d: draw  x: pass  n: new deal  g: redraw"))
+
+(defvar cg-eights-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-eights-left)
+    (define-key map (kbd "<right>") #'cg-eights-right)
+    (define-key map (kbd "RET") #'cg-eights-act)
+    (define-key map (kbd "SPC") #'cg-eights-act)
+    (define-key map "d" #'cg-eights-draw)
+    (define-key map "x" #'cg-eights-pass)
+    (define-key map "n" #'cg-eights-new)
+    (define-key map "g" #'cg-eights-redraw)
+    (define-key map "?" #'cg-eights-help)
+    map)
+  "Keymap for `cg-eights-mode'.")
+
+(define-derived-mode cg-eights-mode special-mode "Crazy8"
+  "Major mode for Crazy Eights."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-eights ()
+  "Play Crazy Eights against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*Crazy Eights*")))
+    (with-current-buffer buf
+      (cg-eights-mode)
+      (setq cg-eights--game (cg-eights-game))
+      (cg-eights--deal cg-eights--game)
+      (cg-eights--run cg-eights--game)
+      (cg-eights--redisplay))
+    (switch-to-buffer buf)))
+
+(provide 'cg-eights)
+;;; cg-eights.el ends here

cg-gaps.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-net.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-patience.el

@@ -0,0 +1,370 @@
+;;; cg-patience.el --- Pile solitaires (Golf, TriPeaks, Pyramid)  -*- 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 "pile" solitaires that clear a fixed layout of cards rather than
+;; building tableau columns:
+;;
+;;   `cg-golf'     -- move an exposed card to the waste when it is one rank
+;;                    above or below the waste's top card; deal when stuck.
+;;   `cg-tripeaks' -- the same, on three overlapping peaks, with Ace-King
+;;                    wrapping so long chains are possible.
+;;   `cg-pyramid'  -- remove pairs of exposed cards whose ranks sum to 13
+;;                    (Kings go alone); deal from the stock to help.
+;;
+;; A board is a vector of card slots; each slot lists the slots that cover
+;; it, and a slot is "exposed" (playable) once all its coverers are gone.
+;; Cards are the package-standard cons (SUIT . RANK) with RANK 0 Ace .. 12
+;; King; a rank's value for the sum-of-13 rule is RANK + 1.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+(defconst cg-pat-ranks
+  ["A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"]
+  "Rank labels indexed 0 (Ace) .. 12 (King).")
+
+(defun cg-pat-card-string (card)
+  "Return a short string for CARD, or a dot for an empty slot."
+  (if (null card) "·"
+    (concat (aref cg-pat-ranks (cdr card)) (cg-suit-glyph (car card)))))
+
+(defsubst cg-pat-red-p (card) (and card (cg-red-suit-p (car card))))
+
+(defun cg-pat--deck () (cg-shuffle (cl-loop for s below 4 append
+                                            (cl-loop for r below 13 collect (cons s r)))))
+
+;;;; Classes
+
+(defclass cg-patience-game (cg-game)
+  ((mode :initform 'build :documentation "Play mode: build (waste) or sum13.")
+   (wrap :initform nil :documentation "Whether Ace-King wrap in build mode.")
+   (vname :initform "Patience"))
+  "Abstract base for the pile solitaires."
+  :abstract t)
+
+(defclass cg-golf-game (cg-patience-game)
+  ((mode :initform 'build) (wrap :initform nil) (vname :initform "Golf")))
+(defclass cg-tripeaks-game (cg-patience-game)
+  ((mode :initform 'build) (wrap :initform t) (vname :initform "TriPeaks")))
+(defclass cg-pyramid-game (cg-patience-game)
+  ((mode :initform 'sum13) (vname :initform "Pyramid")))
+
+;;;; Layouts -- return (CARDS-VECTOR COVER-VECTOR ROWS), ROWS for display.
+
+(cl-defgeneric cg-pat--layout (game deck)
+  "Build GAME's board from DECK; return (CARDS COVER ROWS STOCK WASTE).")
+
+(cl-defmethod cg-pat--layout ((_ cg-golf-game) deck)
+  (let ((cards (make-vector 35 nil)) (cover (make-vector 35 nil)) (rows nil))
+    (dotimes (c 7) (dotimes (r 5)
+      (let ((i (+ (* c 5) r)))
+        (aset cards i (pop deck))
+        (when (< r 4) (aset cover i (list (+ i 1)))))))
+    (dotimes (r 5) (push (cl-loop for c below 7 collect (+ (* c 5) r)) rows))
+    (let ((waste (list (pop deck))))
+      (list cards cover (nreverse rows) deck waste))))
+
+(cl-defmethod cg-pat--layout ((_ cg-tripeaks-game) deck)
+  (let ((cards (make-vector 28 nil))
+        (cover (vector '(3 4) '(5 6) '(7 8)
+                       '(9 10) '(10 11) '(12 13) '(13 14) '(15 16) '(16 17)
+                       '(18 19) '(19 20) '(20 21) '(21 22) '(22 23) '(23 24)
+                       '(24 25) '(25 26) '(26 27)
+                       nil nil nil nil nil nil nil nil nil nil))
+        (rows (list '(0 1 2) '(3 4 5 6 7 8)
+                    '(9 10 11 12 13 14 15 16 17)
+                    '(18 19 20 21 22 23 24 25 26 27))))
+    (dotimes (i 28) (aset cards i (pop deck)))
+    (let ((waste (list (pop deck))))
+      (list cards cover rows deck waste))))
+
+(cl-defmethod cg-pat--layout ((_ cg-pyramid-game) deck)
+  (let ((cards (make-vector 28 nil)) (cover (make-vector 28 nil)) (rows nil))
+    (dotimes (r 7)
+      (let ((start (/ (* r (1+ r)) 2)) (row nil))
+        (dotimes (i (1+ r))
+          (let ((idx (+ start i)))
+            (aset cards idx (pop deck))
+            (push idx row)
+            (when (< r 6)
+              (let ((below (/ (* (1+ r) (+ r 2)) 2)))
+                (aset cover idx (list (+ below i) (+ below i 1)))))))
+        (push (nreverse row) rows)))
+    (list cards cover (nreverse rows) deck nil)))
+
+;;;; Engine
+
+(cl-defmethod cg-pat--deal ((game cg-patience-game))
+  "Deal a fresh board into GAME."
+  (random t)
+  (cl-destructuring-bind (cards cover rows stock waste) (cg-pat--layout game (cg-pat--deck))
+    (cg-put game :cards cards)
+    (cg-put game :cover cover)
+    (cg-put game :rows rows)
+    (cg-put game :stock stock)
+    (cg-put game :waste waste)
+    (cg-put game :marks nil)
+    (cg-put game :cursor 0)
+    (cg-put game :moves 0)
+    (cg-put game :history nil)
+    (cg-put game :message
+            (if (eq (oref game mode) 'sum13)
+                "Remove pairs summing to 13; Kings go alone.  RET marks, stock deals."
+              "Move a card one rank from the waste top.  RET plays; stock deals."))
+    game))
+
+(defun cg-pat--exposed-p (game i)
+  "Return non-nil when board slot I is present and uncovered."
+  (let ((cards (cg-get game :cards)))
+    (and (aref cards i)
+         (cl-every (lambda (j) (null (aref cards j))) (aref (cg-get game :cover) i)))))
+
+(defun cg-pat--exposed (game)
+  "Return the list of exposed board slot indices."
+  (cl-loop for i below (length (cg-get game :cards))
+           when (cg-pat--exposed-p game i) collect i))
+
+(defun cg-pat--spots (game)
+  "Return the ordered spots the cursor can visit."
+  (append (mapcar (lambda (i) (cons 'slot i)) (cg-pat--exposed game))
+          '((waste . 0) (stock . 0))))
+
+(defun cg-pat--waste-top (game) (car (last (cg-get game :waste))))
+
+(defun cg-pat--board-empty-p (game)
+  "Return non-nil when every board slot has been cleared."
+  (cl-every #'null (append (cg-get game :cards) nil)))
+
+(cl-defmethod cg-won-p ((game cg-patience-game))
+  "Return non-nil when the board has been cleared."
+  (cg-pat--board-empty-p game))
+
+(defun cg-pat--adjacent (a b wrap)
+  "Return non-nil when ranks A and B differ by one (or wrap Ace-King)."
+  (let ((d (abs (- a b)))) (or (= d 1) (and wrap (= d 12)))))
+
+(defun cg-pat--snapshot (game)
+  "Record an undo snapshot of GAME."
+  (cg-put game :history
+          (cons (list (copy-sequence (cg-get game :cards))
+                      (copy-sequence (cg-get game :stock))
+                      (copy-sequence (cg-get game :waste))
+                      (cg-get game :moves))
+                (cg-get game :history))))
+
+(defun cg-pat--restore (game)
+  "Undo the last move of GAME, if any."
+  (let ((h (cg-get game :history)))
+    (when h
+      (cl-destructuring-bind (cards stock waste moves) (car h)
+        (cg-put game :cards cards) (cg-put game :stock stock)
+        (cg-put game :waste waste) (cg-put game :moves moves))
+      (cg-put game :history (cdr h))
+      (cg-put game :marks nil)
+      t)))
+
+(defun cg-pat--deal-stock (game)
+  "Turn one card from the stock to the waste."
+  (let ((stock (cg-get game :stock)))
+    (if (null stock)
+        (cg-put game :message "The stock is empty.")
+      (cg-pat--snapshot game)
+      (cg-put game :waste (append (cg-get game :waste) (last stock 1)))
+      (cg-put game :stock (butlast stock 1))
+      (cg-put game :marks nil)
+      (cg-put game :message "Dealt a card."))))
+
+(defun cg-pat--value (card) "Sum-of-13 value of CARD." (1+ (cdr card)))
+
+(defun cg-pat--remove-slot (game i)
+  "Clear board slot I."
+  (aset (cg-get game :cards) i nil))
+
+;;;; Interaction
+
+(defvar-local cg-pat--game nil "The pile-solitaire game in the current buffer.")
+
+(defun cg-pat--cur-spot (game)
+  (let ((spots (cg-pat--spots game)))
+    (nth (min (cg-get game :cursor) (1- (length spots))) spots)))
+
+(defun cg-pat-act ()
+  "Play the spot under the cursor (build move, sum-13 mark, or deal)."
+  (interactive)
+  (let* ((game cg-pat--game) (spot (cg-pat--cur-spot game)))
+    (pcase (car spot)
+      ('stock (cg-pat--deal-stock game))
+      ('waste (when (eq (oref game mode) 'sum13) (cg-pat--toggle-mark game (cons 'waste 0))))
+      ('slot
+       (let* ((i (cdr spot)) (card (aref (cg-get game :cards) i)))
+         (if (eq (oref game mode) 'build)
+             (let ((top (cg-pat--waste-top game)))
+               (if (and top (cg-pat--adjacent (cdr card) (cdr top) (oref game wrap)))
+                   (progn (cg-pat--snapshot game)
+                          (cg-put game :waste (append (cg-get game :waste) (list card)))
+                          (cg-pat--remove-slot game i)
+                          (cg-put game :moves (1+ (cg-get game :moves)))
+                          (cg-put game :message "Played."))
+                 (cg-put game :message "That card is not adjacent to the waste top.")))
+           ;; sum13
+           (if (= 13 (cg-pat--value card))
+               (progn (cg-pat--snapshot game) (cg-pat--remove-slot game i)
+                      (cg-put game :moves (1+ (cg-get game :moves)))
+                      (cg-put game :marks nil)
+                      (cg-put game :message "King removed."))
+             (cg-pat--toggle-mark game (cons 'slot i)))))))
+    (cg-pat--after game)))
+
+(defun cg-pat--mark-value (game m)
+  "Return the card value of mark M (a slot or the waste)."
+  (pcase (car m)
+    ('slot (cg-pat--value (aref (cg-get game :cards) (cdr m))))
+    ('waste (let ((w (cg-pat--waste-top game))) (and w (cg-pat--value w))))))
+
+(defun cg-pat--toggle-mark (game m)
+  "Toggle mark M; when two marks sum to 13, remove both."
+  (if (member m (cg-get game :marks))
+      (cg-put game :marks (remove m (cg-get game :marks)))
+    (cg-put game :marks (cons m (cg-get game :marks))))
+  (let ((marks (cg-get game :marks)))
+    (when (= 2 (length marks))
+      (if (= 13 (+ (cg-pat--mark-value game (nth 0 marks))
+                   (cg-pat--mark-value game (nth 1 marks))))
+          (progn (cg-pat--snapshot game)
+                 (dolist (mm marks)
+                   (pcase (car mm)
+                     ('slot (cg-pat--remove-slot game (cdr mm)))
+                     ('waste (cg-put game :waste (butlast (cg-get game :waste) 1)))))
+                 (cg-put game :moves (1+ (cg-get game :moves)))
+                 (cg-put game :marks nil)
+                 (cg-put game :message "Pair removed."))
+        (cg-put game :marks nil)
+        (cg-put game :message "Those do not sum to 13.")))))
+
+(defun cg-pat--after (game)
+  "Redisplay GAME and announce a win."
+  (cg-pat--redisplay)
+  (when (cg-won-p game)
+    (cg-put game :message "Board cleared -- you won!  Press n for a new game.")
+    (cg-pat--redisplay)
+    (message "Solved!")))
+
+(defun cg-pat--move (delta)
+  (let* ((game cg-pat--game) (n (length (cg-pat--spots game))))
+    (cg-put game :cursor (mod (+ (cg-get game :cursor) delta) n))
+    (cg-pat--redisplay)))
+
+(defun cg-pat-left () "Cursor left." (interactive) (cg-pat--move -1))
+(defun cg-pat-right () "Cursor right." (interactive) (cg-pat--move 1))
+(defun cg-pat-undo () "Undo." (interactive)
+  (let ((game cg-pat--game))
+    (cg-put game :message (if (cg-pat--restore game) "Undid a move." "Nothing to undo."))
+    (cg-pat--redisplay)))
+(defun cg-pat-new () "New deal." (interactive)
+  (cg-pat--deal cg-pat--game) (cg-pat--redisplay))
+(defun cg-pat-redraw () "Redraw." (interactive) (cg-pat--redisplay))
+(defun cg-pat-help () "Controls." (interactive)
+  (message "Arrows: move  RET: play/mark/deal  u: undo  n: new  g: redraw"))
+
+;;;; Rendering
+
+(defun cg-pat--render-card (card &optional exposed marked cursor)
+  (let ((s (cg-pat-card-string card)) (faces nil))
+    (when (cg-pat-red-p card) (push 'cg-red-suit faces))
+    (when (and card (not exposed)) (push 'cg-gap faces))
+    (when marked (push 'cg-hint faces))
+    (when cursor (push 'cg-cursor faces))
+    (propertize (format "%4s" s) 'face (or faces 'default))))
+
+(cl-defmethod cg-render ((game cg-patience-game))
+  "Return a propertized string depicting GAME for a text display."
+  (let* ((cur (cg-pat--cur-spot game)) (marks (cg-get game :marks)) (out (list)))
+    (push (format "  %s   Moves: %d\n\n" (oref game vname) (cg-get game :moves)) out)
+    (dolist (row (cg-get game :rows))
+      (push "  " out)
+      (dolist (i row)
+        (let* ((card (aref (cg-get game :cards) i))
+               (exp (cg-pat--exposed-p game i))
+               (mk (member (cons 'slot i) marks))
+               (cz (equal cur (cons 'slot i))))
+          (push (if card (cg-pat--render-card card exp mk cz) "    ") out)))
+      (push "\n" out))
+    (push (format "\n  Waste: %s    Stock: %d\n"
+                  (let ((w (cg-pat--waste-top game)))
+                    (cg-pat--render-card w t (member '(waste . 0) marks)
+                                         (equal cur '(waste . 0))))
+                  (length (cg-get game :stock)))
+          out)
+    (push (format "  %s\n" (if (equal cur '(stock . 0))
+                               (propertize "[stock]" 'face 'cg-cursor) "")) out)
+    (push (format "\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-pat--redisplay ()
+  (let ((game cg-pat--game) (inhibit-read-only t))
+    (setq-local mode-line-process (format " [%s]" (if (cg-won-p game) "solved" "playing")))
+    (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
+
+;;;; Mode and commands
+
+(defvar cg-pat-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>") #'cg-pat-left)
+    (define-key map (kbd "<right>") #'cg-pat-right)
+    (define-key map (kbd "<up>") #'cg-pat-left)
+    (define-key map (kbd "<down>") #'cg-pat-right)
+    (define-key map (kbd "RET") #'cg-pat-act)
+    (define-key map (kbd "SPC") #'cg-pat-act)
+    (define-key map "u" #'cg-pat-undo)
+    (define-key map "n" #'cg-pat-new)
+    (define-key map "g" #'cg-pat-redraw)
+    (define-key map "?" #'cg-pat-help)
+    map)
+  "Keymap for `cg-pat-mode'.")
+
+(define-derived-mode cg-pat-mode special-mode "Patience"
+  "Major mode for the pile solitaires."
+  (setq-local truncate-lines t))
+
+(defun cg-pat--play (class)
+  (let* ((game (cg-pat--deal (make-instance class)))
+         (buf (get-buffer-create (format "*%s*" (oref game vname)))))
+    (with-current-buffer buf
+      (cg-pat-mode) (setq cg-pat--game game) (cg-pat--redisplay))
+    (switch-to-buffer buf)))
+
+;;;###autoload
+(defun cg-golf () "Play Golf solitaire." (interactive) (cg-pat--play 'cg-golf-game))
+;;;###autoload
+(defun cg-tripeaks () "Play TriPeaks solitaire." (interactive) (cg-pat--play 'cg-tripeaks-game))
+;;;###autoload
+(defun cg-pyramid () "Play Pyramid solitaire." (interactive) (cg-pat--play 'cg-pyramid-game))
+
+(provide 'cg-patience)
+;;; cg-patience.el ends here

cg-president.el

@@ -0,0 +1,378 @@
+;;; cg-president.el --- President (Scum), a climbing card game  -*- 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:
+
+;; President (also Scum, Asshole, Daihinmin): a climbing/shedding game.
+;; The leader plays one to four cards of a single rank; each player in turn
+;; must beat it with the same number of a higher rank or pass.  Once all but
+;; one have passed, the pile clears and the last player to play leads again.
+;; The first player out is President, the last is Scum; on the next deal the
+;; Scum hands the President their two best cards and gets two junk cards back.
+;;
+;; You are the South player (seat 0); the rest are simple AI.  Card power
+;; runs 3 (low) .. K, A, then the Two (highest).  Cards are the package
+;; cons (SUIT . RANK) with RANK 0 (the Two) .. 12 (the Ace).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+(defconst cg-pres-ranks
+  ["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
+  "Rank labels indexed 0 (Two) .. 12 (Ace).")
+
+(defconst cg-pres-titles ["President" "Vice-President" "Citizen"
+                          "Vice-Scum" "Scum"]
+  "Finishing titles from first out to last.")
+
+(defcustom cg-president-players 4
+  "Number of players in President, including you (3-6)."
+  :type 'integer :group 'card-games)
+
+(defun cg-pres--power (rank)
+  "Return the climbing power of RANK; the Two (RANK 0) is highest."
+  (if (= rank 0) 13 rank))
+
+(defun cg-pres-card-string (card)
+  (if (null card) "·"
+    (concat (aref cg-pres-ranks (cdr card)) (cg-suit-glyph (car card)))))
+
+(defsubst cg-pres-red-p (card) (and card (cg-red-suit-p (car card))))
+
+(defun cg-pres--deck ()
+  (cg-shuffle (cl-loop for s below 4 append
+                       (cl-loop for r below 13 collect (cons s r)))))
+
+(defun cg-pres--sort (cards)
+  "Sort CARDS by climbing power then suit."
+  (sort (copy-sequence cards)
+        (lambda (a b) (if (= (cg-pres--power (cdr a)) (cg-pres--power (cdr b)))
+                          (< (car a) (car b))
+                        (< (cg-pres--power (cdr a)) (cg-pres--power (cdr b)))))))
+
+(defclass cg-president-game (cg-game)
+  ((vname :initform "President"))
+  "A game of President (Scum).")
+
+(defsubst cg-pres--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-pres--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-pres--name (_game s)
+  (if (= s 0) "You" (format "Player %d" s)))
+
+;;;; Dealing and the inter-game exchange
+
+(cl-defmethod cg-pres--deal ((game cg-president-game))
+  (let* ((n (max 3 (min 6 cg-president-players)))
+         (deck (cg-pres--deck))
+         (hands (make-vector n nil))
+         (s 0))
+    (while deck
+      (push (pop deck) (aref hands (mod s n)))
+      (cl-incf s))
+    (dotimes (i n) (aset hands i (cg-pres--sort (aref hands i))))
+    (cg-put game :hands hands)
+    (cg-put game :nplayers n)
+    (cg-pres--exchange game)            ; carry out roles from the last deal
+    (cg-put game :count 0)
+    (cg-put game :top -1)
+    (cg-put game :passed (make-vector n nil))
+    (cg-put game :out nil)
+    (cg-put game :last-player nil)
+    (cg-put game :turn 0)
+    (cg-put game :phase 'play)
+    (cg-put game :cursor 0)
+    (unless (cg-get game :games) (cg-put game :games 0))
+    (cg-put game :message
+            "Lead any rank; others beat it with a higher one or pass.  p passes.")
+    game))
+
+(defun cg-pres--best (hand k) "The K highest-power cards of HAND." (last (cg-pres--sort hand) k))
+(defun cg-pres--worst (hand k) "The K lowest-power cards of HAND." (cl-subseq (cg-pres--sort hand) 0 k))
+
+(cl-defmethod cg-pres--exchange ((game cg-president-game))
+  "Trade cards by rank from the previous deal's finishing order, if any."
+  (let ((order (cg-get game :order)) (n (cg-get game :nplayers)))
+    (when (and order (= (length order) n) (>= n 4))
+      (let* ((prez (nth 0 order)) (scum (nth (1- n) order))
+             (vp (nth 1 order)) (vice (nth (- n 2) order)))
+        (cg-pres--give game scum prez 2)   ; scum's 2 best -> president
+        (cg-pres--give game prez scum 2 t) ; president's 2 worst -> scum
+        (cg-pres--give game vice vp 1)
+        (cg-pres--give game vp vice 1 t)))))
+
+(defun cg-pres--give (game from to k &optional worst)
+  "Move K cards (best, or WORST) from seat FROM to seat TO."
+  (let* ((cards (if worst (cg-pres--worst (cg-pres--hand game from) k)
+                  (cg-pres--best (cg-pres--hand game from) k))))
+    (cg-pres--set-hand game from
+                       (cl-set-difference (cg-pres--hand game from) cards :test #'equal))
+    (cg-pres--set-hand game to
+                       (cg-pres--sort (append (cg-pres--hand game to) cards)))))
+
+;;;; Move logic
+
+(defun cg-pres--rank-counts (game s)
+  "Return an alist (RANK . COUNT) for seat S's hand."
+  (let ((tbl nil))
+    (dolist (c (cg-pres--hand game s))
+      (setf (alist-get (cdr c) tbl 0) (1+ (alist-get (cdr c) tbl 0))))
+    tbl))
+
+(defun cg-pres--legal-ranks (game s)
+  "Return the ranks seat S may legally play now."
+  (let ((cnt (cg-get game :count)) (top (cg-get game :top)))
+    (cl-loop for (r . c) in (cg-pres--rank-counts game s)
+             when (if (= cnt 0) t (and (>= c cnt) (> (cg-pres--power r) top)))
+             collect r)))
+
+(defun cg-pres--remove-n (hand rank n)
+  "Remove N cards of RANK from HAND."
+  (let ((out nil) (left n))
+    (dolist (c hand) (if (and (> left 0) (= (cdr c) rank))
+                         (cl-decf left) (push c out)))
+    (nreverse out)))
+
+(defun cg-pres--in-game (game)
+  "Seats that still hold cards."
+  (cl-loop for s below (cg-get game :nplayers)
+           unless (memq s (cg-get game :out)) collect s))
+
+(defun cg-pres--round-active (game)
+  "Seats that can still act on the current pile."
+  (cl-loop for s below (cg-get game :nplayers)
+           unless (or (memq s (cg-get game :out)) (aref (cg-get game :passed) s))
+           collect s))
+
+(defun cg-pres--next (game from)
+  "Next seat after FROM that is still in the round."
+  (let ((n (cg-get game :nplayers)) (s from) (res nil))
+    (dotimes (_ n)
+      (setq s (mod (1+ s) n))
+      (when (and (not res)
+                 (not (memq s (cg-get game :out)))
+                 (not (aref (cg-get game :passed) s)))
+        (setq res s)))
+    (or res from)))
+
+(defun cg-pres--clear (game)
+  "Clear the pile; the last player to play leads (or the next active seat)."
+  (cg-put game :count 0) (cg-put game :top -1)
+  (cg-put game :passed (make-vector (cg-get game :nplayers) nil))
+  (let ((last (cg-get game :last-player)))
+    (cg-put game :turn (if (and last (not (memq last (cg-get game :out)))) last
+                         (cg-pres--next game (or last 0)))))
+  (cg-put game :message "Pile cleared."))
+
+(defun cg-pres--check-finish (game)
+  "End the game when only one player still holds cards (the Scum)."
+  (let ((in (cg-pres--in-game game)))
+    (when (<= (length in) 1)
+      (when in (cg-put game :out (append (cg-get game :out) in)))
+      (cg-put game :order (cg-get game :out))
+      (cg-put game :games (1+ (or (cg-get game :games) 0)))
+      (cg-put game :phase 'game-over)
+      (cg-put game :message (cg-pres--result game))
+      t)))
+
+(defun cg-pres--advance (game)
+  "Decide the next turn or clear the pile after a move."
+  (unless (cg-pres--check-finish game)
+    (let* ((active (cg-pres--round-active game))
+           (last (cg-get game :last-player))
+           (others (and last (cl-remove last active))))
+      (if (and (> (cg-get game :count) 0) (null others))
+          (cg-pres--clear game)
+        (cg-put game :turn (cg-pres--next game (cg-get game :turn)))))))
+
+(defun cg-pres--play (game seat rank n)
+  "Seat SEAT plays N cards of RANK."
+  (cg-pres--set-hand game seat (cg-pres--remove-n (cg-pres--hand game seat) rank n))
+  (cg-put game :count n) (cg-put game :top (cg-pres--power rank))
+  (cg-put game :last-player seat)
+  (when (null (cg-pres--hand game seat))
+    (cg-put game :out (append (cg-get game :out) (list seat))))
+  (cg-put game :message (format "%s plays %d × %s" (cg-pres--name game seat)
+                                n (aref cg-pres-ranks rank)))
+  (cg-pres--advance game))
+
+(defun cg-pres--pass (game seat)
+  "Seat SEAT passes for the current pile."
+  (aset (cg-get game :passed) seat t)
+  (cg-put game :message (format "%s passes." (cg-pres--name game seat)))
+  (cg-pres--advance game))
+
+(defun cg-pres--ai-move (game seat)
+  "Make seat SEAT's move: lead low, beat low, or pass."
+  (let* ((cnt (cg-get game :count)) (top (cg-get game :top))
+         (counts (cg-pres--rank-counts game seat)))
+    (if (= cnt 0)
+        (let ((r (caar (cl-sort counts #'< :key (lambda (x) (cg-pres--power (car x)))))))
+          (cg-pres--play game seat r 1))
+      (let ((cand (cl-loop for (r . c) in counts
+                           when (and (>= c cnt) (> (cg-pres--power r) top)) collect r)))
+        (if cand
+            (cg-pres--play game seat
+                           (car (cl-sort cand #'< :key #'cg-pres--power)) cnt)
+          (cg-pres--pass game seat))))))
+
+(defun cg-pres--result (game)
+  "Return a finishing summary string."
+  (let* ((order (cg-get game :order)) (n (length order)) (parts nil))
+    (dotimes (i n)
+      (let ((title (cond ((= i 0) "President") ((= i (1- n)) "Scum")
+                         ((= i 1) "Vice-President") ((= i (- n 2)) "Vice-Scum")
+                         (t "Citizen"))))
+        (push (format "%s: %s" title (cg-pres--name game (nth i order))) parts)))
+    (concat "Game over -- " (mapconcat #'identity (nreverse parts) ", ")
+            ".  Press n for the next deal.")))
+
+;;;; UI
+
+(defvar-local cg-pres--game nil "The President game in the current buffer.")
+
+(defun cg-pres--run (game)
+  "Advance AI seats until it is the human's turn or the game ends."
+  (while (and (eq (cg-get game :phase) 'play) (/= (cg-get game :turn) 0))
+    (cg-pres--ai-move game (cg-get game :turn))))
+
+(defun cg-pres--hand-ranks (game)
+  "Distinct ranks in seat 0's hand, ordered by power."
+  (let ((rs (delete-dups (mapcar #'cdr (cg-pres--hand game 0)))))
+    (cl-sort rs #'< :key #'cg-pres--power)))
+
+(defun cg-pres-act (&optional count)
+  "Play the selected rank.  With prefix COUNT, lead that many of it."
+  (interactive "P")
+  (let* ((game cg-pres--game)
+         (ranks (cg-pres--hand-ranks game)))
+    (cond
+     ((not (eq (cg-get game :phase) 'play)) (cg-put game :message "Press n for a new deal."))
+     ((/= (cg-get game :turn) 0) (cg-put game :message "Not your turn."))
+     ((null ranks) (cg-put game :message "You are out."))
+     (t (let* ((rank (nth (min (cg-get game :cursor) (1- (length ranks))) ranks))
+               (have (cl-count rank (mapcar #'cdr (cg-pres--hand game 0))))
+               (need (cg-get game :count)))
+          (if (= need 0)
+              (let ((n (min have (max 1 (prefix-numeric-value (or count 1))))))
+                (cg-pres--play game 0 rank n)
+                (cg-put game :cursor 0)
+                (cg-pres--run game))
+            (if (and (>= have need) (> (cg-pres--power rank) (cg-get game :top)))
+                (progn (cg-pres--play game 0 rank need)
+                       (cg-put game :cursor 0)
+                       (cg-pres--run game))
+              (cg-put game :message
+                      (format "Need %d of a rank higher than the pile." need)))))))
+    (cg-pres--redisplay)))
+
+(defun cg-pres-pass ()
+  "Pass for the current pile."
+  (interactive)
+  (let ((game cg-pres--game))
+    (cond
+     ((/= (cg-get game :turn) 0) (cg-put game :message "Not your turn."))
+     ((= (cg-get game :count) 0) (cg-put game :message "You lead -- you must play."))
+     (t (cg-pres--pass game 0) (cg-pres--run game)))
+    (cg-pres--redisplay)))
+
+(defun cg-pres-left () "Cursor left." (interactive)
+  (let* ((g cg-pres--game) (n (length (cg-pres--hand-ranks g))))
+    (when (> n 0) (cg-put g :cursor (mod (1- (cg-get g :cursor)) n))) (cg-pres--redisplay)))
+(defun cg-pres-right () "Cursor right." (interactive)
+  (let* ((g cg-pres--game) (n (length (cg-pres--hand-ranks g))))
+    (when (> n 0) (cg-put g :cursor (mod (1+ (cg-get g :cursor)) n))) (cg-pres--redisplay)))
+(defun cg-pres-new () "New deal." (interactive)
+  (cg-pres--deal cg-pres--game) (cg-pres--run cg-pres--game) (cg-pres--redisplay))
+(defun cg-pres-redraw () "Redraw." (interactive) (cg-pres--redisplay))
+(defun cg-pres-help () "Controls." (interactive)
+  (message "Arrows: choose rank  RET: play (C-u N to lead N)  p: pass  n: new  g: redraw"))
+
+(cl-defmethod cg-render ((game cg-president-game))
+  "Return a propertized string depicting GAME for a text display."
+  (let* ((out (list)) (ranks (cg-pres--hand-ranks game))
+         (cur (cg-get game :cursor)))
+    (push (format "  President\n\n") out)
+    (dotimes (s (cg-get game :nplayers))
+      (unless (= s 0)
+        (push (format "  Player %d: %d cards%s\n" s (length (cg-pres--hand game s))
+                      (if (memq s (cg-get game :out)) "  (out)" "")) out)))
+    (push (format "\n  Pile: %s\n\n"
+                  (if (> (cg-get game :count) 0)
+                      (format "%d × power-%d (last: %s)"
+                              (cg-get game :count) (cg-get game :top)
+                              (cg-pres--name game (cg-get game :last-player)))
+                    "empty -- your lead"))
+          out)
+    (push "  Your hand (by rank):\n   " out)
+    (let ((i 0))
+      (dolist (r ranks)
+        (let* ((cnt (cl-count r (mapcar #'cdr (cg-pres--hand game 0))))
+               (str (format "%s×%d" (aref cg-pres-ranks r) cnt))
+               (faces nil))
+          (when (= i cur) (push 'cg-cursor faces))
+          (push (propertize (format "%6s" str) 'face (or faces 'default)) out))
+        (cl-incf i)))
+    (push (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-pres--redisplay ()
+  (let ((game cg-pres--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))))
+
+(defvar cg-pres-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>") #'cg-pres-left)
+    (define-key map (kbd "<right>") #'cg-pres-right)
+    (define-key map (kbd "RET") #'cg-pres-act)
+    (define-key map (kbd "SPC") #'cg-pres-act)
+    (define-key map "p" #'cg-pres-pass)
+    (define-key map "n" #'cg-pres-new)
+    (define-key map "g" #'cg-pres-redraw)
+    (define-key map "?" #'cg-pres-help)
+    map)
+  "Keymap for `cg-pres-mode'.")
+
+(define-derived-mode cg-pres-mode special-mode "President"
+  "Major mode for President."
+  (setq-local truncate-lines t))
+
+;;;###autoload
+(defun cg-president ()
+  "Play President (Scum) against the computer."
+  (interactive)
+  (let ((buf (get-buffer-create "*President*")))
+    (with-current-buffer buf
+      (cg-pres-mode)
+      (setq cg-pres--game (cg-president-game))
+      (cg-pres--deal cg-pres--game)
+      (cg-pres--run cg-pres--game)
+      (cg-pres--redisplay))
+    (switch-to-buffer buf)))
+
+(provide 'cg-president)
+;;; cg-president.el ends here

cg-render.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-solitaire.el

@@ -0,0 +1,844 @@
+;;; cg-solitaire.el --- Tableau solitaires (Klondike, FreeCell, Spider, Yukon)  -*- 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:
+
+;; A shared engine for tableau solitaires, with four games built on it:
+;;
+;;   `cg-klondike' -- the classic "Solitaire": seven columns, a stock and
+;;                    waste, build the foundations up by suit from the Ace.
+;;   `cg-freecell' -- all cards dealt face up, four free cells, no stock;
+;;                    a game of nearly pure skill.
+;;   `cg-spider'   -- two decks, ten columns; build down regardless of suit
+;;                    but only same-suit runs move; clear eight K..A runs.
+;;   `cg-yukon'    -- Klondike's layout, all face up, move any buried group.
+;;
+;; Cards are the package-standard cons (SUIT . RANK) with SUIT 0 spades,
+;; 1 clubs, 2 diamonds, 3 hearts and RANK 0 Ace .. 12 King.  Each tableau
+;; column is a list ordered bottom (screen top) to top (the accessible
+;; card); a per-column face-down count tracks the hidden prefix.
+;;
+;; Play is by keyboard: move the cursor between piles with the arrow keys
+;; and press RET to pick up the movable run from a pile, then RET again on
+;; a destination to drop it.  `f' sends a card to a foundation, `a' auto-
+;; plays everything it can, and the stock pile deals or recycles on RET.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+;;;; Cards
+
+(defconst cg-sol-ranks
+  ["A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"]
+  "Rank labels indexed 0..12 (Ace through King).")
+
+(defun cg-sol-card-string (card &optional down)
+  "Return a short string for CARD.
+With DOWN non-nil, draw a face-down back instead.  A nil CARD draws an
+empty-slot dot."
+  (cond (down "##")
+        ((null card) "·")
+        (t (concat (aref cg-sol-ranks (cdr card)) (cg-suit-glyph (car card))))))
+
+(defsubst cg-sol-red-p (card)
+  "Return non-nil when CARD is a red suit."
+  (and card (cg-red-suit-p (car card))))
+
+(defun cg-sol--make-deck (ndecks)
+  "Return a shuffled list of NDECKS standard 52-card decks."
+  (random t)
+  (let ((cards nil))
+    (dotimes (_ ndecks)
+      (dotimes (s 4)
+        (dotimes (r 13)
+          (push (cons s r) cards))))
+    (cg-shuffle cards)))
+
+;;;; Game classes
+
+(defclass cg-solitaire-game (cg-game)
+  ((ncols     :initform 7   :documentation "Number of tableau columns.")
+   (ndecks    :initform 1   :documentation "Number of 52-card decks used.")
+   (nfound    :initform 4   :documentation "Number of foundation piles.")
+   (nfree     :initform 0   :documentation "Number of free cells.")
+   (has-stock :initform nil :documentation "Whether a stock pile exists.")
+   (has-waste :initform nil :documentation "Whether a waste pile exists.")
+   (build     :initform 'alt :documentation "Tableau placement rule: alt, suit, any.")
+   (run-rule  :initform 'alt :documentation "Movable-run cohesion: alt, suit, any.")
+   (empty-rule :initform 'king :documentation "Empty-column rule: king or any.")
+   (redeal    :initform t   :documentation "Whether an empty stock recycles the waste.")
+   (draw      :initform 1   :documentation "Cards turned from the stock to the waste.")
+   (target-sets :initform 8 :documentation "Completed runs to win when NFOUND is 0.")
+   (base      :initform 0   :documentation "Foundation base rank (0 = Ace).")
+   (wrap      :initform nil :documentation "Whether foundations wrap King to Ace.")
+   (has-reserve :initform nil :documentation "Whether a reserve pile exists (Canfield).")
+   (vname     :initform "Solitaire" :documentation "Display name."))
+  "Abstract base for tableau solitaires."
+  :abstract t)
+
+(defclass cg-klondike-game (cg-solitaire-game)
+  ((has-stock :initform t) (has-waste :initform t)
+   (vname :initform "Klondike"))
+  "Klondike: seven columns, stock and waste, foundations up by suit.")
+
+(defclass cg-freecell-game (cg-solitaire-game)
+  ((ncols :initform 8) (nfree :initform 4) (empty-rule :initform 'any)
+   (vname :initform "FreeCell"))
+  "FreeCell: eight columns dealt face up, four free cells, no stock.")
+
+(defclass cg-yukon-game (cg-solitaire-game)
+  ((run-rule :initform 'any) (vname :initform "Yukon"))
+  "Yukon: Klondike layout dealt mostly face up; move any buried group.")
+
+(defclass cg-spider-game (cg-solitaire-game)
+  ((ncols :initform 10) (ndecks :initform 2) (nfound :initform 0)
+   (has-stock :initform t) (build :initform 'any) (run-rule :initform 'suit)
+   (empty-rule :initform 'any) (vname :initform "Spider"))
+  "Spider: two decks, ten columns; clear eight K..A same-suit runs.")
+
+;;;; Rules (predicates)
+
+(defun cg-sol--diff-color-p (a b)
+  "Return non-nil when cards A and B are of opposite colours."
+  (not (eq (cg-red-suit-p (car a)) (cg-red-suit-p (car b)))))
+
+(cl-defmethod cg-sol--link-p ((game cg-solitaire-game) upper lower)
+  "Return non-nil when LOWER may rest directly on UPPER within a run."
+  (pcase (oref game run-rule)
+    ('any t)
+    ('suit (and (= (cdr lower) (1- (cdr upper))) (= (car lower) (car upper))))
+    (_     (and (= (cdr lower) (1- (cdr upper))) (cg-sol--diff-color-p upper lower)))))
+
+(cl-defmethod cg-sol--place-p ((game cg-solitaire-game) top card)
+  "Return non-nil when CARD may be placed on a column whose top is TOP."
+  (pcase (oref game build)
+    ('any  (= (cdr card) (1- (cdr top))))
+    ('suit (and (= (cdr card) (1- (cdr top))) (= (car card) (car top))))
+    (_     (and (= (cdr card) (1- (cdr top))) (cg-sol--diff-color-p top card)))))
+
+(cl-defmethod cg-sol--empty-accepts ((game cg-solitaire-game) card)
+  "Return non-nil when CARD may be placed on an empty column."
+  (pcase (oref game empty-rule)
+    ('king (= (cdr card) 12))
+    (_ t)))
+
+;;;; Layout and dealing
+
+(cl-defgeneric cg-sol--layout (game)
+  "Return a list of (DOWN . UP) card counts, one per tableau column.")
+
+(cl-defmethod cg-sol--layout ((_ cg-klondike-game))
+  (cl-loop for i below 7 collect (cons i 1)))
+(cl-defmethod cg-sol--layout ((_ cg-yukon-game))
+  (cons (cons 0 1) (cl-loop for i from 1 below 7 collect (cons i 5))))
+(cl-defmethod cg-sol--layout ((_ cg-freecell-game))
+  (append (make-list 4 (cons 0 7)) (make-list 4 (cons 0 6))))
+(cl-defmethod cg-sol--layout ((_ cg-spider-game))
+  (append (make-list 4 (cons 5 1)) (make-list 6 (cons 4 1))))
+
+(cl-defmethod cg-sol--deal ((game cg-solitaire-game))
+  "Deal a fresh layout into GAME and initialise its environment."
+  (let* ((deck (cg-sol--make-deck (oref game ndecks)))
+         (nc (oref game ncols))
+         (layout (cg-sol--layout game))
+         (tableau (make-vector nc nil))
+         (down (make-vector nc 0)))
+    (dotimes (c nc)
+      (let* ((spec (nth c layout))
+             (col nil))
+        (dotimes (_ (+ (car spec) (cdr spec)))
+          (push (pop deck) col))
+        (aset tableau c (nreverse col))
+        (aset down c (car spec))))
+    (cg-put game :tableau tableau)
+    (cg-put game :down down)
+    (cg-put game :found (make-vector (oref game nfound) nil))
+    (cg-put game :free (make-vector (oref game nfree) nil))
+    (cg-put game :stock deck)
+    (cg-put game :waste nil)
+    (cg-put game :sets 0)
+    (cg-put game :moves 0)
+    (cg-put game :cursor 0)
+    (cg-put game :sel nil)
+    (cg-put game :sel-n 0)
+    (cg-put game :history nil)
+    (cg-put game :message
+            (format "%s.  Arrows move; RET picks up/drops; f=foundation; a=auto; ?=help."
+                    (oref game vname)))
+    game))
+
+;;;; Spots (the cursor visits piles)
+
+(cl-defmethod cg-sol--spots ((game cg-solitaire-game))
+  "Return the ordered list of (TYPE . INDEX) piles the cursor can visit."
+  (append
+   (when (oref game has-stock) '((stock . 0)))
+   (when (oref game has-waste) '((waste . 0)))
+   (when (oref game has-reserve) '((reserve . 0)))
+   (cl-loop for i below (oref game nfree) collect (cons 'free i))
+   (cl-loop for i below (oref game nfound) collect (cons 'found i))
+   (cl-loop for i below (oref game ncols) collect (cons 'col i))))
+
+(defun cg-sol--cur-spot (game)
+  "Return the (TYPE . INDEX) spot currently under the cursor."
+  (nth (cg-get game :cursor) (cg-sol--spots game)))
+
+;;;; Pile access helpers
+
+(defun cg-sol--col (game c) "Column C of GAME (a list)." (aref (cg-get game :tableau) c))
+(defun cg-sol--set-col (game c v) (aset (cg-get game :tableau) c v))
+(defun cg-sol--down (game c) "Face-down count of column C." (aref (cg-get game :down) c))
+(defun cg-sol--set-down (game c v) (aset (cg-get game :down) c v))
+
+(defun cg-sol--col-top (game c)
+  "Return the top (accessible) card of column C, or nil."
+  (car (last (cg-sol--col game c))))
+
+(defun cg-sol--exposed (game c)
+  "Return the face-up cards of column C (bottom..top order)."
+  (nthcdr (cg-sol--down game c) (cg-sol--col game c)))
+
+(cl-defmethod cg-sol--top-run ((game cg-solitaire-game) c)
+  "Return the longest movable run from the top of column C (bottom..top)."
+  (let ((top->bottom (reverse (cg-sol--exposed game c))))
+    (if (null top->bottom)
+        nil
+      (let ((run (list (car top->bottom)))
+            (prev (car top->bottom)))
+        (catch 'done
+          (dolist (card (cdr top->bottom))
+            (if (cg-sol--link-p game card prev)
+                (progn (push card run) (setq prev card))
+              (throw 'done nil))))
+        run))))
+
+(defun cg-sol--spot-top (game spot)
+  "Return the top card available at SPOT, or nil."
+  (pcase (car spot)
+    ('col   (cg-sol--col-top game (cdr spot)))
+    ('waste (car (last (cg-get game :waste))))
+    ('free  (aref (cg-get game :free) (cdr spot)))
+    ('found (car (last (aref (cg-get game :found) (cdr spot)))))
+    ('reserve (car (last (cg-get game :reserve))))
+    (_ nil)))
+
+;;;; Foundations
+
+(defun cg-sol--found-accepts (game i card)
+  "Return non-nil when CARD may go onto foundation I of GAME."
+  (and card
+       (let ((f (aref (cg-get game :found) i)))
+         (if (null f)
+             (= (cdr card) (oref game base))   ; empty foundation takes the base rank
+           (let* ((top (car (last f)))
+                  (need (if (oref game wrap) (mod (1+ (cdr top)) 13) (1+ (cdr top)))))
+             (and (= (car card) (car top))
+                  (= (cdr card) need)))))))
+
+(defun cg-sol--found-for (game card)
+  "Return the index of a foundation that would accept CARD, or nil."
+  (cl-loop for i below (oref game nfound)
+           when (cg-sol--found-accepts game i card) return i))
+
+;;;; Move primitives
+
+(defun cg-sol--snapshot (game)
+  "Push a deep-ish copy of GAME's mutable state onto the undo history."
+  (let ((tab (cg-get game :tableau))
+        (frv (cg-get game :found))
+        (fre (cg-get game :free)))
+    (cg-put game :history
+            (cons (list (vconcat (mapcar #'copy-sequence tab))
+                        (copy-sequence (cg-get game :down))
+                        (vconcat (mapcar #'copy-sequence frv))
+                        (copy-sequence fre)
+                        (copy-sequence (cg-get game :stock))
+                        (copy-sequence (cg-get game :waste))
+                        (cg-get game :sets)
+                        (cg-get game :moves)
+                        (copy-sequence (cg-get game :reserve)))
+                  (cg-get game :history)))))
+
+(defun cg-sol--restore (game)
+  "Pop and restore the most recent undo snapshot of GAME, if any."
+  (let ((h (cg-get game :history)))
+    (when h
+      (cl-destructuring-bind (tab down frv fre stock waste sets moves reserve) (car h)
+        (cg-put game :tableau tab)
+        (cg-put game :down down)
+        (cg-put game :found frv)
+        (cg-put game :free fre)
+        (cg-put game :stock stock)
+        (cg-put game :waste waste)
+        (cg-put game :sets sets)
+        (cg-put game :moves moves)
+        (cg-put game :reserve reserve))
+      (cg-put game :history (cdr h))
+      (cg-put game :sel nil)
+      t)))
+
+(defun cg-sol--flip (game c)
+  "Flip the top of column C face up if it is face down."
+  (let ((len (length (cg-sol--col game c)))
+        (d (cg-sol--down game c)))
+    (when (and (> len 0) (>= d len))
+      (cg-sol--set-down game c (1- len)))))
+
+(defun cg-sol--take (game spot n)
+  "Remove and return the top N cards (bottom..top order) from SPOT."
+  (pcase (car spot)
+    ('col (let* ((c (cdr spot)) (col (cg-sol--col game c))
+                 (run (last col n)))
+            (cg-sol--set-col game c (butlast col n))
+            (let ((len (length (cg-sol--col game c))))
+              (when (> (cg-sol--down game c) len)
+                (cg-sol--set-down game c len)))
+            (cg-sol--flip game c)
+            run))
+    ('waste (let ((w (cg-get game :waste)))
+              (cg-put game :waste (butlast w 1)) (last w 1)))
+    ('free (let ((card (aref (cg-get game :free) (cdr spot))))
+             (aset (cg-get game :free) (cdr spot) nil) (list card)))
+    ('found (let* ((i (cdr spot)) (f (aref (cg-get game :found) i)))
+              (aset (cg-get game :found) i (butlast f 1)) (last f 1)))
+    ('reserve (let ((r (cg-get game :reserve)))
+                (cg-put game :reserve (butlast r 1)) (last r 1)))
+    (_ nil)))
+
+(defun cg-sol--can-drop (game spot cards)
+  "Return non-nil when the run CARDS (bottom..top) may drop on SPOT."
+  (and cards
+       (pcase (car spot)
+         ('col (let* ((c (cdr spot)) (top (cg-sol--col-top game c)))
+                 (if top
+                     (cg-sol--place-p game top (car cards))
+                   (cg-sol--empty-accepts game (car cards)))))
+         ('found (and (= 1 (length cards))
+                      (cg-sol--found-accepts game (cdr spot) (car cards))))
+         ('free (and (= 1 (length cards))
+                     (null (aref (cg-get game :free) (cdr spot)))))
+         (_ nil))))
+
+(defun cg-sol--drop (game spot cards)
+  "Place the run CARDS (bottom..top) onto SPOT."
+  (pcase (car spot)
+    ('col (let ((c (cdr spot)))
+            (cg-sol--set-col game c (append (cg-sol--col game c) cards))))
+    ('found (let ((i (cdr spot)))
+              (aset (cg-get game :found) i
+                    (append (aref (cg-get game :found) i) cards))))
+    ('free (aset (cg-get game :free) (cdr spot) (car cards)))))
+
+;;;; Spider: complete-run removal
+
+(cl-defmethod cg-sol--harvest ((game cg-solitaire-game))
+  "Remove any complete K..A same-suit run from a column top; bump :sets.
+Only games without foundations (NFOUND 0: Spider, Scorpion) harvest runs."
+  (when (= 0 (oref game nfound))
+   (dotimes (c (oref game ncols))
+    (let* ((col (cg-sol--col game c))
+           (exp (cg-sol--exposed game c)))
+      (when (>= (length exp) 13)
+        (let ((run (last exp 13)) (ok t) (suit (car (nth 0 (last exp 13)))))
+          (cl-loop for k below 13
+                   for card = (nth k run)
+                   unless (and (= (car card) suit) (= (cdr card) (- 12 k)))
+                   do (setq ok nil))
+          (when ok
+            (cg-sol--set-col game c (butlast col 13))
+            (let ((len (length (cg-sol--col game c))))
+              (when (> (cg-sol--down game c) len) (cg-sol--set-down game c len)))
+            (cg-sol--flip game c)
+            (cg-put game :sets (1+ (cg-get game :sets))))))))))
+
+;;;; Stock action
+
+(defcustom cg-sol-klondike-draw 1
+  "Number of cards turned from the stock to the waste in Klondike."
+  :type '(choice (const :tag "Draw one" 1) (const :tag "Draw three" 3))
+  :group 'card-games)
+
+(cl-defmethod cg-sol--stock-action ((game cg-solitaire-game))
+  "Deal `draw' cards to the waste, recycling the waste when `redeal'."
+  (if (not (oref game has-waste))
+      (cg-put game :message "No stock to deal.")
+    (cg-sol--snapshot game)
+    (let ((stock (cg-get game :stock)) (waste (cg-get game :waste)))
+      (if stock
+          (let ((n (min (oref game draw) (length stock))))
+            (dotimes (_ n)
+              (setq waste (append waste (last stock 1)))
+              (setq stock (butlast stock 1)))
+            (cg-put game :stock stock) (cg-put game :waste waste)
+            (cg-put game :message "Dealt from stock."))
+        (if (and (oref game redeal) waste)
+            (progn (cg-put game :stock (reverse waste)) (cg-put game :waste nil)
+                   (cg-put game :message "Recycled the waste into the stock."))
+          (cg-put game :message "The stock is empty."))))))
+
+(cl-defmethod cg-sol--stock-action ((game cg-klondike-game))
+  (cg-sol--snapshot game)
+  (let ((stock (cg-get game :stock)) (waste (cg-get game :waste)))
+    (if stock
+        (let ((n (min cg-sol-klondike-draw (length stock))))
+          (dotimes (_ n)
+            (setq waste (append waste (last stock 1)))
+            (setq stock (butlast stock 1)))
+          (cg-put game :stock stock) (cg-put game :waste waste)
+          (cg-put game :message "Dealt from stock."))
+      (if waste
+          (progn (cg-put game :stock (reverse waste)) (cg-put game :waste nil)
+                 (cg-put game :message "Recycled the waste into the stock."))
+        (cg-put game :message "Stock and waste are both empty.")))))
+
+(cl-defmethod cg-sol--stock-action ((game cg-spider-game))
+  (let ((stock (cg-get game :stock)))
+    (cond
+     ((null stock) (cg-put game :message "The stock is empty."))
+     ((cl-loop for c below (oref game ncols)
+               thereis (null (cg-sol--col game c)))
+      (cg-put game :message "Fill every column before dealing from the stock."))
+     (t (cg-sol--snapshot game)
+        (dotimes (c (oref game ncols))
+          (cg-sol--set-col game c (append (cg-sol--col game c) (last stock 1)))
+          (setq stock (butlast stock 1)))
+        (cg-put game :stock stock)
+        (cg-sol--harvest game)
+        (cg-put game :message "Dealt a row from the stock.")))))
+
+;;;; Win
+
+(cl-defmethod cg-won-p ((game cg-solitaire-game))
+  "Return non-nil when GAME is solved."
+  (if (= 0 (oref game nfound))
+      (>= (cg-get game :sets) (oref game target-sets))
+    (cl-every (lambda (f) (= 13 (length f)))
+              (append (cg-get game :found) nil))))
+
+;;;; Interaction
+
+(defvar-local cg-sol--game nil "The solitaire game in the current buffer.")
+
+(cl-defmethod cg-sol--selectable ((game cg-solitaire-game) spot)
+  "Return the run (bottom..top) GAME would pick up from SPOT, or nil."
+  (pcase (car spot)
+    ('col (cg-sol--top-run game (cdr spot)))
+    ('waste (let ((c (cg-sol--spot-top game spot))) (and c (list c))))
+    ('free (let ((c (cg-sol--spot-top game spot))) (and c (list c))))
+    ('found (let ((c (cg-sol--spot-top game spot))) (and c (list c))))
+    ('reserve (let ((c (cg-sol--spot-top game spot))) (and c (list c))))
+    (_ nil)))
+
+(defun cg-sol-act (&optional count)
+  "Pick up from, or drop onto, the pile under the cursor.
+With prefix COUNT, pick up exactly COUNT cards from a column."
+  (interactive "P")
+  (let* ((game cg-sol--game)
+         (spot (cg-sol--cur-spot game))
+         (sel (cg-get game :sel)))
+    (cond
+     ((eq (car spot) 'stock)
+      (cg-put game :sel nil)
+      (cg-sol--stock-action game))
+     ((null sel)
+      (let ((run (cg-sol--selectable game spot)))
+        (cond
+         ((null run) (cg-put game :message "Nothing to pick up there."))
+         (t (when (and count (eq (car spot) 'col))
+              (setq run (last run (min (prefix-numeric-value count) (length run)))))
+            (cg-put game :sel spot)
+            (cg-put game :sel-n (length run))
+            (cg-put game :message
+                    (format "Picked up %d card%s.  RET on a destination."
+                            (length run) (if (= 1 (length run)) "" "s")))))))
+     ((equal sel spot)
+      (cg-put game :sel nil) (cg-put game :message "Cancelled."))
+     (t
+      (let* ((n (cg-get game :sel-n))
+             (cards (last (pcase (car sel)
+                            ('col (cg-sol--col game (cdr sel)))
+                            ('waste (cg-get game :waste))
+                            ('found (aref (cg-get game :found) (cdr sel)))
+                            ('free (list (aref (cg-get game :free) (cdr sel)))))
+                          n)))
+        (if (cg-sol--can-drop game spot cards)
+            (progn (cg-sol--snapshot game)
+                   (cg-sol--take game sel n)
+                   (cg-sol--drop game spot cards)
+                   (cg-put game :moves (1+ (cg-get game :moves)))
+                   (cg-sol--harvest game)
+                   (cg-put game :sel nil)
+                   (cg-put game :message "Moved."))
+          (cg-put game :sel nil)
+          (cg-put game :message "That move is not allowed."))))))
+  (cg-sol--after cg-sol--game))
+
+(defun cg-sol-to-foundation ()
+  "Send the top card of the pile under the cursor to a foundation."
+  (interactive)
+  (let* ((game cg-sol--game)
+         (spot (cg-sol--cur-spot game))
+         (card (cg-sol--spot-top game spot)))
+    (if (and card (memq (car spot) '(col waste free reserve)))
+        (let ((i (cg-sol--found-for game card)))
+          (if i
+              (progn (cg-sol--snapshot game)
+                     (cg-sol--take game spot 1)
+                     (cg-sol--drop game (cons 'found i) (list card))
+                     (cg-put game :moves (1+ (cg-get game :moves)))
+                     (cg-put game :sel nil)
+                     (cg-put game :message "To the foundation."))
+            (cg-put game :message "No foundation will take that card.")))
+      (cg-put game :message "Nothing to send to a foundation.")))
+  (cg-sol--after cg-sol--game))
+
+(defun cg-sol-auto ()
+  "Repeatedly send any eligible card to the foundations."
+  (interactive)
+  (let ((game cg-sol--game) (moved 0))
+    (when (> (oref game nfound) 0)
+      (cg-sol--snapshot game)
+      (let (again)
+        (cl-loop
+         do (setq again nil)
+         (dolist (spot (cg-sol--spots game))
+           (when (memq (car spot) '(col waste free reserve))
+             (let* ((card (cg-sol--spot-top game spot))
+                    (i (and card (cg-sol--found-for game card))))
+               (when i
+                 (cg-sol--take game spot 1)
+                 (cg-sol--drop game (cons 'found i) (list card))
+                 (setq moved (1+ moved) again t)))))
+         while again))
+      (if (> moved 0)
+          (progn (cg-put game :moves (+ moved (cg-get game :moves)))
+                 (cg-put game :sel nil)
+                 (cg-put game :message (format "Auto-played %d card%s."
+                                               moved (if (= 1 moved) "" "s"))))
+        (cg-put game :history (cdr (cg-get game :history)))
+        (cg-put game :message "Nothing to auto-play."))))
+  (cg-sol--after cg-sol--game))
+
+(defun cg-sol-undo ()
+  "Undo the last move."
+  (interactive)
+  (let ((game cg-sol--game))
+    (if (cg-sol--restore game)
+        (cg-put game :message "Undid a move.")
+      (cg-put game :message "Nothing to undo."))
+    (cg-sol--redisplay)))
+
+(defun cg-sol--move (delta)
+  "Move the cursor by DELTA spots."
+  (let* ((game cg-sol--game)
+         (n (length (cg-sol--spots game)))
+         (cur (cg-get game :cursor)))
+    (cg-put game :cursor (mod (+ cur delta) n))
+    (cg-sol--redisplay)))
+
+(defun cg-sol-left () "Move cursor left." (interactive) (cg-sol--move -1))
+(defun cg-sol-right () "Move cursor right." (interactive) (cg-sol--move 1))
+(defun cg-sol-up () "Move cursor left (previous pile)." (interactive) (cg-sol--move -1))
+(defun cg-sol-down () "Move cursor right (next pile)." (interactive) (cg-sol--move 1))
+
+(defun cg-sol--after (game)
+  "Fill empty columns from the reserve, redisplay GAME, and announce a win."
+  (cg-sol--autofill game)
+  (cg-sol--redisplay)
+  (when (cg-won-p game)
+    (cg-put game :message "You won!  Press n for a new game.")
+    (cg-sol--redisplay)
+    (message "Solved!  Well played.")))
+
+(defun cg-sol-new ()
+  "Start a fresh deal of the same game."
+  (interactive)
+  (let ((game cg-sol--game))
+    (cg-sol--deal game)
+    (cg-sol--redisplay)))
+
+(defun cg-sol-help ()
+  "Describe the controls."
+  (interactive)
+  (message "Arrows: move  RET: pick up/drop  f: to foundation  a: auto  u: undo  n: new  g: redraw"))
+
+(defun cg-sol-redraw () "Redraw the board." (interactive) (cg-sol--redisplay))
+
+;;;; Rendering (console)
+
+(defun cg-sol--render-card (card down sel cursor)
+  "Return a propertized 3-column cell for CARD (DOWN, SEL, CURSOR flags)."
+  (let* ((s (cg-sol-card-string card down))
+         (faces nil))
+    (when (and card (not down) (cg-sol-red-p card)) (push 'cg-red-suit faces))
+    (when down (push 'cg-gap faces))
+    (when sel (push 'cg-hint faces))
+    (when cursor (push 'cg-cursor faces))
+    (propertize (format "%3s " s) 'face (or faces 'default))))
+
+(cl-defmethod cg-render ((game cg-solitaire-game))
+  "Return a propertized string depicting GAME for a text display."
+  (let* ((spots (cg-sol--spots game))
+         (cur (cg-get game :cursor))
+         (cur-spot (nth cur spots))
+         (sel (cg-get game :sel))
+         (sel-n (cg-get game :sel-n))
+         (out (list)))
+    (push (format "  %s   Moves: %d%s\n\n"
+                  (oref game vname) (cg-get game :moves)
+                  (if (> (oref game nfound) 0) "" 
+                    (format "   Sets: %d/%d" (cg-get game :sets) (oref game target-sets))))
+          out)
+    ;; Top line: stock / waste / free cells / foundations.
+    (let ((line "  "))
+      (when (oref game has-stock)
+        (let ((on (equal cur-spot '(stock . 0))))
+          (setq line (concat line "Stock:"
+                             (propertize (format "%-4s"
+                                                 (if (cg-get game :stock) "##" "·"))
+                                         'face (if on 'cg-cursor 'default))
+                             (format "(%d) " (length (cg-get game :stock))))) ))
+      (when (oref game has-waste)
+        (let ((on (equal cur-spot '(waste . 0))) (w (car (last (cg-get game :waste)))))
+          (setq line (concat line "Waste:"
+                             (cg-sol--render-card w nil nil on)))))
+      (when (oref game has-reserve)
+        (let ((on (equal cur-spot '(reserve . 0))) (r (car (last (cg-get game :reserve)))))
+          (setq line (concat line "Reserve:"
+                             (cg-sol--render-card r nil nil on)
+                             (format "(%d) " (length (cg-get game :reserve)))))))
+      (dotimes (i (oref game nfree))
+        (let ((on (equal cur-spot (cons 'free i))) (c (aref (cg-get game :free) i)))
+          (setq line (concat line (format "F%d:" (1+ i))
+                             (cg-sol--render-card c nil nil on)))))
+      (dotimes (i (oref game nfound))
+        (let ((on (equal cur-spot (cons 'found i)))
+              (c (car (last (aref (cg-get game :found) i)))))
+          (setq line (concat line (format "%d:" (1+ i))
+                             (cg-sol--render-card c nil nil on)))))
+      (push (concat line "\n\n") out))
+    ;; Column headers.
+    (let ((hdr "   "))
+      (dotimes (c (oref game ncols))
+        (let ((on (equal cur-spot (cons 'col c))))
+          (setq hdr (concat hdr (propertize (format "%2d  " (1+ c))
+                                            'face (if on 'cg-cursor 'default))))))
+      (push (concat hdr "\n") out))
+    ;; Column bodies, row by row.
+    (let* ((tab (cg-get game :tableau))
+           (maxlen (apply #'max 1 (mapcar #'length (append tab nil)))))
+      (dotimes (r maxlen)
+        (let ((row "   "))
+          (dotimes (c (oref game ncols))
+            (let* ((col (aref tab c))
+                   (len (length col))
+                   (card (and (< r len) (nth r col)))
+                   (down (and card (< r (cg-sol--down game c))))
+                   (selp (and (equal sel (cons 'col c))
+                              card (>= r (- len sel-n))))
+                   (cursorp (and (equal cur-spot (cons 'col c)) (= r (1- len)))))
+              (setq row (concat row
+                                (if (< r len)
+                                    (cg-sol--render-card card down selp cursorp)
+                                  "    ")))))
+          (push (concat row "\n") out))))
+    (push (format "\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-sol--redisplay ()
+  "Redraw the current solitaire buffer."
+  (let ((game cg-sol--game)
+        (inhibit-read-only t))
+    (setq-local mode-line-process
+                (format " [%s]" (if (cg-won-p game) "solved"
+                                  (let ((s (cg-get game :sel)))
+                                    (if s "carrying" "playing")))))
+    (erase-buffer)
+    (insert (cg-render game))
+    (goto-char (point-min))))
+
+;;;; Mode and commands
+
+(defvar cg-sol-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-sol-left)
+    (define-key map (kbd "<right>") #'cg-sol-right)
+    (define-key map (kbd "<up>")    #'cg-sol-up)
+    (define-key map (kbd "<down>")  #'cg-sol-down)
+    (define-key map (kbd "RET") #'cg-sol-act)
+    (define-key map (kbd "SPC") #'cg-sol-act)
+    (define-key map "f" #'cg-sol-to-foundation)
+    (define-key map "a" #'cg-sol-auto)
+    (define-key map "u" #'cg-sol-undo)
+    (define-key map "n" #'cg-sol-new)
+    (define-key map "g" #'cg-sol-redraw)
+    (define-key map "?" #'cg-sol-help)
+    map)
+  "Keymap for `cg-sol-mode'.")
+
+(defun cg-sol--classic-keymap ()
+  "Return a copy of `cg-sol-mode-map' with vi-style hjkl added."
+  (let ((map (copy-keymap cg-sol-mode-map)))
+    (define-key map "h" #'cg-sol-left)
+    (define-key map "l" #'cg-sol-right)
+    (define-key map "j" #'cg-sol-down)
+    (define-key map "k" #'cg-sol-up)
+    map))
+
+(define-derived-mode cg-sol-mode special-mode "Solitaire"
+  "Major mode for the tableau solitaires."
+  (setq-local truncate-lines t)
+  (when (eq cg-keys 'classic)
+    (use-local-map (cg-sol--classic-keymap))))
+
+(defun cg-sol--play (class)
+  "Start a solitaire game of CLASS in its own buffer."
+  (let* ((game (cg-sol--deal (make-instance class)))
+         (buf (get-buffer-create (format "*%s*" (oref game vname)))))
+    (with-current-buffer buf
+      (cg-sol-mode)
+      (setq cg-sol--game game)
+      (cg-sol--redisplay))
+    (switch-to-buffer buf)))
+
+;;;###autoload
+(defun cg-klondike ()
+  "Play Klondike, the classic solitaire."
+  (interactive) (cg-sol--play 'cg-klondike-game))
+
+;;;###autoload
+(defun cg-freecell ()
+  "Play FreeCell solitaire."
+  (interactive) (cg-sol--play 'cg-freecell-game))
+
+;;;###autoload
+(defun cg-spider ()
+  "Play Spider solitaire (two decks)."
+  (interactive) (cg-sol--play 'cg-spider-game))
+
+;;;###autoload
+(defun cg-yukon ()
+  "Play Yukon solitaire."
+  (interactive) (cg-sol--play 'cg-yukon-game))
+
+
+;;;; More games: Forty Thieves, Scorpion, Canfield
+
+(defclass cg-forty-game (cg-solitaire-game)
+  ((ncols :initform 10) (ndecks :initform 2) (nfound :initform 8)
+   (has-stock :initform t) (has-waste :initform t) (redeal :initform nil)
+   (build :initform 'suit) (run-rule :initform 'suit) (empty-rule :initform 'any)
+   (vname :initform "Forty Thieves"))
+  "Forty Thieves: two decks, ten columns, eight foundations, no redeal.")
+
+(cl-defmethod cg-sol--layout ((_ cg-forty-game))
+  (make-list 10 (cons 0 4)))
+
+(defclass cg-scorpion-game (cg-solitaire-game)
+  ((ncols :initform 7) (nfound :initform 0) (has-stock :initform t)
+   (build :initform 'suit) (run-rule :initform 'any) (empty-rule :initform 'king)
+   (target-sets :initform 4) (vname :initform "Scorpion"))
+  "Scorpion: build down by suit, move any buried group, clear four runs.")
+
+(cl-defmethod cg-sol--layout ((_ cg-scorpion-game))
+  (append (make-list 4 (cons 3 4)) (make-list 3 (cons 0 7))))
+
+(cl-defmethod cg-sol--stock-action ((game cg-scorpion-game))
+  "Deal the three stock cards onto the first three columns."
+  (let ((stock (cg-get game :stock)))
+    (if (null stock)
+        (cg-put game :message "The stock is empty.")
+      (cg-sol--snapshot game)
+      (dotimes (c (min 3 (length stock)))
+        (cg-sol--set-col game c (append (cg-sol--col game c) (last stock 1)))
+        (setq stock (butlast stock 1)))
+      (cg-put game :stock stock)
+      (cg-sol--harvest game)
+      (cg-put game :message "Dealt the stock onto the first columns."))))
+
+(defclass cg-canfield-game (cg-solitaire-game)
+  ((ncols :initform 4) (nfound :initform 4) (has-stock :initform t)
+   (has-waste :initform t) (has-reserve :initform t) (draw :initform 3)
+   (redeal :initform t) (build :initform 'alt) (run-rule :initform 'alt)
+   (empty-rule :initform 'any) (wrap :initform t) (vname :initform "Canfield"))
+  "Canfield: a 13-card reserve and a variable foundation base rank.")
+
+(cl-defmethod cg-sol--deal ((game cg-canfield-game))
+  "Deal a Canfield layout: reserve, base foundation, four columns, stock."
+  (let* ((deck (cg-sol--make-deck 1))
+         (reserve (cl-loop repeat 13 collect (pop deck)))
+         (first (pop deck))
+         (found (make-vector 4 nil))
+         (tableau (make-vector 4 nil))
+         (down (make-vector 4 0)))
+    (oset game base (cdr first))
+    (aset found 0 (list first))
+    (dotimes (c 4) (aset tableau c (list (pop deck))))
+    (cg-put game :reserve reserve)
+    (cg-put game :tableau tableau)
+    (cg-put game :down down)
+    (cg-put game :found found)
+    (cg-put game :free (make-vector 0 nil))
+    (cg-put game :stock deck)
+    (cg-put game :waste nil)
+    (cg-put game :sets 0)
+    (cg-put game :moves 0)
+    (cg-put game :cursor 0)
+    (cg-put game :sel nil)
+    (cg-put game :sel-n 0)
+    (cg-put game :history nil)
+    (cg-put game :message
+            (format "Canfield.  Foundations build up from %s (wrapping).  RET deals three."
+                    (aref cg-sol-ranks (cdr first))))
+    game))
+
+(cl-defmethod cg-sol--autofill ((_ cg-solitaire-game)) nil)
+(cl-defmethod cg-sol--autofill ((game cg-canfield-game))
+  "Fill empty columns from the reserve, as Canfield requires."
+  (dotimes (c (oref game ncols))
+    (when (and (null (cg-sol--col game c)) (cg-get game :reserve))
+      (let ((card (car (last (cg-get game :reserve)))))
+        (cg-put game :reserve (butlast (cg-get game :reserve) 1))
+        (cg-sol--set-col game c (list card))))))
+
+;;;###autoload
+(defun cg-forty-thieves ()
+  "Play Forty Thieves solitaire (two decks)."
+  (interactive) (cg-sol--play 'cg-forty-game))
+
+;;;###autoload
+(defun cg-scorpion ()
+  "Play Scorpion solitaire."
+  (interactive) (cg-sol--play 'cg-scorpion-game))
+
+;;;###autoload
+(defun cg-canfield ()
+  "Play Canfield solitaire."
+  (interactive) (cg-sol--play 'cg-canfield-game))
+
+(provide 'cg-solitaire)
+;;; cg-solitaire.el ends here

cg-svg.el

@@ -4,7 +4,7 @@
 
 ;; Author: Corwin Brust <corwin@bru.st>
 ;; Maintainer: Corwin Brust <corwin@bru.st>
-;; Version: 1.0.50
+;; Version: 1.0.60
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: games
 ;; URL: https://code.bru.st/corwin/card-game.el

cg-trick.el

@@ -0,0 +1,810 @@
+;;; cg-trick.el --- Four-hand trick-taking games (Hearts, Spades)  -*- 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:
+
+;; A small four-handed trick-taking engine and two games built on it:
+;;
+;;   `cg-hearts' -- the classic avoidance game; dodge every heart and the
+;;                  Queen of Spades, or take them all to "shoot the moon".
+;;   `cg-spades' -- partnership bidding; spades are always trump; make your
+;;                  side's combined bid, beware of bags, and dare a nil.
+;;
+;; You sit South (seat 0); the other three seats are played by simple but
+;; legal AI.  Cards are the package-standard cons (SUIT . RANK) with SUIT
+;; 0 spades, 1 clubs, 2 diamonds, 3 hearts and RANK 0 (the Two) .. 12 (the
+;; Ace); within a suit the higher rank wins, with the trump suit beating
+;; every plain suit.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'cg-core)
+
+;;;; Cards
+
+(defconst cg-trick-ranks
+  ["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
+  "Rank labels indexed 0 (Two) .. 12 (Ace).")
+
+(defconst cg-trick-seat-names ["South" "West" "North" "East"]
+  "Seat names indexed 0..3, going clockwise from the human player.")
+
+(defun cg-trick-card-string (card)
+  "Return a short string for CARD."
+  (if (null card) "·"
+    (concat (aref cg-trick-ranks (cdr card)) (cg-suit-glyph (car card)))))
+
+(defsubst cg-trick-red-p (card) (and card (cg-red-suit-p (car card))))
+
+(defun cg-trick--full-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)))))
+
+(defun cg-trick--sort (cards)
+  "Return CARDS sorted by suit then rank for display."
+  (sort (copy-sequence cards)
+        (lambda (a b) (if (= (car a) (car b)) (< (cdr a) (cdr b))
+                        (< (car a) (car b))))))
+
+;;;; Classes
+
+(defclass cg-trick-game (cg-game)
+  ((trump :initform nil :documentation "Trump suit index, or nil for none.")
+   (restricted :initform 3 :documentation "Suit that cannot be led until broken.")
+   (target :initform 100 :documentation "Score that ends the game.")
+   (hand-size :initform 13 :documentation "Cards dealt to each seat per hand.")
+   (vname  :initform "Trick game"))
+  "Abstract base for four-handed trick-taking games."
+  :abstract t)
+
+(defclass cg-hearts-game (cg-trick-game)
+  ((trump :initform nil) (restricted :initform 3) (target :initform 100)
+   (vname :initform "Hearts"))
+  "Hearts: no trump; avoid hearts and the Queen of Spades.")
+
+(defclass cg-spades-game (cg-trick-game)
+  ((trump :initform 0) (restricted :initform 0) (target :initform 500)
+   (vname :initform "Spades"))
+  "Spades: spades are trump; partnership bidding to 500.")
+
+;;;; Dealing
+
+(cl-defmethod cg-trick--deal ((game cg-trick-game))
+  "Deal a fresh hand into GAME."
+  (let ((deck (cg-trick--full-deck))
+        (hands (make-vector 4 nil))
+        (hs (oref game hand-size))
+        (last nil))
+    (dotimes (s 4)
+      (let ((h nil))
+        (dotimes (_ hs) (setq last (pop deck)) (push last h))
+        (aset hands s (cg-trick--sort h))))
+    (cg-put game :hands hands)
+    (cg-put game :deck deck)
+    (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 nil)
+    (cg-put game :trick-no 0)
+    game))
+
+(defsubst cg-trick--hand (game s) (aref (cg-get game :hands) s))
+(defsubst cg-trick--set-hand (game s v) (aset (cg-get game :hands) s v))
+(defsubst cg-trick--partner (s) (mod (+ s 2) 4))
+(defsubst cg-trick--team (s) (mod s 2))
+
+;;;; Trick mechanics
+
+(defun cg-trick--led-suit (game)
+  "Return the suit led to the current trick, or nil if none yet."
+  (let ((tr (cg-get game :trick)))
+    (and tr (car (cdr (car (last tr)))))))   ; first entry played
+
+(defun cg-trick--first-play (game)
+  "Return the (SEAT . CARD) led to the current trick, or nil."
+  (car (last (cg-get game :trick))))
+
+(cl-defmethod cg-trick--has-points-only-p ((_ cg-trick-game) _hand) nil)
+
+(cl-defmethod cg-trick--legal-p ((game cg-trick-game) seat card)
+  "Return non-nil when SEAT may legally play CARD now."
+  (let* ((hand (cg-trick--hand game seat))
+         (trick (cg-get game :trick))
+         (restricted (oref game restricted))
+         (broken (cg-get game :broken)))
+    (and (member card hand)
+         (if trick
+             ;; following: must follow the led suit if able
+             (let ((led (cg-trick--led-suit game)))
+               (if (cl-some (lambda (c) (= (car c) led)) hand)
+                   (= (car card) led)
+                 t))
+           ;; leading: cannot lead the restricted suit until broken,
+           ;; unless the hand holds nothing else
+           (if (and (= (car card) restricted) (not broken))
+               (cl-every (lambda (c) (= (car c) restricted)) hand)
+             t)))))
+
+(defun cg-trick--legal-moves (game seat)
+  "Return the list of cards SEAT may legally play now."
+  (cl-remove-if-not (lambda (c) (cg-trick--legal-p game seat c))
+                    (cg-trick--hand game seat)))
+
+(cl-defmethod cg-trick--winner ((game cg-trick-game))
+  "Return the seat that wins the now-complete current trick."
+  (let* ((trick (reverse (cg-get game :trick)))   ; play order
+         (led (car (cdr (car trick))))
+         (trump (oref game trump))
+         (best (car trick)))
+    (dolist (play (cdr trick))
+      (let ((bc (cdr best)) (pc (cdr play)))
+        (cond
+         ((and trump (= (car pc) trump) (not (= (car bc) trump)))
+          (setq best play))
+         ((and (= (car pc) (car bc)) (> (cdr pc) (cdr bc)))
+          (setq best play))
+         ((and trump (not (= (car bc) trump)) (= (car pc) led)
+               (> (cdr pc) (cdr bc)))
+          (setq best play)))))
+    (car best)))
+
+(cl-defmethod cg-trick--play ((game cg-trick-game) seat card)
+  "Have SEAT play CARD, resolving the trick when it completes."
+  (cg-trick--set-hand game seat (remove card (cg-trick--hand game seat)))
+  (when (= (car card) (oref game restricted)) (cg-put game :broken t))
+  (cg-put game :trick (cons (cons seat card) (cg-get game :trick)))
+  (if (= 4 (length (cg-get game :trick)))
+      (let* ((w (cg-trick--winner game))
+             (cards (mapcar #'cdr (cg-get game :trick))))
+        (aset (cg-get game :tricks) w (1+ (aref (cg-get game :tricks) w)))
+        (aset (cg-get game :taken) w (append cards (aref (cg-get game :taken) w)))
+        (cg-put game :trick nil)
+        (cg-put game :trick-no (1+ (cg-get game :trick-no)))
+        (cg-put game :leader w)
+        (cg-put game :turn w)
+        w)
+    (cg-put game :turn (mod (1+ seat) 4))
+    nil))
+
+(defun cg-trick--hand-over-p (game)
+  "Return non-nil when all 13 tricks of the hand have been played."
+  (and (null (cg-get game :trick))
+       (cl-every #'null (append (cg-get game :hands) nil))))
+
+;;;; Hearts specifics
+
+(defun cg-hearts--card-points (card)
+  "Return the penalty points for CARD in Hearts."
+  (cond ((equal card '(0 . 10)) 13)   ; Queen of Spades
+        ((= (car card) 3) 1)          ; any heart
+        (t 0)))
+
+(cl-defmethod cg-trick--legal-p ((game cg-hearts-game) seat card)
+  "Hearts legality, adding the first-trick rules to the base."
+  (and (cl-call-next-method)
+       (let ((trick (cg-get game :trick))
+             (hand (cg-trick--hand game seat))
+             (first (= 0 (cg-get game :trick-no))))
+         (cond
+          ;; the very first card of the hand must be the Two of Clubs
+          ((and first (null trick))
+           (equal card '(1 . 0)))
+          ;; no points on the first trick unless that is all one holds
+          ((and first trick (> (cg-hearts--card-points card) 0))
+           (cl-every (lambda (c) (> (cg-hearts--card-points c) 0)) hand))
+          (t t)))))
+
+(cl-defmethod cg-trick--leader-init ((game cg-hearts-game))
+  "Hearts: the holder of the Two of Clubs leads first."
+  (let (seat)
+    (dotimes (s 4)
+      (when (member '(1 . 0) (cg-trick--hand game s)) (setq seat s)))
+    (cg-put game :leader seat) (cg-put game :turn seat)))
+
+(cl-defmethod cg-trick--leader-init ((game cg-spades-game))
+  "Spades: the player left of the dealer leads first."
+  (let ((s (mod (1+ (or (cg-get game :dealer) 3)) 4)))
+    (cg-put game :leader s) (cg-put game :turn s)))
+
+(cl-defmethod cg-trick--score-hand ((game cg-hearts-game))
+  "Score a finished Hearts hand into the cumulative scores."
+  (let ((pts (make-vector 4 0)) (scores (cg-get game :scores)))
+    (dotimes (s 4)
+      (aset pts s (apply #'+ (mapcar #'cg-hearts--card-points
+                                     (aref (cg-get game :taken) s)))))
+    ;; shooting the moon
+    (let ((moon (cl-position 26 (append pts nil))))
+      (if moon
+          (dotimes (s 4) (unless (= s moon)
+                           (aset scores s (+ (aref scores s) 26))))
+        (dotimes (s 4) (aset scores s (+ (aref scores s) (aref pts s))))))
+    (cg-put game :last-points pts)))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-hearts-game))
+  "Hearts ends when any score reaches the target."
+  (cl-some (lambda (s) (>= s (oref game target))) (append (cg-get game :scores) nil)))
+
+(cl-defmethod cg-trick--winner-seat ((game cg-hearts-game))
+  "Return the winning seat (lowest score) for a finished Hearts game."
+  (let ((best 0))
+    (dotimes (s 4) (when (< (aref (cg-get game :scores) s)
+                            (aref (cg-get game :scores) best))
+                     (setq best s)))
+    best))
+
+;;;; Spades specifics
+
+(cl-defmethod cg-trick--score-hand ((game cg-spades-game))
+  "Score a finished Spades hand into the cumulative team scores."
+  (let ((scores (cg-get game :scores))
+        (bags (cg-get game :bags))
+        (bids (cg-get game :bids))
+        (tricks (cg-get game :tricks)))
+    (dotimes (team 2)
+      (let* ((a team) (b (+ team 2))
+             (teambid 0) (teamtricks (+ (aref tricks a) (aref tricks b)))
+             (delta 0))
+        ;; nil bids handled per player
+        (dolist (s (list a b))
+          (if (= (aref bids s) 0)
+              (setq delta (+ delta (if (= (aref tricks s) 0) 100 -100)))
+            (setq teambid (+ teambid (aref bids s)))))
+        (if (>= teamtricks teambid)
+            (let ((over (- teamtricks teambid)))
+              ;; overtricks beyond nil winners count as bags
+              (setq delta (+ delta (* 10 teambid) over))
+              (aset bags team (+ (aref bags team) over))
+              (when (>= (aref bags team) 10)
+                (setq delta (- delta 100))
+                (aset bags team (- (aref bags team) 10))))
+          (setq delta (- delta (* 10 teambid))))
+        (aset scores a (+ (aref scores a) delta))
+        (aset scores b (aref scores a))))
+    (cg-put game :scores scores)))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-spades-game))
+  "Spades ends when a team reaches the target (or falls badly behind)."
+  (cl-some (lambda (s) (>= s (oref game target))) (append (cg-get game :scores) nil)))
+
+(cl-defmethod cg-trick--winner-seat ((game cg-spades-game))
+  "Return a member seat of the winning team for a finished Spades game."
+  (if (>= (aref (cg-get game :scores) 0) (aref (cg-get game :scores) 1)) 0 1))
+
+;;;; AI
+
+(cl-defmethod cg-trick--ai-bid ((game cg-spades-game) seat)
+  "Return a simple trick estimate (bid) for SEAT in Spades."
+  (let ((hand (cg-trick--hand game seat)) (bid 0))
+    (dolist (c hand)
+      (cond
+       ((= (cdr c) 12) (setq bid (1+ bid)))                 ; aces
+       ((and (= (cdr c) 11)) (setq bid (1+ bid)))           ; kings
+       ((and (= (car c) 0) (>= (cdr c) 9)) (setq bid (1+ bid))))) ; high spades
+    ;; long spades add tricks
+    (let ((nsp (cl-count-if (lambda (c) (= (car c) 0)) hand)))
+      (when (> nsp 4) (setq bid (+ bid (- nsp 4)))))
+    (max 1 (min 13 bid))))
+
+(cl-defmethod cg-trick--ai-play ((game cg-hearts-game) seat)
+  "Choose a legal Hearts card for SEAT, avoiding points."
+  (let* ((moves (cg-trick--legal-moves game seat))
+         (trick (cg-get game :trick)))
+    (or
+     (if (null trick)
+         ;; leading: play a low non-point card
+         (car (sort (copy-sequence moves)
+                    (lambda (a b) (< (+ (* 4 (cg-hearts--card-points a)) (cdr a))
+                                     (+ (* 4 (cg-hearts--card-points b)) (cdr b))))))
+       ;; following: if we can duck under the current winner, play highest
+       ;; safe card; else dump the most dangerous card
+       (let* ((led (cg-trick--led-suit game))
+              (winrank (apply #'max (cons -1 (mapcar (lambda (p) (if (= (car (cdr p)) led)
+                                                                     (cdr (cdr p)) -1))
+                                                     trick))))
+              (under (cl-remove-if-not (lambda (c) (and (= (car c) led)
+                                                        (< (cdr c) winrank)))
+                                       moves)))
+         (cond
+          (under (car (last (cg-trick--sort under))))      ; highest still safe
+          ((cl-some (lambda (c) (/= (car c) led)) moves)   ; void: dump worst
+           (car (sort (copy-sequence moves)
+                      (lambda (a b) (> (+ (* 4 (cg-hearts--card-points a)) (cdr a))
+                                       (+ (* 4 (cg-hearts--card-points b)) (cdr b)))))))
+          (t (car (sort (copy-sequence moves)        ; must follow & take: lowest
+                        (lambda (a b) (< (cdr a) (cdr b)))))))))
+     (car moves))))
+
+(cl-defmethod cg-trick--ai-play ((game cg-spades-game) seat)
+  "Choose a legal Spades card for SEAT."
+  (let* ((moves (cg-trick--legal-moves game seat))
+         (trick (cg-get game :trick))
+         (trump (oref game trump)))
+    (or
+     (if (null trick)
+         ;; lead a high non-spade if possible, else lowest
+         (let ((non (cl-remove-if (lambda (c) (= (car c) trump)) moves)))
+           (if non (car (last (cg-trick--sort non)))
+             (car (cg-trick--sort moves))))
+       (let* ((led (cg-trick--led-suit game))
+              (cur (cg-get game :trick))
+              ;; current winning play
+              (winner (cg-trick--winner-of game cur))
+              (partner-winning (and winner (= (cg-trick--team winner)
+                                              (cg-trick--team seat)))))
+         (if partner-winning
+             (car (cg-trick--sort moves))   ; let partner have it: play low
+           ;; try to win cheaply
+           (let* ((followers (cl-remove-if-not (lambda (c) (= (car c) led)) moves)))
+             (or (car (cg-trick--sort followers))
+                 (car (cg-trick--sort moves)))))))
+     (car moves))))
+
+(defun cg-trick--winner-of (game trick)
+  "Return the seat currently winning the partial TRICK of GAME."
+  (when trick
+    (let* ((order (reverse trick))
+           (led (car (cdr (car order))))
+           (trump (oref game trump))
+           (best (car order)))
+      (dolist (play (cdr order))
+        (let ((bc (cdr best)) (pc (cdr play)))
+          (cond
+           ((and trump (= (car pc) trump) (not (= (car bc) trump))) (setq best play))
+           ((and (= (car pc) (car bc)) (> (cdr pc) (cdr bc))) (setq best play))
+           ((and trump (not (= (car bc) trump)) (= (car pc) led)
+                 (> (cdr pc) (cdr bc))) (setq best play)))))
+      (car best))))
+
+;;;; Game driver (logic; UI layered on top)
+
+(cl-defmethod cg-trick--start-hand ((game cg-trick-game))
+  "Deal and prepare a new hand, leaving GAME ready for the first lead."
+  (cg-trick--deal game)
+  (cg-trick--leader-init game)
+  game)
+
+(defun cg-trick--simulate-hand (game)
+  "Play a whole hand with AI for every seat (used by tests)."
+  (while (not (cg-trick--hand-over-p game))
+    (let ((seat (cg-get game :turn)))
+      (cg-trick--play game seat (cg-trick--ai-play game seat))))
+  (cg-trick--score-hand game))
+
+;;;; New-game / hand lifecycle
+
+(defvar-local cg-trick--game nil "The trick-taking game in the current buffer.")
+
+(defconst cg-trick--pass-dirs [1 3 2 0]
+  "Pass directions by hand: left, right, across, hold (then repeat).")
+
+(defun cg-trick--dir-name (dir)
+  "Return a human label for pass direction DIR."
+  (pcase dir (1 "left") (3 "right") (2 "across") (_ "hold")))
+
+(cl-defgeneric cg-trick--begin-hand (game)
+  "Deal and set up a new hand of GAME, then run AI up to the human's turn.")
+
+(cl-defmethod cg-trick--begin-hand ((game cg-hearts-game))
+  (cg-trick--deal game)
+  (cg-put game :hand-no (1+ (or (cg-get game :hand-no) 0)))
+  (cg-put game :cursor 0) (cg-put game :marks nil)
+  (let ((dir (aref cg-trick--pass-dirs (mod (1- (cg-get game :hand-no)) 4))))
+    (cg-put game :pass-dir dir)
+    (if (= dir 0)
+        (progn (cg-trick--leader-init game)
+               (cg-put game :phase 'play)
+               (cg-put game :message "No passing this hand.  Play begins.")
+               (cg-trick--run game))
+      (cg-put game :phase 'pass)
+      (cg-put game :message
+              (format "Pass three cards %s.  RET marks a card; p sends them."
+                      (cg-trick--dir-name dir))))))
+
+(cl-defmethod cg-trick--begin-hand ((game cg-spades-game))
+  (cg-trick--deal game)
+  (cg-put game :dealer (mod (1+ (or (cg-get game :dealer) 3)) 4))
+  (cg-put game :cursor 0)
+  (let ((bids (make-vector 4 0)))
+    (dotimes (s 4) (unless (= s 0) (aset bids s (cg-trick--ai-bid game s))))
+    (aset bids 0 (if noninteractive (cg-trick--ai-bid game 0)
+                   (let ((sug (cg-trick--ai-bid game 0)))
+                     (max 0 (min 13 (read-number
+                                     (format "Your bid (0 = nil) [suggest %d]: " sug)
+                                     sug))))))
+    (cg-put game :bids bids))
+  (cg-trick--leader-init game)
+  (cg-put game :phase 'play)
+  (cg-put game :message
+          (format "You bid %d.  Make your side's combined bid."
+                  (aref (cg-get game :bids) 0)))
+  (cg-trick--run game))
+
+(defun cg-trick--new (game)
+  "Initialise GAME for a fresh match and deal the first hand."
+  (cg-put game :scores (make-vector 4 0))
+  (cg-put game :bags (make-vector 2 0))
+  (cg-put game :dealer 3)
+  (cg-put game :hand-no 0)
+  (cg-put game :round 0)
+  (cg-trick--begin-hand game)
+  game)
+
+(defun cg-trick--run (game)
+  "Advance AI seats until it is the human's turn or the hand ends."
+  (while (and (eq (cg-get game :phase) 'play)
+              (not (cg-trick--hand-over-p game))
+              (/= (cg-get game :turn) 0))
+    (let ((s (cg-get game :turn)))
+      (cg-trick--play game s (cg-trick--ai-play game s))))
+  (when (and (eq (cg-get game :phase) 'play) (cg-trick--hand-over-p game))
+    (cg-trick--finish-hand game)))
+
+(defun cg-trick--finish-hand (game)
+  "Score the finished hand of GAME and start the next, or end the match."
+  (cg-trick--score-hand game)
+  (if (cg-trick--game-over-p game)
+      (progn (cg-put game :phase 'game-over)
+             (cg-put game :message
+                     (format "Game over.  %s.  Press n for a new match."
+                             (cg-trick--result-string game))))
+    (cg-trick--begin-hand game)))
+
+(cl-defmethod cg-trick--result-string ((game cg-hearts-game))
+  (format "%s wins with the lowest score"
+          (aref cg-trick-seat-names (cg-trick--winner-seat game))))
+
+(cl-defmethod cg-trick--result-string ((game cg-spades-game))
+  (let ((w (cg-trick--winner-seat game)))
+    (format "%s win" (if (= w 0) "You and North" "West and East"))))
+
+;;;; AI passing
+
+(cl-defmethod cg-trick--ai-pass ((_ cg-hearts-game) hand)
+  "Return three cards to pass from HAND (shed the most dangerous)."
+  (let ((danger (lambda (c) (+ (* 6 (cg-hearts--card-points c))
+                               (if (and (= (car c) 0) (>= (cdr c) 10)) 5 0)
+                               (cdr c)))))
+    (cl-subseq (sort (copy-sequence hand)
+                     (lambda (a b) (> (funcall danger a) (funcall danger b))))
+               0 3)))
+
+(defun cg-trick--do-pass (game)
+  "Exchange the chosen passing cards among the four seats of GAME."
+  (let* ((dir (cg-get game :pass-dir))
+         (sel (make-vector 4 nil))
+         (kept (make-vector 4 nil)))
+    (aset sel 0 (copy-sequence (cg-get game :marks)))
+    (dotimes (s 4)
+      (unless (= s 0)
+        (aset sel s (copy-sequence (cg-trick--ai-pass game (cg-trick--hand game s))))))
+    ;; what each seat keeps (its hand minus the cards it gives away)
+    (dotimes (s 4)
+      (aset kept s (cl-remove-if (lambda (c) (member c (aref sel s)))
+                                 (cg-trick--hand game s))))
+    ;; deal each seat's three cards to the seat DIR places along
+    (dotimes (s 4)
+      (let ((r (mod (+ s dir) 4)))
+        (aset kept r (append (aref kept r) (aref sel s)))))
+    (dotimes (s 4)
+      (cg-trick--set-hand game s (cg-trick--sort (aref kept s))))
+    (cg-trick--leader-init game)
+    (cg-put game :phase 'play)
+    (cg-put game :marks nil)
+    (cg-put game :message "Cards passed.  Play begins.")
+    (cg-trick--run game)))
+
+(defun cg-trick--seat-line (game s)
+  "Return a status line for opponent seat S of GAME."
+  (let* ((n (length (cg-trick--hand game s)))
+         (bid (and (cg-get game :bids) (aref (cg-get game :bids) s)))
+         (won (and (cg-get game :tricks) (aref (cg-get game :tricks) s))))
+    (format "  %-6s %2d cards%s%s\n" (aref cg-trick-seat-names s) n
+            (if bid (format "  bid %d" bid) "")
+            (if won (format "  won %d" won) ""))))
+
+(cl-defmethod cg-render ((game cg-trick-game))
+  "Return a propertized string depicting GAME for a text display."
+  (let* ((out (list))
+         (scores (cg-get game :scores))
+         (marks (cg-get game :marks))
+         (cursor (cg-get game :cursor))
+         (hand (cg-trick--sort (cg-trick--hand game 0))))
+    (push (format "  %s\n" (oref game vname)) out)
+    (when scores
+      (push (format "  Scores:  South %d  West %d  North %d  East %d\n\n"
+                    (aref scores 0) (aref scores 1) (aref scores 2) (aref scores 3))
+            out))
+    (dolist (s '(2 1 3))                 ; North, West, East
+      (push (cg-trick--seat-line game s) out))
+    ;; current trick
+    (push "\n  Trick: " out)
+    (if (cg-get game :trick)
+        (dolist (play (reverse (cg-get game :trick)))
+          (push (format "%s:%s  " (aref cg-trick-seat-names (car play))
+                        (let ((cs (cg-trick-card-string (cdr play))))
+                          (if (cg-trick-red-p (cdr play))
+                              (propertize cs 'face 'cg-red-suit) cs)))
+                out))
+      (push "(empty)" out))
+    (push "\n\n  Your hand (South):\n   " out)
+    (let ((i 0))
+      (dolist (c hand)
+        (let* ((cs (cg-trick-card-string c))
+               (faces nil))
+          (when (cg-trick-red-p c) (push 'cg-red-suit faces))
+          (when (member c marks) (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 (format "\n\n  %s\n" (cg-get game :message)) out)
+    (apply #'concat (nreverse out))))
+
+(defun cg-trick--redisplay ()
+  "Redraw the current trick-game buffer."
+  (let ((game cg-trick--game) (inhibit-read-only t))
+    (setq-local mode-line-process
+                (format " [%s]" (or (cg-get game :phase) "play")))
+    (erase-buffer)
+    (insert (cg-render game))
+    (goto-char (point-min))))
+
+;;;; Commands
+
+(defun cg-trick--cursor-card (game)
+  "Return the South card currently under the cursor."
+  (nth (cg-get game :cursor) (cg-trick--sort (cg-trick--hand game 0))))
+
+(defun cg-trick-left ()
+  "Move the hand cursor left."
+  (interactive)
+  (let* ((game cg-trick--game) (n (length (cg-trick--hand game 0))))
+    (when (> n 0) (cg-put game :cursor (mod (1- (cg-get game :cursor)) n)))
+    (cg-trick--redisplay)))
+
+(defun cg-trick-right ()
+  "Move the hand cursor right."
+  (interactive)
+  (let* ((game cg-trick--game) (n (length (cg-trick--hand game 0))))
+    (when (> n 0) (cg-put game :cursor (mod (1+ (cg-get game :cursor)) n)))
+    (cg-trick--redisplay)))
+
+(defun cg-trick-act ()
+  "Play, or (during the Hearts pass) mark, the selected card."
+  (interactive)
+  (let* ((game cg-trick--game)
+         (phase (cg-get game :phase))
+         (card (cg-trick--cursor-card game)))
+    (pcase phase
+      ('play
+       (cond
+        ((/= (cg-get game :turn) 0) (cg-put game :message "Not your turn."))
+        ((not (cg-trick--legal-p game 0 card))
+         (cg-put game :message "Illegal play — you must follow suit."))
+        (t (cg-trick--play game 0 card)
+           (cg-put game :cursor (max 0 (min (cg-get game :cursor)
+                                            (1- (length (cg-trick--hand game 0))))))
+           (cg-trick--run game))))
+      ('pass
+       (if (member card (cg-get game :marks))
+           (cg-put game :marks (remove card (cg-get game :marks)))
+         (if (>= (length (cg-get game :marks)) 3)
+             (cg-put game :message "Three already marked — press p to pass.")
+           (cg-put game :marks (cons card (cg-get game :marks))))))
+      (_ (cg-put game :message "Press n for a new match.")))
+    (cg-trick--redisplay)))
+
+(defun cg-trick-pass ()
+  "Confirm the Hearts pass once three cards are marked."
+  (interactive)
+  (let ((game cg-trick--game))
+    (if (and (eq (cg-get game :phase) 'pass) (= 3 (length (cg-get game :marks))))
+        (cg-trick--do-pass game)
+      (cg-put game :message "Mark exactly three cards first."))
+    (cg-trick--redisplay)))
+
+(defun cg-trick-new ()
+  "Start a fresh match in this buffer."
+  (interactive)
+  (cg-trick--new cg-trick--game)
+  (cg-trick--redisplay))
+
+(defun cg-trick-redraw () "Redraw the table." (interactive) (cg-trick--redisplay))
+
+(defun cg-trick-help ()
+  "Describe the controls."
+  (interactive)
+  (message "Arrows: choose card  RET: play/mark  p: pass (Hearts)  n: new  g: redraw"))
+
+(defvar cg-trick-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<left>")  #'cg-trick-left)
+    (define-key map (kbd "<right>") #'cg-trick-right)
+    (define-key map (kbd "RET") #'cg-trick-act)
+    (define-key map (kbd "SPC") #'cg-trick-act)
+    (define-key map "p" #'cg-trick-pass)
+    (define-key map "n" #'cg-trick-new)
+    (define-key map "g" #'cg-trick-redraw)
+    (define-key map "?" #'cg-trick-help)
+    map)
+  "Keymap for `cg-trick-mode'.")
+
+(define-derived-mode cg-trick-mode special-mode "Trick"
+  "Major mode for the four-handed trick-taking games."
+  (setq-local truncate-lines t))
+
+(defun cg-trick--play-game (class)
+  "Start a trick game of CLASS in its own buffer."
+  (let* ((game (make-instance class))
+         (buf (get-buffer-create (format "*%s*" (oref game vname)))))
+    (with-current-buffer buf
+      (cg-trick-mode)
+      (setq cg-trick--game game)
+      (cg-trick--new game)
+      (cg-trick--redisplay))
+    (switch-to-buffer buf)))
+
+;;;###autoload
+(defun cg-hearts ()
+  "Play Hearts against three computer opponents."
+  (interactive) (cg-trick--play-game 'cg-hearts-game))
+
+;;;###autoload
+(defun cg-spades ()
+  "Play Spades (partnership) against three computer opponents."
+  (interactive) (cg-trick--play-game 'cg-spades-game))
+
+
+;;;; Whist and Oh Hell
+
+(defclass cg-whist-game (cg-trick-game)
+  ((restricted :initform -1) (target :initform 5) (vname :initform "Whist"))
+  "Whist: trump set by the turned card, no bidding, score tricks over six.")
+
+(defclass cg-ohhell-game (cg-trick-game)
+  ((restricted :initform -1) (target :initform 0) (vname :initform "Oh Hell"))
+  "Oh Hell: hand size shrinks each round; bid the exact tricks you will take.")
+
+(cl-defmethod cg-trick--leader-init ((game cg-whist-game))
+  (let ((s (mod (1+ (or (cg-get game :dealer) 3)) 4)))
+    (cg-put game :leader s) (cg-put game :turn s)))
+(cl-defmethod cg-trick--leader-init ((game cg-ohhell-game))
+  (let ((s (mod (1+ (or (cg-get game :dealer) 3)) 4)))
+    (cg-put game :leader s) (cg-put game :turn s)))
+
+(defun cg-trick--ai-trump-play (game seat)
+  "A generic legal trump-game play for SEAT: follow and win cheaply, else low."
+  (let* ((moves (cg-trick--legal-moves game seat))
+         (trick (cg-get game :trick)))
+    (or
+     (if (null trick)
+         (car (last (cg-trick--sort moves)))
+       (let* ((winner (cg-trick--winner-of game trick))
+              (partner-winning (and winner (= (cg-trick--team winner)
+                                              (cg-trick--team seat))))
+              (led (cg-trick--led-suit game)))
+         (if partner-winning
+             (car (cg-trick--sort moves))
+           (let ((follow (cl-remove-if-not (lambda (c) (= (car c) led)) moves)))
+             (or (car (last (cg-trick--sort follow)))
+                 (car (cg-trick--sort moves)))))))
+     (car moves))))
+
+(cl-defmethod cg-trick--ai-play ((game cg-whist-game) seat)
+  (cg-trick--ai-trump-play game seat))
+(cl-defmethod cg-trick--ai-play ((game cg-ohhell-game) seat)
+  (cg-trick--ai-trump-play game seat))
+
+;; Whist
+(cl-defmethod cg-trick--begin-hand ((game cg-whist-game))
+  (cg-trick--deal game)
+  (cg-put game :dealer (mod (1+ (or (cg-get game :dealer) 3)) 4))
+  (oset game trump (car (cg-get game :last-card)))   ; dealer's last card turns trump
+  (cg-put game :cursor 0)
+  (cg-trick--leader-init game)
+  (cg-put game :phase 'play)
+  (cg-put game :message (format "Trump is %s.  Take tricks past the book of six."
+                                (cg-suit-glyph (oref game trump))))
+  (cg-trick--run game))
+
+(cl-defmethod cg-trick--score-hand ((game cg-whist-game))
+  (let ((scores (cg-get game :scores)) (tricks (cg-get game :tricks)))
+    (dotimes (team 2)
+      (let ((over (max 0 (- (+ (aref tricks team) (aref tricks (+ team 2))) 6))))
+        (aset scores team (+ (aref scores team) over))
+        (aset scores (+ team 2) (aref scores team))))
+    (cg-put game :scores scores)))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-whist-game))
+  (cl-some (lambda (s) (>= s (oref game target))) (append (cg-get game :scores) nil)))
+(cl-defmethod cg-trick--winner-seat ((game cg-whist-game))
+  (if (>= (aref (cg-get game :scores) 0) (aref (cg-get game :scores) 1)) 0 1))
+(cl-defmethod cg-trick--result-string ((game cg-whist-game))
+  (format "%s win" (if (= 0 (cg-trick--winner-seat game)) "You and North" "West and East")))
+
+;; Oh Hell
+(defconst cg-ohhell--sizes [7 6 5 4 3 2 1]
+  "Hand sizes dealt in successive Oh Hell rounds.")
+
+(cl-defmethod cg-trick--ai-bid ((game cg-ohhell-game) seat)
+  (let ((hand (cg-trick--hand game seat)) (trump (oref game trump)) (bid 0))
+    (dolist (c hand)
+      (cond ((= (cdr c) 12) (cl-incf bid))
+            ((and (= (car c) trump) (>= (cdr c) 9)) (cl-incf bid))))
+    (min bid (length hand))))
+
+(cl-defmethod cg-trick--begin-hand ((game cg-ohhell-game))
+  (let* ((round (or (cg-get game :round) 0))
+         (hs (aref cg-ohhell--sizes (min round (1- (length cg-ohhell--sizes))))))
+    (oset game hand-size hs)
+    (cg-trick--deal game)
+    (cg-put game :dealer (mod (1+ (or (cg-get game :dealer) 3)) 4))
+    (let ((up (car (cg-get game :deck))))
+      (oset game trump (if up (car up) 0)))
+    (cg-put game :cursor 0)
+    (let ((bids (make-vector 4 0)))
+      (dotimes (s 4) (unless (= s 0) (aset bids s (cg-trick--ai-bid game s))))
+      (aset bids 0 (if noninteractive (cg-trick--ai-bid game 0)
+                     (max 0 (min hs (read-number
+                                     (format "Round %d (trump %s) -- your bid (0-%d): "
+                                             (1+ round) (cg-suit-glyph (oref game trump)) hs)
+                                     (cg-trick--ai-bid game 0))))))
+      (cg-put game :bids bids))
+    (cg-trick--leader-init game)
+    (cg-put game :phase 'play)
+    (cg-put game :message (format "Round %d: make EXACTLY your bid (trump %s)."
+                                  (1+ round) (cg-suit-glyph (oref game trump))))
+    (cg-trick--run game)))
+
+(cl-defmethod cg-trick--score-hand ((game cg-ohhell-game))
+  (let ((scores (cg-get game :scores)) (bids (cg-get game :bids))
+        (tricks (cg-get game :tricks)))
+    (dotimes (s 4)
+      (when (= (aref tricks s) (aref bids s))
+        (aset scores s (+ (aref scores s) 10 (aref bids s)))))
+    (cg-put game :scores scores)
+    (cg-put game :round (1+ (or (cg-get game :round) 0)))))
+
+(cl-defmethod cg-trick--game-over-p ((game cg-ohhell-game))
+  (>= (or (cg-get game :round) 0) (length cg-ohhell--sizes)))
+(cl-defmethod cg-trick--winner-seat ((game cg-ohhell-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-ohhell-game))
+  (format "%s wins" (aref cg-trick-seat-names (cg-trick--winner-seat game))))
+
+;;;###autoload
+(defun cg-whist () "Play Whist against three computer opponents."
+  (interactive) (cg-trick--play-game 'cg-whist-game))
+;;;###autoload
+(defun cg-ohhell () "Play Oh Hell against three computer opponents."
+  (interactive) (cg-trick--play-game 'cg-ohhell-game))
+
+(provide 'cg-trick)
+;;; cg-trick.el ends here

test/card-games-tests.el

@@ -332,3 +332,499 @@
             (should (aref (cg-get hgame :passed) 1)))
         (cg-net-disconnect)
         (cg-net-host-stop)))))
+
+
+;;;; --- New games added 2026-06-24: solitaires, trick games, Crazy Eights ---
+
+(ert-deftest cgt-sol-deck ()
+  (should (= 52 (length (cg-sol--make-deck 1))))
+  (should (= 104 (length (cg-sol--make-deck 2)))))
+
+(ert-deftest cgt-sol-klondike-deal ()
+  (let* ((g (cg-sol--deal (cg-klondike-game))))
+    (should (= 7 (oref g ncols)))
+    (dotimes (c 7)
+      (should (= (1+ c) (length (cg-sol--col g c))))
+      (should (= c (cg-sol--down g c)))
+      ;; top card is face up
+      (should (cg-sol--col-top g c)))
+    (should (= 24 (length (cg-get g :stock))))
+    (should (cl-every #'null (append (cg-get g :found) nil)))))
+
+(ert-deftest cgt-sol-freecell-deal ()
+  (let* ((g (cg-sol--deal (cg-freecell-game)))
+         (total 0))
+    (should (= 8 (oref g ncols)))
+    (dotimes (c 8) (cl-incf total (length (cg-sol--col g c)))
+             (should (= 0 (cg-sol--down g c))))
+    (should (= 52 total))
+    (should (null (cg-get g :stock)))
+    (should (= 4 (length (cg-get g :free))))))
+
+(ert-deftest cgt-sol-spider-deal ()
+  (let* ((g (cg-sol--deal (cg-spider-game)))
+         (total 0))
+    (should (= 10 (oref g ncols)))
+    (dotimes (c 10) (cl-incf total (length (cg-sol--col g c))))
+    (should (= 54 total))
+    (should (= 50 (length (cg-get g :stock))))
+    (dotimes (c 4) (should (= 6 (length (cg-sol--col g c)))))
+    (dotimes (k 6) (should (= 5 (length (cg-sol--col g (+ 4 k))))))))
+
+(ert-deftest cgt-sol-rules-alt ()
+  (let ((g (cg-klondike-game)))
+    ;; red 6 onto black 7 ok; black 6 onto black 7 no
+    (should (cg-sol--place-p g '(0 . 6) '(3 . 5)))      ; 7s under 6h
+    (should-not (cg-sol--place-p g '(0 . 6) '(1 . 5)))  ; 6c on 7s same color
+    (should (cg-sol--empty-accepts g '(0 . 12)))        ; king
+    (should-not (cg-sol--empty-accepts g '(0 . 11)))))  ; queen
+
+(ert-deftest cgt-sol-rules-spider ()
+  (let ((g (cg-spider-game)))
+    ;; build down any suit
+    (should (cg-sol--place-p g '(0 . 6) '(3 . 5)))
+    (should (cg-sol--place-p g '(0 . 6) '(1 . 5)))
+    ;; run cohesion requires same suit
+    (should (cg-sol--link-p g '(0 . 6) '(0 . 5)))
+    (should-not (cg-sol--link-p g '(0 . 6) '(1 . 5)))
+    (should (cg-sol--empty-accepts g '(0 . 3)))))
+
+(ert-deftest cgt-sol-top-run ()
+  (let ((g (cg-klondike-game)))
+    (cg-put g :tableau (vector (list '(0 . 9) '(2 . 8) '(1 . 7))))  ; 9s 8d 7c
+    (cg-put g :down (vector 0))
+    ;; 9s(black) 8d(red) 7c(black) is a valid alt run of 3
+    (should (= 3 (length (cg-sol--top-run g 0))))
+    ;; break color: 9s 8d 7d -> only 8d 7d? 7d red on 8d red invalid -> run is just 7d
+    (cg-put g :tableau (vector (list '(0 . 9) '(2 . 8) '(2 . 7))))
+    (should (= 1 (length (cg-sol--top-run g 0))))))
+
+(ert-deftest cgt-sol-move-col ()
+  (let ((g (cg-sol--deal (cg-klondike-game))))
+    ;; craft: col0 top = 7c(black), col1 top = 6h(red); move 6h onto 7c
+    (cg-put g :tableau (vector (list '(1 . 7)) (list '(3 . 6)) nil nil nil nil nil))
+    (cg-put g :down (vector 0 0 0 0 0 0 0))
+    (let ((cards (last (cg-sol--col g 1) 1)))
+      (should (cg-sol--can-drop g '(col . 0) cards))
+      (cg-sol--take g '(col . 1) 1)
+      (cg-sol--drop g '(col . 0) cards))
+    (should (equal '((1 . 7) (3 . 6)) (cg-sol--col g 0)))
+    (should (null (cg-sol--col g 1)))))
+
+(ert-deftest cgt-sol-foundation-and-win ()
+  (let ((g (cg-sol--deal (cg-klondike-game))))
+    ;; empty foundations: place an Ace then a 2 of same suit
+    (should (cg-sol--found-accepts g 0 '(0 . 0)))
+    (cg-sol--drop g '(found . 0) (list '(0 . 0)))
+    (should (cg-sol--found-accepts g 0 '(0 . 1)))
+    (should-not (cg-sol--found-accepts g 0 '(1 . 1)))
+    ;; build a winning state: fill all four foundations A..K
+    (let ((found (make-vector 4 nil)))
+      (dotimes (s 4)
+        (aset found s (cl-loop for r below 13 collect (cons s r))))
+      (cg-put g :found found))
+    (should (cg-won-p g))))
+
+(ert-deftest cgt-sol-spider-harvest ()
+  (let ((g (cg-sol--deal (cg-spider-game))))
+    ;; put a complete K..A spade run as the whole of column 0
+    (cg-put g :tableau (let ((v (cg-get g :tableau)))
+                         (aset v 0 (cl-loop for r from 12 downto 0 collect (cons 0 r)))
+                         v))
+    (cg-put g :down (let ((v (cg-get g :down))) (aset v 0 0) v))
+    (cg-put g :sets 0)
+    (cg-sol--harvest g)
+    (should (= 1 (cg-get g :sets)))
+    (should (null (cg-sol--col g 0)))))
+
+(ert-deftest cgt-sol-undo ()
+  (let ((g (cg-sol--deal (cg-klondike-game))))
+    (cg-put g :tableau (vector (list '(1 . 7)) (list '(3 . 6)) nil nil nil nil nil))
+    (cg-put g :down (vector 0 0 0 0 0 0 0))
+    (cg-sol--snapshot g)
+    (let ((cards (last (cg-sol--col g 1) 1)))
+      (cg-sol--take g '(col . 1) 1)
+      (cg-sol--drop g '(col . 0) cards))
+    (should (null (cg-sol--col g 1)))
+    (should (cg-sol--restore g))
+    (should (equal '((3 . 6)) (cg-sol--col g 1)))))
+
+(ert-deftest cgt-sol-render-builds ()
+  (dolist (cls '(cg-klondike-game cg-freecell-game cg-spider-game cg-yukon-game))
+    (let ((g (cg-sol--deal (make-instance cls))))
+      (should (stringp (cg-render g))))))
+
+(defun cgt--init-hearts ()
+  (let ((g (cg-hearts-game)))
+    (cg-put g :scores (make-vector 4 0))
+    (cg-trick--start-hand g) g))
+
+(defun cgt--init-spades ()
+  (let ((g (cg-spades-game)))
+    (cg-put g :scores (make-vector 4 0))
+    (cg-put g :bags (make-vector 2 0))
+    (cg-put g :dealer 3)
+    (cg-trick--deal g)
+    (cg-put g :bids (let ((v (make-vector 4 0)))
+                      (dotimes (s 4) (aset v s (cg-trick--ai-bid g s))) v))
+    (cg-trick--leader-init g) g))
+
+(ert-deftest cgt-trick-deal ()
+  (let ((g (cg-trick--deal (cg-hearts-game))))
+    (let ((tot 0))
+      (dotimes (s 4) (cl-incf tot (length (cg-trick--hand g s))))
+      (should (= 52 tot)))
+    (dotimes (s 4) (should (= 13 (length (cg-trick--hand g s)))))))
+
+(ert-deftest cgt-trick-winner-trump ()
+  (let ((g (cg-spades-game)))
+    ;; play order: S leads 10h, W 13h(K), N 2s(trump), E 12h
+    (cg-put g :trick (list (cons 3 '(3 . 11)) (cons 2 '(0 . 0))
+                           (cons 1 '(3 . 12)) (cons 0 '(3 . 8))))
+    ;; :trick is stored reversed (newest first); winner = North (trump)
+    (should (= 2 (cg-trick--winner g)))))
+
+(ert-deftest cgt-trick-winner-notrump ()
+  (let ((g (cg-hearts-game)))
+    ;; led hearts; highest heart wins (no trump)
+    (cg-put g :trick (list (cons 3 '(1 . 12)) (cons 2 '(3 . 12))
+                           (cons 1 '(3 . 5)) (cons 0 '(3 . 8))))
+    ;; North played Ace of hearts (3 . 12) -> winner North
+    (should (= 2 (cg-trick--winner g)))))
+
+(ert-deftest cgt-hearts-first-must-be-2c ()
+  (let* ((g (cgt--init-hearts))
+         (leader (cg-get g :turn)))
+    (let ((moves (cg-trick--legal-moves g leader)))
+      (should (equal moves '((1 . 0)))))))
+
+(ert-deftest cgt-hearts-full-hand ()
+  (let ((g (cgt--init-hearts)))
+    (cg-trick--simulate-hand g)
+    ;; 13 tricks distributed
+    (should (= 13 (apply #'+ (append (cg-get g :tricks) nil))))
+    ;; total points across players is 26 (no moon) or 78 (moon: 3*26)
+    (let ((tot (apply #'+ (append (cg-get g :scores) nil))))
+      (should (memq tot '(26 78))))))
+
+(ert-deftest cgt-hearts-many-hands ()
+  (let ((g (cgt--init-hearts)) (n 0))
+    (while (and (not (cg-trick--game-over-p g)) (< n 60))
+      (cg-trick--simulate-hand g)
+      (cl-incf n)
+      (unless (cg-trick--game-over-p g) (cg-trick--start-hand g)))
+    (should (cg-trick--game-over-p g))
+    (should (integerp (cg-trick--winner-seat g)))))
+
+(ert-deftest cgt-spades-bid-range ()
+  (let ((g (cg-trick--deal (cg-spades-game))))
+    (dotimes (s 4)
+      (let ((b (cg-trick--ai-bid g s)))
+        (should (and (>= b 1) (<= b 13)))))))
+
+(ert-deftest cgt-spades-full-hand ()
+  (let ((g (cgt--init-spades)))
+    (cg-trick--simulate-hand g)
+    (should (= 13 (apply #'+ (append (cg-get g :tricks) nil))))
+    ;; teammates share a score
+    (should (= (aref (cg-get g :scores) 0) (aref (cg-get g :scores) 2)))
+    (should (= (aref (cg-get g :scores) 1) (aref (cg-get g :scores) 3)))))
+
+(ert-deftest cgt-spades-full-game ()
+  (let ((g (cgt--init-spades)) (n 0))
+    (while (and (not (cg-trick--game-over-p g)) (< n 80))
+      (cg-trick--simulate-hand g)
+      (cl-incf n)
+      (unless (cg-trick--game-over-p g)
+        (cg-trick--deal g)
+        (cg-put g :bids (let ((v (make-vector 4 0)))
+                          (dotimes (s 4) (aset v s (cg-trick--ai-bid g s))) v))
+        (cg-trick--leader-init g)))
+    (should (cg-trick--game-over-p g))))
+
+(ert-deftest cgt-trick-ui-new-and-render ()
+  (dolist (cls '(cg-hearts-game cg-spades-game))
+    (let ((noninteractive t)
+          (g (make-instance cls)))
+      (cg-trick--new g)            ; spades bids via ai (noninteractive), hearts -> pass phase
+      (should (stringp (cg-render g)))
+      (should (memq (cg-get g :phase) '(pass play))))))
+(ert-deftest cgt-trick-ui-hearts-pass ()
+  (let* ((noninteractive t) (g (make-instance 'cg-hearts-game)))
+    (cg-trick--new g)
+    ;; hand 1 passes left; mark 3 cards from South and pass
+    (when (eq (cg-get g :phase) 'pass)
+      (cg-put g :marks (cl-subseq (cg-trick--sort (cg-trick--hand g 0)) 0 3))
+      (cg-trick--do-pass g)
+      (should (eq (cg-get g :phase) 'play))
+      ;; cards are conserved: hands plus the cards already played this trick
+      (let ((tot (length (cg-get g :trick))))
+        (dotimes (s 4) (cl-incf tot (length (cg-trick--hand g s))))
+        (should (= 52 tot))))))
+(ert-deftest cgt-trick-ui-spades-human-play ()
+  (let* ((noninteractive t) (g (make-instance 'cg-spades-game)))
+    (cg-trick--new g)              ; runs AI until South's turn
+    (should (eq (cg-get g :phase) 'play))
+    (should (= 0 (cg-get g :turn)))
+    ;; play a legal card for South, then run; eventually hand completes/scores
+    (let ((guard 0))
+      (while (and (eq (cg-get g :phase) 'play) (< guard 20)
+                  (= 0 (cg-get g :turn)))
+        (let ((card (car (cg-trick--legal-moves g 0))))
+          (cg-trick--play g 0 card)
+          (cg-trick--run g))
+        (cl-incf guard)))
+    (should (vectorp (cg-get g :scores)))))
+
+(ert-deftest cgt-eights-deal ()
+  (let* ((cg-eights-players 3) (g (cg-eights--deal (cg-eights-game))))
+    (should (= 3 (cg-get g :nplayers)))
+    (dotimes (s 3) (should (= 5 (length (cg-eights--hand g s)))))
+    (should (cg-eights--top g))
+    (should-not (= cg-eights--wild (cdr (cg-eights--top g))))))  ; starter not an eight
+(ert-deftest cgt-eights-legal ()
+  (let ((g (cg-eights-game)))
+    (cg-put g :discard (list '(0 . 3))) (cg-put g :suit 0)
+    (should (cg-eights--legal-p g '(0 . 8)))      ; same suit (spades)
+    (should (cg-eights--legal-p g '(1 . 3)))      ; same rank
+    (should (cg-eights--legal-p g '(2 . 6)))      ; eight (wild)
+    (should-not (cg-eights--legal-p g '(1 . 4))))) ; neither
+(ert-deftest cgt-eights-full-game ()
+  (let* ((cg-eights-players 4) (noninteractive t) (g (cg-eights--deal (cg-eights-game)))
+         (guard 0))
+    ;; drive entirely by AI from every seat
+    (while (and (eq (cg-get g :phase) 'play) (< guard 2000))
+      (cg-eights--ai-turn g (cg-get g :turn))
+      (when (>= (cg-get g :passes) (cg-get g :nplayers)) (cg-eights--deadlock g))
+      (cl-incf guard))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (integerp (cg-get g :winner)))))
+(ert-deftest cgt-eights-wild-sets-suit ()
+  (let* ((cg-eights-players 2) (g (cg-eights--deal (cg-eights-game))))
+    (cg-eights--set-hand g 0 (list '(3 . 6)))   ; the human holds only an eight
+    (cg-put g :discard (list '(0 . 3))) (cg-put g :suit 0)
+    (cg-eights--play g 0 '(3 . 6) 2)            ; play it, name diamonds (2)
+    (should (= 2 (cg-get g :suit)))
+    (should (eq (cg-get g :phase) 'game-over))))  
+
+;;;; --- Wave 2 (2026-06-24): Forty Thieves/Scorpion/Canfield, Golf/TriPeaks/Pyramid, Whist/Oh Hell, President ---
+
+(ert-deftest cgt-sol-forty-deal ()
+  (let ((g (cg-sol--deal (cg-forty-game))) (tot 0))
+    (should (= 10 (oref g ncols)))
+    (dotimes (c 10) (should (= 4 (length (cg-sol--col g c)))) (cl-incf tot 4))
+    (should (= 8 (oref g nfound)))
+    (should (= 64 (length (cg-get g :stock))))
+    (should (= 104 (+ tot (length (cg-get g :stock)))))))
+
+(ert-deftest cgt-sol-forty-no-redeal ()
+  (let ((g (cg-sol--deal (cg-forty-game))))
+    (cg-put g :stock nil) (cg-put g :waste '((0 . 0) (1 . 1)))
+    (cg-sol--stock-action g)            ; redeal nil -> stays empty
+    (should (null (cg-get g :stock)))))
+
+(ert-deftest cgt-sol-forty-win ()
+  (let ((g (cg-sol--deal (cg-forty-game))) (found (make-vector 8 nil)))
+    (dotimes (i 8) (aset found i (cl-loop for r below 13 collect (cons (mod i 4) r))))
+    (cg-put g :found found)
+    (should (cg-won-p g))))
+
+(ert-deftest cgt-sol-scorpion-deal ()
+  (let ((g (cg-sol--deal (cg-scorpion-game))) (tot 0))
+    (should (= 7 (oref g ncols)))
+    (dotimes (c 7) (should (= 7 (length (cg-sol--col g c)))) (cl-incf tot 7))
+    (dotimes (c 4) (should (= 3 (cg-sol--down g c))))
+    (dotimes (k 3) (should (= 0 (cg-sol--down g (+ 4 k)))))
+    (should (= 3 (length (cg-get g :stock))))
+    (should (= 0 (oref g nfound)))))
+
+(ert-deftest cgt-sol-scorpion-harvest-win ()
+  (let ((g (cg-sol--deal (cg-scorpion-game))))
+    (cg-put g :sets 3)
+    ;; place a complete K..A clubs run as column 0
+    (aset (cg-get g :tableau) 0 (cl-loop for r from 12 downto 0 collect (cons 1 r)))
+    (aset (cg-get g :down) 0 0)
+    (cg-sol--harvest g)
+    (should (= 4 (cg-get g :sets)))
+    (should (cg-won-p g))))
+
+(ert-deftest cgt-sol-canfield-deal ()
+  (let ((g (cg-sol--deal (cg-canfield-game))))
+    (should (= 13 (length (cg-get g :reserve))))
+    (should (= 1 (length (aref (cg-get g :found) 0))))
+    (dotimes (c 4) (should (= 1 (length (cg-sol--col g c)))))
+    (should (= 34 (length (cg-get g :stock))))
+    ;; base equals the rank of the first foundation card
+    (should (= (oref g base) (cdr (car (aref (cg-get g :found) 0)))))))
+
+(ert-deftest cgt-sol-canfield-base-wrap ()
+  (let ((g (cg-canfield-game)))
+    (oset g base 5) (oset g wrap t)
+    (cg-put g :found (make-vector 4 nil))
+    (should (cg-sol--found-accepts g 1 '(2 . 5)))       ; empty -> base rank 5
+    (should-not (cg-sol--found-accepts g 1 '(2 . 6)))
+    ;; wrap: a King on top accepts the Ace next
+    (aset (cg-get g :found) 0 (list '(0 . 12)))
+    (should (cg-sol--found-accepts g 0 '(0 . 0)))))
+
+(ert-deftest cgt-sol-canfield-autofill ()
+  (let ((g (cg-sol--deal (cg-canfield-game))))
+    (let ((rlen (length (cg-get g :reserve))))
+      (aset (cg-get g :tableau) 0 nil)   ; empty a column
+      (cg-sol--autofill g)
+      (should (= 1 (length (cg-sol--col g 0))))
+      (should (= (1- rlen) (length (cg-get g :reserve)))))))
+
+(ert-deftest cgt-pat-golf-deal ()
+  (let ((g (cg-pat--deal (cg-golf-game))))
+    (should (= 35 (length (cg-get g :cards))))
+    (should (= 16 (length (cg-get g :stock))))
+    (should (= 1 (length (cg-get g :waste))))
+    (should (= 7 (length (cg-pat--exposed g))))))   ; one per column (r=4)
+
+(ert-deftest cgt-pat-tripeaks-deal ()
+  (let ((g (cg-pat--deal (cg-tripeaks-game))))
+    (should (= 28 (length (cg-get g :cards))))
+    (should (= 23 (length (cg-get g :stock))))
+    (should (equal (number-sequence 18 27) (cg-pat--exposed g)))   ; base row
+    (should-not (cg-pat--exposed-p g 0))))                          ; apex covered
+
+(ert-deftest cgt-pat-pyramid-deal ()
+  (let ((g (cg-pat--deal (cg-pyramid-game))))
+    (should (= 28 (length (cg-get g :cards))))
+    (should (= 24 (length (cg-get g :stock))))
+    (should (null (cg-get g :waste)))
+    (should (equal (number-sequence 21 27) (cg-pat--exposed g)))   ; base row r=6
+    (should-not (cg-pat--exposed-p g 0))))                          ; apex covered by 1,2
+
+(ert-deftest cgt-pat-exposed-reveal ()
+  (let ((g (cg-pat--deal (cg-golf-game))))
+    ;; clear column 0's lower cards; slot 0 (top) becomes exposed
+    (dolist (i '(4 3 2 1)) (cg-pat--remove-slot g i))
+    (should (cg-pat--exposed-p g 0))))
+
+(ert-deftest cgt-pat-build-and-win ()
+  (let ((g (cg-pat--deal (cg-golf-game))))
+    ;; reduce to one exposed card adjacent to the waste top
+    (cg-put g :cards (let ((v (make-vector 35 nil))) (aset v 34 '(0 . 5)) v))
+    (cg-put g :waste (list '(1 . 4)))           ; 5 of clubs, rank 4; 6s is adjacent
+    (cg-put g :stock nil) (cg-put g :cursor 0)
+    (with-temp-buffer
+      (setq cg-pat--game g)
+      (cg-pat-act))                              ; plays slot 34 onto the waste
+    (should (null (aref (cg-get g :cards) 34)))
+    (should (cg-won-p g))))
+
+(ert-deftest cgt-pat-sum13 ()
+  (let ((g (cg-pat--deal (cg-pyramid-game))))
+    ;; King value is 13
+    (should (= 13 (cg-pat--value '(0 . 12))))
+    ;; mark two base cards summing to 13 -> both removed
+    (cg-put g :cards (let ((v (make-vector 28 nil)))
+                       (aset v 21 '(0 . 4)) (aset v 22 '(1 . 7)) v))  ; 5 (val5) + 8 (val8) = 13
+    (cg-put g :marks nil)
+    (cg-pat--toggle-mark g '(slot . 21))
+    (cg-pat--toggle-mark g '(slot . 22))
+    (should (null (aref (cg-get g :cards) 21)))
+    (should (null (aref (cg-get g :cards) 22)))))
+
+(ert-deftest cgt-pat-render ()
+  (dolist (cls '(cg-golf-game cg-tripeaks-game cg-pyramid-game))
+    (let ((g (cg-pat--deal (make-instance cls))))
+      (should (stringp (cg-render g))))))
+
+(defun cgt--drive (g limit)
+  "Play a whole match with AI for every seat, including the human seat 0."
+  (let ((n 0))
+    (while (and (not (cg-trick--game-over-p g)) (< n limit))
+      (when (eq (cg-get g :phase) 'play)
+        (cg-trick--play g (cg-get g :turn) (cg-trick--ai-play g (cg-get g :turn)))
+        (cg-trick--run g))
+      (cl-incf n))))
+
+(ert-deftest cgt-whist-deal-trump ()
+  (let ((noninteractive t) (g (make-instance 'cg-whist-game)))
+    (cg-trick--new g)
+    (should (memq (oref g trump) '(0 1 2 3)))
+    (let ((tot (length (cg-get g :trick))))
+      (dotimes (s 4) (cl-incf tot (length (cg-trick--hand g s))))
+      (should (= 52 tot)))))
+
+(ert-deftest cgt-whist-full-game ()
+  (let ((noninteractive t) (g (make-instance 'cg-whist-game)))
+    (cg-trick--new g)
+    (cgt--drive g 400)
+    (should (cg-trick--game-over-p g))
+    (should (integerp (cg-trick--winner-seat g)))))
+
+(ert-deftest cgt-ohhell-rounds ()
+  (let ((noninteractive t) (g (make-instance 'cg-ohhell-game)))
+    (cg-trick--new g)
+    ;; first round deals 7 cards each
+    (should (= 7 (length (cg-trick--hand g 0))))
+    (cgt--drive g 400)
+    (should (cg-trick--game-over-p g))
+    (should (= 7 (cg-get g :round)))            ; seven rounds played
+    (should (integerp (cg-trick--winner-seat g)))))
+
+(ert-deftest cgt-ohhell-exact-scoring ()
+  (let ((g (make-instance 'cg-ohhell-game)))
+    (cg-put g :scores (make-vector 4 0))
+    (cg-put g :round 0)
+    (cg-put g :bids (vector 2 0 1 3))
+    (cg-put g :tricks (vector 2 1 1 0))         ; seats 0 and 2 made exact bids
+    (cg-trick--score-hand g)
+    (should (= 12 (aref (cg-get g :scores) 0)))  ; 10 + 2
+    (should (= 0 (aref (cg-get g :scores) 1)))   ; bid 0 took 1 -> miss
+    (should (= 11 (aref (cg-get g :scores) 2)))  ; 10 + 1
+    (should (= 0 (aref (cg-get g :scores) 3)))))
+
+(ert-deftest cgt-whist-render ()
+  (let ((noninteractive t) (g (make-instance 'cg-whist-game)))
+    (cg-trick--new g) (should (stringp (cg-render g)))))
+
+(ert-deftest cgt-pres-power ()
+  (should (> (cg-pres--power 0) (cg-pres--power 12)))   ; the Two beats the Ace
+  (should (< (cg-pres--power 1) (cg-pres--power 11))))  ; 3 below King
+
+(ert-deftest cgt-pres-deal ()
+  (let* ((cg-president-players 4) (g (cg-pres--deal (cg-president-game))) (tot 0))
+    (should (= 4 (cg-get g :nplayers)))
+    (dotimes (s 4) (cl-incf tot (length (cg-pres--hand g s))))
+    (should (= 52 tot))
+    (should (= 0 (cg-get g :count)))))
+
+(ert-deftest cgt-pres-legal ()
+  (let ((g (cg-president-game)))
+    (cg-put g :hands (vector (list '(0 . 5) '(1 . 5) '(0 . 8)) nil nil nil))
+    (cg-put g :nplayers 4)
+    ;; leading: any rank ok
+    (cg-put g :count 0) (cg-put g :top -1)
+    (should (= 2 (length (cg-pres--legal-ranks g 0))))   ; ranks 5 and 8
+    ;; following a single of power 5: need power>5 -> only rank 8
+    (cg-put g :count 1) (cg-put g :top 5)
+    (should (equal '(8) (cg-pres--legal-ranks g 0)))
+    ;; following a PAIR: need 2 of a higher rank -> rank 5 has two but power 5 not >5; none
+    (cg-put g :count 2) (cg-put g :top 5)
+    (should (null (cg-pres--legal-ranks g 0)))))
+
+(ert-deftest cgt-pres-full-game ()
+  (let* ((cg-president-players 4) (g (cg-pres--deal (cg-president-game))) (n 0))
+    (while (and (eq (cg-get g :phase) 'play) (< n 5000))
+      (cg-pres--ai-move g (cg-get g :turn))
+      (cl-incf n))
+    (should (eq (cg-get g :phase) 'game-over))
+    (should (= 4 (length (cg-get g :order))))            ; everyone placed
+    (should (= 4 (length (delete-dups (copy-sequence (cg-get g :order)))))))) ; all distinct
+
+(ert-deftest cgt-pres-exchange ()
+  (let* ((cg-president-players 4) (g (cg-president-game)))
+    ;; simulate a prior finishing order, then deal and check the swap happened
+    (cg-put g :order '(2 3 1 0))   ; prez=2, scum=0
+    (cg-pres--deal g)
+    ;; conservation: still 52 cards across 4 hands after the exchange
+    (let ((tot 0)) (dotimes (s 4) (cl-incf tot (length (cg-pres--hand g s))))
+      (should (= 52 tot)))))
+
+(ert-deftest cgt-pres-render ()
+  (let ((g (cg-pres--deal (cg-president-game)))) (should (stringp (cg-render g)))))