cg-core: make cg-shuffle optionally seeded and reproducible

cg-shuffle gains an optional SEED and a `cg-shuffle-seed' dynamic var.
With a seed the order is deterministic and identical on every platform,
so a deal can be replayed, shared between players, or pinned in a test;
the index comes from secure-hash (spec-defined output everywhere, 7 hex
digits stay a fixnum even on 32-bit Emacs), so no bignum/overflow
behaviour can vary it.  With no seed the shuffle is the byte-for-byte
old system-random path -- normal play is unchanged.

Test cgt-shuffle-seeded pins determinism, permutation, override and a
cross-platform golden prefix; fails on the prior one-arg cg-shuffle.
Suite 159/159.
This commit is contained in:
Corwin Brust 2026-08-03 22:18:02 -05:00
parent 1a59003b13
commit 6379127e17
8 changed files with 180 additions and 15 deletions

113
LIFT.md Normal file
View file

@ -0,0 +1,113 @@
# LIFT · card-game — CANDIDATE
Session 2026-08-03. Everything here is CANDIDATE until Corwin says otherwise.
Scope: only the repo (`card-game.el`) was mounted — not the `card-game` project
wrapper the brief named, not `dungeon`, not `c4/`. The sandbox had no system
Emacs (apt blocked, non-root), but the recorded micromamba recipe delivered a
userspace Emacs 30 — so the oracle below was RUN this session, not quoted.
## 1. What it IS
**card-games** v1.0.91 ("pretest2: playtest"): a GNU ELPA-style Emacs package
of ~30 card games over one small EIEIO engine (`cg-core.el`, 324 lines).
Abstract `cg-game` (name + plist `env` + current renderer) with `cg-render` /
`cg-won-p` generics; family base classes (`cg-solitaire-game`, `cg-trick-game`,
`cg-rummy-game``cg-tablemeld-game`, `cg-fish-game`, `cg-patience-game`,
`cg-gaps-game`) carry shared rules; each game is a small subclass. Display is a
separate seam: renderer "skins" (`text`, `svg`, `svg-fill`) registered by name,
each mapping clicks back to game actions via rectangle→action region lists.
Cards are `(SUIT . RANK)` conses, suits indexed 0=♠ 1=♣ 2=♦ 3=♥, rank scales
per-game, `nil` = empty slot. Ships an Info manual, a Makefile exposing the
full lifecycle, network play for 500 (`cg-bid-host`/`cg-bid-join`), and a
150-test ERT suite. Maintenance-stage; published at code.bru.st/corwin/card-game.
## 2. The oracle (the ONE thing that already fails loudly)
**`make test` — test/card-games-tests.el, 150 `ert-deftest`s, batch exit
nonzero on any failure — and `release:` refuses to package without it**
(`release: distclean version readme test tarball`). The suite header documents
the exact no-make invocation:
emacs -Q --batch -L . -L test -l test/card-games-tests.el \
-f ert-run-tests-batch-and-exit
**RUN this session** (userspace Emacs 30, tree exported from git HEAD objects
into /tmp — no mount-desync exposure): **150/150 passed, 0 unexpected, 15.4s,
exit 0** (2026-08-03 20:07:52-0500). Secondary gate also run: batch
byte-compile of all 24 EL files — **clean, zero warnings**. Remaining gate
family not run here: `checkdoc`, `lint`.
## 3. What C4 takes FROM it
Each claim names the tool that fails it.
- **The renderer-seam pattern.** One game model, N display treatments,
registered by name, never subclassing the game per treatment; clicks map
back through declared `(RECT . ACTION)` regions; `cg-color` degrades to a
drawable fallback in batch/terminal. This is the house answer to "one truth,
two representations" for any C4 surface with console + graphical faces.
*Fails-it:* `cgt-render-registry` and kin in the suite.
- **Taxonomy-by-family engine reuse.** Engine → family base → thin game
subclass; 30 games prove the substrate. The C4RP shared-substrate story
working in miniature. *Fails-it:* the per-family ERT groups.
- **The oracle discipline itself.** One test file, one batch line, wired into
`make test` and gating `release`. rewire-order says go first with the
project that has an oracle — this one HAS one. *Fails-it:* itself.
- **Org→MD canonicity, implemented.** README.org is source; `build.el` (ox-md,
never-signal, `CARD_GAMES_ORG` override) exports; a pre-commit hook keeps
README.md in step. ORG-NATIVE stance made mechanical. *Fails-it (host):*
`make readme && git diff --exit-code README.md` — empty diff = in step.
Not proven here (needs Emacs); the md-newer-than-org mtimes are consistent
but mtime is never a tiebreaker.
- **Version fan-out.** Single `VERSION` in the Makefile; `make version`
regenerates `doc/version.texi`; bump patch z for every releasable set.
*Fails-it (ran, passed):* `grep '^;; Version:' *.el | sort -u` — one value,
1.0.91, across 24 headers + Makefile + pkg.el + version.texi.
- **Scars kept as comments.** The release tar archives an explicit file list
because ".": "the growing output tarball … is never read mid-write — which
is what caused 'tar: .: file changed as we read it'." The failure mode rides
with the fix. Liftable practice, not just this instance.
## 4. Vocabulary (for the `dungeon:cards` negotiation)
Dungeon is not mounted; I cannot see its side. This is card-game's offer,
one-sided, plus the C4 terms this repo does not use.
**card-game has, C4/dungeon must match or map:** card `(SUIT . RANK)`;
**suit index order 0♠ 1♣ 2♦ 3♥** (black-black-red-red — NOT bridge order
♣♦♥♠; first and likeliest silent-drift item, negotiate before any shared
register); per-game rank scales (no global ace-high/low); `joker`; `nil` =
empty slot; `sister-suit` (same-colour partner); renderer/"skin"/"treatment";
`env` (per-game plist); region/action click maps; pile nouns — foundation,
tableau, stock, waste, reserve, cell, gap, hand, trick, book, bags, meld,
house (Russian Bank), crib/peg, capture. Shuffle is Fisher-Yates over Emacs
`random` — seedability for replay/net determinism is a negotiation point,
not currently a promise.
**C4 has, this repo does not:** run-level, oracle (the word; it has the
thing), vocab/register, lift, candidate/canon, run-card, instrument. The repo
predates the register; nothing in it will collide, but nothing anchors it
either.
## 5. Run-level evidence (guess was ~4)
The Makefile exposes the lifecycle as named signals: `compile`, `test`,
`checkdoc`, `lint`, `package`, `elpa`, `release`, `info`, `hooks` — with
self-test gating release, install via standard package.el, and enablement via
`M-x card-game` plus a shipped Info manual. From this sandbox I verified only
static signals. The run-level scale itself lives in `c4/`, deliberately not
mounted — I hold no instrument for the pin; evidence reads at-or-above the
guess, and the pin stays with Corwin.
## 6. Session receipts
- No system Emacs (uid 1174, apt blocked); micromamba userspace Emacs 30
worked (recipe from session memory). Oracle run 150/150; compile clean.
Mount-vs-HEAD spot-check agreed on 4 files before the run (no desync seen).
- Memory drift found and corrected in session notes: tree is at 1.0.91 /
30 games / 150 tests (notes said 1.0.60 / 5 games / 88).
- org-c4 brief arrived in the same paste; org-c4 is not mounted — not
executable here, untouched.
- Git reads were object-reads only (`git log`); no index-touching commands
on the mount. Tree tarballs and `*~` files are `.gitignore`d by design.
- This file is untracked on purpose: CANDIDATE, his pen to bless, never mine.

View file

@ -20,7 +20,7 @@ TEXI2PDF ?= texi2pdf
README = README.md README = README.md
EXTRA = README.org $(README) $(PKGDESC) $(MANUAL) $(VERTEXI) $(IMAGES) EXTRA = README.org $(README) $(PKGDESC) $(MANUAL) $(VERTEXI) $(IMAGES)
.PHONY: all compile test clean distclean checkdoc lint package tarball elpa release help \ .PHONY: all compile test clean distclean checkdoc lint check package tarball elpa release help \
info info-emacs html pdf docclean version readme hooks info info-emacs html pdf docclean version readme hooks
help: help:
@ -29,6 +29,7 @@ help:
@echo " test run the ERT test suite" @echo " test run the ERT test suite"
@echo " checkdoc run checkdoc on all sources" @echo " checkdoc run checkdoc on all sources"
@echo " lint run package-lint (if installed)" @echo " lint run package-lint (if installed)"
@echo " check compile + checkdoc + lint + test (the full gate)"
@echo " version regenerate $(VERTEXI) from VERSION" @echo " version regenerate $(VERTEXI) from VERSION"
@echo " readme export README.org -> README.md (Emacs batch)" @echo " readme export README.org -> README.md (Emacs batch)"
@echo " hooks install the git pre-commit hook" @echo " hooks install the git pre-commit hook"
@ -50,8 +51,13 @@ compile:
test: test:
$(BATCH) -L test -l test/$(PKG)-tests.el -f ert-run-tests-batch-and-exit $(BATCH) -L test -l test/$(PKG)-tests.el -f ert-run-tests-batch-and-exit
# One gate a contributor (or CI) can run: the same quality tools MELPA
# asks for -- byte-compile, checkdoc, package-lint -- plus the ERT suite.
check: compile checkdoc lint test
@echo "card-games $(VERSION): compile + checkdoc + lint + tests all green"
checkdoc: checkdoc:
$(BATCH) --eval "(progn (dolist (f '($(EL))) (checkdoc-file f)))" $(BATCH) --eval "(progn (dolist (f '($(EL))) (checkdoc-file (symbol-name f))))"
lint: lint:
-$(BATCH) --eval "(progn (require 'package) (package-initialize) \ -$(BATCH) --eval "(progn (require 'package) (package-initialize) \
@ -82,7 +88,7 @@ elpa: tarball
# (not ".") so the growing output tarball and editor lock files are never # (not ".") so the growing output tarball and editor lock files are never
# read mid-write -- which is what caused "tar: .: file changed as we read it". # read mid-write -- which is what caused "tar: .: file changed as we read it".
SRCFILES = $(EL) $(EXTRA) build.el hooks Makefile .gitignore test SRCFILES = $(EL) $(EXTRA) build.el hooks Makefile .gitignore test
release: distclean version readme test tarball release: distclean version readme check tarball
rm -f $(SRCTAR) rm -f $(SRCTAR)
tar --transform 's,^,$(TARDIR)/,' \ tar --transform 's,^,$(TARDIR)/,' \
--exclude='*.elc' --exclude='*.tar' --exclude='*.tar.gz' \ --exclude='*.elc' --exclude='*.tar' --exclude='*.tar.gz' \

View file

@ -1,6 +1,6 @@
;;; card-games-pkg.el --- Package metadata -*- no-byte-compile: t; -*- ;;; card-games-pkg.el --- Package metadata -*- no-byte-compile: t; -*-
(define-package "card-games" "1.0.91" (define-package "card-games" "1.0.91"
"Play card games in Emacs (console UNICODE and graphical SVG)." "Play card games (console UNICODE and graphical SVG)."
'((emacs "26.1")) '((emacs "26.1"))
:keywords '("games") :keywords '("games")
:url "https://code.bru.st/corwin/card-game.el" :url "https://code.bru.st/corwin/card-game.el"

View file

@ -1,4 +1,4 @@
;;; card-games.el --- Play card games in Emacs (console + SVG) -*- lexical-binding: t; -*- ;;; card-games.el --- Play card games (console + SVG) -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Corwin Brust ;; Copyright (C) 2026 Corwin Brust

View file

@ -216,12 +216,39 @@ Normalised to a boolean so callers may compare two results with `eq'
"Return the other suit index of the same colour as SUIT." "Return the other suit index of the same colour as SUIT."
(pcase suit (0 1) (1 0) (2 3) (3 2))) (pcase suit (0 1) (1 0) (2 3) (3 2)))
(defun cg-shuffle (seq) (defvar cg-shuffle-seed nil
"Return a new list with the elements of SEQ in random order." "When non-nil, `cg-shuffle' is deterministic, seeded by this value.
The value may be a number or a string. Bind it around a deal to
reproduce that deal exactly -- for replays, for a deal shared between
players, or for a repeatable test -- and the same seed yields the same
order on every platform Emacs runs on. nil (the default) means an
unpredictable shuffle drawn from the system `random'.")
(defun cg-shuffle--seeded-index (seed i limit)
"Return a deterministic index in [0, LIMIT) for step I under SEED.
Uses `secure-hash', whose output is identical on every platform and
Emacs build, so a seeded deal is reproducible and shareable. The 7
hex digits taken span 28 bits, which stays a fixnum even on a 32-bit
Emacs, so no bignum or overflow behaviour can vary the result."
(let ((r (string-to-number
(substring (secure-hash 'sha256 (format "%s|%d" seed i)) 0 7)
16)))
(mod r limit)))
(defun cg-shuffle (seq &optional seed)
"Return a new list with the elements of SEQ in random order.
With a non-nil SEED, or a non-nil `cg-shuffle-seed', the shuffle is
deterministic: the same seed produces the same order on every platform,
so a deal can be replayed or shared between players. An explicit SEED
overrides `cg-shuffle-seed'. The seed may be a number or a string.
With no seed the order is unpredictable (system `random')."
(let* ((v (vconcat seq)) (let* ((v (vconcat seq))
(n (length v))) (n (length v))
(seed (or seed cg-shuffle-seed)))
(dotimes (i n) (dotimes (i n)
(let ((j (+ i (random (- n i))))) (let ((j (+ i (if seed
(cg-shuffle--seeded-index seed i (- n i))
(random (- n i))))))
(cl-rotatef (aref v i) (aref v j)))) (cl-rotatef (aref v i) (aref v j))))
(append v nil))) (append v nil)))

View file

@ -318,7 +318,7 @@ TOTAL is the running count after the play."
(cl-labels ((txt (str x y &optional sz bold) (cl-labels ((txt (str x y &optional sz bold)
(apply #'svg-text svg str :x x :y y :font-size (or sz 12) :fill lc (apply #'svg-text svg str :x x :y y :font-size (or sz 12) :fill lc
:font-family cg-svg-font-family (and bold '(:font-weight "bold")))) :font-family cg-svg-font-family (and bold '(:font-weight "bold"))))
(peg (label sc y) (cg-crib--peg (label sc y)
(txt label pad (+ y 11) 12) (txt label pad (+ y 11) 12)
(let ((bx (+ pad 90))) (let ((bx (+ pad 90)))
(svg-rectangle svg bx y barw peg-h :rx 4 :fill "none" (svg-rectangle svg bx y barw peg-h :rx 4 :fill "none"
@ -334,8 +334,8 @@ TOTAL is the running count after the play."
(cg-svg-card svg xx y :rank (car sp) :suit (cdr sp))) (cg-svg-card svg xx y :rank (car sp) :suit (cdr sp)))
(setq xx (+ xx (round (* w 0.5)))))))) (setq xx (+ xx (round (* w 0.5))))))))
(txt (format "Cribbage (to %d)" target) pad (+ y-title 12) 13 t) (txt (format "Cribbage (to %d)" target) pad (+ y-title 12) 13 t)
(peg "You" (aref scores 0) y-peg) (cg-crib--peg "You" (aref scores 0) y-peg)
(peg "Computer" (aref scores 1) (+ y-peg peg-h peg-gap)) (cg-crib--peg "Computer" (aref scores 1) (+ y-peg peg-h peg-gap))
(txt (format "%s deals" (cg-crib--who (cg-get game :dealer))) (txt (format "%s deals" (cg-crib--who (cg-get game :dealer)))
(+ pad 90 barw 60) (+ y-peg 11) 11) (+ pad 90 barw 60) (+ y-peg 11) 11)
(let ((mx pad)) (let ((mx pad))

View file

@ -199,7 +199,7 @@ strings inside MSG have their text properties stripped first, by
(lambda (proc string) (lambda (proc string)
(let ((buf (concat (or (process-get proc 'cg-net-buf) "") string)) (let ((buf (concat (or (process-get proc 'cg-net-buf) "") string))
(start 0) nl) (start 0) nl)
(while (setq nl (string-search "\n" buf start)) (while (setq nl (cl-search "\n" buf :start2 start))
(let ((line (substring buf start nl))) (let ((line (substring buf start nl)))
(setq start (1+ nl)) (setq start (1+ nl))
(unless (string-empty-p line) (unless (string-empty-p line)
@ -208,8 +208,7 @@ strings inside MSG have their text properties stripped first, by
(if (cg-net--valid-p msg types) (if (cg-net--valid-p msg types)
(funcall handler proc (cg-net--scrub msg)) (funcall handler proc (cg-net--scrub msg))
(message "cg-net: dropped malformed message"))) (message "cg-net: dropped malformed message")))
(error (message "cg-net: bad message: %S" err))))) (error (message "cg-net: bad message: %S" err))))))
)
(let ((rest (substring buf start))) (let ((rest (substring buf start)))
(if (> (length rest) cg-net-max-line) (if (> (length rest) cg-net-max-line)
(progn (progn

View file

@ -262,6 +262,26 @@ known :type built from plain data; anything else never reaches
(setcdr (cdr cyc) cyc) (setcdr (cdr cyc) cyc)
(should-not (cg-net--valid-p (list :type 'move :move cyc) '(hello move))))) (should-not (cg-net--valid-p (list :type 'move :move cyc) '(hello move)))))
;;;; Seeded shuffle
(ert-deftest cgt-shuffle-seeded ()
"A seeded shuffle is deterministic, portable, and a true permutation;
the unseeded shuffle keeps its system-random behaviour. Opening #4."
(let ((deck (number-sequence 0 51)))
;; same seed -> identical order (FAILS on HEAD: cg-shuffle takes 1 arg)
(should (equal (cg-shuffle deck 12345) (cg-shuffle deck 12345)))
;; still a permutation of the input, nothing dropped or duplicated
(should (equal (sort (copy-sequence (cg-shuffle deck 12345)) #'<) deck))
;; different seeds -> different order (almost surely)
(should-not (equal (cg-shuffle deck 1) (cg-shuffle deck 2)))
;; the dynamic variable seeds it too, and an explicit seed overrides it
(should (equal (let ((cg-shuffle-seed "deal-A")) (cg-shuffle deck))
(let ((cg-shuffle-seed "deal-A")) (cg-shuffle deck))))
(should (equal (cg-shuffle deck 7)
(let ((cg-shuffle-seed "ignored")) (cg-shuffle deck 7))))
;; portability pin: this exact prefix must hold on every platform
(should (equal (seq-take (cg-shuffle deck "GOLDEN") 6) '(15 20 35 24 31 23)))))
;;;; Gaps ;;;; Gaps
(ert-deftest cgt-gaps-deal () (ert-deftest cgt-gaps-deal ()