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

Render SVG boards for the tableau and remaining games

Browse source 
Add SVG layouts so every game draws card faces on a graphical display:
- cg-solitaire: a board with the stock/waste/reserve/free-cells/foundations
  row and overlapping columns (face-down backs, cursor ring, carried-run
  hints) -- Klondike, FreeCell, Spider, Yukon, Canfield, Forty Thieves,
  Scorpion.
- cg-patience: rows overlapped into the pyramid/peaks/Golf shapes with the
  waste and stock -- Golf, TriPeaks, Pyramid.
- cg-eights: the hand as an SVG row with legal-play hints.
- cg-president: one face per rank with a count, keeping the rank-group cursor.

Each game keeps the plain-text row as the terminal/batch fallback behind a
cg-*-svg-cards toggle. Suite still 109/109.
This commit is contained in:
Corwin Brust 2026-06-25 07:59:49 -05:00
parent 51eceb205e
commit acc46622c7
4 changed files with 200 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

22
cg-eights.el
View file

@ -39,6 +39,7 @@
(require 'cl-lib)
(require 'eieio)
(require 'cg-core)
(require 'cg-svg)
(defconst cg-eights-ranks
["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
@ -204,6 +205,14 @@ Return the drawn card, or nil when none is available."
(defvar-local cg-eights--game nil "The Crazy Eights game in the current buffer.")
(defcustom cg-eights-svg-cards t
"When non-nil, draw the hand as SVG on a graphical display."
:type 'boolean :group 'card-games)
(defun cg-eights--spec (card)
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
(cons (aref cg-eights-ranks (cdr card)) (car card)))
(cl-defmethod cg-render ((game cg-eights-game))
"Return a propertized string depicting GAME for a text display."
(let* ((out (list)) (top (cg-eights--top game))
@ -221,6 +230,17 @@ Return the drawn card, or nil when none is available."
(length (cg-get game :stock)))
out)
(push (format " Your hand (score %d):\n " (aref (cg-get game :scores) 0)) out)
(if (and cg-eights-svg-cards (display-graphic-p))
(let ((hi '()) (i 0))
(dolist (c hand) (when (cg-eights--legal-p game c) (push i hi)) (setq i (1+ i)))
(push (propertize "*" 'display
(cg-svg-image
(cg-svg-hand-svg (mapcar #'cg-eights--spec hand)
:cursor cursor :hints hi
:overlap (if (> (length hand) 11)
(max 0 (- cg-svg-card-width 24)) 0))
(cg-scale)))
out))
(let ((i 0))
(dolist (c hand)
(let ((cs (cg-eights-card-string c)) (faces nil))
@ -228,7 +248,7 @@ Return the drawn card, or nil when none is available."
(when (cg-eights--legal-p game c) (push 'cg-hint faces))
(when (= i cursor) (push 'cg-cursor faces))
(push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
(setq i (1+ i))))
(setq i (1+ i)))))
(push (format "\n\n %s\n" (cg-get game :message)) out)
(apply #'concat (nreverse out))))

54
cg-patience.el
View file

@ -44,6 +44,7 @@
(require 'cl-lib)
(require 'eieio)
(require 'cg-core)
(require 'cg-svg)
(defconst cg-pat-ranks
["A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"]
@ -302,8 +303,59 @@
(when cursor (push 'cg-cursor faces))
(propertize (format "%4s" s) 'face (or faces 'default))))
(defcustom cg-pat-svg-cards t
"When non-nil, draw the patience board as SVG on a graphical display."
:type 'boolean :group 'card-games)
(defun cg-pat--spec (card)
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD, or nil."
(and card (cons (aref cg-pat-ranks (cdr card)) (car card))))
(defun cg-pat--svg (game)
"Return a propertized one-image SVG board for patience GAME."
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (pad 12) (gap cg-svg-card-gap)
(rowstep 30) (rows (cg-get game :rows)) (cur (cg-pat--cur-spot game))
(marks (cg-get game :marks)) (lc (cg-color 'shadow :foreground "gray40"))
(maxlen (apply #'max 1 (mapcar #'length rows))) (nrows (length rows))
(width (+ (* 2 pad) (* maxlen (+ w gap))))
(boardh (+ (* (1- nrows) rowstep) h)) (bottom-y (+ pad boardh 26))
(height (+ bottom-y h pad)) (svg (svg-create width height)) (r 0))
(dolist (row rows)
(let* ((len (length row)) (x0 (/ (- width (* len (+ w gap))) 2))
(y (+ pad (* r rowstep))) (c 0))
(dolist (i row)
(let* ((card (aref (cg-get game :cards) i)) (x (+ x0 (* c (+ w gap)))))
(when card
(cg-svg-card svg x y :rank (car (cg-pat--spec card))
:suit (cdr (cg-pat--spec card))
:highlight (equal cur (cons 'slot i))
:hint (and (member (cons 'slot i) marks) t))))
(setq c (1+ c))))
(setq r (1+ r)))
(svg-text svg "Waste" :x pad :y (- bottom-y 3) :font-size 11 :fill lc
:font-family cg-svg-font-family)
(let ((wt (cg-pat--waste-top game)))
(if wt (cg-svg-card svg pad bottom-y :rank (car (cg-pat--spec wt))
:suit (cdr (cg-pat--spec wt))
:highlight (equal cur '(waste . 0))
:hint (and (member '(waste . 0) marks) t))
(cg-svg-card svg pad bottom-y :gap t :highlight (equal cur '(waste . 0)))))
(svg-text svg (format "Stock(%d)" (length (cg-get game :stock)))
:x (+ pad w gap) :y (- bottom-y 3) :font-size 11 :fill lc
:font-family cg-svg-font-family)
(if (cg-get game :stock)
(cg-svg-card svg (+ pad w gap) bottom-y :down t :highlight (equal cur '(stock . 0)))
(cg-svg-card svg (+ pad w gap) bottom-y :gap t :highlight (equal cur '(stock . 0))))
(propertize "*" 'display (cg-svg-image svg (cg-scale)))))
(cl-defmethod cg-render ((game cg-patience-game))
"Return a propertized string depicting GAME for a text display."
"Return a propertized depiction of GAME (SVG on a graphical display)."
(if (and cg-pat-svg-cards (display-graphic-p))
(cg-pat--svg game)
(cg-pat--render-text game)))
(defun cg-pat--render-text (game)
"Return a plain-text depiction of patience GAME."
(let* ((cur (cg-pat--cur-spot game)) (marks (cg-get game :marks)) (out (list)))
(push (format " %s Moves: %d\n\n" (oref game vname) (cg-get game :moves)) out)
(dolist (row (cg-get game :rows))

27
cg-president.el
View file

@ -40,6 +40,7 @@
(require 'cl-lib)
(require 'eieio)
(require 'cg-core)
(require 'cg-svg)
(defconst cg-pres-ranks
["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
@ -311,6 +312,28 @@
(defun cg-pres-help () "Controls." (interactive)
(message "Arrows: choose rank RET: play (C-u N to lead N) p: pass n: new g: redraw"))
(defcustom cg-pres-svg-cards t
"When non-nil, draw the hand as SVG on a graphical display."
:type 'boolean :group 'card-games)
(defun cg-pres--svg (game)
"Return a propertized SVG row of the hand, one card per rank with a count."
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (pad 10)
(gap (+ cg-svg-card-gap 8)) (ranks (cg-pres--hand-ranks game))
(cur (cg-get game :cursor)) (hand (cg-pres--hand game 0))
(n (length ranks)) (lc (cg-color 'shadow :foreground "gray40"))
(width (+ (* 2 pad) (max (+ w gap) (* n (+ w gap)))))
(height (+ pad h 20 pad)) (svg (svg-create width height)) (x pad) (i 0))
(dolist (r ranks)
(let* ((cnt (cl-count r (mapcar #'cdr hand)))
(suit (car (cl-find r hand :key #'cdr))))
(cg-svg-card svg x pad :rank (aref cg-pres-ranks r) :suit suit
:highlight (= i cur))
(svg-text svg (format "x%d" cnt) :x (+ x 3) :y (+ pad h 15)
:font-size 13 :fill lc :font-family cg-svg-font-family))
(setq x (+ x w gap) i (1+ i)))
(propertize "*" 'display (cg-svg-image svg (cg-scale)))))
(cl-defmethod cg-render ((game cg-president-game))
"Return a propertized string depicting GAME for a text display."
(let* ((out (list)) (ranks (cg-pres--hand-ranks game))
@ -328,6 +351,8 @@
"empty -- your lead"))
out)
(push " Your hand (by rank):\n " out)
(if (and cg-pres-svg-cards (display-graphic-p))
(push (cg-pres--svg game) out)
(let ((i 0))
(dolist (r ranks)
(let* ((cnt (cl-count r (mapcar #'cdr (cg-pres--hand game 0))))
@ -335,7 +360,7 @@
(faces nil))
(when (= i cur) (push 'cg-cursor faces))
(push (propertize (format "%6s" str) 'face (or faces 'default)) out))
(cl-incf i)))
(cl-incf i))))
(push (format "\n\n %s\n" (cg-get game :message)) out)
(apply #'concat (nreverse out))))

87
cg-solitaire.el
View file

@ -49,6 +49,7 @@
(require 'cl-lib)
(require 'eieio)
(require 'cg-core)
(require 'cg-svg)
;;;; Cards
@ -600,8 +601,92 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
(when cursor (push 'cg-cursor faces))
(propertize (format "%3s " s) 'face (or faces 'default))))
(defcustom cg-sol-svg-cards t
"When non-nil, draw the solitaire board as SVG on a graphical display."
:type 'boolean :group 'card-games)
(defun cg-sol--spec (card)
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD, or nil."
(and card (cons (aref cg-sol-ranks (cdr card)) (car card))))
(defun cg-sol--svg (game)
"Return a propertized one-image SVG board for solitaire GAME."
(let* ((w cg-svg-card-width) (h cg-svg-card-height)
(pad 12) (gap cg-svg-card-gap) (colgap 8) (vdown 12) (vup 26)
(ncols (oref game ncols))
(cur-spot (cg-sol--cur-spot game))
(sel (cg-get game :sel)) (sel-n (or (cg-get game :sel-n) 0))
(lc (cg-color 'shadow :foreground "gray40"))
(slots '()))
(when (oref game has-stock)
(push (list (format "Stock(%d)" (length (cg-get game :stock)))
nil (and (cg-get game :stock) t) (equal cur-spot '(stock . 0))) slots))
(when (oref game has-waste)
(push (list "Waste" (cg-sol--spec (car (last (cg-get game :waste)))) nil
(equal cur-spot '(waste . 0))) slots))
(when (oref game has-reserve)
(push (list (format "Resv(%d)" (length (cg-get game :reserve)))
(cg-sol--spec (car (last (cg-get game :reserve)))) nil
(equal cur-spot '(reserve . 0))) slots))
(dotimes (i (oref game nfree))
(push (list (format "F%d" (1+ i)) (cg-sol--spec (aref (cg-get game :free) i)) nil
(equal cur-spot (cons 'free i))) slots))
(dotimes (i (oref game nfound))
(push (list (format "%d" (1+ i))
(cg-sol--spec (car (last (aref (cg-get game :found) i)))) nil
(equal cur-spot (cons 'found i))) slots))
(setq slots (nreverse slots))
(let* ((ntop (length slots))
(topw (+ (* 2 pad) (* ntop (+ w gap))))
(colsw (+ (* 2 pad) (* ncols (+ w colgap))))
(width (max topw colsw))
(top-y (+ pad 14)) (col-label-y (+ top-y h 18)) (col-y (+ col-label-y 6))
(tab (cg-get game :tableau))
(maxext (let ((m h))
(dotimes (c ncols)
(let* ((col (aref tab c)) (d (cg-sol--down game c))
(nu (- (length col) d))
(ext (+ (* d vdown) (* (max 0 (1- nu)) vup) h)))
(setq m (max m ext))))
m))
(height (+ col-y maxext pad))
(svg (svg-create width height)))
(let ((x pad))
(dolist (sl slots)
(cl-destructuring-bind (label spec downp cursorp) sl
(svg-text svg label :x (+ x 1) :y (- top-y 3) :font-size 11 :fill lc
:font-family cg-svg-font-family)
(cond (downp (cg-svg-card svg x top-y :down t :highlight cursorp))
(spec (cg-svg-card svg x top-y :rank (car spec) :suit (cdr spec)
:highlight cursorp))
(t (cg-svg-card svg x top-y :gap t :highlight cursorp))))
(setq x (+ x w gap))))
(dotimes (c ncols)
(let* ((x (+ pad (* c (+ w colgap)))) (col (aref tab c)) (len (length col))
(d (cg-sol--down game c)) (y col-y) (r 0)
(cursorp (equal cur-spot (cons 'col c))))
(svg-text svg (format "%d" (1+ c)) :x (+ x 1) :y col-label-y
:font-size 11 :fill lc :font-family cg-svg-font-family)
(if (= len 0)
(cg-svg-card svg x y :gap t :highlight cursorp)
(dolist (card col)
(let* ((downp (< r d)) (top-card (= r (1- len)))
(selp (and (equal sel (cons 'col c)) (>= r (- len sel-n)))))
(if downp (cg-svg-card svg x y :down t)
(cg-svg-card svg x y :rank (car (cg-sol--spec card))
:suit (cdr (cg-sol--spec card))
:highlight (and top-card cursorp) :hint selp))
(setq y (+ y (if downp vdown vup)) r (1+ r)))))))
(propertize "*" 'display (cg-svg-image svg (cg-scale))))))
(cl-defmethod cg-render ((game cg-solitaire-game))
"Return a propertized string depicting GAME for a text display."
"Return a propertized depiction of GAME (SVG on a graphical display)."
(if (and cg-sol-svg-cards (display-graphic-p))
(cg-sol--svg game)
(cg-sol--render-text game)))
(defun cg-sol--render-text (game)
"Return a plain-text depiction of solitaire GAME."
(let* ((spots (cg-sol--spots game))
(cur (cg-get game :cursor))
(cur-spot (nth cur spots))