From 519021f17d2185e8f68888ad4674b170f3431d14 Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Fri, 26 Jun 2026 15:30:46 -0500 Subject: [PATCH] Click-to-play for the trick family and Bridge; factor cg-svg-hand-image Extract the clickable hand+slider builder into cg-svg-hand-image and have the rummy, trick, and bridge svg rows delegate to it. Tag the South hand in cg-trick (covers all seven trick games) and the acting hand in cg-bridge with click regions, mapping (hand . i) to select-and-play via cg-render-apply; bind [mouse-1] and +/-/0. Suite 111/111. --- cg-bridge.el | 30 ++++++++++++++++++++---------- cg-rummy.el | 48 +++++++++++++----------------------------------- cg-svg.el | 29 +++++++++++++++++++++++++++++ cg-trick.el | 31 +++++++++++++++++++++---------- 4 files changed, 83 insertions(+), 55 deletions(-) diff --git a/cg-bridge.el b/cg-bridge.el index d03dbf5..fe24ce8 100644 --- a/cg-bridge.el +++ b/cg-bridge.el @@ -490,15 +490,13 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD." (cons (aref cg-bridge-ranks (cdr card)) (car card))) -(cl-defun cg-bridge--svg-row (cards &key cursor hints) - "Return a one-image SVG row for CARDS with CURSOR and HINTS indices." - (propertize "*" 'display - (cg-svg-image - (cg-svg-hand-svg (mapcar #'cg-bridge--spec cards) - :cursor cursor :hints hints - :overlap (if (> (length cards) 11) - (max 0 (- cg-svg-card-width 26)) 0)) - (cg-scale)))) +(cl-defun cg-bridge--svg-row (cards &key cursor hints region-tag) + "Return a one-image SVG row for CARDS (clickable + sliderful when REGION-TAG)." + (cg-svg-hand-image (mapcar #'cg-bridge--spec cards) + :cursor cursor :hints hints + :overlap (if (> (length cards) 11) + (max 0 (- cg-svg-card-width 26)) 0) + :region-tag region-tag)) (cl-defmethod cg-render ((game cg-bridge-game)) "Return a propertized depiction of the Bridge GAME." @@ -565,7 +563,7 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: (when (and (= (cg-get game :turn) act) (cg-bridge--legal-play-p game act c)) (push i hi)) (setq i (1+ i))) - (push (cg-bridge--svg-row hand :cursor cursor :hints hi) out))) + (push (cg-bridge--svg-row hand :cursor cursor :hints hi :region-tag 'hand) out))) ((eq phase 'play) (let ((i 0)) (dolist (c hand) @@ -580,8 +578,15 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: (push (format "\n\n %s\n" (cg-get game :message)) out) (apply #'concat (nreverse out)))) +(cl-defmethod cg-render-apply ((g cg-bridge-game) action) + "Apply a click ACTION on the hand: select that card and play it." + (pcase action + (`(hand . ,i) (cg-put g :cursor i) (cg-bridge-play)) + (_ (cl-call-next-method)))) + (defun cg-bridge--redisplay () (let ((game cg-bridge--game) (inhibit-read-only t)) + (setq cg-current-game game cg-redisplay-function #'cg-bridge--redisplay) (setq-local mode-line-process (format " [%s]" (cg-get game :phase))) (erase-buffer) (insert (cg-render game)) (goto-char (point-min)))) @@ -728,6 +733,11 @@ vulnerability, and TRICKS the declarer side's trick count. Keys: (defvar cg-bridge-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 "") #'cg-bridge-left) (define-key map (kbd "") #'cg-bridge-right) (define-key map (kbd "") #'cg-bridge-up) diff --git a/cg-rummy.el b/cg-rummy.el index cac8351..8fcf13b 100644 --- a/cg-rummy.el +++ b/cg-rummy.el @@ -290,41 +290,19 @@ Set to nil to force the plain-text card row everywhere." (cons (aref cg-rummy-ranks (cdr card)) (car card)))) (defun cg-rummy--svg-row (cards cursor marks hint-fn &optional region-tag) - "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)) - (dolist (c cards) (when (funcall hint-fn c) (push i hs)) - (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))) - (if (not region-tag) - (propertize "*" 'display - (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))))) + "Return a one-image SVG row for CARDS (clickable + sliderful when REGION-TAG). +HINT-FN is an optional predicate marking playable cards." + (let ((hints (when hint-fn + (let ((hs '()) (i 0)) + (dolist (c cards) (when (funcall hint-fn c) (push i hs)) + (setq i (1+ i))) + hs)))) + (cg-svg-hand-image (mapcar #'cg-rummy--card-spec cards) + :cursor (and (integerp cursor) (>= cursor 0) cursor) + :marks marks :hints hints + :overlap (if (> (length cards) 11) + (max 0 (- cg-svg-card-width 24)) 0) + :region-tag region-tag))) (defun cg-rummy--render-cards (cards cursor marks &optional hint-fn region-tag) "Return a propertized row of CARDS. diff --git a/cg-svg.el b/cg-svg.el index 993ac41..b5be549 100644 --- a/cg-svg.el +++ b/cg-svg.el @@ -435,5 +435,34 @@ Return its click regions as a list of (RECT . (scale . VALUE))." (setq i (1+ i))) (nreverse regions))) +(cl-defun cg-svg-hand-image (specs &key cursor marks hints (overlap 0) region-tag) + "Return a propertized one-image string for a hand of card SPECS. +CURSOR is the highlighted index; MARKS and HINTS are index lists. With +REGION-TAG non-nil, the image carries a `cg-regions' click map (each card +as (REGION-TAG . INDEX)) and a card-size slider beneath the row." + (if (not region-tag) + (propertize "*" 'display + (cg-svg-image (cg-svg-hand-svg specs :cursor cursor :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 specs)) + (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 cursor) (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)))) + (provide 'cg-svg) ;;; cg-svg.el ends here diff --git a/cg-trick.el b/cg-trick.el index ec1cae2..45d2783 100644 --- a/cg-trick.el +++ b/cg-trick.el @@ -537,15 +537,13 @@ "Return the cg-svg display spec (RANK-STRING . SUIT) for CARD." (cons (aref cg-trick-ranks (cdr card)) (car card))) -(cl-defun cg-trick--svg-row (cards &key cursor marks hints) - "Return a one-image SVG row for CARDS with CURSOR, MARKS, HINTS indices." - (propertize "*" 'display - (cg-svg-image - (cg-svg-hand-svg (mapcar #'cg-trick--spec cards) - :cursor cursor :marks marks :hints hints - :overlap (if (> (length cards) 11) - (max 0 (- cg-svg-card-width 24)) 0)) - (cg-scale)))) +(cl-defun cg-trick--svg-row (cards &key cursor marks hints region-tag) + "Return a one-image SVG row for CARDS (clickable + sliderful when REGION-TAG)." + (cg-svg-hand-image (mapcar #'cg-trick--spec cards) + :cursor cursor :marks marks :hints hints + :overlap (if (> (length cards) 11) + (max 0 (- cg-svg-card-width 24)) 0) + :region-tag region-tag)) (cl-defmethod cg-render ((game cg-trick-game)) "Return a propertized string depicting GAME for a text display." @@ -584,7 +582,8 @@ (when (member c marks) (push i mi)) (when (and legalp (cg-trick--legal-p game 0 c)) (push i hi)) (setq i (1+ i))) - (push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi) out)) + (push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi + :region-tag 'hand) out)) (let ((i 0)) (dolist (c hand) (let* ((cs (cg-trick-card-string c)) @@ -597,9 +596,16 @@ (push (format "\n\n %s\n" (cg-get game :message)) out) (apply #'concat (nreverse out)))) +(cl-defmethod cg-render-apply ((g cg-trick-game) action) + "Apply a click ACTION on the hand: select that card and play it." + (pcase action + (`(hand . ,i) (cg-put g :cursor i) (cg-trick-act)) + (_ (cl-call-next-method)))) + (defun cg-trick--redisplay () "Redraw the current trick-game buffer." (let ((game cg-trick--game) (inhibit-read-only t)) + (setq cg-current-game game cg-redisplay-function #'cg-trick--redisplay) (setq-local mode-line-process (format " [%s]" (or (cg-get game :phase) "play"))) (erase-buffer) @@ -675,6 +681,11 @@ (defvar cg-trick-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 "") #'cg-trick-left) (define-key map (kbd "") #'cg-trick-right) (define-key map (kbd "RET") #'cg-trick-act)