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

@@ -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"
+         (push (format "\n  Dummy (%s):\n   "
-                       (aref cg-bridge-seat-names (cg-get game :dummy))
+                       (aref cg-bridge-seat-names (cg-get game :dummy))) out)
-                       (cg-bridge--hand-by-suit (cg-bridge--hand game (cg-get game :dummy))))
+         (if (and cg-bridge-svg-cards (display-graphic-p))
-               out))
+             (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)
+       (cond
-           (dolist (p (reverse (cg-get game :trick)))
+        ((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))
+                           (cg-bridge-card-string (cdr p))) out))))
-         (push "(empty)" 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)
+      (cond
-          (let ((i 0))
+       ((and (eq phase 'play) cg-bridge-svg-cards (display-graphic-p))
-            (dolist (c hand)
+        (let ((hi '()) (i 0))
-              (let ((cs (cg-bridge-card-string c)) (faces nil))
+          (dolist (c hand)
-                (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))
-                (when (and (= (cg-get game :turn) act)
+              (push i hi))
-                           (cg-bridge--legal-play-p game act c)) (push 'cg-hint faces))
+            (setq i (1+ i)))
-                (when (= i cursor) (push 'cg-cursor faces))
+          (push (cg-bridge--svg-row hand :cursor cursor :hints hi) out)))
-                (push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
+       ((eq phase 'play)
-              (setq i (1+ i))))
+        (let ((i 0))
-        (push (cg-bridge--hand-by-suit hand) out)))
+          (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))))
 

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)."

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

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)
+    (cond
-        (dolist (play (reverse (cg-get game :trick)))
+     ((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))
+                out))))
-      (push "(empty)" out))
     (push "\n\n  Your hand (South):\n   " out)
-    (let ((i 0))
+    (if (and cg-trick-svg-cards (display-graphic-p))
-      (dolist (c hand)
+        (let ((mi '()) (hi '()) (i 0)
-        (let* ((cs (cg-trick-card-string c))
+              (legalp (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0))))
-               (faces nil))
+          (dolist (c hand)
-          (when (cg-trick-red-p c) (push 'cg-red-suit faces))
+            (when (member c marks) (push i mi))
-          (when (member c marks) (push 'cg-hint faces))
+            (when (and legalp (cg-trick--legal-p game 0 c)) (push i hi))
-          (when (= i cursor) (push 'cg-cursor faces))
+            (setq i (1+ i)))
-          (push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
+          (push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi) out))
-        (setq i (1+ i))))
+      (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))))