corwin/card-game.el
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Cribbage and Bridge: full SVG boards (completes full-SVG package)

Browse source 
* 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.
This commit is contained in:
Corwin Brust 2026-07-01 05:13:46 -05:00
parent 32fb9f0c6d
commit fdccde0634
4 changed files with 216 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

102
cg-bridge.el
View file

@ -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"