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:
parent
1a59003b13
commit
6379127e17
8 changed files with 180 additions and 15 deletions
113
LIFT.md
Normal file
113
LIFT.md
Normal 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.
|
||||||
12
Makefile
12
Makefile
|
|
@ -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' \
|
||||||
|
|
|
||||||
|
|
@ -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"
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
||||||
35
cg-core.el
35
cg-core.el
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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))
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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 ()
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue