From a464f1cfc46502722ac4bbdde19255a59ec62a6a Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Thu, 25 Jun 2026 07:10:50 -0500 Subject: [PATCH 1/2] Render SVG card faces in the hand-based games Add cg-svg-hand-svg, a hand-row primitive that fans a list of card specs with cursor, hint, and mark rings, reusing the existing card art. Route cg-rummy--render-cards through it on a graphical display, with the plain-text row kept as the terminal/batch fallback (cg-rummy-svg-cards). This gives SVG faces to every game that shares that helper: Gin, Rummy, Rummy 500, Hand & Foot, Go Fish, Old Maid, Cribbage, Scopa, Casino, and Spite & Malice. Suite still 109/109; batch rendering uses the text path. --- cg-rummy.el | 32 ++++++++++++++++++++++++++++++-- cg-svg.el | 19 +++++++++++++++++++ 2 files changed, 49 insertions(+), 2 deletions(-) diff --git a/cg-rummy.el b/cg-rummy.el index bf9ba0e..2e68dfc 100644 --- a/cg-rummy.el +++ b/cg-rummy.el @@ -48,6 +48,7 @@ (require 'cl-lib) (require 'eieio) (require 'cg-core) +(require 'cg-svg) (defconst cg-rummy-ranks ["A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"] @@ -278,10 +279,37 @@ NDECKS defaults to 1 and JOKERS to 0." (sb (if (cg-rummy-joker-p b) 99 (car b)))) (if (= sa sb) (< (cdr a) (cdr b)) (< sa sb)))))) +(defcustom cg-rummy-svg-cards t + "When non-nil, draw cards as SVG images on a graphical display. +Set to nil to force the plain-text card row everywhere." + :type 'boolean :group 'card-games) + +(defun cg-rummy--card-spec (card) + "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD." + (if (cg-rummy-joker-p card) (cons "" 'joker) + (cons (aref cg-rummy-ranks (cdr card)) (car card)))) + +(defun cg-rummy--svg-row (cards cursor marks hint-fn) + "Return a one-image SVG row for CARDS with CURSOR, MARKS and HINT-FN." + (let* ((specs (mapcar #'cg-rummy--card-spec cards)) + (hints (when hint-fn + (let ((hs '()) (i 0)) + (dolist (c cards) (when (funcall hint-fn c) (push i hs)) + (setq i (1+ i))) + hs))) + (cur (and (integerp cursor) (>= cursor 0) cursor)) + (overlap (if (> (length cards) 11) (max 0 (- cg-svg-card-width 24)) 0)) + (svg (cg-svg-hand-svg specs :cursor cur :hints hints + :marks marks :overlap overlap))) + (propertize "*" 'display (cg-svg-image svg (cg-scale))))) + (defun cg-rummy--render-cards (cards cursor marks &optional hint-fn) "Return a propertized row of CARDS. CURSOR is the highlighted index, MARKS a list of marked indices, and -HINT-FN an optional predicate marking playable cards." +HINT-FN an optional predicate marking playable cards. Draws SVG cards on +a graphical display (see `cg-rummy-svg-cards'), else a plain-text row." + (if (and cg-rummy-svg-cards (display-graphic-p)) + (cg-rummy--svg-row cards cursor marks hint-fn) (let ((i 0) (out '())) (dolist (c cards) (let ((cs (cg-rummy-card-string c)) (faces nil)) @@ -292,7 +320,7 @@ HINT-FN an optional predicate marking playable cards." (when (eql i cursor) (push 'cg-cursor faces)) (push (propertize (format "%4s" cs) 'face (or faces 'default)) out)) (setq i (1+ i))) - (apply #'concat (nreverse out)))) + (apply #'concat (nreverse out))))) (defun cg-rummy--melds-string (melds) "Return a one-line depiction of MELDS (a list of card-lists)." diff --git a/cg-svg.el b/cg-svg.el index 3a74be5..dea4b85 100644 --- a/cg-svg.el +++ b/cg-svg.el @@ -384,5 +384,24 @@ targets. PAD is the margin around the grid." (svg-print svg) (buffer-string))) +(cl-defun cg-svg-hand-svg (specs &key cursor hints marks (overlap 0) (pad 8)) + "Return an svg drawing SPECS as a left-to-right hand. +CURSOR is the index to ring as the cursor; HINTS and MARKS are lists of +indices to ring as playable and as marked; OVERLAP fans the cards." + (let* ((w cg-svg-card-width) (h cg-svg-card-height) + (step (max 1 (- (+ w cg-svg-card-gap) overlap))) + (n (length specs)) + (width (+ (* 2 pad) (if (> n 0) (+ (* (1- n) step) w) w))) + (height (+ (* 2 pad) h)) + (svg (svg-create width height)) + (x pad) (i 0)) + (dolist (spec specs) + (cg-svg--draw-spec svg x pad spec (eql i cursor) (and (memq i hints) t)) + (when (memq i marks) + (svg-rectangle svg (- x 3) (- pad 3) (+ w 6) (+ h 6) + :rx 7 :fill "none" :stroke "#4a90d9" :stroke-width 3)) + (setq x (+ x step) i (1+ i))) + svg)) + (provide 'cg-svg) ;;; cg-svg.el ends here From 51eceb205ef7c4cc6903a66a4041d1b247daeb4c Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Thu, 25 Jun 2026 07:20:03 -0500 Subject: [PATCH 2/2] Render SVG card faces in the trick games and Bridge Route cg-trick's shared render (the South hand and the current trick) through cg-svg-hand-svg, showing legal plays as hint rings; this covers Hearts, Spades, Whist, Oh Hell, Euchre, Pitch, and Briscola at once. Do the same in cg-bridge for the hand, the trick, and the exposed dummy. Plain-text rows remain the terminal/batch fallback. Suite still 109/109. --- cg-bridge.el | 71 ++++++++++++++++++++++++++++++++++++++-------------- cg-trick.el | 58 ++++++++++++++++++++++++++++++++---------- 2 files changed, 97 insertions(+), 32 deletions(-) diff --git a/cg-bridge.el b/cg-bridge.el index d3b7379..d03dbf5 100644 --- a/cg-bridge.el +++ b/cg-bridge.el @@ -46,6 +46,7 @@ (require 'cl-lib) (require 'eieio) (require 'cg-core) +(require 'cg-svg) (defconst cg-bridge-ranks ["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"] @@ -481,6 +482,24 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: out)) (if out (mapconcat #'identity (nreverse out) " ") "(no calls yet)"))) +(defcustom cg-bridge-svg-cards t + "When non-nil, draw cards as SVG images on a graphical display." + :type 'boolean :group 'card-games) + +(defun cg-bridge--spec (card) + "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD." + (cons (aref cg-bridge-ranks (cdr card)) (car card))) + +(cl-defun cg-bridge--svg-row (cards &key cursor hints) + "Return a one-image SVG row for CARDS with CURSOR and HINTS indices." + (propertize "*" 'display + (cg-svg-image + (cg-svg-hand-svg (mapcar #'cg-bridge--spec cards) + :cursor cursor :hints hints + :overlap (if (> (length cards) 11) + (max 0 (- cg-svg-card-width 26)) 0)) + (cg-scale)))) + (cl-defmethod cg-render ((game cg-bridge-game)) "Return a propertized depiction of the Bridge GAME." (let* ((out '()) (phase (cg-get game :phase)) (cursor (cg-get game :cursor))) @@ -511,16 +530,22 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: (cg-get game :tricks)) out) (when (and (cg-get game :exposed) (cg-get game :dummy)) - (push (format "\n Dummy (%s):\n%s" - (aref cg-bridge-seat-names (cg-get game :dummy)) - (cg-bridge--hand-by-suit (cg-bridge--hand game (cg-get game :dummy)))) - out)) + (push (format "\n Dummy (%s):\n " + (aref cg-bridge-seat-names (cg-get game :dummy))) out) + (if (and cg-bridge-svg-cards (display-graphic-p)) + (push (cg-bridge--svg-row + (cg-bridge--sort (cg-bridge--hand game (cg-get game :dummy)))) out) + (push (cg-bridge--hand-by-suit (cg-bridge--hand game (cg-get game :dummy))) out))) (push "\n Trick: " out) - (if (cg-get game :trick) - (dolist (p (reverse (cg-get game :trick))) + (cond + ((null (cg-get game :trick)) (push "(empty)" out)) + ((and cg-bridge-svg-cards (display-graphic-p)) + (push (concat (mapconcat (lambda (p) (aref cg-bridge-seat-names (car p))) + (reverse (cg-get game :trick)) " ") " ") out) + (push (cg-bridge--svg-row (mapcar #'cdr (reverse (cg-get game :trick)))) out)) + (t (dolist (p (reverse (cg-get game :trick))) (push (format "%s:%s " (aref cg-bridge-seat-names (car p)) - (cg-bridge-card-string (cdr p))) out)) - (push "(empty)" out)) + (cg-bridge-card-string (cdr p))) out)))) (push "\n" out))) ;; the human's hand (South), or the seat being played from when it is dummy (let* ((act (if (and (eq phase 'play) (memq (cg-get game :turn) @@ -533,17 +558,25 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: ((= act 0) " (you)") (t " (dummy, you play)"))) out) - (if (eq phase 'play) - (let ((i 0)) - (dolist (c hand) - (let ((cs (cg-bridge-card-string c)) (faces nil)) - (when (cg-red-suit-p (car c)) (push 'cg-red-suit faces)) - (when (and (= (cg-get game :turn) act) - (cg-bridge--legal-play-p game act 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 (cg-bridge--hand-by-suit hand) out))) + (cond + ((and (eq phase 'play) cg-bridge-svg-cards (display-graphic-p)) + (let ((hi '()) (i 0)) + (dolist (c hand) + (when (and (= (cg-get game :turn) act) (cg-bridge--legal-play-p game act c)) + (push i hi)) + (setq i (1+ i))) + (push (cg-bridge--svg-row hand :cursor cursor :hints hi) out))) + ((eq phase 'play) + (let ((i 0)) + (dolist (c hand) + (let ((cs (cg-bridge-card-string c)) (faces nil)) + (when (cg-red-suit-p (car c)) (push 'cg-red-suit faces)) + (when (and (= (cg-get game :turn) act) + (cg-bridge--legal-play-p game act 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))))) + (t (push (cg-bridge--hand-by-suit hand) out)))) (push (format "\n\n %s\n" (cg-get game :message)) out) (apply #'concat (nreverse out)))) diff --git a/cg-trick.el b/cg-trick.el index f5f438c..ec1cae2 100644 --- a/cg-trick.el +++ b/cg-trick.el @@ -42,6 +42,7 @@ (require 'cl-lib) (require 'eieio) (require 'cg-core) +(require 'cg-svg) ;;;; Cards @@ -528,6 +529,24 @@ (if bid (format " bid %d" bid) "") (if won (format " won %d" won) "")))) +(defcustom cg-trick-svg-cards t + "When non-nil, draw cards as SVG images on a graphical display." + :type 'boolean :group 'card-games) + +(defun cg-trick--spec (card) + "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD." + (cons (aref cg-trick-ranks (cdr card)) (car card))) + +(cl-defun cg-trick--svg-row (cards &key cursor marks hints) + "Return a one-image SVG row for CARDS with CURSOR, MARKS, HINTS indices." + (propertize "*" 'display + (cg-svg-image + (cg-svg-hand-svg (mapcar #'cg-trick--spec cards) + :cursor cursor :marks marks :hints hints + :overlap (if (> (length cards) 11) + (max 0 (- cg-svg-card-width 24)) 0)) + (cg-scale)))) + (cl-defmethod cg-render ((game cg-trick-game)) "Return a propertized string depicting GAME for a text display." (let* ((out (list)) @@ -544,24 +563,37 @@ (push (cg-trick--seat-line game s) out)) ;; current trick (push "\n Trick: " out) - (if (cg-get game :trick) - (dolist (play (reverse (cg-get game :trick))) + (cond + ((null (cg-get game :trick)) (push "(empty)" out)) + ((and cg-trick-svg-cards (display-graphic-p)) + (push (concat (mapconcat (lambda (p) (aref cg-trick-seat-names (car p))) + (reverse (cg-get game :trick)) " ") " ") + out) + (push (cg-trick--svg-row (mapcar #'cdr (reverse (cg-get game :trick)))) out)) + (t (dolist (play (reverse (cg-get game :trick))) (push (format "%s:%s " (aref cg-trick-seat-names (car play)) (let ((cs (cg-trick-card-string (cdr play)))) (if (cg-trick-red-p (cdr play)) (propertize cs 'face 'cg-red-suit) cs))) - out)) - (push "(empty)" out)) + out)))) (push "\n\n Your hand (South):\n " out) - (let ((i 0)) - (dolist (c hand) - (let* ((cs (cg-trick-card-string c)) - (faces nil)) - (when (cg-trick-red-p c) (push 'cg-red-suit faces)) - (when (member c marks) (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-trick-svg-cards (display-graphic-p)) + (let ((mi '()) (hi '()) (i 0) + (legalp (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0)))) + (dolist (c hand) + (when (member c marks) (push i mi)) + (when (and legalp (cg-trick--legal-p game 0 c)) (push i hi)) + (setq i (1+ i))) + (push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi) out)) + (let ((i 0)) + (dolist (c hand) + (let* ((cs (cg-trick-card-string c)) + (faces nil)) + (when (cg-trick-red-p c) (push 'cg-red-suit faces)) + (when (member c marks) (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))))