Hand-cluster mouse + card-size slider

Shared hand row gains a region-tag: tagged hands carry a cg-regions click
map (cards -> (hand . i)) and a card-size slider in the same image.
cg-core adds cg-mouse-action, cg-card-click, zoom commands, cg-card-scale
(folded into cg-scale), and a cg-render-apply base for scale/zoom. Seven
hand games are now click-to-position (Scopa/Casino/Spite click-to-play),
with [mouse-1] and +/-/0 bound. Adds cgt-hand-regions; suite 111/111.

cg-core.el

@@ -44,6 +44,11 @@
   :group 'games
   :prefix "cg-")
 
+(defcustom cg-card-scale 1.0
+  "Card-size multiplier applied on top of any text scaling.
+Adjust with the card-size slider or the zoom keys (+/-/0)."
+  :type 'number :group 'card-games)
+
 
 ;;;; Engine base
 
@@ -127,9 +132,15 @@ Each region is (RECT . ACTION) with RECT (X Y W H) in image pixels."
 
 (cl-defgeneric cg-render-apply (game action)
   "Perform ACTION (returned by a renderer hit) on GAME.
-The default does nothing; games specialise this to make clicks act."
+Card-size actions (scale/zoom) are handled here; games specialise this
-  (ignore game action)
+for their own actions and delegate the rest with `cl-call-next-method'."
-  nil)
+  (ignore game)
+  (pcase action
+    (`(scale . ,v) (setq cg-card-scale v) t)
+    ('zoom-in  (setq cg-card-scale (min 3.0 (+ cg-card-scale 0.15))) t)
+    ('zoom-out (setq cg-card-scale (max 0.4 (- cg-card-scale 0.15))) t)
+    ('zoom-reset (setq cg-card-scale 1.0) t)
+    (_ nil)))
 
 (defvar cg-renderers nil
   "Alist mapping a treatment name (a symbol) to a `cg-renderer' subclass.
@@ -217,10 +228,53 @@ or batch), so callers always get a drawable colour string."
 
 (defun cg-scale ()
   "Return the SVG card scale factor for the current buffer.
-Tracks `text-scale-increase'/`text-scale-decrease' via the buffer-local
+Combines `cg-card-scale' with `text-scale-mode-amount', so both the
-`text-scale-mode-amount', so enlarging the text enlarges the cards."
+size slider and `text-scale-increase' enlarge the cards."
   (let ((amt (if (boundp 'text-scale-mode-amount) text-scale-mode-amount 0)))
-    (max 0.4 (min 4.0 (expt 1.15 amt)))))
+    (max 0.3 (min 4.0 (* cg-card-scale (expt 1.15 amt))))))
+
+(defvar-local cg-current-game nil
+  "The `cg-game' shown in the current buffer (for shared mouse/zoom).")
+
+(defvar-local cg-redisplay-function #'ignore
+  "Buffer-local function that redraws the current game's buffer.")
+
+(defun cg-card-refresh ()
+  "Redraw the current game buffer via `cg-redisplay-function'."
+  (funcall cg-redisplay-function))
+
+(defun cg-mouse-action (event)
+  "Return the action under mouse EVENT from the clicked image's region map.
+The clicked display string must carry a `cg-regions' text property."
+  (let* ((posn (event-start event)) (pt (posn-point posn))
+         (regions (and pt (get-text-property pt 'cg-regions))))
+    (when regions
+      (let ((xy (posn-object-x-y posn)) (sc (cg-scale)))
+        (and xy (cg-regions-hit regions
+                                (round (/ (car xy) sc)) (round (/ (cdr xy) sc))))))))
+
+(defun cg-card-click (event)
+  "Dispatch a mouse click on a card or control to the current game."
+  (interactive "e")
+  (let ((action (cg-mouse-action event)))
+    (when (and action cg-current-game)
+      (cg-render-apply cg-current-game action)
+      (cg-card-refresh))))
+
+(defun cg-card-zoom-in ()
+  "Make the cards larger."
+  (interactive)
+  (setq cg-card-scale (min 3.0 (+ cg-card-scale 0.15))) (cg-card-refresh))
+
+(defun cg-card-zoom-out ()
+  "Make the cards smaller."
+  (interactive)
+  (setq cg-card-scale (max 0.4 (- cg-card-scale 0.15))) (cg-card-refresh))
+
+(defun cg-card-zoom-reset ()
+  "Reset the card size."
+  (interactive)
+  (setq cg-card-scale 1.0) (cg-card-refresh))
 
 (provide 'cg-core)
 ;;; cg-core.el ends here

cg-cribbage.el

@@ -319,12 +319,19 @@ TOTAL is the running count after the play."
                         (mapconcat #'cg-rummy-card-string (cg-get game :crib) " ")) out))))
     (let* ((hand (if (eq phase 'play) (cg-crib--play game 0) (cg-crib--hand game 0))))
       (push (format "\n  Your %s:\n   " (if (eq phase 'play) "cards" "hand")) out)
-      (push (cg-rummy--render-cards hand cursor (cg-get game :marks)) out))
+      (push (cg-rummy--render-cards hand cursor (cg-get game :marks) nil 'hand) out))
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-cribbage-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-crib--redisplay ()
   (let ((game cg-crib--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-crib--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -406,6 +413,11 @@ TOTAL is the running count after the play."
 
 (defvar cg-cribbage-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-crib-left)
     (define-key map (kbd "<right>") #'cg-crib-right)
     (define-key map (kbd "SPC") #'cg-crib-mark)

cg-handfoot.el

@@ -366,13 +366,20 @@
                   (length (cg-get game :stock)))
           out)
     (push (format "  Your %s:\n   " (if (= (aref (cg-get game :stage) 0) 1) "foot" "hand")) out)
-    (push (cg-rummy--render-cards hand cursor (cg-get game :marks)) out)
+    (push (cg-rummy--render-cards hand cursor (cg-get game :marks) nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-handfoot-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-hf--redisplay ()
   "Redraw the Hand & Foot buffer."
   (let ((game cg-hf--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-hf--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :step) (cg-get game :phase))))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@@ -495,6 +502,11 @@
 
 (defvar cg-handfoot-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-hf-left)
     (define-key map (kbd "<right>") #'cg-hf-right)
     (define-key map (kbd "SPC") #'cg-hf-mark)

cg-match.el

@@ -208,12 +208,19 @@ Return non-nil when S can ask."
     (push (format "\n  Stock: %d        Your books: %d\n\n"
                   (length (cg-get game :stock)) (cg-gf--books game 0)) out)
     (push "  Your hand:\n   " out)
-    (push (cg-rummy--render-cards hand cursor nil) out)
+    (push (cg-rummy--render-cards hand cursor nil nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-go-fish-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-gf--redisplay ()
   (let ((game cg-gf--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-gf--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -257,6 +264,11 @@ Return non-nil when S can ask."
 
 (defvar cg-go-fish-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-gf-left)
     (define-key map (kbd "<right>") #'cg-gf-right)
     (dolist (k '("1" "2" "3" "4")) (define-key map k #'cg-gf-ask))

cg-rum500.el

@@ -306,14 +306,21 @@ Return non-nil if any meld was laid."
                     (format "  (score %d)" (aref scores 0))))
           out)
     (push (cg-rummy--render-cards hand cursor (cg-get game :marks)
-                                  (cg-tm--layoff-hint game))
+                                  (cg-tm--layoff-hint game) 'hand)
           out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-tablemeld-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-tm--redisplay ()
   "Redraw the table-meld buffer."
   (let ((game cg-tm--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-tm--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :step) (cg-get game :phase))))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@@ -443,6 +450,11 @@ Return non-nil if any meld was laid."
 
 (defvar cg-tm-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-tm-left)
     (define-key map (kbd "<right>") #'cg-tm-right)
     (define-key map (kbd "SPC") #'cg-tm-mark)

cg-rummy.el

@@ -289,8 +289,10 @@ Set to nil to force the plain-text card row everywhere."
   (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)
+(defun cg-rummy--svg-row (cards cursor marks hint-fn &optional region-tag)
-  "Return a one-image SVG row for CARDS with CURSOR, MARKS and HINT-FN."
+  "Return a one-image SVG row for CARDS.
+When REGION-TAG is non-nil, attach a `cg-regions' click map (each card as
+\(REGION-TAG . INDEX)) and draw a card-size slider beneath the row."
   (let* ((specs (mapcar #'cg-rummy--card-spec cards))
          (hints (when hint-fn
                   (let ((hs '()) (i 0))
@@ -298,18 +300,41 @@ Set to nil to force the plain-text card row everywhere."
                             (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))
+         (overlap (if (> (length cards) 11) (max 0 (- cg-svg-card-width 24)) 0)))
-         (svg (cg-svg-hand-svg specs :cursor cur :hints hints
+    (if (not region-tag)
-                               :marks marks :overlap overlap)))
+        (propertize "*" 'display
-    (propertize "*" 'display (cg-svg-image svg (cg-scale)))))
+                    (cg-svg-image (cg-svg-hand-svg specs :cursor cur :hints hints
+                                                   :marks marks :overlap overlap)
+                                  (cg-scale)))
+      (let* ((w cg-svg-card-width) (h cg-svg-card-height) (pad 8)
+             (step (max 1 (- (+ w cg-svg-card-gap) overlap)))
+             (n (length cards))
+             (cardw (if (> n 0) (+ (* (1- n) step) w) w))
+             (sh (cg-svg-slider-height))
+             (width (+ (* 2 pad) (max cardw (cg-svg-slider-width))))
+             (height (+ (* 2 pad) h 8 sh))
+             (svg (svg-create width height)) (regions '()) (x pad) (i 0))
+        (dolist (spec specs)
+          (cg-svg--draw-spec svg x pad spec (eql i cur) (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))
+          (push (cons (list x pad w h) (cons region-tag i)) regions)
+          (setq x (+ x step) i (1+ i)))
+        (setq regions (append (nreverse regions)
+                              (cg-svg-slider-draw svg pad (+ pad h 8) cg-card-scale)))
+        (propertize "*" 'display (cg-svg-image svg (cg-scale))
+                    'cg-regions regions)))))
 
-(defun cg-rummy--render-cards (cards cursor marks &optional hint-fn)
+(defun cg-rummy--render-cards (cards cursor marks &optional hint-fn region-tag)
   "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.  Draws SVG cards on
+HINT-FN an optional predicate marking playable cards.  When REGION-TAG is
-a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
+non-nil the SVG row is clickable (each card mapped to (REGION-TAG . INDEX))
+and carries a card-size slider.  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)
+      (cg-rummy--svg-row cards cursor marks hint-fn region-tag)
   (let ((i 0) (out '()))
     (dolist (c cards)
       (let ((cs (cg-rummy-card-string c)) (faces nil))
@@ -485,7 +510,7 @@ a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
           out)
     (push (format "  Your hand (deadwood %d, score %d):\n   "
                   (cg-gin--deadwood hand) (aref scores 0)) out)
-    (push (cg-rummy--render-cards hand cursor nil) out)
+    (push (cg-rummy--render-cards hand cursor nil nil 'hand) out)
     (when reveal
       (let ((p (cg-rummy-best-partition hand)))
         (push (format "\n    melds: %s\n    deadwood: %s"
@@ -495,9 +520,16 @@ a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-gin-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i))
+    (_ (cl-call-next-method))))
+
 (defun cg-gin--redisplay ()
   "Redraw the Gin Rummy buffer."
   (let ((game cg-gin--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-gin--redisplay)
     (setq-local mode-line-process
                 (format " [%s]" (or (cg-get game :step) (cg-get game :phase))))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@@ -610,6 +642,11 @@ a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
 
 (defvar cg-gin-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-gin-left)
     (define-key map (kbd "<right>") #'cg-gin-right)
     (define-key map "s" #'cg-gin-draw-stock)

cg-scopa.el

@@ -235,12 +235,20 @@ Only subsets of two or more cards are considered.  Return nil if none."
             "(empty)")
           out)
     (push "\n\n  Your hand:\n   " out)
-    (push (cg-rummy--render-cards (cg-fish--hand game 0) cursor nil) out)
+    (push (cg-rummy--render-cards (cg-fish--hand game 0) cursor nil nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-fish-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i)
+      (cg-fish-play))
+    (_ (cl-call-next-method))))
+
 (defun cg-fish--redisplay ()
   (let ((game cg-fish--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-fish--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -287,6 +295,11 @@ Only subsets of two or more cards are considered.  Return nil if none."
 
 (defvar cg-fish-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-fish-left)
     (define-key map (kbd "<right>") #'cg-fish-right)
     (define-key map (kbd "RET") #'cg-fish-play)

cg-spite.el

@@ -291,12 +291,20 @@
           out)
     (push (format "  Your discards: %s\n\n" (cg-spite--disc-string game 0)) out)
     (push "  Your hand:\n   " out)
-    (push (cg-rummy--render-cards (cg-spite--hand game 0) cursor nil) out)
+    (push (cg-rummy--render-cards (cg-spite--hand game 0) cursor nil nil 'hand) out)
     (push (format "\n\n  %s\n" (cg-get game :message)) out)
     (apply #'concat (nreverse out))))
 
+(cl-defmethod cg-render-apply ((g cg-spite-game) action)
+  "Apply a click ACTION on the hand to GAME G."
+  (pcase action
+    (`(hand . ,i) (cg-put g :cursor i)
+      (cg-spite-play))
+    (_ (cl-call-next-method))))
+
 (defun cg-spite--redisplay ()
   (let ((game cg-spite--game) (inhibit-read-only t))
+        (setq cg-current-game game cg-redisplay-function #'cg-spite--redisplay)
     (setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
     (erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
 
@@ -391,6 +399,11 @@
 
 (defvar cg-spite-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-spite-left)
     (define-key map (kbd "<right>") #'cg-spite-right)
     (define-key map (kbd "RET") #'cg-spite-play)

cg-svg.el

@@ -404,5 +404,36 @@ indices to ring as playable and as marked; OVERLAP fans the cards."
       (setq x (+ x step) i (1+ i)))
     svg))
 
+(defcustom cg-svg-slider-stops '(0.6 0.8 1.0 1.25 1.5 1.8 2.2)
+  "Card-size slider stops, as scale multipliers."
+  :type '(repeat number) :group 'card-games)
+
+(defun cg-svg-slider-width ()
+  "Return the pixel width of the card-size slider."
+  (+ 36 (* (length cg-svg-slider-stops) 24) 8))
+
+(defun cg-svg-slider-height ()
+  "Return the pixel height of the card-size slider."
+  24)
+
+(defun cg-svg-slider-draw (svg x y current)
+  "Draw a card-size slider into SVG at X, Y knobbed at CURRENT.
+Return its click regions as a list of (RECT . (scale . VALUE))."
+  (let* ((stops cg-svg-slider-stops) (segw 24) (regions '()) (i 0)
+         (cy (+ y 10)) (tx (+ x 36)))
+    (svg-text svg "size" :x x :y (+ y 14) :font-size 9 :fill "gray55"
+              :font-family cg-svg-font-family)
+    (svg-line svg tx cy (+ tx (* (length stops) segw)) cy
+              :stroke "gray60" :stroke-width 2)
+    (dolist (v stops)
+      (let* ((px (+ tx (* i segw) (/ segw 2)))
+             (near (< (abs (- v current)) 0.08)))
+        (svg-circle svg px cy (if near 7 4)
+                    :fill (if near (cg-svg--highlight) "white")
+                    :stroke "gray50" :stroke-width 1)
+        (push (cons (list (+ tx (* i segw)) y segw 22) (cons 'scale v)) regions))
+      (setq i (1+ i)))
+    (nreverse regions)))
+
 (provide 'cg-svg)
 ;;; cg-svg.el ends here

test/card-games-tests.el

@@ -1085,3 +1085,19 @@
     (should (> (buffer-size) 0))
     (cg-render-apply cg-sol--game '(col . 5))
     (should (= 11 (cg-get cg-sol--game :cursor)))))   ; spot index of (col . 5)
+;;;; Hand-cluster click regions + card-size slider
+
+(ert-deftest cgt-hand-regions ()
+  (let* ((cards '((0 . 0) (0 . 1) (1 . 5)))
+         (str (cg-rummy--svg-row cards 0 nil nil 'hand))
+         (regs (get-text-property 0 'cg-regions str)))
+    (should (= (+ 3 (length cg-svg-slider-stops)) (length regs)))   ; 3 cards + stops
+    (should (equal '(hand . 0) (cdr (car regs))))
+    (should (cl-find-if (lambda (r) (eq (car-safe (cdr r)) 'scale)) regs)))
+  (let ((g (cg-gin--deal (cg-gin-game))) (cg-card-scale 1.0))
+    (cg-render-apply g '(hand . 2))
+    (should (= 2 (cg-get g :cursor)))
+    (cg-render-apply g '(scale . 1.5))         ; base method handles scale
+    (should (= 1.5 cg-card-scale))
+    (cg-render-apply g 'zoom-reset)
+    (should (= 1.0 cg-card-scale))))