diff --git a/cg-core.el b/cg-core.el index 58fb2ea..0e5ed53 100644 --- a/cg-core.el +++ b/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 diff --git a/cg-render.el b/cg-render.el index 4e6a5f8..f6e3c32 100644 --- a/cg-render.el +++ b/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 diff --git a/cg-solitaire.el b/cg-solitaire.el index 8393a78..57500e1 100644 --- a/cg-solitaire.el +++ b/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 "") #'cg-sol-left) (define-key map (kbd "") #'cg-sol-right) (define-key map (kbd "") #'cg-sol-up) diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 62d530f..4845bf5 100644 --- a/test/card-games-tests.el +++ b/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)