Trick games: full SVG table (opponents, trick, fanned hand)
* cg-trick.el (cg-trick--svg, cg-trick--draw-backs): draw the whole table as one SVG -- three opponents, the trick in a diamond, the South hand fanned with cursor, legal-play hints, and pass marks; hand cards carry (hand . INDEX) click regions. (cg-trick--render-text): the text fallback. (cg-render): dispatch SVG on a graphical display, else text. Add a footer legend; refresh the help. Covers Hearts, Spades, Whist, Oh Hell, and the Euchre/Pitch/Briscola subclasses. * test/card-games-tests.el: add cgt-trick-svg-smoke, cgt-trick-svg-bidding. * NEWS: note the trick-taking SVG table.
This commit is contained in:
parent
5060835731
commit
400e5830be
3 changed files with 161 additions and 36 deletions
153
cg-trick.el
153
cg-trick.el
|
|
@ -545,8 +545,100 @@
|
|||
(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."
|
||||
(defun cg-trick--draw-backs (svg x y n)
|
||||
"Draw up to three overlapped face-down backs at X, Y for a hand of N cards."
|
||||
(let ((k (min (max n 0) 3)) (xx x))
|
||||
(dotimes (_ k)
|
||||
(cg-svg-card svg xx y :down t)
|
||||
(setq xx (+ xx 16)))))
|
||||
|
||||
(defun cg-trick--svg (game)
|
||||
"Return a propertized full-table SVG depiction of trick GAME.
|
||||
The South hand carries clickable (hand . INDEX) regions."
|
||||
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap)
|
||||
(pad 16)
|
||||
(hand (cg-trick--sort (cg-trick--hand game 0)))
|
||||
(n (length hand))
|
||||
(overlap (cond ((> n 11) (- w 24)) ((> n 8) 20) (t 0)))
|
||||
(step (max 14 (- (+ w gap) overlap)))
|
||||
(fanw (if (> n 0) (+ (* (1- n) step) w) w))
|
||||
(width (max (+ fanw (* 2 pad)) 720))
|
||||
(cx (/ width 2))
|
||||
(scores (cg-get game :scores))
|
||||
(trick (cg-get game :trick))
|
||||
(turn (cg-get game :turn))
|
||||
(phase (cg-get game :phase))
|
||||
(marks (cg-get game :marks))
|
||||
(cursor (cg-get game :cursor))
|
||||
(bids (cg-get game :bids))
|
||||
(tks (cg-get game :tricks))
|
||||
(y-title 6) (y-north 26)
|
||||
(y-tn (+ y-north h 22))
|
||||
(cy (+ y-tn (round (* h 0.55))))
|
||||
(y-ts (+ cy (round (* h 0.15))))
|
||||
(y-south (+ y-ts h 34))
|
||||
(height (+ y-south h 30))
|
||||
(svg (svg-create width height))
|
||||
(lc (cg-color 'shadow :foreground "gray50"))
|
||||
(regions '()))
|
||||
(cl-labels
|
||||
((txt (str x y &optional sz bold anchor)
|
||||
(apply #'svg-text svg str :x x :y y :font-size (or sz 12) :fill lc
|
||||
:font-family cg-svg-font-family
|
||||
(append (and bold '(:font-weight "bold"))
|
||||
(and anchor (list :text-anchor anchor)))))
|
||||
(seat (s x y)
|
||||
(cg-trick--draw-backs svg x (+ y 6) (length (cg-trick--hand game s)))
|
||||
(txt (format "%s%s%s%s" (aref cg-trick-seat-names s)
|
||||
(if (and bids (aref bids s)) (format " bid %d" (aref bids s)) "")
|
||||
(if (and tks (> (aref tks s) 0)) (format " won %d" (aref tks s)) "")
|
||||
(if (= turn s) " <-" ""))
|
||||
x y 11))
|
||||
(trick-card (s x y)
|
||||
(let ((play (assq s trick)))
|
||||
(when play
|
||||
(let ((sp (cg-trick--spec (cdr play))))
|
||||
(cg-svg-card svg x y :rank (car sp) :suit (cdr sp)))))))
|
||||
(txt (format "%s -- %s" (oref game vname)
|
||||
(pcase phase
|
||||
('pass "pass three cards") ('bid "bidding")
|
||||
('play (if (= turn 0) "your turn" "opponents playing"))
|
||||
(_ "play")))
|
||||
pad (+ y-title 12) 13 t)
|
||||
(when scores
|
||||
(txt (format "S %d W %d N %d E %d"
|
||||
(aref scores 0) (aref scores 1) (aref scores 2) (aref scores 3))
|
||||
(- width pad) (+ y-title 12) 12 nil "end"))
|
||||
(seat 2 (- cx 40) y-north)
|
||||
(seat 1 pad cy)
|
||||
(seat 3 (- width pad 100) cy)
|
||||
(trick-card 2 (- cx (/ w 2)) y-tn)
|
||||
(trick-card 0 (- cx (/ w 2)) y-ts)
|
||||
(trick-card 1 (- cx w (round (* w 0.4))) (round (- cy (* h 0.25))))
|
||||
(trick-card 3 (+ cx (round (* w 0.4))) (round (- cy (* h 0.25))))
|
||||
(txt (format "Your hand (South)%s"
|
||||
(if (eq phase 'pass) (format " -- marked %d/3" (length marks)) ""))
|
||||
pad (- y-south 6) 11)
|
||||
(let ((x (- cx (/ fanw 2))) (i 0)
|
||||
(legalp (and (eq phase 'play) (= turn 0))))
|
||||
(dolist (c hand)
|
||||
(let ((sp (cg-trick--spec c))
|
||||
(curp (= i cursor))
|
||||
(markp (member c marks))
|
||||
(hintp (and legalp (cg-trick--legal-p game 0 c))))
|
||||
(cg-svg-card svg x y-south :rank (car sp) :suit (cdr sp)
|
||||
:highlight curp :hint hintp)
|
||||
(when markp
|
||||
(svg-rectangle svg (- x 3) (- y-south 3) (+ w 6) (+ h 6)
|
||||
:rx 8 :fill "none" :stroke "#4a90d9" :stroke-width 3))
|
||||
(push (cons (list x y-south (if (= i (1- n)) w step) h) (cons 'hand i)) regions))
|
||||
(setq x (+ x step) i (1+ i))))
|
||||
(txt (or (cg-get game :message) "") pad (- height 8) 12))
|
||||
(propertize "*" 'display (cg-svg-image svg (cg-scale))
|
||||
'cg-regions (nreverse regions))))
|
||||
|
||||
(defun cg-trick--render-text (game)
|
||||
"Return a plain-text depiction of trick GAME."
|
||||
(let* ((out (list))
|
||||
(scores (cg-get game :scores))
|
||||
(marks (cg-get game :marks))
|
||||
|
|
@ -557,45 +649,36 @@
|
|||
(push (format " Scores: South %d West %d North %d East %d\n\n"
|
||||
(aref scores 0) (aref scores 1) (aref scores 2) (aref scores 3))
|
||||
out))
|
||||
(dolist (s '(2 1 3)) ; North, West, East
|
||||
(dolist (s '(2 1 3))
|
||||
(push (cg-trick--seat-line game s) out))
|
||||
;; current trick
|
||||
(push "\n Trick: " out)
|
||||
(cond
|
||||
((null (cg-get game :trick)) (push "(empty)" out))
|
||||
((and cg-trick-svg-cards (display-graphic-p))
|
||||
(push (concat (mapconcat (lambda (p) (aref cg-trick-seat-names (car p)))
|
||||
(reverse (cg-get game :trick)) " ") " ")
|
||||
out)
|
||||
(push (cg-trick--svg-row (mapcar #'cdr (reverse (cg-get game :trick)))) out))
|
||||
(t (dolist (play (reverse (cg-get game :trick)))
|
||||
(push (format "%s:%s " (aref cg-trick-seat-names (car play))
|
||||
(let ((cs (cg-trick-card-string (cdr play))))
|
||||
(if (cg-trick-red-p (cdr play))
|
||||
(propertize cs 'face 'cg-red-suit) cs)))
|
||||
out))))
|
||||
(if (null (cg-get game :trick))
|
||||
(push "(empty)" out)
|
||||
(dolist (play (reverse (cg-get game :trick)))
|
||||
(push (format "%s:%s " (aref cg-trick-seat-names (car play))
|
||||
(let ((cs (cg-trick-card-string (cdr play))))
|
||||
(if (cg-trick-red-p (cdr play))
|
||||
(propertize cs 'face 'cg-red-suit) cs)))
|
||||
out)))
|
||||
(push "\n\n Your hand (South):\n " out)
|
||||
(if (and cg-trick-svg-cards (display-graphic-p))
|
||||
(let ((mi '()) (hi '()) (i 0)
|
||||
(legalp (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0))))
|
||||
(dolist (c hand)
|
||||
(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
|
||||
:region-tag 'hand) out))
|
||||
(let ((i 0))
|
||||
(dolist (c hand)
|
||||
(let* ((cs (cg-trick-card-string c))
|
||||
(faces nil))
|
||||
(when (cg-trick-red-p c) (push 'cg-red-suit faces))
|
||||
(when (member c marks) (push 'cg-hint faces))
|
||||
(when (= i cursor) (push 'cg-cursor faces))
|
||||
(push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
|
||||
(setq i (1+ i)))))
|
||||
(let ((i 0))
|
||||
(dolist (c hand)
|
||||
(let ((cs (cg-trick-card-string c)) (faces nil))
|
||||
(when (cg-trick-red-p c) (push 'cg-red-suit faces))
|
||||
(when (member c marks) (push 'cg-hint faces))
|
||||
(when (= i cursor) (push 'cg-cursor faces))
|
||||
(push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
|
||||
(setq i (1+ i))))
|
||||
(push (format "\n\n %s\n" (cg-get game :message)) out)
|
||||
(apply #'concat (nreverse out))))
|
||||
|
||||
(cl-defmethod cg-render ((game cg-trick-game))
|
||||
"Return a depiction of GAME: a full SVG table on a graphical display,
|
||||
else a plain-text board."
|
||||
(if (and cg-trick-svg-cards (display-graphic-p))
|
||||
(cg-trick--svg game)
|
||||
(cg-trick--render-text game)))
|
||||
|
||||
(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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue