Wire the renderer registry: SVG treatment returns a region click-map

cg-renderer gains a regions slot; the text/svg treatments get real
draw/hit methods; cg-regions-hit + cg-render-apply complete the loop.
Prototype on solitaire: cg-sol--svg returns (image . regions), redisplay
goes through cg-render-game, and [mouse-1] selects-and-acts by reusing the
keyboard pick-up/drop. Adds cgt-keystone-regions; suite 110/110.

cg-core.el

@@ -94,7 +94,10 @@ and SPC as an action key.  Takes effect the next time a game starts."
 
 (defclass cg-renderer ()
   ((name :initarg :name :initform 'text :type symbol
-         :documentation "Symbol naming this treatment."))
+         :documentation "Symbol naming this treatment.")
+   (regions :initarg :regions :initform nil
+            :documentation "Click map from the last draw: list of (RECT . ACTION),
+RECT being (X Y W H) in unscaled image pixels."))
   "Abstract base class for a display treatment (a \"skin\")."
   :abstract t)
 
@@ -114,6 +117,20 @@ Return non-nil when the click was handled.")
   "Default method: treat the click as unhandled."
   nil)
 
+(defun cg-regions-hit (regions px py)
+  "Return the ACTION of the first region in REGIONS containing PX, PY.
+Each region is (RECT . ACTION) with RECT (X Y W H) in image pixels."
+  (cl-loop for (rect . action) in regions
+           for (x y w h) = rect
+           when (and (>= px x) (< px (+ x w)) (>= py y) (< py (+ y h)))
+           return action))
+
+(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."
+  (ignore game action)
+  nil)
+
 (defvar cg-renderers nil
   "Alist mapping a treatment name (a symbol) to a `cg-renderer' subclass.
 Populate it with `cg-register-renderer' and look entries up with

cg-render.el

@@ -94,5 +94,33 @@ The default treatment comes from `cg-render-resolve-treatment'."
   "Switch GAME to the treatment NAME and return its new renderer."
   (oset game renderer (cg-make-renderer name)))
 
+(cl-defgeneric cg-render-text (game)
+  "Return the plain-text display string for GAME.
+The default falls back to the game's `cg-render' method."
+  (cg-render game))
+
+(cl-defgeneric cg-render-svg (game)
+  "Return (DISPLAY-STRING . REGIONS) for GAME's SVG treatment.
+The default falls back to the `cg-render' string with no click regions."
+  (cons (cg-render game) nil))
+
+(cl-defmethod cg-renderer-draw ((r cg-text-renderer) (game cg-game))
+  "Draw GAME as plain text, clearing any click regions."
+  (oset r regions nil)
+  (insert (cg-render-text game)))
+
+(cl-defmethod cg-renderer-draw ((r cg-svg-renderer) (game cg-game))
+  "Draw GAME as SVG and record its click regions on R."
+  (let ((res (cg-render-svg game)))
+    (oset r regions (cdr res))
+    (insert (car res))))
+
+(cl-defmethod cg-renderer-hit ((r cg-svg-renderer) (game cg-game) position)
+  "Map POSITION to a game action via the regions recorded at the last draw."
+  (ignore game)
+  (let ((xy (posn-object-x-y position)) (sc (cg-scale)))
+    (and xy (cg-regions-hit (oref r regions)
+                            (round (/ (car xy) sc)) (round (/ (cdr xy) sc))))))
+
 (provide 'cg-render)
 ;;; cg-render.el ends here

cg-solitaire.el

@@ -50,6 +50,7 @@
 (require 'eieio)
 (require 'cg-core)
 (require 'cg-svg)
+(require 'cg-render)
 
 ;;;; Cards
 
@@ -610,31 +611,34 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
   (and card (cons (aref cg-sol-ranks (cdr card)) (car card))))
 
 (defun cg-sol--svg (game)
-  "Return a propertized one-image SVG board for solitaire GAME."
+  "Return (DISPLAY . REGIONS) for an SVG board of solitaire GAME.
+DISPLAY is a propertized one-image string; REGIONS is a click map of
+\(RECT . SPOT) entries, RECT being (X Y W H) in unscaled image pixels."
   (let* ((w cg-svg-card-width) (h cg-svg-card-height)
          (pad 12) (gap cg-svg-card-gap) (colgap 8) (vdown 12) (vup 26)
          (ncols (oref game ncols))
          (cur-spot (cg-sol--cur-spot game))
          (sel (cg-get game :sel)) (sel-n (or (cg-get game :sel-n) 0))
          (lc (cg-color 'shadow :foreground "gray40"))
-         (slots '()))
+         (regions '()) (slots '()))
     (when (oref game has-stock)
       (push (list (format "Stock(%d)" (length (cg-get game :stock)))
-                  nil (and (cg-get game :stock) t) (equal cur-spot '(stock . 0))) slots))
+                  nil (and (cg-get game :stock) t) (equal cur-spot '(stock . 0))
+                  '(stock . 0)) slots))
     (when (oref game has-waste)
       (push (list "Waste" (cg-sol--spec (car (last (cg-get game :waste)))) nil
-                  (equal cur-spot '(waste . 0))) slots))
+                  (equal cur-spot '(waste . 0)) '(waste . 0)) slots))
     (when (oref game has-reserve)
       (push (list (format "Resv(%d)" (length (cg-get game :reserve)))
                   (cg-sol--spec (car (last (cg-get game :reserve)))) nil
-                  (equal cur-spot '(reserve . 0))) slots))
+                  (equal cur-spot '(reserve . 0)) '(reserve . 0)) slots))
     (dotimes (i (oref game nfree))
       (push (list (format "F%d" (1+ i)) (cg-sol--spec (aref (cg-get game :free) i)) nil
-                  (equal cur-spot (cons 'free i))) slots))
+                  (equal cur-spot (cons 'free i)) (cons 'free i)) slots))
     (dotimes (i (oref game nfound))
       (push (list (format "%d" (1+ i))
                   (cg-sol--spec (car (last (aref (cg-get game :found) i)))) nil
-                  (equal cur-spot (cons 'found i))) slots))
+                  (equal cur-spot (cons 'found i)) (cons 'found i)) slots))
     (setq slots (nreverse slots))
     (let* ((ntop (length slots))
            (topw (+ (* 2 pad) (* ntop (+ w gap))))
@@ -653,13 +657,14 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
            (svg (svg-create width height)))
       (let ((x pad))
         (dolist (sl slots)
-          (cl-destructuring-bind (label spec downp cursorp) sl
+          (cl-destructuring-bind (label spec downp cursorp spot) sl
             (svg-text svg label :x (+ x 1) :y (- top-y 3) :font-size 11 :fill lc
                       :font-family cg-svg-font-family)
             (cond (downp (cg-svg-card svg x top-y :down t :highlight cursorp))
                   (spec (cg-svg-card svg x top-y :rank (car spec) :suit (cdr spec)
                                      :highlight cursorp))
-                  (t (cg-svg-card svg x top-y :gap t :highlight cursorp))))
+                  (t (cg-svg-card svg x top-y :gap t :highlight cursorp)))
+            (push (cons (list x top-y w h) spot) regions))
           (setq x (+ x w gap))))
       (dotimes (c ncols)
         (let* ((x (+ pad (* c (+ w colgap)))) (col (aref tab c)) (len (length col))
@@ -667,6 +672,7 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
                (cursorp (equal cur-spot (cons 'col c))))
           (svg-text svg (format "%d" (1+ c)) :x (+ x 1) :y col-label-y
                     :font-size 11 :fill lc :font-family cg-svg-font-family)
+          (push (cons (list x col-y w maxext) (cons 'col c)) regions)
           (if (= len 0)
               (cg-svg-card svg x y :gap t :highlight cursorp)
             (dolist (card col)
@@ -677,14 +683,27 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
                                :suit (cdr (cg-sol--spec card))
                                :highlight (and top-card cursorp) :hint selp))
                 (setq y (+ y (if downp vdown vup)) r (1+ r)))))))
-      (propertize "*" 'display (cg-svg-image svg (cg-scale))))))
+      (cons (propertize "*" 'display (cg-svg-image svg (cg-scale)))
+            (nreverse regions)))))
 
 (cl-defmethod cg-render ((game cg-solitaire-game))
   "Return a propertized depiction of GAME (SVG on a graphical display)."
   (if (and cg-sol-svg-cards (display-graphic-p))
-      (cg-sol--svg game)
+      (car (cg-sol--svg game))
     (cg-sol--render-text game)))
 
+(cl-defmethod cg-render-text ((game cg-solitaire-game))
+  (cg-sol--render-text game))
+
+(cl-defmethod cg-render-svg ((game cg-solitaire-game))
+  (if cg-sol-svg-cards (cg-sol--svg game)
+    (cons (cg-sol--render-text game) nil)))
+
+(cl-defmethod cg-render-apply ((game cg-solitaire-game) action)
+  "Apply a click ACTION (a cursor spot) by selecting it and acting."
+  (let ((idx (cl-position action (cg-sol--spots game) :test #'equal)))
+    (when idx (cg-put game :cursor idx) (cg-sol-act))))
+
 (defun cg-sol--render-text (game)
   "Return a plain-text depiction of solitaire GAME."
   (let* ((spots (cg-sol--spots game))
@@ -763,13 +782,22 @@ With prefix COUNT, pick up exactly COUNT cards from a column."
                                   (let ((s (cg-get game :sel)))
                                     (if s "carrying" "playing")))))
     (erase-buffer)
-    (insert (cg-render game))
+    (cg-render-game game)
     (goto-char (point-min))))
 
 ;;;; Mode and commands
 
+(defun cg-sol-mouse (event)
+  "Handle a mouse click on the solitaire board: select that pile and act."
+  (interactive "e")
+  (let* ((game cg-sol--game)
+         (r (and game (oref game renderer)))
+         (action (and r (cg-renderer-hit r game (event-start event)))))
+    (when action (cg-render-apply game action))))
+
 (defvar cg-sol-mode-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cg-sol-mouse)
     (define-key map (kbd "<left>")  #'cg-sol-left)
     (define-key map (kbd "<right>") #'cg-sol-right)
     (define-key map (kbd "<up>")    #'cg-sol-up)

test/card-games-tests.el

@@ -1063,3 +1063,25 @@
         (should (memq (cg-get g :phase) '(scored passed-out)))
         (should (stringp (cg-render g)))))
     (should (> scored 0))))
+;;;; Renderer registry / region keystone
+
+(ert-deftest cgt-keystone-regions ()
+  (let* ((g (cg-sol--deal (make-instance 'cg-klondike-game)))
+         (res (cg-render-svg g)))
+    (should (stringp (car res)))
+    (should (>= (length (cdr res)) 13))           ; 6 top slots + 7 columns
+    (let* ((reg (cl-find '(col . 3) (cdr res) :key #'cdr :test #'equal))
+           (rect (car reg)))
+      (should reg)
+      (should (equal '(col . 3)
+                     (cg-regions-hit (cdr res)
+                                     (+ (nth 0 rect) (/ (nth 2 rect) 2))
+                                     (+ (nth 1 rect) 10)))))
+    (should (null (cg-regions-hit (cdr res) -5 -5))))
+  (with-temp-buffer
+    (setq cg-sol--game (cg-sol--deal (make-instance 'cg-klondike-game)))
+    (cg-render-game cg-sol--game)
+    (should (oref cg-sol--game renderer))
+    (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)