From 1a5d23d39eb3d7dfcdeabc8e99c2673fd4937434 Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Sun, 16 Aug 2026 09:51:47 -0500 Subject: [PATCH] Replace bid-net advice with a dispatch seam; MELPA review cleanups Address riscy's first-pass review of MELPA PR #10147. * card-games-bid-ui.el (card-games-bid-submit): New generic; the four player commands validate once and submit through it. (card-games-bid-after-refresh-hook): New hook run after refresh. (card-games-bid-mode-map): Bind "s" here, not from bid-net at load. * card-games-bid-net.el (card-games-bid-client-game): New subclass whose card-games-bid-submit method forwards intents to the host. Remove all six top-level advice-adds and the top-level define-key. * card-games-bid.el (card-games-bid-inhibit-prompts): New variable replacing the nominate-suit advice. * card-games-core.el, card-games-gaps.el, card-games-crapette.el, card-games-solitaire.el, card-games-trick-ext.el, card-games-bid-ui.el: Docstring widths, checkdoc disambiguations, sharp-quoted defalias, derived-mode-p, require NOERROR. * test/card-games-tests.el: Six new tests pinning the no-advice contract and the dispatch seam. * Bump to 1.0.92; NEWS entry; regenerate README.md. Assisted-by: Claude:claude-fable-5 --- BE16.png | 95 +++++++++++ Makefile | 2 +- NEWS | 19 +++ README.md | 6 +- README.org | 6 +- ...b-vendoring-setup-shape-queries-Claude.log | 33 ++++ card-games-bid-net.el | 150 ++++-------------- card-games-bid-ui.el | 82 +++++++--- card-games-bid.el | 15 +- card-games-bridge.el | 2 +- card-games-core.el | 10 +- card-games-crapette.el | 4 +- card-games-cribbage.el | 2 +- card-games-eights.el | 2 +- card-games-gaps.el | 8 +- card-games-handfoot.el | 2 +- card-games-match.el | 2 +- card-games-net.el | 2 +- card-games-patience.el | 2 +- card-games-pkg.el | 2 +- card-games-president.el | 2 +- card-games-render.el | 2 +- card-games-rum500.el | 2 +- card-games-rummy.el | 2 +- card-games-scopa.el | 2 +- card-games-solitaire.el | 7 +- card-games-spite.el | 2 +- card-games-svg.el | 2 +- card-games-trick-ext.el | 5 +- card-games-trick.el | 2 +- card-games.el | 2 +- doc/version.texi | 2 +- test/card-games-tests.el | 67 ++++++++ 33 files changed, 359 insertions(+), 186 deletions(-) create mode 100644 BE16.png create mode 100644 avalon-github-vendoring-setup-shape-queries-Claude.log diff --git a/BE16.png b/BE16.png new file mode 100644 index 0000000..632ef11 --- /dev/null +++ b/BE16.png @@ -0,0 +1,95 @@ + + + + + + + + Potential Threat Detected + + + + + + + + + + + + + + + +
+ +
+
+

This site could be risky

+
+
+

Advanced Security blocked access to

+

+
+
+

This site might compromise your device or contain high-risk content.

+

To avoid these risks, we recommend avoiding this site.

+
+
+ Visit anyway +
+
+ +
+

Ce site pourrait compromettre la sécurité

+
+
+

La fonction de Sécurité avancée a bloqué l’accès à

+

+
+
+

Pour éviter ces risques, nous recommandons d’éviter ce site.

+

Ce site pourrait compromettre votre appareil ou contenir du contenu présentant un risque élevé.

+
+
+ Visitez le site malgré tout +
+
+ +
+

Este sitio podría ser arriesgado

+
+
+

Advanced Security bloqueó el acceso a

+

+
+
+

Este sitio puede poner en peligro a tu dispositivo o tener contenido de alto riesgo.

+

Para evitar estos riesgos, recomendamos evitar este sitio.

+
+
+ Visitar de todos modos +
+
+ + +
+

Questo sito potrebbe essere pericoloso

+
+
+

Wifi Sicuro ha bloccato l'accesso a

+

+
+
+

Questo sito potrebbe compromettere il dispositivo o includere contenuti ad alto rischio.

+

Per evitare questi rischi, consigliamo di non visitare questo sito.

+
+
+ Visita comunque +
+
+ + + + + diff --git a/Makefile b/Makefile index 7928785..f322d9b 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ # Makefile for card-games -- byte-compile, test, and package. EMACS ?= emacs PKG = card-games -VERSION = 1.0.91 +VERSION = 1.0.92 # Source files in dependency order (card-games-core first). EL = card-games-core.el card-games-svg.el card-games-render.el card-games-net.el card-games-bid.el card-games-gaps.el card-games-bid-ui.el card-games-bid-net.el card-games-solitaire.el card-games-trick.el card-games-eights.el card-games-patience.el card-games-president.el card-games-rummy.el card-games-rum500.el card-games-handfoot.el card-games-match.el card-games-cribbage.el card-games-scopa.el card-games-trick-ext.el card-games-spite.el card-games-bridge.el card-games-crapette.el card-games.el ELC = $(EL:.el=.elc) diff --git a/NEWS b/NEWS index 91faeb2..8fa3e6e 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,25 @@ card-games NEWS -- user-visible changes ======================================== +* Version 1.0.92 (pretest3: MELPA review) + +** Packaging and internals + - The networked 500 client no longer patches game commands with + advice. Player commands submit their action through the new + ~card-games-bid-submit~ generic; a joining Emacs plays a + ~card-games-bid-client-game~, whose method forwards each intent to + the host. Behaviour is unchanged, and the client now shares the + solo game's turn and legality checks exactly. + - The host broadcasts from the new ~card-games-bid-after-refresh-hook~ + instead of advising the refresh loop, and prompts that cannot reach + a remote player are suppressed with ~card-games-bid-inhibit-prompts~. + - The lobby start key ~s~ is defined in ~card-games-bid-mode-map~ + itself rather than pushed in when the network layer loads. + - Byte-compile and checkdoc are warning-clean across the package + (docstring widths, ambiguous doc references, ~derived-mode-p~, a + sharp-quoted ~defalias~, and ~require~'s NOERROR argument), from + MELPA review feedback (thanks riscy). + * Version 1.0.91 (pretest2: playtest) ** Documentation diff --git a/README.md b/README.md index 123a038..096b31e 100644 --- a/README.md +++ b/README.md @@ -175,9 +175,9 @@ with its command. From the menu you can also switch the card treatment ## From the package tarball - make package # builds card-games-1.0.91.tar + make package # builds card-games-1.0.92.tar -Then in Emacs: `M-x package-install-file RET card-games-1.0.91.tar`. +Then in Emacs: `M-x package-install-file RET card-games-1.0.92.tar`. ## With `use-package` @@ -246,7 +246,7 @@ mouse: click cards, board slots, buttons, and the slider. # Testing -This is a 1.0.91 pre-test snapshot. To try it: +This is a 1.0.92 pre-test snapshot. To try it: 1. `make compile && make test` – should be warning-free and all green. 2. `M-x card-games` opens the menu, or jump straight in, e.g. diff --git a/README.org b/README.org index f3ee790..08cc218 100644 --- a/README.org +++ b/README.org @@ -151,9 +151,9 @@ with its command. From the menu you can also switch the card treatment * Install ** From the package tarball #+begin_src -make package # builds card-games-1.0.91.tar +make package # builds card-games-1.0.92.tar #+end_src -Then in Emacs: ~M-x package-install-file RET card-games-1.0.91.tar~. +Then in Emacs: ~M-x package-install-file RET card-games-1.0.92.tar~. ** With ~use-package~ Once the package is on your ~load-path~ (installed from the tarball or an @@ -213,7 +213,7 @@ mouse: click cards, board slots, buttons, and the slider. [[file:doc/images/hearts.png]] * Testing -This is a 1.0.91 pre-test snapshot. To try it: +This is a 1.0.92 pre-test snapshot. To try it: 1. ~make compile && make test~ -- should be warning-free and all green. 2. ~M-x card-games~ opens the menu, or jump straight in, e.g. ~M-x card-games-klondike~, ~M-x card-games-bid~ (500), ~M-x card-games-gin~, ~M-x card-games-handfoot~. diff --git a/avalon-github-vendoring-setup-shape-queries-Claude.log b/avalon-github-vendoring-setup-shape-queries-Claude.log new file mode 100644 index 0000000..079028a --- /dev/null +++ b/avalon-github-vendoring-setup-shape-queries-Claude.log @@ -0,0 +1,33 @@ +note we can query here; something wrong with blow code.bru.st push auth in the command? +On branch master +Your branch is up to date with 'upstream/master'. + +You are in the middle of an am session. + (fix conflicts and then run "git am --continue") + (use "git am --skip" to skip this patch) + (use "git am --abort" to restore the original branch) + +Untracked files: + (use "git add ..." to include in what will be committed) + BE16.png + avalon-github-vendoring-setup-shape-queries-Claude.log + +nothing added to commit but untracked files present (use "git add" to track) +git version 2.54.0 +winupdater.recentlyseenversion=2.25.0.windows.1 +user.email=corwin@bru.st +user.name=Corwin Brust +github.user=mplscorwin +transfer.fsckobjects=true +gui.recentrepo=G:/git/emacs-30-patches +git@github.com: Permission denied (publickey). +gh-exit:255 +Permission denied, please try again. +brust-exit:0 +origin git@github.com:mplscorwin/melpa-cg.git (fetch) +origin git@github.com:mplscorwin/melpa-cg.git (push) +02288397 Add recipe for nu-ts-mode (#10045) +25dcef28 Add recipe for promptu (#10139) +bfd86a93 Update recipe for sol-mode (#10134) +## add-card-games +?? recipes/card-games diff --git a/card-games-bid-net.el b/card-games-bid-net.el index 657b77e..67f9c3d 100644 --- a/card-games-bid-net.el +++ b/card-games-bid-net.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -59,11 +59,6 @@ East, so it is chance, not arrival order, that decides who partners whom." (defvar card-games-bid--net-seat 0 "This player's absolute seat in a live game (the host is always 0).") -(defvar card-games-bid--applying-remote nil - "Bound non-nil while the host applies a remote player's move. -While set, prompts that would block the host (such as nominating a suit -for a Joker lead) fall back to an automatic choice.") - ;;;; Per-seat state filter (host -> client) (defun card-games-bid--rot (x seat) @@ -176,26 +171,14 @@ non-nil when the move was legal and applied, so the host broadcasts." (card-games-bid--hand game seat) (card-games-get game :led) (card-games-bid-trump (card-games-get game :contract))))) - (let ((card-games-bid--applying-remote t)) (card-games-bid--play game seat card)) + (let ((card-games-bid-inhibit-prompts t)) + (card-games-bid--play game seat card)) (setq ok t)))) (when ok - (let ((card-games-bid--applying-remote t)) (card-games-bid--run game)) + (let ((card-games-bid-inhibit-prompts t)) (card-games-bid--run game)) (card-games-bid--net-host-refresh)) ok)) -(defun card-games-bid--net-nominate-advice (orig game seat) - "Around advice for `card-games-bid--nominate-suit'. -While the host applies a remote move (ORIG GAME SEAT), pick the longest -suit automatically instead of prompting." - (if card-games-bid--applying-remote - (let ((counts (make-vector 4 0)) (best 0)) - (dolist (c (card-games-bid--hand game seat)) - (unless (card-games-bid-joker-p c) (cl-incf (aref counts (car c))))) - (dotimes (s 4) (when (> (aref counts s) (aref counts best)) (setq best s))) - best) - (funcall orig game seat))) -(advice-add 'card-games-bid--nominate-suit :around #'card-games-bid--net-nominate-advice) - ;;;; Host bookkeeping and display (defun card-games-bid--net-host-refresh () @@ -204,11 +187,11 @@ suit automatically instead of prompting." (when (buffer-live-p buf) (with-current-buffer buf (card-games-bid--redisplay))))) -(defun card-games-bid--net-broadcast-advice (&rest _) - "After advice on `card-games-bid--refresh' that broadcasts when hosting." +(defun card-games-bid--net-broadcast () + "Broadcast fresh per-seat state to every client when hosting. +Runs from `card-games-bid-after-refresh-hook'." (when (and (eq card-games-bid--net-role 'host) (card-games-net-hosting-p)) (card-games-net-host-broadcast))) -(advice-add 'card-games-bid--refresh :after #'card-games-bid--net-broadcast-advice) (defun card-games-bid--net-lobby-display () "Show the host's pre-game lobby of seats." @@ -246,7 +229,7 @@ The host keeps South (seat 0)." (when card-games-bid-shuffle-partners (card-games-bid--net-shuffle-seats)) (setq card-games-bid--human-seats (cl-remove-duplicates card-games-bid--human-seats)) (card-games-bid--deal game 3) - (let ((card-games-bid--applying-remote t)) (card-games-bid--run game)) + (let ((card-games-bid-inhibit-prompts t)) (card-games-bid--run game)) (card-games-bid--net-host-refresh) (card-games-net-host-broadcast))) @@ -281,108 +264,40 @@ The host keeps South (seat 0)." (goto-char (point-min))) (card-games-bid--redisplay)))))) -;;;; Client move interception +;;;; Client game: intents go to the host -(defun card-games-bid--net-client-bid-advice (orig) - "Around advice on `card-games-bid-make-bid' (ORIG): send the bid, do not apply it." - (if (eq card-games-bid--net-role 'client) - (let ((game card-games-bid--game)) - (if (or (not (eq (card-games-get game :phase) 'auction)) - (/= (card-games-get game :bidder) 0)) - (progn (card-games-put game :message "Not your turn to bid.") - (card-games-bid--redisplay)) - (let* ((legal (card-games-bid--legal-bids game)) - (completion-ignore-case t) - (choices (append - (mapcar (lambda (b) - (cons (format "%-4s %s (%d)" - (card-games-bid--code b) - (card-games-bid-name b) - (card-games-bid-value b)) - b)) - legal) - '(("Pass" . pass)))) - (pick (completing-read - "Your bid (e.g. 7H, 8NT, NL; or Pass): " - (mapcar #'car choices) nil t)) - (sel (cdr (assoc pick choices)))) - (card-games-net-send-move (if (eq sel 'pass) '(pass) (list 'bid sel))) - (card-games-put game :message "Bid sent — waiting…") - (card-games-bid--redisplay)))) - (funcall orig))) -(advice-add 'card-games-bid-make-bid :around #'card-games-bid--net-client-bid-advice) +(defclass card-games-bid-client-game (card-games-bid-game) () + "A 500 game whose authoritative state lives at a remote host. +Submitting an action forwards the player's intent over the wire; the +host validates it, applies it to the canonical game, and broadcasts a +per-seat view back (see `card-games-bid-submit').") -(defun card-games-bid--net-client-pass-advice (orig) - "Around advice on `card-games-bid-pass' (ORIG): send a pass, do not apply it." - (if (eq card-games-bid--net-role 'client) - (let ((game card-games-bid--game)) - (if (or (not (eq (card-games-get game :phase) 'auction)) - (/= (card-games-get game :bidder) 0)) - (progn (card-games-put game :message "Not your turn to bid.") - (card-games-bid--redisplay)) - (card-games-net-send-move '(pass)) - (card-games-put game :message "Pass sent — waiting…") - (card-games-bid--redisplay))) - (funcall orig))) -(advice-add 'card-games-bid-pass :around #'card-games-bid--net-client-pass-advice) - -(defun card-games-bid--net-client-select-advice (orig) - "Around advice on `card-games-bid-select' (ORIG): send a play, or mark locally." - (if (eq card-games-bid--net-role 'client) - (let* ((game card-games-bid--game) - (phase (card-games-get game :phase)) - (card (card-games-bid--current-card))) - (pcase phase - ('kitty - (when (eql (card-games-get game :contractor) 0) - (let ((marks (card-games-get game :marks))) - (card-games-put game :marks (if (member card marks) - (remove card marks) - (cons card marks))) - (card-games-put game :message - (format "%d of 5 marked for discard." - (length (card-games-get game :marks)))) - (card-games-bid--redisplay)))) - ('play - (cond - ((/= (card-games-get game :turn) 0) - (card-games-put game :message "Not your turn.") (card-games-bid--redisplay)) - ((null card) (card-games-bid--redisplay)) - (t (card-games-net-send-move (list 'play card)) - (card-games-put game :message "Card sent — waiting…") - (card-games-bid--redisplay)))) - (_ (card-games-bid--redisplay)))) - (funcall orig))) -(advice-add 'card-games-bid-select :around #'card-games-bid--net-client-select-advice) - -(defun card-games-bid--net-client-discard-advice (orig) - "Around advice on `card-games-bid-discard-marked' (ORIG): send the discard intent." - (if (eq card-games-bid--net-role 'client) - (let* ((game card-games-bid--game) (marks (card-games-get game :marks))) - (cond - ((not (eq (card-games-get game :phase) 'kitty)) - (card-games-put game :message "Nothing to discard now.") (card-games-bid--redisplay)) - ((/= (length marks) 5) - (card-games-put game :message - (format "Mark exactly 5 (have %d)." (length marks))) - (card-games-bid--redisplay)) - (t (card-games-net-send-move (cons 'discard marks)) - (card-games-put game :marks nil) - (card-games-put game :message "Discard sent — waiting…") - (card-games-bid--redisplay)))) - (funcall orig))) -(advice-add 'card-games-bid-discard-marked :around #'card-games-bid--net-client-discard-advice) +(cl-defmethod card-games-bid-submit ((game card-games-bid-client-game) action) + "Send ACTION to the host and note in GAME that a reply is pending. +The shared validation has already run in the calling command; the host +remains authoritative and validates again before applying." + (card-games-net-send-move action) + (when (eq (car action) 'discard) + (card-games-put game :marks nil)) + (card-games-put game :message + (format "%s sent — waiting…" + (pcase (car action) + ('bid "Bid") ('pass "Pass") + ('discard "Discard") ('play "Card")))) + (card-games-bid--redisplay)) ;;;; Commands +;;;###autoload (defun card-games-bid-start-now () - "Start a hosted game immediately, AI filling any empty seats." + "Start a hosted game immediately, AI filling any empty seats. +Bound to \`s' in `card-games-bid-mode-map'; outside a hosted lobby it +only explains itself." (interactive) (if (and (eq card-games-bid--net-role 'host) (eq (card-games-get card-games-bid--game :phase) 'lobby)) (card-games-bid--net-start) (message "Not hosting a lobby."))) -(define-key card-games-bid-mode-map "s" #'card-games-bid-start-now) ;;;###autoload (defun card-games-bid-host (port) @@ -400,6 +315,7 @@ The host keeps South (seat 0)." (card-games-net-host-start card-games-bid--game port) (setf (card-games-net-host-next-seat card-games-net--host) 1) (add-hook 'card-games-net-connect-functions #'card-games-bid--net-on-connect) + (add-hook 'card-games-bid-after-refresh-hook #'card-games-bid--net-broadcast) (card-games-bid--net-lobby-display)) (switch-to-buffer buf) (message "Hosting 500 on port %d — waiting for players (press s to start)." @@ -414,7 +330,7 @@ The host keeps South (seat 0)." (let ((buf (get-buffer-create "*500 Bid*"))) (with-current-buffer buf (card-games-bid-mode) - (setq card-games-bid--game (make-instance 'card-games-bid-game) + (setq card-games-bid--game (make-instance 'card-games-bid-client-game) card-games-bid--net-role 'client card-games-bid--human-seats '(0)) (card-games-put card-games-bid--game :phase 'lobby) diff --git a/card-games-bid-ui.el b/card-games-bid-ui.el index 5b07176..2dd8ac6 100644 --- a/card-games-bid-ui.el +++ b/card-games-bid-ui.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -333,7 +333,8 @@ Folds the controls into the single action-button row (see ;;;; Interaction -(defvar-local card-games-bid--game nil "The `card-games-bid-game' in the current buffer.") +(defvar-local card-games-bid--game nil + "The 500 game object played in the current buffer.") (defun card-games-bid--mode-line (game) "Return a mode-line status string for GAME." @@ -430,8 +431,14 @@ The treatment is chosen by `card-games-bid--treatment' and dispatched with (card-games-renderer-draw renderer game) (goto-char (point-min)))) +(defvar card-games-bid-after-refresh-hook nil + "Normal hook run after `card-games-bid--refresh' settles the table. +The network layer adds to it while hosting, broadcasting each settled +state to the connected clients.") + (defun card-games-bid--refresh () - "Advance AI to the next human action, animating each turn if enabled." + "Advance AI to the next human action, animating each turn if enabled. +Runs `card-games-bid-after-refresh-hook' once the table has settled." (let ((game card-games-bid--game)) (if (or (not card-games-bid-animate) (<= card-games-bid-ai-delay 0)) (progn (card-games-bid--run game) (card-games-bid--redisplay)) @@ -447,7 +454,8 @@ The treatment is chosen by `card-games-bid--treatment' and dispatched with card-games-bid-ai-delay)) t))))) (card-games-bid--redisplay)) - (card-games-bid--announce game))) + (card-games-bid--announce game) + (run-hooks 'card-games-bid-after-refresh-hook))) (defun card-games-bid-left () "Move the hand cursor left." @@ -466,6 +474,24 @@ The treatment is chosen by `card-games-bid--treatment' and dispatched with "Return the card under the hand cursor." (nth (card-games-get card-games-bid--game :cursor) (card-games-get card-games-bid--game :sorted-hand))) +(cl-defgeneric card-games-bid-submit (game action) + "Submit ACTION for the South player of GAME. +ACTION is (bid BID), (pass), (discard CARD...) or (play CARD), already +validated by the calling command. The base method applies it to the +local game; `card-games-bid-client-game' (see `card-games-bid-net') +overrides this to forward the intent to the hosting Emacs instead.") + +(cl-defmethod card-games-bid-submit ((game card-games-bid-game) action) + "Apply ACTION for seat 0 directly to the local GAME, then refresh." + (pcase action + (`(bid ,bid) (card-games-bid--auction-act game 0 bid)) + (`(pass) (card-games-bid--auction-act game 0 nil)) + (`(discard . ,cards) + (card-games-bid--discard game (card-games-get game :contractor) cards) + (card-games-put game :marks nil)) + (`(play ,card) (card-games-bid--play game 0 card))) + (card-games-bid--refresh)) + (defun card-games-bid-select () "Play (in play phase) or mark/unmark (in kitty phase) the current card." (interactive) @@ -491,16 +517,19 @@ The treatment is chosen by `card-games-bid--treatment' and dispatched with (format "%d of 5 marked for discard." np)))))) (card-games-bid--redisplay)))) ('play - (if (/= (card-games-get game :turn) 0) - (progn (card-games-put game :message "Not your turn.") (card-games-bid--redisplay)) - (let ((legal (card-games-bid-legal-cards (card-games-bid--hand game 0) - (card-games-get game :led) - (card-games-bid-trump (card-games-get game :contract))))) - (if (not (member card legal)) - (progn (card-games-put game :message "Illegal — you must follow suit.") - (card-games-bid--redisplay)) - (card-games-bid--play game 0 card) - (card-games-bid--refresh))))) + (cond + ((/= (card-games-get game :turn) 0) + (card-games-put game :message "Not your turn.") + (card-games-bid--redisplay)) + ((null card) (card-games-bid--redisplay)) + ((not (member card (card-games-bid-legal-cards + (card-games-bid--hand game 0) + (card-games-get game :led) + (card-games-bid-trump + (card-games-get game :contract))))) + (card-games-put game :message "Illegal — you must follow suit.") + (card-games-bid--redisplay)) + (t (card-games-bid-submit game (list 'play card))))) (_ (card-games-bid--redisplay))))) (defun card-games-bid-discard-marked () @@ -514,9 +543,7 @@ The treatment is chosen by `card-games-bid--treatment' and dispatched with ((/= (length marks) 5) (card-games-put game :message (format "Mark exactly 5 (have %d)." (length marks))) (card-games-bid--redisplay)) - (t (card-games-bid--discard game (card-games-get game :contractor) marks) - (card-games-put game :marks nil) - (card-games-bid--refresh))))) + (t (card-games-bid-submit game (cons 'discard marks)))))) (defun card-games-bid--code (bid) "Return a short ASCII code for BID, e.g. \"7H\", \"8NT\", \"NL\"." @@ -547,8 +574,8 @@ Type a short code such as 7H, 8NT, NL (case-insensitive)." (pick (completing-read "Your bid (e.g. 7H, 8NT, NL; or Pass): " (mapcar #'car choices) nil t)) (sel (cdr (assoc pick choices)))) - (card-games-bid--auction-act game 0 (if (eq sel 'pass) nil sel)) - (card-games-bid--refresh))))) + (card-games-bid-submit game + (if (eq sel 'pass) '(pass) (list 'bid sel))))))) (defun card-games-bid-pass () "Pass during the auction." @@ -558,8 +585,7 @@ Type a short code such as 7H, 8NT, NL (case-insensitive)." (/= (card-games-get game :bidder) 0)) (progn (card-games-put game :message "Not your turn to bid.") (card-games-bid--redisplay)) - (card-games-bid--auction-act game 0 nil) - (card-games-bid--refresh)))) + (card-games-bid-submit game '(pass))))) (defun card-games-bid-new () "Advance to the next hand, or start a fresh game once one is over. @@ -627,6 +653,8 @@ must be played out (unlike the solitaire games)." (interactive) (card-games-bid--redisplay)) +(declare-function card-games-bid-start-now "card-games-bid-net" ()) + (defvar card-games-bid-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "") #'card-games-bid-left) @@ -637,6 +665,7 @@ must be played out (unlike the solitaire games)." (define-key map "x" #'card-games-bid-discard-marked) (define-key map "g" #'card-games-bid-redraw) (define-key map "n" #'card-games-bid-new) + (define-key map "s" #'card-games-bid-start-now) (define-key map "?" #'card-games-bid-help) (define-key map "+" #'card-games-bid-zoom-in) (define-key map "=" #'card-games-bid-zoom-in) @@ -727,7 +756,8 @@ per-deal, so the hand always fits the table." (apply #'svg-text svg str a))) (defun card-games-bid--ui-label (svg str x y &optional size) - "Draw STR as an all-caps, letter-spaced section label on SVG (font SIZE, default 10)." + "Draw STR at X,Y as an all-caps, letter-spaced label on SVG. +SIZE is the font size in pixels, defaulting to 10." (svg-text svg (upcase str) :x (round x) :y (round y) :font-size (round (or size 10)) :fill "#8fc79b" :text-anchor "start" :font-family card-games-svg-font-family :font-weight "bold" :letter-spacing "2")) @@ -857,7 +887,8 @@ nullo bids share the bottom row." (list (+ gx (* col (+ cw g))) (+ gy (* row (+ ch g))) cw ch)))) (defun card-games-bid--grid-pass-cell (gx gy cw ch g) - "Return (X Y W H) for the double-width Pass button, from GX GY CW CH G (cols 3-4)." + "Return (X Y W H) for the double-width Pass button (columns 3-4). +GX GY are the grid origin, CW CH the cell size, and G the gutter." (list (+ gx (* 3 (+ cw g))) (+ gy (* 5 (+ ch g))) (+ (* 2 cw) g) ch)) (defun card-games-bid--draw-left-panel (svg game h lpw fs ccy) @@ -1160,7 +1191,7 @@ When `card-games-bid-svg-fill', size the canvas to fill the window." (defun card-games-bid--fit (&rest _) "Re-render the SVG-UI to fit the window after a configuration change." (when (and card-games-bid--game card-games-bid-svg-ui card-games-bid-svg-fill - (eq major-mode 'card-games-bid-mode)) + (derived-mode-p 'card-games-bid-mode)) (let ((win (get-buffer-window (current-buffer)))) (when win (let ((sz (cons (window-body-width win t) (window-body-height win t)))) @@ -1196,7 +1227,8 @@ Elsewhere, fall back to normal buffer scrolling." ((or 'wheel-up 'mouse-4) (card-games-bid-log-up)) ((or 'wheel-down 'mouse-5) (card-games-bid-log-down)))))) (unless handled - (ignore-errors (require 'mwheel) (mwheel-scroll event))))) + (when (require 'mwheel nil t) + (ignore-errors (mwheel-scroll event)))))) (defun card-games-bid--region-bid (px py rg) "Return the bid at PX,PY within REGIONS RG, or nil." diff --git a/card-games-bid.el b/card-games-bid.el index 3bb3974..92975f7 100644 --- a/card-games-bid.el +++ b/card-games-bid.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -217,6 +217,12 @@ Trumps lead (strongest first), then each side suit runs high to low." (defvar card-games-bid--human-seats '(0) "List of seats controlled by a human player. South is seat 0.") +(defvar card-games-bid-inhibit-prompts nil + "When non-nil, choices that would prompt fall back to the AI's pick. +The network layer binds this while the host applies a remote player's +move: the seat belongs to a human, but one at another Emacs, so a +local minibuffer prompt could never reach them.") + (defconst card-games-bid-seat-names ["South" "West" "North" "East"] "Seat labels; partners sit opposite (0/2 and 1/3).") @@ -412,9 +418,12 @@ Trumps lead (strongest first), then each side suit runs high to low." (card-games-put game :turn (card-games-bid--next-seat game seat))))) (defun card-games-bid--nominate-suit (game seat) - "Choose the suit GAME SEAT nominates when the Joker leads under no-trump." + "Choose the suit GAME SEAT nominates when the Joker leads under no-trump. +A local human is prompted; the AI, or a human seat while +`card-games-bid-inhibit-prompts' is non-nil, takes the longest suit." (let ((hand (card-games-bid--hand game seat))) - (if (card-games-bid--human-p seat) + (if (and (card-games-bid--human-p seat) + (not card-games-bid-inhibit-prompts)) (let ((ch (read-char-choice "Joker leads — nominate a suit [s]pades [c]lubs [d]iamonds [h]earts: " '(?s ?c ?d ?h)))) diff --git a/card-games-bridge.el b/card-games-bridge.el index d4f44e7..2884ac8 100644 --- a/card-games-bridge.el +++ b/card-games-bridge.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-core.el b/card-games-core.el index d7ebb15..bc712c3 100644 --- a/card-games-core.el +++ b/card-games-core.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -165,9 +165,9 @@ for their own actions and delegate the rest with `cl-call-next-method'." (_ nil))) (defvar card-games-renderers nil - "Alist mapping a treatment name (a symbol) to a `card-games-renderer' subclass. -Populate it with `card-games-register-renderer' and look entries up with -`card-games-make-renderer'.") + "Alist mapping a treatment name (a symbol) to a renderer subclass. +Populate it with `card-games-register-renderer' and look entries up +with `card-games-make-renderer'.") (defun card-games-register-renderer (name class) "Register renderer CLASS (an EIEIO class) under the treatment NAME." @@ -291,7 +291,7 @@ size slider and `text-scale-increase' enlarge the cards." (max 0.3 (min 4.0 (* card-games-card-scale (expt 1.15 amt)))))) (defvar-local card-games-current-game nil - "The `card-games-game' shown in the current buffer (for shared mouse/zoom).") + "The game object shown in the current buffer (for shared mouse/zoom).") (defvar-local card-games-redisplay-function #'ignore "Buffer-local function that redraws the current game's buffer.") diff --git a/card-games-crapette.el b/card-games-crapette.el index e11c37e..8bd14dd 100644 --- a/card-games-crapette.el +++ b/card-games-crapette.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -88,7 +88,7 @@ Set to nil to force the plain-text board everywhere." "Two-player Russian Bank (Crapette): you (South) versus one AI opponent.") (defvar-local card-games-crap--game nil - "The `card-games-crapette-game' played in the current buffer.") + "The Crapette game object played in the current buffer.") (defvar card-games-crap--recording t "When nil, `card-games-crap--snapshot' does not record (used during the AI turn).") diff --git a/card-games-cribbage.el b/card-games-cribbage.el index 46bb28e..321a49a 100644 --- a/card-games-cribbage.el +++ b/card-games-cribbage.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-eights.el b/card-games-eights.el index 164d136..8590e0f 100644 --- a/card-games-eights.el +++ b/card-games-eights.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-gaps.el b/card-games-gaps.el index f7b7e19..05718cc 100644 --- a/card-games-gaps.el +++ b/card-games-gaps.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -106,7 +106,7 @@ Subclasses set the head rank and build direction by overriding (cl-defmethod card-games-gaps--step ((_ card-games-acre-game)) "Hell's Half-Acre builds down, -1 per column." -1) (cl-defmethod card-games-gaps--vname ((_ card-games-acre-game)) "Return Hell's Half-Acre's display name." "Hell's Half-Acre") -(defalias 'card-games-gaps--shuffle 'card-games-shuffle) +(defalias 'card-games-gaps--shuffle #'card-games-shuffle) (defun card-games-gaps--full-deck () "Return the 48 playable cards (Two..King in every suit)." @@ -387,7 +387,7 @@ Only used when `card-games-gaps-svg-ui' is enabled." ;;;; Interaction (defvar-local card-games-gaps--game nil - "The `card-games-gaps-game' object played in the current buffer.") + "The gaps-family game object played in the current buffer.") (defun card-games-gaps--goto-cell (r c) "Move point onto the rendered cell at row R column C, if present." @@ -782,7 +782,7 @@ The board scales to fill the area beside a proportional left panel." (defun card-games-gaps--fit (&rest _) "Re-render the full-SVG gaps UI to fit the window after a config change." (when (and card-games-gaps--game card-games-gaps-svg-ui card-games-gaps-svg-fill - (eq major-mode 'card-games-gaps-mode)) + (derived-mode-p 'card-games-gaps-mode)) (let ((win (get-buffer-window (current-buffer)))) (when win (let ((sz (cons (window-body-width win t) (window-body-height win t)))) diff --git a/card-games-handfoot.el b/card-games-handfoot.el index 366f0fc..cdfe7c3 100644 --- a/card-games-handfoot.el +++ b/card-games-handfoot.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-match.el b/card-games-match.el index c6970a1..0cc8bf8 100644 --- a/card-games-match.el +++ b/card-games-match.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-net.el b/card-games-net.el index c870e60..f68d635 100644 --- a/card-games-net.el +++ b/card-games-net.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-patience.el b/card-games-patience.el index eda33a6..153468a 100644 --- a/card-games-patience.el +++ b/card-games-patience.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-pkg.el b/card-games-pkg.el index 8157305..fb109f6 100644 --- a/card-games-pkg.el +++ b/card-games-pkg.el @@ -1,5 +1,5 @@ ;;; card-games-pkg.el --- Package metadata -*- no-byte-compile: t; -*- -(define-package "card-games" "1.0.91" +(define-package "card-games" "1.0.92" "Play card games (console UNICODE and graphical SVG)." '((emacs "26.1")) :keywords '("games") diff --git a/card-games-president.el b/card-games-president.el index 7f6df8a..6e87084 100644 --- a/card-games-president.el +++ b/card-games-president.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-render.el b/card-games-render.el index 8499958..b9b8fea 100644 --- a/card-games-render.el +++ b/card-games-render.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-rum500.el b/card-games-rum500.el index cd929b4..8fa041b 100644 --- a/card-games-rum500.el +++ b/card-games-rum500.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-rummy.el b/card-games-rummy.el index 6b197eb..4a90d26 100644 --- a/card-games-rummy.el +++ b/card-games-rummy.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-scopa.el b/card-games-scopa.el index a2ece6f..d424d2e 100644 --- a/card-games-scopa.el +++ b/card-games-scopa.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-solitaire.el b/card-games-solitaire.el index 99d22a5..129ae3a 100644 --- a/card-games-solitaire.el +++ b/card-games-solitaire.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -967,8 +967,9 @@ DISPLAY is a propertized one-image string; REGIONS is a click map of (redeal :initform t) (build :initform 'alt) (run-rule :initform 'alt) (empty-rule :initform 'any) (base :initform 0) (wrap :initform nil) (vname :initform "Russian Bank")) - "Russian Bank patience: eight houses down by alternating colour, four -foundations up by suit from the Ace, and a thirteen-card reserve.") + "Russian Bank patience. +Eight houses build down by alternating colour, four foundations build +up by suit from the Ace, and a thirteen-card reserve feeds the game.") (cl-defmethod card-games-sol--deal ((game card-games-russian-bank-game)) "Deal GAME's Russian Bank layout: reserve, eight houses, and a stock." diff --git a/card-games-spite.el b/card-games-spite.el index f70b41b..016a90f 100644 --- a/card-games-spite.el +++ b/card-games-spite.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-svg.el b/card-games-svg.el index eed5abe..b78636e 100644 --- a/card-games-svg.el +++ b/card-games-svg.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games-trick-ext.el b/card-games-trick-ext.el index c4c997f..f2b4319 100644 --- a/card-games-trick-ext.el +++ b/card-games-trick-ext.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -218,7 +218,8 @@ POWERFN, LEDFN rank cards; VALUEFN gives a card's point worth." (t t))))))) (cl-defmethod card-games-trick--play ((game card-games-pitch-game) seat card) - "In GAME, set trump from the pitcher's first lead (SEAT plays CARD), then play on." + "In GAME, set trump from the pitcher's first lead, then play on. +SEAT plays CARD as usual once trump is fixed." (when (and (null (oref game trump)) (null (card-games-get game :trick))) (oset game trump (car card)) (card-games-put game :message diff --git a/card-games-trick.el b/card-games-trick.el index cc45477..b311986 100644 --- a/card-games-trick.el +++ b/card-games-trick.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/card-games.el b/card-games.el index 58a9db3..52da0d8 100644 --- a/card-games.el +++ b/card-games.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.91 +;; Version: 1.0.92 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/doc/version.texi b/doc/version.texi index 0380b8a..d29997b 100644 --- a/doc/version.texi +++ b/doc/version.texi @@ -1,3 +1,3 @@ -@set VERSION 1.0.91 +@set VERSION 1.0.92 @set UPDATED 1 July 2026 @set YEAR 2026 diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 2059265..78a805d 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -1837,3 +1837,70 @@ left a 15-card hand in play." (should card-games-sol-svg-cards) (should-not card-games-bid-svg-ui)) (dolist (pr saved) (set (car pr) (cdr pr))) (setq card-games-treatment savedt)))) + +;;;; Live 500: dispatch seam replaces advice (MELPA review, PR #10147) + +(defun cgt--advised-p (symbol) + "Return non-nil when SYMBOL carries any advice." + (let (found) + (advice-mapc (lambda (&rest _) (setq found t)) symbol) + found)) + +(ert-deftest cgt-bid-net-no-advice () + "Loading the net layer must not install advice on bid functions." + (require 'card-games-bid-net) + (dolist (sym '(card-games-bid--nominate-suit card-games-bid--refresh + card-games-bid-make-bid card-games-bid-pass + card-games-bid-select card-games-bid-discard-marked)) + (should-not (cgt--advised-p sym)))) + +(ert-deftest cgt-bid-submit-local () + "`card-games-bid-submit' applies an action locally on a base game." + (let ((game (make-instance 'card-games-bid-game)) calls) + (cl-letf (((symbol-function 'card-games-bid--auction-act) + (lambda (_g seat bid) (push (list 'act seat bid) calls))) + ((symbol-function 'card-games-bid--refresh) + (lambda () (push 'refresh calls)))) + (card-games-bid-submit game '(pass))) + (should (equal (reverse calls) '((act 0 nil) refresh))))) + +(ert-deftest cgt-bid-submit-client () + "`card-games-bid-submit' on a client game sends and never applies." + (require 'card-games-bid-net) + (let ((game (make-instance 'card-games-bid-client-game)) sent applied) + (cl-letf (((symbol-function 'card-games-net-send-move) + (lambda (move) (push move sent))) + ((symbol-function 'card-games-bid--auction-act) + (lambda (&rest _) (setq applied t))) + ((symbol-function 'card-games-bid--redisplay) #'ignore)) + (card-games-bid-submit game '(pass))) + (should (equal sent '((pass)))) + (should-not applied) + (should (equal (card-games-get game :message) "Pass sent — waiting…")))) + +(ert-deftest cgt-bid-nominate-inhibit () + "Inhibited prompts fall back to the AI pick for a human seat." + (require 'card-games-bid-net) + (let ((game (make-instance 'card-games-bid-game))) + (card-games-put game :hands (vector '((2 . 5) (2 . 6) (0 . 14)) nil nil nil)) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (&rest _) (error "Prompted despite inhibit")))) + (let ((card-games-bid-inhibit-prompts t) + (card-games-bid--human-seats '(0))) + (should (= (card-games-bid--nominate-suit game 0) 2)))))) + +(ert-deftest cgt-bid-after-refresh-hook () + "`card-games-bid--refresh' runs `card-games-bid-after-refresh-hook'." + (let ((game (make-instance 'card-games-bid-game)) ran) + (cl-letf (((symbol-function 'card-games-bid--run) #'ignore) + ((symbol-function 'card-games-bid--redisplay) #'ignore) + ((symbol-function 'card-games-bid--announce) #'ignore)) + (let ((card-games-bid--game game) + (card-games-bid-animate nil) + (card-games-bid-after-refresh-hook (list (lambda () (setq ran t))))) + (card-games-bid--refresh))) + (should ran))) + +(ert-deftest cgt-bid-start-now-key () + "The lobby start key lives in the owner keymap, not a load-time patch." + (should (eq (lookup-key card-games-bid-mode-map "s") 'card-games-bid-start-now)))