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

Hand & Foot, Scopa, Casino: full SVG board via the shared helper

Browse source 
* cg-rummy.el (cg-rummy--board-svg): add :stock-label and a :discard 'none
books and your hand/foot.
* cg-scopa.el (cg-fish--svg, cg-fish--render-text): board with the table
* NEWS: note the new boards.
This commit is contained in:
Corwin Brust 2026-07-01 04:50:10 -05:00
parent 585c4449a0
commit 2ee802f52d
5 changed files with 92 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

3
NEWS
View file

@ -43,6 +43,9 @@ the mouse as well as the keyboard.
the stock and discard, the melds already down on the table, and your
fanned hand with cursor, marks, and lay-off hints; click a card to
select it. Honours ~cg-rummy-svg-cards~.
- The same board now covers Hand & Foot (each team's books, and your
hand or foot) and the fishing games Scopa and Casino (the loose
table cards and the deck).
** Rummy-family rules completed
- Rummy 500: take a card from anywhere in the discard pile (key ~T~) --

39
cg-handfoot.el
View file

@ -505,8 +505,45 @@ Return non-nil when the team goes down."
(defvar-local cg-hf--game nil "The Hand & Foot game in the current buffer.")
(defun cg-hf--svg (game)
"Return an SVG board for the Hand & Foot GAME."
(let* ((scores (cg-get game :scores)) (infos '()) (melds '()))
(dotimes (team (cg-get game :nteams))
(push (format "Team %d (score %d)%s%s" team (aref scores team)
(if (cg-hf--down-p game team) " down"
(format " needs %d" (cg-hf--min-for-round game)))
(let ((k (length (aref (cg-get game :redthrees) team))))
(if (> k 0) (format " red3:%d" k) "")))
infos)
(dolist (bk (cg-hf--books game team))
(push (cons (format "T%d%s" team
(if (cg-hf--book-complete-p bk)
(if (cg-hf--book-clean-p bk) " clean" " dirty") ""))
bk)
melds)))
(dotimes (s (cg-get game :nplayers))
(unless (= s 0)
(push (format "%s: %d in hand%s" (aref cg-handfoot--names s)
(length (cg-rummy--hand game s))
(if (= (aref (cg-get game :stage) s) 1) " (on foot)" ""))
infos)))
(cg-rummy--board-svg
:title (format "Hand & Foot target %d round %d (min %d)"
cg-handfoot-target (1+ (or (cg-get game :round) 0))
(cg-hf--min-for-round game))
:infos (nreverse infos) :melds (nreverse melds)
:discard (cg-rummy--top game) :stock (length (cg-get game :stock))
:hand (cg-rummy--hand game 0) :cursor (cg-get game :cursor)
:marks (cg-get game :marks) :message (cg-get game :message))))
(cl-defmethod cg-render ((game cg-handfoot-game))
"Return a propertized depiction of the Hand & Foot GAME."
"Return a depiction of the Hand & Foot GAME: SVG board if graphical, else text."
(if (and cg-rummy-svg-cards (display-graphic-p))
(cg-hf--svg game)
(cg-hf--render-text game)))
(defun cg-hf--render-text (game)
"Return a plain-text depiction of the Hand & Foot GAME."
(let* ((out '()) (scores (cg-get game :scores))
(hand (cg-rummy--hand game 0)) (cursor (cg-get game :cursor)))
(push (format " Hand & Foot target %d round %d (go-down minimum %d)\n\n"

10
cg-rummy.el
View file

@ -335,8 +335,11 @@ Keyword ARGS: :title :infos :melds :discard :stock :hand :cursor :marks
(raw-melds (plist-get args :melds))
(show-table (not (eq raw-melds 'none)))
(melds (and show-table raw-melds))
(discard (plist-get args :discard))
(raw-discard (plist-get args :discard))
(show-discard (not (eq raw-discard 'none)))
(discard (and show-discard raw-discard))
(stock (or (plist-get args :stock) 0))
(stock-label (or (plist-get args :stock-label) "Stock"))
(hand (plist-get args :hand))
(cursor (or (plist-get args :cursor) 0))
(marks (plist-get args :marks))
@ -383,13 +386,14 @@ Keyword ARGS: :title :infos :melds :discard :stock :hand :cursor :marks
(let ((yy (+ y-info 4)))
(dolist (line infos) (txt line pad yy 12) (setq yy (+ yy 16))))
(cg-svg-card svg pad y-sd :down (> stock 0) :gap (= stock 0))
(txt (format "Stock %d" stock) pad (+ y-sd h 13) 11)
(txt (format "%s %d" stock-label stock) pad (+ y-sd h 13) 11)
(when show-discard
(let ((dx (+ pad w gap 24)))
(if discard
(let ((sp (cg-rummy--card-spec discard)))
(cg-svg-card svg dx y-sd :rank (car sp) :suit (cdr sp)))
(cg-svg-card svg dx y-sd :gap t))
(txt "Discard" dx (+ y-sd h 13) 11))
(txt "Discard" dx (+ y-sd h 13) 11)))
(when show-table
(txt "Table" pad (- y-melds 4) 11)
(if (null melds)

22
cg-scopa.el
View file

@ -219,8 +219,28 @@ Only subsets of two or more cards are considered. Return nil if none."
(defvar-local cg-fish--game nil "The fishing game in the current buffer.")
(defun cg-fish--svg (game)
"Return an SVG board for the fishing GAME."
(cg-rummy--board-svg
:title (format "%s (to %d)" (oref game vname) (oref game target))
:infos (list (format "Computer: %d cards captured %d (score %d)"
(length (cg-fish--hand game 1)) (length (cg-fish--captured game 1))
(aref (cg-get game :scores) 1))
(format "Your captured: %d (score %d)"
(length (cg-fish--captured game 0)) (aref (cg-get game :scores) 0)))
:stock-label "Deck" :stock (length (cg-get game :deck)) :discard 'none
:melds (list (cons "Table" (cg-rummy-sort-hand (cg-get game :table))))
:hand (cg-fish--hand game 0) :cursor (cg-get game :cursor)
:message (cg-get game :message)))
(cl-defmethod cg-render ((game cg-fish-game))
"Return a propertized depiction of the fishing GAME."
"Return a depiction of the fishing GAME: SVG board if graphical, else text."
(if (and cg-rummy-svg-cards (display-graphic-p))
(cg-fish--svg game)
(cg-fish--render-text game)))
(defun cg-fish--render-text (game)
"Return a plain-text depiction of the fishing GAME."
(let* ((out '()) (cursor (cg-get game :cursor)))
(push (format " %s to %d\n\n" (oref game vname) (oref game target)) out)
(push (format " Computer: %d cards captured %d (score %d)\n"

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

@ -876,6 +876,24 @@
(should (rassoc '(hand . 0) regs))
(should (cl-every (lambda (r) (= 4 (length (car r)))) regs)))))
(ert-deftest cgt-hf-svg-smoke ()
(let ((g (cg-handfoot-game)))
(cg-put g :nplayers 4) (cg-put g :nteams 2) (cg-put g :scores (make-vector 2 0))
(cg-hf--deal g)
(cg-put g :cursor 0) (cg-put g :message "x")
(should (stringp (cg-hf--render-text g)))
(let ((regs (get-text-property 0 'cg-regions (cg-hf--svg g))))
(should (rassoc '(hand . 0) regs))
(should (cl-every (lambda (r) (= 4 (length (car r)))) regs)))))
(ert-deftest cgt-fish-svg-smoke ()
(let ((g (cg-scopa-game)))
(cg-fish--deal-round g)
(cg-put g :cursor 0) (cg-put g :message "x")
(should (stringp (cg-fish--render-text g)))
(should (rassoc '(hand . 0)
(get-text-property 0 'cg-regions (cg-fish--svg g))))))
(ert-deftest cgt-pat-golf-deal ()
(let ((g (cg-pat--deal (cg-golf-game))))
(should (= 35 (length (cg-get g :cards))))