From acc46622c7f02a73ee29b214db02033fe2532fd2 Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Thu, 25 Jun 2026 07:59:49 -0500 Subject: [PATCH] Render SVG boards for the tableau and remaining games 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. --- cg-eights.el | 36 +++++++++++++++----- cg-patience.el | 54 +++++++++++++++++++++++++++++- cg-president.el | 41 ++++++++++++++++++----- cg-solitaire.el | 87 ++++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 200 insertions(+), 18 deletions(-) diff --git a/cg-eights.el b/cg-eights.el index ff2b19c..ac0f4f9 100644 --- a/cg-eights.el +++ b/cg-eights.el @@ -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,14 +230,25 @@ 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) - (let ((i 0)) - (dolist (c hand) - (let ((cs (cg-eights-card-string c)) (faces nil)) - (when (cg-eights-red-p c) (push 'cg-red-suit faces)) - (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)))) + (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)) + (when (cg-eights-red-p c) (push 'cg-red-suit faces)) + (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))))) (push (format "\n\n %s\n" (cg-get game :message)) out) (apply #'concat (nreverse out)))) diff --git a/cg-patience.el b/cg-patience.el index c08d464..21a55e4 100644 --- a/cg-patience.el +++ b/cg-patience.el @@ -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)) diff --git a/cg-president.el b/cg-president.el index f060125..3035dd7 100644 --- a/cg-president.el +++ b/cg-president.el @@ -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,14 +351,16 @@ "empty -- your lead")) out) (push " Your hand (by rank):\n " out) - (let ((i 0)) - (dolist (r ranks) - (let* ((cnt (cl-count r (mapcar #'cdr (cg-pres--hand game 0)))) - (str (format "%s×%d" (aref cg-pres-ranks r) cnt)) - (faces nil)) - (when (= i cur) (push 'cg-cursor faces)) - (push (propertize (format "%6s" str) 'face (or faces 'default)) out)) - (cl-incf i))) + (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)))) + (str (format "%s×%d" (aref cg-pres-ranks r) cnt)) + (faces nil)) + (when (= i cur) (push 'cg-cursor faces)) + (push (propertize (format "%6s" str) 'face (or faces 'default)) out)) + (cl-incf i)))) (push (format "\n\n %s\n" (cg-get game :message)) out) (apply #'concat (nreverse out)))) diff --git a/cg-solitaire.el b/cg-solitaire.el index a2d37f8..8393a78 100644 --- a/cg-solitaire.el +++ b/cg-solitaire.el @@ -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))