Crazy Eights, Spite & Malice, Old Maid: SVG boards" \

discard, suit in play, stock, and the hand.
* cg-spite.el (cg-spite--board-svg, cg-spite--render-text): centre piles,
goal, discards, and hand.
* cg-match.el (cg-om--svg, cg-om--render-text, cg-render-apply): Old Maid
board with clickable target cards; wire mouse-1, zoom, and cg-current-game.
* test/card-games-tests.el: add cgt-eights-svg-smoke, cgt-spite-svg-smoke,
cgt-om-svg-smoke.
* NEWS: note the new boards.

NEWS

@@ -46,6 +46,10 @@ the mouse as well as the keyboard.
   - The same board now covers Hand & Foot (each team's books, and your
     hand or foot) and the fishing games Scopa and Casino (the loose
     table cards and the deck).
+  - SVG boards for Crazy Eights (the discard, the suit in play, and the
+    stock), Spite & Malice (the four centre piles, your goal and discard
+    piles), and Old Maid (the opponents and your hand; click one of the
+    next player's face-down cards to draw it).
 
 ** Rummy-family rules completed
   - Rummy 500: take a card from anywhere in the discard pile (key ~T~) --

cg-eights.el

@@ -213,8 +213,65 @@ Return the drawn card, or nil when none is available."
   "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
   (cons (aref cg-eights-ranks (cdr card)) (car card)))
 
+(defun cg-eights--board-svg (game)
+  "Return an SVG board for the Crazy Eights GAME."
+  (let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
+         (hand (cg-eights--hand game 0)) (n (length hand))
+         (cursor (cg-get game :cursor))
+         (top (cg-eights--top game)) (suit (cg-get game :suit))
+         (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))
+         (np (cg-get game :nplayers)) (nstock (length (cg-get game :stock)))
+         (y-title 6) (y-info 26)
+         (y-mid (+ y-info (* (1- np) 16) 14))
+         (y-hand (+ y-mid h 42))
+         (height (+ y-hand h 30))
+         (width (max (+ fanw (* 2 pad)) 560))
+         (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")))))
+      (txt "Crazy Eights" pad (+ y-title 12) 13 t)
+      (let ((yy (+ y-info 4)))
+        (dotimes (s np)
+          (unless (= s 0)
+            (txt (format "Player %d: %d cards   (score %d)" s
+                         (length (cg-eights--hand game s)) (aref (cg-get game :scores) s))
+                 pad yy 12)
+            (setq yy (+ yy 16)))))
+      (cg-svg-card svg pad y-mid :down (> nstock 0) :gap (= nstock 0))
+      (txt (format "Stock %d" nstock) pad (+ y-mid h 13) 11)
+      (let ((dx (+ pad w gap 28)) (sp (cg-eights--spec top)))
+        (cg-svg-card svg dx y-mid :rank (car sp) :suit (cdr sp))
+        (txt "Discard" dx (+ y-mid h 13) 11)
+        (let ((sx (+ dx w gap 34))
+              (col (if (cg-red-suit-p suit) "#c0392b" "#2c3e50")))
+          (txt "Suit in play" sx (- y-mid 4) 11)
+          (svg-text svg (cg-suit-glyph suit) :x (+ sx 12) :y (+ y-mid 46)
+                    :font-size 44 :fill col :font-family cg-svg-font-family)))
+      (txt "Your hand" pad (- y-hand 6) 11)
+      (let ((x (max pad (- (/ width 2) (/ fanw 2)))) (i 0))
+        (dolist (c hand)
+          (let ((sp (cg-eights--spec c)) (curp (= i cursor))
+                (hintp (cg-eights--legal-p game c)))
+            (cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp)
+                         :highlight curp :hint hintp)
+            (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-eights-game))
-  "Return a propertized string depicting GAME for a text display."
+  "Return a depiction of GAME: an SVG board if graphical, else text."
+  (if (and cg-eights-svg-cards (display-graphic-p))
+      (cg-eights--board-svg game)
+    (cg-eights--render-text game)))
+
+(defun cg-eights--render-text (game)
+  "Return a plain-text depiction of GAME."
   (let* ((out (list)) (top (cg-eights--top game))
          (hand (cg-eights--hand game 0)) (cursor (cg-get game :cursor)))
     (push (format "  Crazy Eights\n\n") out)

cg-match.el

@@ -452,8 +452,69 @@ instead of hunting for one overlapped card in a big hand."
 
 (defvar-local cg-om--game nil "The Old Maid game in the current buffer.")
 
+(defun cg-om--svg (game)
+  "Return an SVG board for the Old Maid GAME."
+  (let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
+         (hand (cg-om--hand game 0)) (n (length hand))
+         (target (cg-om--target game 0)) (pick (or (cg-get game :pick) 0))
+         (yourp (and target (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0)))
+         (np (cg-get game :nplayers))
+         (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))
+         (bstep 20)
+         (tn (and target (length (cg-om--hand game target))))
+         (y-title 6) (y-info 26)
+         (y-target (+ y-info (* (1- np) 16) 18))
+         (y-hand (+ y-target h 42))
+         (targetw (if (and yourp tn (> tn 0)) (+ (* (1- tn) bstep) w) 0))
+         (height (+ y-hand h 30))
+         (width (max (+ fanw (* 2 pad)) (+ targetw (* 2 pad)) 560))
+         (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")))))
+      (txt "Old Maid" pad (+ y-title 12) 13 t)
+      (let ((yy (+ y-info 4)))
+        (dotimes (s np)
+          (unless (= s 0)
+            (txt (format "Player %d: %d cards%s" s (length (cg-om--hand game s))
+                         (if (eql s target) "   <- draw from here" ""))
+                 pad yy 12)
+            (setq yy (+ yy 16)))))
+      (when (and yourp tn (> tn 0))
+        (txt (format "Pick a card from Player %d:" target) pad (- y-target 6) 11)
+        (let ((x pad))
+          (dotimes (i tn)
+            (cg-svg-card svg x y-target :down t :highlight (= i pick))
+            (push (cons (list x y-target (if (= i (1- tn)) w bstep) h) (cons 'pick i))
+                  regions)
+            (setq x (+ x bstep)))))
+      (txt "Your hand" pad (- y-hand 6) 11)
+      (let ((x (max pad (- (/ width 2) (/ fanw 2)))))
+        (dolist (c hand)
+          (let ((sp (cg-rummy--card-spec c)))
+            (cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp)))
+          (setq x (+ x step))))
+      (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-apply ((g cg-old-maid-game) action)
+  "Apply a click ACTION: pick that card from the target and draw it."
+  (pcase action
+    (`(pick . ,i) (cg-put g :pick i) (cg-om-draw))
+    (_ (cl-call-next-method))))
+
 (cl-defmethod cg-render ((game cg-old-maid-game))
-  "Return a propertized depiction of the Old Maid GAME."
+  "Return a depiction of the Old Maid GAME: SVG board if graphical, else text."
+  (if (and cg-rummy-svg-cards (display-graphic-p))
+      (cg-om--svg game)
+    (cg-om--render-text game)))
+
+(defun cg-om--render-text (game)
+  "Return a plain-text depiction of the Old Maid GAME."
   (let* ((out '()) (target (cg-om--target game 0)))
     (push "  Old Maid\n\n" out)
     (dotimes (s (cg-get game :nplayers))
@@ -472,6 +533,7 @@ instead of hunting for one overlapped card in a big hand."
 
 (defun cg-om--redisplay ()
   (let ((game cg-om--game) (inhibit-read-only t))
+    (setq cg-current-game game cg-redisplay-function #'cg-om--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -510,6 +572,11 @@ instead of hunting for one overlapped card in a big hand."
 
 (defvar cg-old-maid-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-card-click)
+    (define-key map "+" #'cg-card-zoom-in)
+    (define-key map "=" #'cg-card-zoom-in)
+    (define-key map "-" #'cg-card-zoom-out)
+    (define-key map "0" #'cg-card-zoom-reset)
     (define-key map (kbd "<left>")  #'cg-om-left)
     (define-key map (kbd "<right>") #'cg-om-right)
     (define-key map (kbd "RET") #'cg-om-draw)

cg-spite.el

@@ -273,8 +273,74 @@
         (push (format "%d:%s" (1+ d) (if top (cg-rummy-card-string top) "--")) parts)))
     (mapconcat #'identity (nreverse parts) "  ")))
 
+(defun cg-spite--board-svg (game)
+  "Return an SVG board for the Spite & Malice GAME."
+  (let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
+         (hand (cg-spite--hand game 0)) (n (length hand))
+         (cursor (cg-get game :cursor)) (center (cg-get game :center))
+         (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))
+         (colstep (+ w 14))
+         (y-title 6) (y-opp 26)
+         (y-center (+ y-opp 16))
+         (y-sm (+ y-center h 16))
+         (y-ylabel (+ y-sm 12))
+         (y-yours (+ y-ylabel 6))
+         (y-hand (+ y-yours h 42))
+         (height (+ y-hand h 30))
+         (width (max (+ fanw (* 2 pad)) (+ (* 5 colstep) (* 2 pad)) 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"))))
+                (pilecard (spec x y)
+                          (if spec (cg-svg-card svg x y :rank (car spec) :suit (cdr spec))
+                            (cg-svg-card svg x y :gap t))))
+      (txt (format "Spite & Malice   (goal %d)" cg-spite-goal-size) pad (+ y-title 12) 13 t)
+      (txt (format "Computer:  goal %d left   hand %d   discards %s"
+                   (length (cg-spite--goal game 1)) (length (cg-spite--hand game 1))
+                   (cg-spite--disc-string game 1))
+           pad (+ y-opp 4) 12)
+      (txt "Centre (build A..Q; King is wild)" pad (- y-center 4) 11)
+      (dotimes (i 4)
+        (let* ((x (+ pad (* i colstep))) (pp (aref center i))
+               (spec (and pp (cons (aref cg-rummy-ranks (car pp)) (car (cadr pp))))))
+          (pilecard spec x y-center)))
+      (txt (format "Stock %d    Muck %d"
+                   (length (cg-get game :stock)) (length (cg-get game :muck)))
+           pad y-sm 11)
+      (let* ((gtop (car (cg-spite--goal game 0)))
+             (gspec (and gtop (cg-rummy--card-spec gtop))))
+        (txt (format "Your goal (%d left)" (length (cg-spite--goal game 0)))
+             pad y-ylabel 11)
+        (txt "Discards" (+ pad colstep) y-ylabel 11)
+        (pilecard gspec pad y-yours)
+        (dotimes (d 4)
+          (let* ((x (+ pad colstep (* d colstep)))
+                 (dtop (car (aref (cg-spite--disc game 0) d)))
+                 (dspec (and dtop (cg-rummy--card-spec dtop))))
+            (pilecard dspec x y-yours))))
+      (txt "Your 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)))
+            (cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp) :highlight curp)
+            (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-spite-game))
-  "Return a propertized depiction of the Spite & Malice GAME."
+  "Return a depiction of the GAME: an SVG board if graphical, else text."
+  (if (and cg-rummy-svg-cards (display-graphic-p))
+      (cg-spite--board-svg game)
+    (cg-spite--render-text game)))
+
+(defun cg-spite--render-text (game)
+  "Return a plain-text depiction of the Spite & Malice GAME."
   (let* ((out '()) (cursor (cg-get game :cursor)))
     (push "  Spite & Malice\n\n" out)
     (push (format "  Computer goal: %d left    hand: %d    discards: %s\n\n"

test/card-games-tests.el

@@ -894,6 +894,31 @@
     (should (rassoc '(hand . 0)
                     (get-text-property 0 'cg-regions (cg-fish--svg g))))))
 
+(ert-deftest cgt-eights-svg-smoke ()
+  (let ((g (cg-eights-game)))
+    (cg-put g :nplayers 3) (cg-put g :scores (make-vector 3 0))
+    (cg-eights--deal g) (cg-put g :cursor 0) (cg-put g :message "x")
+    (should (stringp (cg-eights--render-text g)))
+    (let ((regs (get-text-property 0 'cg-regions (cg-eights--board-svg g))))
+      (should (rassoc '(hand . 0) regs))
+      (should (cl-every (lambda (r) (= 4 (length (car r)))) regs)))))
+
+(ert-deftest cgt-spite-svg-smoke ()
+  (let ((g (cg-spite-game)))
+    (cg-put g :nplayers 2) (cg-put g :scores (make-vector 2 0))
+    (cg-spite--deal g) (cg-put g :cursor 0) (cg-put g :message "x")
+    (aset (cg-get g :center) 0 (cons 3 (list '(1 . 3))))
+    (should (stringp (cg-spite--render-text g)))
+    (should (rassoc '(hand . 0)
+                    (get-text-property 0 'cg-regions (cg-spite--board-svg g))))))
+
+(ert-deftest cgt-om-svg-smoke ()
+  (let ((g (cg-old-maid-game)))
+    (cg-om--deal g)
+    (cg-put g :phase 'play) (cg-put g :turn 0) (cg-put g :message "x")
+    (should (stringp (cg-om--render-text g)))
+    (should (stringp (cg-om--svg g)))))
+
 (ert-deftest cgt-pat-golf-deal ()
   (let ((g (cg-pat--deal (cg-golf-game))))
     (should (= 35 (length (cg-get g :cards))))