Finish mouse support: Crazy Eights, President, the patience boards

The last three keyboard-only games are now click-to-play, so every game
in the package responds to the mouse.

Crazy Eights and President route their hands through the shared
cg-regions click map (President maps each rank group to a click); the
patience boards (Golf, TriPeaks, Pyramid) follow the solitaire keystone,
mapping exposed slots plus the waste and stock to their spots.  Each adds
a card-size slider, [mouse-1], and +/-/0 zoom.

Add cgt-mouse-regions asserting the SVG click maps build (suite -> 116).

cg-eights.el

@@ -233,13 +233,11 @@ Return the drawn card, or nil when none is available."
     (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
+          (push (cg-svg-hand-image (mapcar #'cg-eights--spec hand)
-                            (cg-svg-image
+                                   :cursor cursor :hints hi
-                             (cg-svg-hand-svg (mapcar #'cg-eights--spec hand)
+                                   :overlap (if (> (length hand) 11)
-                                              :cursor cursor :hints hi
+                                                (max 0 (- cg-svg-card-width 24)) 0)
-                                              :overlap (if (> (length hand) 11)
+                                   :region-tag 'hand)
-                                                           (max 0 (- cg-svg-card-width 24)) 0))
-                             (cg-scale)))
                 out))
       (let ((i 0))
         (dolist (c hand)
@@ -252,9 +250,19 @@ Return the drawn card, or nil when none is available."
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-eights-game) action)
+  "Apply a click ACTION on the hand to GAME G (a click also plays)."
+  (pcase action
+    (`(hand . ,i)
+     (cg-put g :cursor i)
+     (when (and (eq (cg-get g :phase) 'play) (= (cg-get g :turn) 0))
+       (cg-eights-act)))
+    (_ (cl-call-next-method))))
+
 (defun cg-eights--redisplay ()
   "Redraw the Crazy Eights buffer."
   (let ((game cg-eights--game) (inhibit-read-only t))
+    (setq cg-current-game game cg-redisplay-function #'cg-eights--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -335,10 +343,15 @@ Return the drawn card, or nil when none is available."
 (defun cg-eights-help ()
   "Describe the controls."
   (interactive)
-  (message "Arrows: choose  RET: play  d: draw  x: pass  n: new deal  g: redraw"))
+  (message "Arrows or click: choose/play  RET: play  d: draw  x: pass  +/-: size  n: new  g: redraw"))
 
 (defvar cg-eights-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-eights-left)
     (define-key map (kbd "<right>") #'cg-eights-right)
     (define-key map (kbd "RET") #'cg-eights-act)

cg-patience.el

@@ -291,7 +291,7 @@
   (cg-pat--deal cg-pat--game) (cg-pat--redisplay))
 (defun cg-pat-redraw () "Redraw." (interactive) (cg-pat--redisplay))
 (defun cg-pat-help () "Controls." (interactive)
-  (message "Arrows: move  RET: play/mark/deal  u: undo  n: new  g: redraw"))
+  (message "Arrows or click: move/play  RET: play/mark/deal  u: undo  +/-: size  n: new"))
 
 ;;;; Rendering
 
@@ -312,14 +312,19 @@
   (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."
+  "Return a propertized, clickable one-image SVG board for patience GAME.
+Exposed slots, the waste, and the stock each carry a click region (the
+matching spot); a card-size slider sits below."
   (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))))
+         (sh (cg-svg-slider-height))
+         (width (+ (* 2 pad) (max (* maxlen (+ w gap)) (cg-svg-slider-width))))
          (boardh (+ (* (1- nrows) rowstep) h)) (bottom-y (+ pad boardh 26))
-         (height (+ bottom-y h pad)) (svg (svg-create width height)) (r 0))
+         (slider-y (+ bottom-y h 10))
+         (height (+ slider-y sh pad)) (svg (svg-create width height))
+         (r 0) (regions '()))
     (dolist (row rows)
       (let* ((len (length row)) (x0 (/ (- width (* len (+ w gap))) 2))
              (y (+ pad (* r rowstep))) (c 0))
@@ -329,7 +334,9 @@
               (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))))
+                           :hint (and (member (cons 'slot i) marks) t))
+              (when (cg-pat--exposed-p game i)
+                (push (cons (list x y w h) (cons 'slot i)) regions))))
           (setq c (1+ c))))
       (setq r (1+ r)))
     (svg-text svg "Waste" :x pad :y (- bottom-y 3) :font-size 11 :fill lc
@@ -340,13 +347,25 @@
                           :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)))))
+    (push (cons (list pad bottom-y w h) (cons 'waste 0)) regions)
     (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)))))
+    (push (cons (list (+ pad w gap) bottom-y w h) (cons 'stock 0)) regions)
+    (setq regions (append (nreverse regions)
+                          (cg-svg-slider-draw svg pad slider-y cg-card-scale)))
+    (propertize "*" 'display (cg-svg-image svg (cg-scale)) 'cg-regions regions)))
+
+(cl-defmethod cg-render-apply ((g cg-patience-game) action)
+  "Apply a click ACTION (a board spot) to GAME G: select that spot and play."
+  (pcase action
+    ((or `(slot . ,_) `(waste . ,_) `(stock . ,_))
+     (let ((idx (cl-position action (cg-pat--spots g) :test #'equal)))
+       (when idx (cg-put g :cursor idx) (cg-pat-act))))
+    (_ (cl-call-next-method))))
 
 (cl-defmethod cg-render ((game cg-patience-game))
   "Return a propertized depiction of GAME (SVG on a graphical display)."
@@ -380,6 +399,7 @@
 
 (defun cg-pat--redisplay ()
   (let ((game cg-pat--game) (inhibit-read-only t))
+    (setq cg-current-game game cg-redisplay-function #'cg-pat--redisplay)
     (setq-local mode-line-process (format " [%s]" (if (cg-won-p game) "solved" "playing")))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -387,6 +407,11 @@
 
 (defvar cg-pat-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-pat-left)
     (define-key map (kbd "<right>") #'cg-pat-right)
     (define-key map (kbd "<up>") #'cg-pat-left)

cg-president.el

@@ -310,29 +310,35 @@
   (cg-pres--deal cg-pres--game) (cg-pres--run cg-pres--game) (cg-pres--redisplay))
 (defun cg-pres-redraw () "Redraw." (interactive) (cg-pres--redisplay))
 (defun cg-pres-help () "Controls." (interactive)
-  (message "Arrows: choose rank  RET: play (C-u N to lead N)  p: pass  n: new  g: redraw"))
+  (message "Arrows or click: choose/play  RET: play (C-u N to lead N)  p: pass  +/-: size  n: new"))
 
 (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."
+  "Return a propertized, clickable SVG row of the hand: one card per rank.
+Each rank maps to a (hand . INDEX) region and a card-size slider sits below."
   (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)))))
+         (sh (cg-svg-slider-height)) (slider-y (+ pad h 22))
-         (height (+ pad h 20 pad)) (svg (svg-create width height)) (x pad) (i 0))
+         (width (+ (* 2 pad) (max (+ w gap) (* n (+ w gap)) (cg-svg-slider-width))))
+         (height (+ slider-y sh pad)) (svg (svg-create width height))
+         (x pad) (i 0) (regions '()))
     (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))
+                  :font-size 13 :fill lc :font-family cg-svg-font-family)
+        (push (cons (list x pad w h) (cons 'hand i)) regions))
       (setq x (+ x w gap) i (1+ i)))
-    (propertize "*" 'display (cg-svg-image svg (cg-scale)))))
+    (setq regions (append (nreverse regions)
+                          (cg-svg-slider-draw svg pad slider-y cg-card-scale)))
+    (propertize "*" 'display (cg-svg-image svg (cg-scale)) 'cg-regions regions)))
 
 (cl-defmethod cg-render ((game cg-president-game))
   "Return a propertized string depicting GAME for a text display."
@@ -364,13 +370,28 @@
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-president-game) action)
+  "Apply a click ACTION on the rank row to GAME G (a click also plays)."
+  (pcase action
+    (`(hand . ,i)
+     (cg-put g :cursor i)
+     (when (and (eq (cg-get g :phase) 'play) (= (cg-get g :turn) 0))
+       (cg-pres-act)))
+    (_ (cl-call-next-method))))
+
 (defun cg-pres--redisplay ()
   (let ((game cg-pres--game) (inhibit-read-only t))
+    (setq cg-current-game game cg-redisplay-function #'cg-pres--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
 (defvar cg-pres-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-pres-left)
     (define-key map (kbd "<right>") #'cg-pres-right)
     (define-key map (kbd "RET") #'cg-pres-act)

test/card-games-tests.el

@@ -1165,3 +1165,28 @@
       (should (cg-hf--book-valid-p (car (cg-hf--books g 0))))
       (should (= 4 (length (cg-rummy--hand g 0))))
       (should-not (cg-get g :discard)))))
+
+;;;; Mouse click-region wiring for eights, president, and the patience boards
+
+(ert-deftest cgt-mouse-regions ()
+  "The newly clickable games attach a `cg-regions' map to their SVG."
+  (let* ((g (cg-pat--deal (cg-golf-game)))
+         (regs (get-text-property 0 'cg-regions (cg-pat--svg g))))
+    (should regs)
+    (should (cl-find '(waste . 0) (mapcar #'cdr regs) :test #'equal))
+    (should (cl-find '(stock . 0) (mapcar #'cdr regs) :test #'equal))
+    (should (cl-find-if (lambda (a) (eq (car a) 'slot)) (mapcar #'cdr regs))))
+  (let ((g (cg-president-game)))
+    (cg-put g :games 0) (cg-pres--deal g)
+    (let ((regs (get-text-property 0 'cg-regions (cg-pres--svg g))))
+      (should regs)
+      (should (cl-find-if (lambda (a) (and (consp a) (eq (car a) 'hand)))
+                          (mapcar #'cdr regs)))))
+  (let ((g (cg-eights-game)))
+    (cg-put g :scores (make-vector 3 0)) (cg-eights--deal g)
+    (let* ((img (cg-svg-hand-image (mapcar #'cg-eights--spec (cg-eights--hand g 0))
+                                   :region-tag 'hand))
+           (regs (get-text-property 0 'cg-regions img)))
+      (should regs)
+      (should (cl-find-if (lambda (a) (and (consp a) (eq (car a) 'hand)))
+                          (mapcar #'cdr regs))))))