From fdccde0634794f271c3d1da02a7bca5f29c8a856 Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Wed, 1 Jul 2026 05:13:46 -0500 Subject: [PATCH] Cribbage and Bridge: full SVG boards (completes full-SVG package) * cg-cribbage.el (cg-crib--svg, cg-crib--render-text): board with a peg-track, the starter, the pegging count/cards, the crib, and the hand. board with the rubber/contract, four seats with the dummy exposed, the trick, and the interactive hand. * test/card-games-tests.el: add cgt-crib-svg-smoke, cgt-bridge-svg-smoke. * NEWS: note the boards; every game now has a full SVG board. --- NEWS | 5 ++ cg-bridge.el | 102 ++++++++++++++++++++++++++++++++++++++- cg-cribbage.el | 77 ++++++++++++++++++++++++++++- test/card-games-tests.el | 34 +++++++++++++ 4 files changed, 216 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index b3d9adf..429db38 100644 --- a/NEWS +++ b/NEWS @@ -50,6 +50,11 @@ the mouse as well as the keyboard. stock), Spite & Malice (the four centre piles, your goal and discard piles), and Old Maid (the opponents and your hand; click one of the next player's face-down cards to draw it). + - SVG boards for Cribbage (a peg-track for each player, the starter, the + pegging count and cards, and the crib at the show) and Bridge (the + rubber and contract, all four seats with the dummy exposed, the trick + in the middle, and the hand you are playing). With these every game + in the collection now has a full graphical board. ** Rummy-family rules completed - Rummy 500: take a card from anywhere in the discard pile (key ~T~) -- diff --git a/cg-bridge.el b/cg-bridge.el index 2d6feb8..90f936c 100644 --- a/cg-bridge.el +++ b/cg-bridge.el @@ -498,8 +498,108 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: (max 0 (- cg-svg-card-width 26)) 0) :region-tag region-tag)) +(defun cg-bridge--draw-backs (svg x y n) + "Draw up to three overlapped backs at X, Y for a hand of N cards." + (let ((k (min (max n 0) 3)) (xx x)) + (dotimes (_ k) (cg-svg-card svg xx y :down t) (setq xx (+ xx 16))))) + +(defun cg-bridge--svg (game) + "Return an SVG board for the Bridge GAME (four seats, dummy exposed)." + (let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16) + (phase (cg-get game :phase)) (cursor (cg-get game :cursor)) + (turn (cg-get game :turn)) (dummy (cg-get game :dummy)) + (exposed (cg-get game :exposed)) (trick (cg-get game :trick)) + (act (if (and (eq phase 'play) (memq turn (cg-bridge--controls game))) turn 0)) + (ahand (cg-bridge--sort (cg-bridge--hand game act))) + (n (length ahand)) + (overlap (cond ((> n 11) (- w 26)) ((> n 8) 20) (t 0))) + (step (max 14 (- (+ w gap) overlap))) + (fanw (if (> n 0) (+ (* (1- n) step) w) w)) + (width (max (+ fanw (* 2 pad)) 760)) + (cx (/ width 2)) + (y-title 6) (y-info 24) (y-north 62) + (y-tn (+ y-north h 20)) + (cyc (+ y-tn (round (* h 0.5)))) + (y-ts (+ cyc (round (* h 0.15)))) + (y-hand (+ y-ts h 42)) + (height (+ y-hand h 30)) + (svg (svg-create width height)) + (lc (cg-color 'shadow :foreground "gray50")) + (regions '())) + (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 + :font-family cg-svg-font-family (and bold '(:font-weight "bold")))) + (seat (s x y) + (if (and exposed (eql s dummy) (/= s act)) + (let ((cs (cg-bridge--sort (cg-bridge--hand game s))) (xx x)) + (dolist (c cs) + (let ((sp (cg-bridge--spec c))) + (cg-svg-card svg xx y :rank (car sp) :suit (cdr sp))) + (setq xx (+ xx 15)))) + (cg-bridge--draw-backs svg x (+ y 6) (length (cg-bridge--hand game s)))) + (txt (format "%s%s%s" (aref cg-bridge-seat-names s) + (if (eql s dummy) " (dummy)" "") + (if (= turn s) " <-" "")) + x y 11)) + (trick-card (s x y) + (let ((play (assq s trick))) + (when play + (let ((sp (cg-bridge--spec (cdr play)))) + (cg-svg-card svg x y :rank (car sp) :suit (cdr sp))))))) + (txt "Bridge" pad (+ y-title 12) 13 t) + (txt (format "Games N-S %d E-W %d Below %d/%d Above %d/%d" + (aref (cg-get game :games) 0) (aref (cg-get game :games) 1) + (aref (cg-get game :below) 0) (aref (cg-get game :below) 1) + (aref (cg-get game :above) 0) (aref (cg-get game :above) 1)) + pad (+ y-info 8) 11) + (pcase phase + ('auction + (txt (format "Auction: %s" (cg-bridge--auction-string game)) pad (+ y-info 24) 11) + (txt (format "Your bid: %d %s (arrows compose, RET bids)" + (cg-get game :bid-level) + (aref cg-bridge-strains (cg-get game :bid-strain))) + pad (+ y-info 40) 11)) + ((or 'play 'scored 'passed-out) + (txt (format "Contract: %s by %s Declarer tricks: %d" + (cg-bridge--contract-string game) + (if (cg-get game :declarer) + (aref cg-bridge-seat-names (cg-get game :declarer)) "--") + (cg-get game :tricks)) + pad (+ y-info 24) 11))) + (seat 2 (- cx 40) y-north) + (seat 1 pad cyc) + (seat 3 (- width pad 110) cyc) + (when (eq phase 'play) + (trick-card 2 (- cx (/ w 2)) y-tn) + (trick-card 0 (- cx (/ w 2)) y-ts) + (trick-card 1 (- cx w (round (* w 0.4))) (round (- cyc (* h 0.25)))) + (trick-card 3 (+ cx (round (* w 0.4))) (round (- cyc (* h 0.25))))) + (txt (format "%s%s" (aref cg-bridge-seat-names act) + (cond ((eq phase 'auction) " (you)") + ((= act 0) " (you)") + (t " (dummy -- you play)"))) + pad (- y-hand 6) 11) + (let ((x (max pad (- (/ width 2) (/ fanw 2)))) (i 0) + (legalp (and (eq phase 'play) (= turn act)))) + (dolist (c ahand) + (let ((sp (cg-bridge--spec c)) (curp (= i cursor)) + (hintp (and legalp (cg-bridge--legal-play-p game act c)))) + (cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp) + :highlight curp :hint hintp) + (push (cons (list x y-hand (if (= i (1- n)) w step) h) (cons 'hand i)) regions)) + (setq x (+ x step) i (1+ i)))) + (txt (or (cg-get game :message) "") pad (- height 8) 12)) + (propertize "*" 'display (cg-svg-image svg (cg-scale)) 'cg-regions (nreverse regions)))) + (cl-defmethod cg-render ((game cg-bridge-game)) - "Return a propertized depiction of the Bridge GAME." + "Return a depiction of the Bridge GAME: SVG board if graphical, else text." + (if (and cg-bridge-svg-cards (display-graphic-p)) + (cg-bridge--svg game) + (cg-bridge--render-text game))) + +(defun cg-bridge--render-text (game) + "Return a plain-text depiction of the Bridge GAME." (let* ((out '()) (phase (cg-get game :phase)) (cursor (cg-get game :cursor))) (push " Bridge\n" out) (push (format " Rubber: You/North games %d East/West games %d%s\n" diff --git a/cg-cribbage.el b/cg-cribbage.el index ecacb3c..5ab6497 100644 --- a/cg-cribbage.el +++ b/cg-cribbage.el @@ -297,8 +297,83 @@ TOTAL is the running count after the play." (defvar-local cg-crib--game nil "The Cribbage game in the current buffer.") +(defun cg-crib--svg (game) + "Return an SVG board for the Cribbage GAME (with a peg-track)." + (let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16) + (phase (cg-get game :phase)) (scores (cg-get game :scores)) + (hand (if (eq phase 'play) (cg-crib--play game 0) (cg-crib--hand game 0))) + (n (length hand)) (cursor (cg-get game :cursor)) (marks (cg-get game :marks)) + (overlap (cond ((> n 11) (- w 24)) ((> n 8) 20) (t 0))) + (step (max 14 (- (+ w gap) overlap))) + (fanw (if (> n 0) (+ (* (1- n) step) w) w)) + (target cg-cribbage-target) (barw 220) (peg-h 14) (peg-gap 8) + (y-title 6) (y-peg 26) + (y-mid (+ y-peg (* 2 (+ peg-h peg-gap)) 18)) + (y-hand (+ y-mid h 44)) + (height (+ y-hand h 30)) + (width (max (+ fanw (* 2 pad)) (+ pad 90 barw 120) 620)) + (svg (svg-create width height)) + (lc (cg-color 'shadow :foreground "gray50")) + (regions '())) + (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 + :font-family cg-svg-font-family (and bold '(:font-weight "bold")))) + (peg (label sc y) + (txt label pad (+ y 11) 12) + (let ((bx (+ pad 90))) + (svg-rectangle svg bx y barw peg-h :rx 4 :fill "none" + :stroke lc :stroke-width 1) + (svg-rectangle svg bx y + (round (* barw (/ (float (min sc target)) target))) + peg-h :rx 4 :fill "#3aa15a") + (txt (format "%d" sc) (+ bx barw 8) (+ y 11) 12))) + (crow (cards x y) + (let ((xx x)) + (dolist (c cards) + (let ((sp (cg-rummy--card-spec c))) + (cg-svg-card svg xx y :rank (car sp) :suit (cdr sp))) + (setq xx (+ xx (round (* w 0.5)))))))) + (txt (format "Cribbage (to %d)" target) pad (+ y-title 12) 13 t) + (peg "You" (aref scores 0) y-peg) + (peg "Computer" (aref scores 1) (+ y-peg peg-h peg-gap)) + (txt (format "%s deals" (cg-crib--who (cg-get game :dealer))) + (+ pad 90 barw 60) (+ y-peg 11) 11) + (let ((mx pad)) + (when (cg-get game :starter) + (let ((sp (cg-rummy--card-spec (cg-get game :starter)))) + (cg-svg-card svg mx y-mid :rank (car sp) :suit (cdr sp)) + (txt "Starter" mx (+ y-mid h 13) 11) + (setq mx (+ mx w gap 24)))) + (cond + ((eq phase 'play) + (txt (format "Count: %d" (cg-get game :total)) mx (- y-mid 4) 12) + (crow (reverse (cg-get game :seq)) mx y-mid)) + ((memq phase '(show game-over)) + (when (cg-get game :crib) + (txt (format "Crib (%s)" (cg-crib--who (cg-get game :dealer))) mx (- y-mid 4) 11) + (crow (cg-get game :crib) mx y-mid))))) + (txt (format "Your %s" (if (eq phase 'play) "cards" "hand")) pad (- y-hand 6) 11) + (let ((x (max pad (- (/ width 2) (/ fanw 2)))) (i 0)) + (dolist (c hand) + (let ((sp (cg-rummy--card-spec c)) (curp (= i cursor)) + (markp (and marks (memq i marks)))) + (cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp) :highlight curp) + (when markp + (svg-rectangle svg (- x 3) (- y-hand 3) (+ w 6) (+ h 6) + :rx 8 :fill "none" :stroke "#4a90d9" :stroke-width 3)) + (push (cons (list x y-hand (if (= i (1- n)) w step) h) (cons 'hand i)) regions)) + (setq x (+ x step) i (1+ i)))) + (txt (or (cg-get game :message) "") pad (- height 8) 12)) + (propertize "*" 'display (cg-svg-image svg (cg-scale)) 'cg-regions (nreverse regions)))) + (cl-defmethod cg-render ((game cg-cribbage-game)) - "Return a propertized depiction of the Cribbage GAME." + "Return a depiction of the Cribbage GAME: SVG board if graphical, else text." + (if (and cg-rummy-svg-cards (display-graphic-p)) + (cg-crib--svg game) + (cg-crib--render-text game))) + +(defun cg-crib--render-text (game) + "Return a plain-text depiction of the Cribbage GAME." (let* ((out '()) (scores (cg-get game :scores)) (phase (cg-get game :phase)) (cursor (cg-get game :cursor))) (push (format " Cribbage to %d\n\n" cg-cribbage-target) out) diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 2dc0354..bffa2c9 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -919,6 +919,40 @@ (should (stringp (cg-om--render-text g))) (should (stringp (cg-om--svg g))))) +(ert-deftest cgt-crib-svg-smoke () + (let ((g (cg-cribbage-game))) + (cg-put g :scores (make-vector 2 0)) + (cg-crib--deal g) + (cg-put g :cursor 0) (cg-put g :message "x") + (should (stringp (cg-crib--render-text g))) + (let ((regs (get-text-property 0 'cg-regions (cg-crib--svg g)))) + (should (rassoc '(hand . 0) regs)) + (should (cl-every (lambda (r) (= 4 (length (car r)))) regs)))) + (let ((g (cg-cribbage-game))) + (cg-put g :scores (vector 60 90)) + (cg-crib--deal g) + (cg-put g :phase 'play) (cg-put g :starter '(2 . 4)) (cg-put g :total 15) + (cg-put g :play (vector (cg-crib--hand g 0) (cg-crib--hand g 1))) + (cg-put g :seq (list '(0 . 6) '(3 . 8))) (cg-put g :message "x") + (should (stringp (cg-crib--svg g))))) + +(ert-deftest cgt-bridge-svg-smoke () + (let ((g (cg-bridge-game))) + (cg-bridge--deal g) + (cg-put g :cursor 0) (cg-put g :turn 0) (cg-put g :bid-level 1) (cg-put g :bid-strain 0) + (cg-put g :message "x") + (should (stringp (cg-bridge--render-text g))) + (should (rassoc '(hand . 0) + (get-text-property 0 'cg-regions (cg-bridge--svg g))))) + (let ((g (cg-bridge-game))) + (cg-bridge--deal g) + (cg-put g :phase 'play) (cg-put g :turn 0) (cg-put g :cursor 0) + (cg-put g :declarer 0) (cg-put g :dummy 2) (cg-put g :exposed t) (cg-put g :tricks 0) + (cg-put g :contract '(3 . 3)) (cg-put g :doubled nil) + (cg-put g :trick (list (cons 1 (car (cg-bridge--hand g 1))))) + (cg-put g :message "x") + (should (stringp (cg-bridge--svg g))))) + (ert-deftest cgt-pat-golf-deal () (let ((g (cg-pat--deal (cg-golf-game)))) (should (= 35 (length (cg-get g :cards))))