diff --git a/.gitignore b/.gitignore index e5f2d10..0edcb84 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ /card-games-*.tar /card-games-*-src.tar.gz *.sketch +*~ diff --git a/Makefile b/Makefile index d77e1ff..359ba3b 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.60 +VERSION = 1.0.90 # Source files in dependency order (cg-core first). EL = cg-core.el cg-svg.el cg-render.el cg-net.el cg-bid.el cg-gaps.el cg-bid-ui.el cg-bid-net.el cg-solitaire.el cg-trick.el cg-eights.el cg-patience.el cg-president.el cg-rummy.el cg-rum500.el cg-handfoot.el cg-match.el cg-cribbage.el cg-scopa.el cg-trick-ext.el cg-spite.el cg-bridge.el card-games.el ELC = $(EL:.el=.elc) diff --git a/README.org b/README.org index ad42a09..9a939c7 100644 --- a/README.org +++ b/README.org @@ -119,17 +119,19 @@ with its command. * TODO - [X] make the suit symbols customizable (~cg-symbols~) and obey them - [ ] a Texinfo manual +- [ ] finish ~checkdoc~ docstrings across the per-game files + (the shared engine files are clean; ~make compile~ is warning-free) - [ ] renderer "skins": let games subclass the display components (text, SVG, full-window SVG) -- [ ] a manual card-size control for the full-window SVG UI +- [X] a manual card-size control for the full-window SVG UI - [ ] more games * Install ** From the package tarball #+begin_src -make package # builds card-games-1.0.60.tar +make package # builds card-games-1.0.90.tar #+end_src -Then in Emacs: ~M-x package-install-file RET card-games-1.0.60.tar~. +Then in Emacs: ~M-x package-install-file RET card-games-1.0.90.tar~. ** From a local ELPA archive #+begin_src @@ -162,8 +164,23 @@ graphical display. - 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. +On a graphical display, ~v~ toggles the full-window SVG table. A +*Card size* slider (and the ~+~ / ~-~ / ~0~ keys) resizes the cards, and +in 500 the ~? Help / Rules~ button explains play. Every game accepts the +mouse: click cards, board slots, buttons, and the slider. + +* Testing +This is a 1.0.90 pre-test snapshot. To try it: +1. ~make compile && make test~ -- should be warning-free and all green. +2. ~M-x card-game~ opens the menu, or jump straight in, e.g. + ~M-x cg-klondike~, ~M-x cg-bid~ (500), ~M-x cg-gin~, ~M-x cg-handfoot~. +3. On a graphical display, press ~v~ in 500 for the full-window SVG + table and play entirely with the mouse: click a bid, click five kitty + cards and the *Discard* button, click cards to play, move the *Card + size* slider, and open ~? Help / Rules~. + +Feedback most wanted: anything a mouse-only player who is new to Emacs +finds confusing or unreachable, rules bugs, and rendering glitches. * Customization ~M-x customize-group RET cg-svg~ and ~RET card-games~: diff --git a/card-games-pkg.el b/card-games-pkg.el index 9bf10e7..3a3cfa3 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.60" +(define-package "card-games" "1.0.90" "Play card games in Emacs (console UNICODE and graphical SVG)." '((emacs "26.1")) :keywords '("games") diff --git a/card-games.el b/card-games.el index b9b783b..eb75ac5 100644 --- a/card-games.el +++ b/card-games.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -147,7 +147,7 @@ Each entry is (NAME COMMAND DESCRIPTION); `card-game' lists them.") (define-derived-mode card-game-mode special-mode "Card-Games" "Major mode for the `card-game' chooser." - (setq-local cursor-type nil)) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun card-game () diff --git a/cg-bid-net.el b/cg-bid-net.el index 29ae018..9367a97 100644 --- a/cg-bid-net.el +++ b/cg-bid-net.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/cg-bid-ui.el b/cg-bid-ui.el index e4d23a5..ba7e578 100644 --- a/cg-bid-ui.el +++ b/cg-bid-ui.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -173,6 +173,11 @@ the left, and a scrollable message log on the right." South hand, re-fitting on window changes. Only used when `cg-bid-svg-ui'." :type 'boolean :group 'cg-svg) +(defcustom cg-bid-card-scale 1.0 + "Card-size multiplier for the South hand in the full-SVG 500 UI. +Driven by the on-screen card-size slider and the +/-/0 keys." + :type 'number :group 'cg-svg) + (defun cg-bid--header-text (game) "Return the header lines (scores, contract, tricks) for GAME." @@ -345,24 +350,28 @@ Folds the controls into the single action-button row (see ('gameover " [Game over — n]") (_ ""))) +(defun cg-bid--phase-text (game) + "Return a short prompt describing what to do now in GAME." + (pcase (cg-get game :phase) + ('auction (if (= (cg-get game :bidder) 0) + "Your turn to bid — click a bid, or Pass." + (format "Waiting for %s to bid..." + (aref cg-bid-seat-names (cg-get game :bidder))))) + ('kitty (if (cg-bid--human-p (cg-get game :contractor)) + "Click 5 cards to discard, then Discard." + (format "%s is exchanging the kitty..." + (aref cg-bid-seat-names (cg-get game :contractor))))) + ('play (if (= (cg-get game :turn) 0) + "Your turn — click a card to play." + (format "Waiting for %s to play..." + (aref cg-bid-seat-names (cg-get game :turn))))) + ('done (or (cg-get game :hand-result) (cg-get game :message))) + ('gameover (or (cg-get game :message) "Game over — click New game.")) + (_ (cg-get game :message)))) + (defun cg-bid--announce (game) "Echo a prompt or status describing what to do now in GAME." - (message "%s" - (pcase (cg-get game :phase) - ('auction (if (= (cg-get game :bidder) 0) - "Your turn to bid — press b to bid (e.g. 7H) or p to pass." - (format "Waiting for %s to bid..." - (aref cg-bid-seat-names (cg-get game :bidder))))) - ('kitty (if (cg-bid--human-p (cg-get game :contractor)) - "You won the bid — mark five cards (RET) then press x to discard." - (format "%s is exchanging the kitty..." - (aref cg-bid-seat-names (cg-get game :contractor))))) - ('play (if (= (cg-get game :turn) 0) - "Your turn — pick a card (arrows + RET, or click a card)." - (format "Waiting for %s to play..." - (aref cg-bid-seat-names (cg-get game :turn))))) - ('done (or (cg-get game :hand-result) (cg-get game :message))) - (_ (cg-get game :message))))) + (message "%s" (cg-bid--phase-text game))) (defun cg-bid--button (label cmd help) "Insert a clickable button LABEL running CMD with tooltip HELP." @@ -468,12 +477,19 @@ The treatment is chosen by `cg-bid--treatment' and dispatched with ('kitty (when (cg-bid--human-p (cg-get game :contractor)) (let ((marks (cg-get game :marks))) - (cg-put game :marks (if (member card marks) - (remove card marks) - (cons card marks))) - (cg-put game :message - (format "%d of 5 marked for discard." - (length (cg-get game :marks)))) + (cond + ((member card marks) + (cg-put game :marks (remove card marks)) + (cg-put game :message + (format "%d of 5 marked for discard." (length (cg-get game :marks))))) + ((>= (length marks) 5) + (cg-put game :message + "Five already marked — click a marked card to unmark first.")) + (t (cg-put game :marks (cons card marks)) + (cg-put game :message + (let ((np (length (cg-get game :marks)))) + (if (= np 5) "5 of 5 marked — press Discard." + (format "%d of 5 marked for discard." np)))))) (cg-bid--redisplay)))) ('play (if (/= (cg-get game :turn) 0) @@ -584,15 +600,28 @@ progress must be played out (unlike the solitaire games)." "Show brief help." (interactive) (message "%s" (concat "500: win the auction, exchange the kitty, take your bid " - "in tricks. Trump order: Joker, right bower, left bower, " - "A K Q 10 9 8 7 6 5 4. b=bid p=pass, arrows+RET to play."))) + "in tricks. Click the ? Help button (SVG UI) for the rules."))) (defun cg-bid-zoom-in () - "Enlarge the cards." (interactive) (text-scale-increase 1) (cg-bid--redisplay)) + "Enlarge the cards." + (interactive) + (if (and cg-bid-svg-ui (display-graphic-p)) + (progn (setq cg-bid-card-scale (min 2.2 (+ (or cg-bid-card-scale 1.0) 0.2))) + (cg-bid--redisplay)) + (text-scale-increase 1) (cg-bid--redisplay))) (defun cg-bid-zoom-out () - "Shrink the cards." (interactive) (text-scale-decrease 1) (cg-bid--redisplay)) + "Shrink the cards." + (interactive) + (if (and cg-bid-svg-ui (display-graphic-p)) + (progn (setq cg-bid-card-scale (max 0.6 (- (or cg-bid-card-scale 1.0) 0.2))) + (cg-bid--redisplay)) + (text-scale-decrease 1) (cg-bid--redisplay))) (defun cg-bid-zoom-reset () - "Reset the card size." (interactive) (text-scale-set 0) (cg-bid--redisplay)) + "Reset the card size." + (interactive) + (if (and cg-bid-svg-ui (display-graphic-p)) + (progn (setq cg-bid-card-scale 1.0) (cg-bid--redisplay)) + (text-scale-set 0) (cg-bid--redisplay))) (defun cg-bid-redraw () "Redraw the table (e.g. after a theme or frame change)." @@ -636,6 +665,7 @@ progress must be played out (unlike the solitaire games)." (define-derived-mode cg-bid-mode special-mode "500" "Major mode for playing 500 (Bid)." (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type) (add-hook 'window-configuration-change-hook #'cg-bid--fit nil t) (when (eq cg-keys 'classic) (use-local-map (cg-bid--classic-keymap)))) @@ -672,8 +702,10 @@ fast as the window widens, so the hand compresses (cards overlap) as the table enlarges. Capped at 42% of canvas height; width is capped later, per-deal, so the hand always fits the table." (let* ((wf (- w cg-bid--ui-w)) (hf (- h cg-bid--ui-h)) - (sh (max 76 (min (round (* h 0.42)) - (round (+ 92 (* hf 0.20) (* wf 0.40)))))) + (base (max 76 (min (round (* h 0.42)) + (round (+ 92 (* hf 0.20) (* wf 0.40)))))) + (sh (max 50 (min (round (* h 0.60)) + (round (* base (or cg-bid-card-scale 1.0)))))) (sw (round (* sh 0.70)))) (cons sw sh))) @@ -765,13 +797,21 @@ Return (:hand (X0 STEP Y N SH))." (cursor (cg-get game :cursor)) (marks (cg-get game :marks)) (i 0)) (svg-rectangle svg tx (- y 6) tw (+ sh 14) :rx 10 :fill "#ffffff" :fill-opacity 0.05) - (let ((cg-svg-card-width sw) (cg-svg-card-height sh)) + (let ((cg-svg-card-width sw) (cg-svg-card-height sh) + (legal (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0) + (cg-bid-legal-cards + (cg-bid--hand game 0) (cg-get game :led) + (and (cg-get game :contract) + (cg-bid-trump (cg-get game :contract))))))) (dolist (card hand) (let* ((spec (cg-bid--spec card)) (marked (and (member card marks) t)) + (illegal (and legal (not (member card legal)))) (hl (or (and (eq (cg-get game :phase) 'play) (= i cursor)) marked)) + (cxc (+ x0 (* i step))) (cy (if marked (- y (round (* sh 0.17))) y))) - (cg-svg-card svg (+ x0 (* i step)) cy - :rank (car spec) :suit (cdr spec) :highlight hl)) + (cg-svg-card svg cxc cy :rank (car spec) :suit (cdr spec) :highlight hl) + (when illegal + (svg-rectangle svg cxc cy sw sh :rx 6 :fill "#0a1a0c" :fill-opacity 0.55))) (setq i (1+ i)))) (list :hand (list x0 step y n sh))))) @@ -882,7 +922,10 @@ panel content grows with the window." (let* ((gx px0) (gy y) (g (funcall F 5)) (cw (max 24 (/ (- lpw px0 (funcall F 12) (* 4 g)) 5))) - (ch (funcall F 26)) + ;; full height when the panel is tall; shrink to fit on short windows + (ch (min (funcall F 26) + (max (funcall F 10) + (- (/ (- (- h (funcall F 14)) gy) 6) g)))) (legal (cg-bid--legal-bids game)) (bids nil)) (dolist (b cg-bid-schedule) (when (memq b legal) @@ -903,13 +946,29 @@ panel content grows with the window." (+ (nth 1 pr) (round (* ch 0.66))) (funcall F 12) "#ffffff" t) (setq regions (plist-put regions :pass pr))))) + ;; kitty: a Discard button for the human contractor (mouse-only path) + (when (and (eq (cg-get game :phase) 'kitty) + (cg-bid--human-p (cg-get game :contractor))) + (setq y (+ y (funcall F 18))) + (cg-bid--ui-label svg "Kitty" px0 y (funcall F 10)) + (setq y (+ y (funcall F 14))) + (let* ((nmk (length (cg-get game :marks))) (ready (= nmk 5)) + (bx px0) (by y) (bw (- lpw px0 (funcall F 12))) (bh (funcall F 30))) + (svg-rectangle svg bx by bw bh :rx 6 + :fill (if ready "#2e7d32" "#14401f") + :fill-opacity (if ready 1.0 0.6) + :stroke "#0a3a1a" :stroke-width 1) + (cg-svg--text svg (format "Discard %d / 5" nmk) + (+ bx (/ bw 2)) (+ by (round (* bh 0.64))) + (funcall F 13) (if ready "#ffffff" "#9fd0a8") t) + (setq regions (plist-put regions :discard (list bx by bw bh))))) regions)) (defun cg-bid--draw-log (svg game x w h fs ccy) "Draw the full-height right log panel (emblem + scrolling story); return regions. FS scales the emblem and fonts; CCY aligns the divider with the compass." (let* ((F (lambda (n) (round (* n fs)))) - (y 6) (bottom (- h 6)) + (y 6) (bottom (- h 6 (funcall F 64))) ; reserve a control strip (logtop (+ ccy (funcall F 44) (funcall F 12))) ; align with left divider (lh (funcall F 16)) (list-top (+ logtop (funcall F 24))) @@ -918,7 +977,7 @@ FS scales the emblem and fonts; CCY aligns the divider with the compass." (scroll (or (cg-get game :log-scroll) 0)) (vis (max 1 (/ (- bottom list-top) lh))) (maxch (max 12 (round (/ (- w (funcall F 22)) (* 0.62 (funcall F 11))))))) - (svg-rectangle svg x y w (- bottom y) :rx 10 :fill "#0d4a22" :fill-opacity 0.9 + (svg-rectangle svg x y w (- (- h 6) y) :rx 10 :fill "#0d4a22" :fill-opacity 0.9 :stroke "#0a3a1a" :stroke-width 1) ;; emblem in the open top area, divider aligned with the left compass divider (cg-bid--draw-logo svg (+ x (/ w 2)) ccy fs) @@ -949,7 +1008,86 @@ FS scales the emblem and fonts; CCY aligns the divider with the compass." (if top? "#f4faf4" "#cfe3cf") top?) (setq yy (+ yy (if top? (funcall F 22) lh)))) (setq ents (cdr ents) k (1+ k)))) - (list :scroll-up up :scroll-down dn :log-region (list x y w (- bottom y)))))) + ;; global controls (Help, card size) in the reserved bottom strip + (cg-bid--ui-divider svg (+ x (funcall F 10)) (- (+ x w) (funcall F 10)) + (+ bottom (funcall F 4))) + (let* ((cz (+ bottom (funcall F 12))) + (hx (+ x (funcall F 12))) (hw (- w (funcall F 24))) (hh (funcall F 24)) + (sy (+ cz hh (funcall F 14))) + (lx (+ x (funcall F 36))) (rx2 (- (+ x w) (funcall F 14))) + (stops cg-svg-slider-stops) + (segw (/ (float (- rx2 lx)) (max 1 (1- (length stops))))) + (srs nil) (k 0)) + (svg-rectangle svg hx cz hw hh :rx (funcall F 6) + :fill "#14401f" :stroke "#2e7d32" :stroke-width 1) + (cg-svg--text svg "? Help / Rules" (+ hx (/ hw 2)) (+ cz (round (* hh 0.66))) + (funcall F 12) "#cfe3cf" t) + (cg-bid--ui-label svg "Size" (+ x (funcall F 12)) (+ sy (funcall F 4)) (funcall F 9)) + (svg-line svg lx sy rx2 sy :stroke "#1b6b35" :stroke-width 2) + (dolist (v stops) + (let* ((cxk (round (+ lx (* k segw)))) + (near (< (abs (- v (or cg-bid-card-scale 1.0))) 0.08))) + (svg-circle svg cxk sy (if near 7 4) + :fill (if near "#f1c40f" "#eaffea") + :stroke "#0a3a1a" :stroke-width 1) + (push (cons (list (- cxk (round (/ segw 2))) (- sy 10) + (max 12 (round segw)) 20) (cons 'scale v)) srs)) + (setq k (1+ k))) + (list :scroll-up up :scroll-down dn :log-region (list x y w (- bottom y)) + :help (list hx cz hw hh) :sizer (nreverse srs)))))) + +(defun cg-bid--draw-banner (svg game tx tw ty fs) + "Draw the phase-prompt banner across the top of the table." + (let* ((txt (cg-bid--phase-text game)) + (by (+ ty (round (* 6 fs)))) (bh (round (* 30 fs))) + (bw (min (- tw (round (* 90 fs))) + (max (round (* 240 fs)) (* (length txt) (round (* 8 fs)))))) + (bx (+ tx (/ (- tw bw) 2)))) + (svg-rectangle svg bx by bw bh :rx (round (* 15 fs)) + :fill "#0d2c17" :fill-opacity 0.88 :stroke "#2e7d32" :stroke-width 1) + (cg-svg--text svg txt (+ bx (/ bw 2)) (+ by (round (* bh 0.66))) + (round (* 14 fs)) "#f4faf4" t))) + +(defun cg-bid--draw-help-overlay (svg _game tx ty tw th fs) + "Draw the rules/legend overlay over the table; return its regions." + (let* ((F (lambda (n) (round (* n fs)))) + (m (funcall F 26)) + (ox (+ tx m)) (oy (+ ty m)) (ow (- tw (* 2 m))) (oh (- th (* 2 m))) + (lx (+ ox (funcall F 22))) (y (+ oy (funcall F 36))) + (lines '("How to play 500" + "" + "You (South) + North are partners vs West + East." + "1. AUCTION — bid how many tricks your side will take," + " or Pass. Click a bid in the left panel; high bid wins." + "2. KITTY — the winner takes 5 hidden cards, then clicks" + " 5 to throw away (the Discard button turns green at 5)." + "3. PLAY — take turns clicking a card; follow the led suit." + " Take at least as many tricks as you bid to score." + "" + "Bids: 7♠ = take 7 tricks, spades trump. NT = no-trump." + " NL / ON / GN = misère bids (try to take none)." + "Trump rank: Joker, right & left bowers, A K Q 10 9 ... 4.")) + (regions nil)) + (svg-rectangle svg ox oy ow oh :rx (funcall F 14) + :fill "#08200f" :fill-opacity 0.97 :stroke "#2e7d32" :stroke-width 2) + (dolist (ln lines) + (let ((title (string-prefix-p "How to" ln))) + (cg-bid--text-left svg ln lx y (if title (funcall F 18) (funcall F 13)) + (if title "#f1c40f" "#eaffea") title)) + (setq y (+ y (funcall F 22)))) + (let* ((by (- (+ oy oh) (funcall F 44))) + (bw (funcall F 130)) (bh (funcall F 30)) (g (funcall F 14)) (bx lx)) + (cl-flet ((btn (label key fill) + (svg-rectangle svg bx by bw bh :rx (funcall F 6) :fill fill + :stroke "#0a3a1a" :stroke-width 1) + (cg-svg--text svg label (+ bx (/ bw 2)) (+ by (round (* bh 0.64))) + (funcall F 13) "#ffffff" t) + (setq regions (plist-put regions key (list bx by bw bh))) + (setq bx (+ bx bw g)))) + (btn "Close" :help-close "#2e7d32") + (btn "Classic view" :help-classic "#34495e") + (btn "Quit" :help-quit "#7f3b3b"))) + regions)) (defun cg-bid--ui-svg (game &optional w h) "Return (SVG . REGIONS) for the full-buffer SVG-UI of GAME (W by H). @@ -991,19 +1129,21 @@ table cards, PSCALE the side-panel widths." (setq regions (append regions (cg-bid--draw-south-region svg game tx tw (+ ty th) (car ss) (cdr ss))))) - (let* ((hy (nth 2 (plist-get regions :hand))) - (bw (round (* 120 fs))) (bh (round (* 26 fs))) - (bx (- cx (/ bw 2))) (by (- hy bh (round (* 8 fs)))) - (active (memq (cg-get game :phase) '(done gameover)))) - (svg-rectangle svg bx by bw bh :rx 6 - :fill (if active "#2e7d32" "#14401f") - :fill-opacity (if active 1.0 0.55) - :stroke "#0a3a1a" :stroke-width 1) - (cg-svg--text svg "Next hand" (+ bx (/ bw 2)) (+ by (round (* bh 0.66))) - (round (* 14 fs)) (if active "#ffffff" "#7fa888") active) - (when active (setq regions (plist-put regions :next (list bx by bw bh))))) + (when (memq (cg-get game :phase) '(done gameover)) + (let* ((hy (nth 2 (plist-get regions :hand))) + (bw (round (* 120 fs))) (bh (round (* 26 fs))) + (bx (- cx (/ bw 2))) (by (- hy bh (round (* 8 fs))))) + (svg-rectangle svg bx by bw bh :rx 6 :fill "#2e7d32" + :stroke "#0a3a1a" :stroke-width 1) + (cg-svg--text svg "Next hand" (+ bx (/ bw 2)) (+ by (round (* bh 0.66))) + (round (* 14 fs)) "#ffffff" t) + (setq regions (plist-put regions :next (list bx by bw bh))))) (setq regions (append regions (cg-bid--draw-left-panel svg game H lpw fs ccy))) (setq regions (append regions (cg-bid--draw-log svg game rp-x rp-w H fs ccy))) + (cg-bid--draw-banner svg game tx tw ty fs) + (when (cg-get game :help-open) + (setq regions (append regions + (cg-bid--draw-help-overlay svg game tx ty tw th fs)))) (cons svg regions))) (defun cg-bid--insert-svg-ui (game) @@ -1017,7 +1157,8 @@ When `cg-bid-svg-fill', size the canvas to fill the window." (when fill (setq cg-bid--last-size (cons (window-body-width win t) (window-body-height win t)))) (setq cg-bid--regions (cdr sr)) - (insert-image (cg-svg-image (car sr) (if fill 1.0 (cg-scale)))))) + (insert-image (cg-svg-image (car sr) (if fill 1.0 (cg-scale)))) + (put-text-property (point-min) (point-max) 'pointer 'hand))) (defun cg-bid--fit (&rest _) "Re-render the SVG-UI to fit the window after a configuration change." @@ -1074,22 +1215,40 @@ Elsewhere, fall back to normal buffer scrolling." (<= py (+ y sh 8)) (>= px x0)) (let ((i (if (<= step 0) 0 (/ (- px x0) step)))) (when (< i n) i)))))) +(defun cg-bid--sizer-hit (px py rg) + "If PX,PY lands on a card-size slider stop in RG, apply it; return non-nil." + (let ((hit (cl-some (lambda (e) (and (cg-bid--in-rect px py (car e)) (cdr e))) + (plist-get rg :sizer)))) + (when (and (consp hit) (eq (car hit) 'scale)) + (setq cg-bid-card-scale (cdr hit)) + (cg-bid--refresh) + t))) + (defun cg-bid--svg-ui-click (start) "Dispatch a click at posn START within the SVG-UI." (let* ((xy (posn-object-x-y start)) (s (cg-scale)) (px (round (/ (car xy) s))) (py (round (/ (cdr xy) s))) (game cg-bid--game) (rg cg-bid--regions) bid) - (cond - ((cg-bid--in-rect px py (plist-get rg :scroll-up)) (cg-bid-log-up)) - ((cg-bid--in-rect px py (plist-get rg :scroll-down)) (cg-bid-log-down)) - ((cg-bid--in-rect px py (plist-get rg :next)) (cg-bid-new)) - ((and (cg-bid--in-rect px py (plist-get rg :pass)) - (eq (cg-get game :phase) 'auction) (= (cg-get game :bidder) 0)) - (cg-bid--auction-act game 0 nil) (cg-bid--refresh)) - ((setq bid (cg-bid--region-bid px py rg)) - (cg-bid--auction-act game 0 bid) (cg-bid--refresh)) - (t (let ((i (cg-bid--region-hand px py (plist-get rg :hand)))) - (when i (cg-put game :cursor i) (cg-bid-select))))))) + (if (cg-get game :help-open) + (cond + ((cg-bid--in-rect px py (plist-get rg :help-classic)) (cg-bid-toggle-svg-ui)) + ((cg-bid--in-rect px py (plist-get rg :help-quit)) (quit-window)) + (t (cg-put game :help-open nil) (cg-bid--redisplay))) + (cond + ((cg-bid--in-rect px py (plist-get rg :help)) + (cg-put game :help-open t) (cg-bid--redisplay)) + ((cg-bid--in-rect px py (plist-get rg :scroll-up)) (cg-bid-log-up)) + ((cg-bid--in-rect px py (plist-get rg :scroll-down)) (cg-bid-log-down)) + ((cg-bid--in-rect px py (plist-get rg :next)) (cg-bid-new)) + ((cg-bid--in-rect px py (plist-get rg :discard)) (cg-bid-discard-marked)) + ((cg-bid--sizer-hit px py rg)) + ((and (cg-bid--in-rect px py (plist-get rg :pass)) + (eq (cg-get game :phase) 'auction) (= (cg-get game :bidder) 0)) + (cg-bid--auction-act game 0 nil) (cg-bid--refresh)) + ((setq bid (cg-bid--region-bid px py rg)) + (cg-bid--auction-act game 0 bid) (cg-bid--refresh)) + (t (let ((i (cg-bid--region-hand px py (plist-get rg :hand)))) + (when i (cg-put game :cursor i) (cg-bid-select)))))))) (defun cg-bid-toggle-svg-ui () "Toggle the full-buffer SVG UI for 500." diff --git a/cg-bid.el b/cg-bid.el index 265dc33..979a20a 100644 --- a/cg-bid.el +++ b/cg-bid.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/cg-bridge.el b/cg-bridge.el index fe24ce8..14001ed 100644 --- a/cg-bridge.el +++ b/cg-bridge.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -753,7 +753,8 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: (define-derived-mode cg-bridge-mode special-mode "Bridge" "Major mode for contract Bridge." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-bridge () diff --git a/cg-core.el b/cg-core.el index e01bd8c..9ebe0e2 100644 --- a/cg-core.el +++ b/cg-core.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -49,6 +49,18 @@ Adjust with the card-size slider or the zoom keys (+/-/0)." :type 'number :group 'card-games) +(defcustom cg-cursor-type nil + "Cursor shape in card-game buffers. +Card-game buffers are display surfaces -- you act on the highlighted +card or board cell, not on the text cursor -- so the text cursor is +hidden by default (nil), which also stops it blinking without touching +the global `blink-cursor-mode'. Set to a value such as `box' or `bar' +to show a cursor instead." + :type '(choice (const :tag "Hidden (no blink)" nil) + (const :tag "Box" box) (const :tag "Bar" bar) + (const :tag "Frame default" t)) + :group 'card-games) + ;;;; Engine base @@ -114,7 +126,7 @@ RECT being (X Y W H) in unscaled image pixels.")) Return non-nil when the click was handled.") (cl-defmethod cg-renderer-draw ((renderer cg-renderer) (game cg-game)) - "Default method: report that no drawing method exists for this pair." + "Default method: signal that RENDERER cannot draw GAME." (error "No `cg-renderer-draw' for %s under the `%s' renderer" (eieio-object-class-name game) (oref renderer name))) @@ -254,7 +266,7 @@ The clicked display string must carry a `cg-regions' text property." (round (/ (car xy) sc)) (round (/ (cdr xy) sc)))))))) (defun cg-card-click (event) - "Dispatch a mouse click on a card or control to the current game." + "Dispatch mouse EVENT on a card or control to the current game." (interactive "e") (let ((action (cg-mouse-action event))) (when (and action cg-current-game) diff --git a/cg-cribbage.el b/cg-cribbage.el index 60b5b8b..9970086 100644 --- a/cg-cribbage.el +++ b/cg-cribbage.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -431,7 +431,8 @@ TOTAL is the running count after the play." (define-derived-mode cg-cribbage-mode special-mode "Cribbage" "Major mode for Cribbage." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-cribbage () diff --git a/cg-eights.el b/cg-eights.el index 8391407..7c1605b 100644 --- a/cg-eights.el +++ b/cg-eights.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -366,7 +366,8 @@ Return the drawn card, or nil when none is available." (define-derived-mode cg-eights-mode special-mode "Crazy8" "Major mode for Crazy Eights." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-eights () diff --git a/cg-gaps.el b/cg-gaps.el index f13bfae..02f4012 100644 --- a/cg-gaps.el +++ b/cg-gaps.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -829,7 +829,7 @@ The board scales to fill the area beside a proportional left panel." (define-derived-mode cg-gaps-mode special-mode "Gaps" "Major mode for playing the gaps family of solitaires." - (setq-local cursor-type 'box) + (setq-local cursor-type cg-cursor-type) (setq-local truncate-lines t) (add-hook 'window-configuration-change-hook #'cg-gaps--fit nil t) (when (eq cg-keys 'classic) diff --git a/cg-handfoot.el b/cg-handfoot.el index 592f2e8..d59d394 100644 --- a/cg-handfoot.el +++ b/cg-handfoot.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -732,7 +732,8 @@ action. After that, mark single books as usual." (define-derived-mode cg-handfoot-mode special-mode "Hand&Foot" "Major mode for Hand & Foot." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-handfoot () diff --git a/cg-match.el b/cg-match.el index a41bfee..605b89a 100644 --- a/cg-match.el +++ b/cg-match.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -280,7 +280,8 @@ Return non-nil when S can ask." (define-derived-mode cg-go-fish-mode special-mode "GoFish" "Major mode for Go Fish." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-go-fish () @@ -475,7 +476,8 @@ Return non-nil when S can ask." (define-derived-mode cg-old-maid-mode special-mode "OldMaid" "Major mode for Old Maid." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-old-maid () diff --git a/cg-net.el b/cg-net.el index 7a5d237..cff0ced 100644 --- a/cg-net.el +++ b/cg-net.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/cg-patience.el b/cg-patience.el index ff37bcc..e9eb5db 100644 --- a/cg-patience.el +++ b/cg-patience.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -427,7 +427,8 @@ matching spot); a card-size slider sits below." (define-derived-mode cg-pat-mode special-mode "Patience" "Major mode for the pile solitaires." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) (defun cg-pat--play (class) (let* ((game (cg-pat--deal (make-instance class))) diff --git a/cg-president.el b/cg-president.el index 32f9c8c..45e838c 100644 --- a/cg-president.el +++ b/cg-president.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -405,7 +405,8 @@ Each rank maps to a (hand . INDEX) region and a card-size slider sits below." (define-derived-mode cg-pres-mode special-mode "President" "Major mode for President." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-president () diff --git a/cg-render.el b/cg-render.el index f6e3c32..265a619 100644 --- a/cg-render.el +++ b/cg-render.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -105,7 +105,7 @@ The default falls back to the `cg-render' string with no click regions." (cons (cg-render game) nil)) (cl-defmethod cg-renderer-draw ((r cg-text-renderer) (game cg-game)) - "Draw GAME as plain text, clearing any click regions." + "Draw GAME as plain text on renderer R, clearing any click regions." (oset r regions nil) (insert (cg-render-text game))) @@ -116,7 +116,7 @@ The default falls back to the `cg-render' string with no click regions." (insert (car res)))) (cl-defmethod cg-renderer-hit ((r cg-svg-renderer) (game cg-game) position) - "Map POSITION to a game action via the regions recorded at the last draw." + "Map POSITION to a GAME action via R regions from the last draw." (ignore game) (let ((xy (posn-object-x-y position)) (sc (cg-scale))) (and xy (cg-regions-hit (oref r regions) diff --git a/cg-rum500.el b/cg-rum500.el index f604ce5..be3b41b 100644 --- a/cg-rum500.el +++ b/cg-rum500.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -573,7 +573,8 @@ melded or laid off at once, the rest go into your hand." (define-derived-mode cg-tm-mode special-mode "Rummy" "Major mode for the table-meld rummy games." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) (defun cg-tm--start (game buffer-name) "Start GAME in a buffer named BUFFER-NAME." diff --git a/cg-rummy.el b/cg-rummy.el index 8fcf13b..1be4dcd 100644 --- a/cg-rummy.el +++ b/cg-rummy.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -639,7 +639,8 @@ and carries a card-size slider. Draws SVG cards on a graphical display (define-derived-mode cg-gin-mode special-mode "Gin" "Major mode for Gin Rummy." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-gin () diff --git a/cg-scopa.el b/cg-scopa.el index d28757d..38b4166 100644 --- a/cg-scopa.el +++ b/cg-scopa.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -311,7 +311,8 @@ Only subsets of two or more cards are considered. Return nil if none." (define-derived-mode cg-fish-mode special-mode "Fish" "Major mode for the capturing games Scopa and Casino." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) (defun cg-fish--start (game buffer-name) "Start GAME in a buffer named BUFFER-NAME." diff --git a/cg-solitaire.el b/cg-solitaire.el index 57500e1..0674a14 100644 --- a/cg-solitaire.el +++ b/cg-solitaire.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -825,6 +825,7 @@ DISPLAY is a propertized one-image string; REGIONS is a click map of (define-derived-mode cg-sol-mode special-mode "Solitaire" "Major mode for the tableau solitaires." (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type) (when (eq cg-keys 'classic) (use-local-map (cg-sol--classic-keymap)))) diff --git a/cg-spite.el b/cg-spite.el index c5677de..9ec04c2 100644 --- a/cg-spite.el +++ b/cg-spite.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -418,7 +418,8 @@ (define-derived-mode cg-spite-mode special-mode "Spite" "Major mode for Spite & Malice." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) ;;;###autoload (defun cg-spite () diff --git a/cg-svg.el b/cg-svg.el index b5be549..059d323 100644 --- a/cg-svg.el +++ b/cg-svg.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -388,7 +388,8 @@ targets. PAD is the margin around the grid." (cl-defun cg-svg-hand-svg (specs &key cursor hints marks (overlap 0) (pad 8)) "Return an svg drawing SPECS as a left-to-right hand. CURSOR is the index to ring as the cursor; HINTS and MARKS are lists of -indices to ring as playable and as marked; OVERLAP fans the cards." +indices to ring as playable and as marked; OVERLAP fans the cards and +PAD insets the row." (let* ((w cg-svg-card-width) (h cg-svg-card-height) (step (max 1 (- (+ w cg-svg-card-gap) overlap))) (n (length specs)) @@ -437,9 +438,10 @@ Return its click regions as a list of (RECT . (scale . VALUE))." (cl-defun cg-svg-hand-image (specs &key cursor marks hints (overlap 0) region-tag) "Return a propertized one-image string for a hand of card SPECS. -CURSOR is the highlighted index; MARKS and HINTS are index lists. With -REGION-TAG non-nil, the image carries a `cg-regions' click map (each card -as (REGION-TAG . INDEX)) and a card-size slider beneath the row." +CURSOR is the highlighted index; MARKS and HINTS are index lists and +OVERLAP fans the cards. With REGION-TAG non-nil, the image carries a +`cg-regions' click map (each card as (REGION-TAG . INDEX)) and a +card-size slider beneath the row." (if (not region-tag) (propertize "*" 'display (cg-svg-image (cg-svg-hand-svg specs :cursor cursor :hints hints diff --git a/cg-trick-ext.el b/cg-trick-ext.el index a8997be..a5b9050 100644 --- a/cg-trick-ext.el +++ b/cg-trick-ext.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el diff --git a/cg-trick.el b/cg-trick.el index 45d2783..54ecbde 100644 --- a/cg-trick.el +++ b/cg-trick.el @@ -4,7 +4,7 @@ ;; Author: Corwin Brust ;; Maintainer: Corwin Brust -;; Version: 1.0.60 +;; Version: 1.0.90 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: games ;; URL: https://code.bru.st/corwin/card-game.el @@ -699,7 +699,8 @@ (define-derived-mode cg-trick-mode special-mode "Trick" "Major mode for the four-handed trick-taking games." - (setq-local truncate-lines t)) + (setq-local truncate-lines t) + (setq-local cursor-type cg-cursor-type)) (defun cg-trick--play-game (class) "Start a trick game of CLASS in its own buffer." diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 5cddfa2..939ef1c 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -1190,3 +1190,46 @@ (should regs) (should (cl-find-if (lambda (a) (and (consp a) (eq (car a) 'hand))) (mapcar #'cdr regs)))))) + +;;;; 500 SVG-UI: kitty discard cap and on-screen controls + +(ert-deftest cgt-bid-kitty-cap () + "Kitty marking never exceeds five cards, and the UI exposes the controls." + (let ((g (cg-bid-game)) (cg-bid--human-seats '(0))) + (cg-bid--deal g 3) + (cg-put g :phase 'kitty) (cg-put g :contractor 0) + (cg-put g :contract (nth 0 cg-bid-schedule)) + (let ((hand (cg-bid-sort-display (cg-bid--hand g 0) nil))) + (cg-put g :sorted-hand hand) + (cg-put g :marks (cl-subseq hand 0 5)) ; already five + (cg-put g :cursor 5) ; a sixth, unmarked + (with-temp-buffer + (setq-local cg-bid--game g) + (cg-bid-select) ; must refuse the sixth + (should (= 5 (length (cg-get g :marks)))) + ;; unmark a card that is actually marked (redisplay may have re-sorted + ;; the hand by trump, so cursor 0 is not necessarily a marked card) + (let* ((sh (cg-get g :sorted-hand)) (mk (cg-get g :marks)) + (idx (cl-position-if (lambda (c) (member c mk)) sh))) + (cg-put g :cursor idx) + (cg-bid-select) + (should (= 4 (length (cg-get g :marks))))))) + ;; the full-SVG kitty panel exposes a Discard region and a card-size slider + (let* ((cg-bid-svg-ui t) (cg-bid-svg-fill t) + (rg (cdr (cg-bid--ui-svg g 1100 700)))) + (should (plist-get rg :discard)) + (should (plist-get rg :sizer))))) + +(ert-deftest cgt-bid-svg-controls () + "The full-SVG UI exposes Help and, when open, the overlay's buttons." + (let ((g (cg-bid-game)) (cg-bid-svg-ui t) (cg-bid-svg-fill t)) + (cg-bid--deal g 3) + (cg-put g :phase 'auction) (cg-put g :bidder 0) + (let ((rg (cdr (cg-bid--ui-svg g 1100 700)))) + (should (plist-get rg :help)) + (should-not (plist-get rg :help-close))) + (cg-put g :help-open t) + (let ((rg (cdr (cg-bid--ui-svg g 1100 700)))) + (should (plist-get rg :help-close)) + (should (plist-get rg :help-classic)) + (should (plist-get rg :help-quit)))))