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

77
cg-cribbage.el
View file

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