Crazy Eights, Spite & Malice, Old Maid: SVG boards" \
discard, suit in play, stock, and the hand. * cg-spite.el (cg-spite--board-svg, cg-spite--render-text): centre piles, goal, discards, and hand. * cg-match.el (cg-om--svg, cg-om--render-text, cg-render-apply): Old Maid board with clickable target cards; wire mouse-1, zoom, and cg-current-game. * test/card-games-tests.el: add cgt-eights-svg-smoke, cgt-spite-svg-smoke, cgt-om-svg-smoke. * NEWS: note the new boards.
This commit is contained in:
parent
2ee802f52d
commit
32fb9f0c6d
5 changed files with 222 additions and 3 deletions
68
cg-spite.el
68
cg-spite.el
|
|
@ -273,8 +273,74 @@
|
|||
(push (format "%d:%s" (1+ d) (if top (cg-rummy-card-string top) "--")) parts)))
|
||||
(mapconcat #'identity (nreverse parts) " ")))
|
||||
|
||||
(defun cg-spite--board-svg (game)
|
||||
"Return an SVG board for the Spite & Malice GAME."
|
||||
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
|
||||
(hand (cg-spite--hand game 0)) (n (length hand))
|
||||
(cursor (cg-get game :cursor)) (center (cg-get game :center))
|
||||
(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))
|
||||
(colstep (+ w 14))
|
||||
(y-title 6) (y-opp 26)
|
||||
(y-center (+ y-opp 16))
|
||||
(y-sm (+ y-center h 16))
|
||||
(y-ylabel (+ y-sm 12))
|
||||
(y-yours (+ y-ylabel 6))
|
||||
(y-hand (+ y-yours h 42))
|
||||
(height (+ y-hand h 30))
|
||||
(width (max (+ fanw (* 2 pad)) (+ (* 5 colstep) (* 2 pad)) 620))
|
||||
(svg (svg-create width height))
|
||||
(lc (cg-color 'shadow :foreground "gray50"))
|
||||
(regions '()))
|
||||
(cl-labels ((txt (str x y &optional sz bold)
|
||||
(apply #'svg-text svg str :x x :y y :font-size (or sz 12) :fill lc
|
||||
:font-family cg-svg-font-family (and bold '(:font-weight "bold"))))
|
||||
(pilecard (spec x y)
|
||||
(if spec (cg-svg-card svg x y :rank (car spec) :suit (cdr spec))
|
||||
(cg-svg-card svg x y :gap t))))
|
||||
(txt (format "Spite & Malice (goal %d)" cg-spite-goal-size) pad (+ y-title 12) 13 t)
|
||||
(txt (format "Computer: goal %d left hand %d discards %s"
|
||||
(length (cg-spite--goal game 1)) (length (cg-spite--hand game 1))
|
||||
(cg-spite--disc-string game 1))
|
||||
pad (+ y-opp 4) 12)
|
||||
(txt "Centre (build A..Q; King is wild)" pad (- y-center 4) 11)
|
||||
(dotimes (i 4)
|
||||
(let* ((x (+ pad (* i colstep))) (pp (aref center i))
|
||||
(spec (and pp (cons (aref cg-rummy-ranks (car pp)) (car (cadr pp))))))
|
||||
(pilecard spec x y-center)))
|
||||
(txt (format "Stock %d Muck %d"
|
||||
(length (cg-get game :stock)) (length (cg-get game :muck)))
|
||||
pad y-sm 11)
|
||||
(let* ((gtop (car (cg-spite--goal game 0)))
|
||||
(gspec (and gtop (cg-rummy--card-spec gtop))))
|
||||
(txt (format "Your goal (%d left)" (length (cg-spite--goal game 0)))
|
||||
pad y-ylabel 11)
|
||||
(txt "Discards" (+ pad colstep) y-ylabel 11)
|
||||
(pilecard gspec pad y-yours)
|
||||
(dotimes (d 4)
|
||||
(let* ((x (+ pad colstep (* d colstep)))
|
||||
(dtop (car (aref (cg-spite--disc game 0) d)))
|
||||
(dspec (and dtop (cg-rummy--card-spec dtop))))
|
||||
(pilecard dspec x y-yours))))
|
||||
(txt "Your hand" pad (- y-hand 6) 11)
|
||||
(let ((x (max pad (- (/ width 2) (/ fanw 2)))) (i 0))
|
||||
(dolist (c hand)
|
||||
(let ((sp (cg-rummy--card-spec c)) (curp (= i cursor)))
|
||||
(cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp) :highlight curp)
|
||||
(push (cons (list x y-hand (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))))
|
||||
|
||||
(cl-defmethod cg-render ((game cg-spite-game))
|
||||
"Return a propertized depiction of the Spite & Malice GAME."
|
||||
"Return a depiction of the GAME: an SVG board if graphical, else text."
|
||||
(if (and cg-rummy-svg-cards (display-graphic-p))
|
||||
(cg-spite--board-svg game)
|
||||
(cg-spite--render-text game)))
|
||||
|
||||
(defun cg-spite--render-text (game)
|
||||
"Return a plain-text depiction of the Spite & Malice GAME."
|
||||
(let* ((out '()) (cursor (cg-get game :cursor)))
|
||||
(push " Spite & Malice\n\n" out)
|
||||
(push (format " Computer goal: %d left hand: %d discards: %s\n\n"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue