corwin/card-game.el
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Corwin Brust 2026-06-25 09:10:42 -05:00
parent 4dc839e719
commit 287700ddca
4 changed files with 108 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

19
cg-core.el
View file

@ -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

28
cg-render.el
View file

@ -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

52
cg-solitaire.el
View file

@ -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)

22
test/card-games-tests.el
View file

@ -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)