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

Add nine games: Go Fish, Old Maid, Cribbage, Scopa, Casino,

Browse source 
Euchre, Pitch, Briscola, and Spite & Malice

Five new files, each reusing or extending an existing engine.

* cg-match.el: Go Fish and Old Maid, matching games on a shared
  helper set (completes the original wishlist).
* cg-cribbage.el: two-handed Cribbage to 121 -- the crib, the cut,
  pegging, and a full show scorer (fifteens, pairs, runs, flush, nobs).
* cg-scopa.el: a capture-by-sum engine driving Scopa (40-card, sette
  bello, primiera, scopas) and Casino (pairs and sums, big/little
  casino, aces, sweeps). Casino omits builds.
* cg-trick-ext.el: Euchre (24-card with both bowers), Auction Pitch
  (bid, pitch sets trump, High/Low/Jack/Game), and Briscola (fixed
  trump, no follow), as subclasses of the cg-trick engine.
* cg-spite.el: Spite & Malice, a competitive patience to empty the
  goal pile onto shared Ace-to-Queen centre piles; Kings are wild.

Wire all nine commands into the card-game chooser, extend the Makefile
EL list, and add README sections. Add ten ERT tests covering each
game's engine and a full AI-driven game; the suite is now 107/107 and
every file byte-compiles cleanly.

New files at Version 1.0.60 to match the tree; post-1.0.60 work
toward 1.0.90.
This commit is contained in:
Corwin Brust 2026-06-25 06:31:44 -05:00
parent 86c44a362a
commit 905d5989c2
9 changed files with 2421 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -908,3 +908,119 @@
(when (> turns 500000) (error "runaway")))))
(should (eq (cg-get g :phase) 'game-over))
(should (stringp (cg-render g)))))
;;;; Matching games (Go Fish, Old Maid)
(ert-deftest cgt-gofish-full ()
(let ((cg-go-fish-players 4) (g (cg-go-fish-game)) (guard 0))
(cg-gf--deal g)
(while (and (not (eq (cg-get g :phase) 'game-over)) (< guard 20000))
(cg-gf--ai-turn g (cg-get g :turn)) (cl-incf guard))
(should (eq (cg-get g :phase) 'game-over))
(let ((tot 0)) (dotimes (s 4) (cl-incf tot (cg-gf--books g s)))
(should (= tot 13)))
(should (stringp (cg-render g)))))
(ert-deftest cgt-oldmaid-full ()
(let ((cg-old-maid-players 4) (g (cg-old-maid-game)) (guard 0))
(cg-om--deal g)
(while (and (not (eq (cg-get g :phase) 'game-over)) (< guard 20000))
(cg-om--ai-turn g (cg-get g :turn)) (cl-incf guard))
(should (eq (cg-get g :phase) 'game-over))
(should (= 1 (cg-om--total g)))
(should (stringp (cg-render g)))))
;;;; Cribbage
(ert-deftest cgt-cribbage-scorer ()
(should (= 29 (cg-crib--score-show '((0 . 4)(1 . 4)(3 . 4)(2 . 10)) '(2 . 4))))
(should (= 12 (cg-crib--count-pairs '((0 . 4)(1 . 4)(2 . 4)(3 . 4)))))
(should (= 5 (cg-crib--count-runs '((0 . 1)(0 . 2)(0 . 3)(0 . 4)(0 . 5)))))
(should (= 2 (cg-crib--peg-score '((0 . 10)(0 . 4)) 15)))
(should (= 3 (cg-crib--peg-score '((0 . 2)(0 . 3)(0 . 4)) 12)))
(should (= 6 (cg-crib--peg-score '((0 . 6)(1 . 6)(2 . 6)) 21))))
(ert-deftest cgt-cribbage-full ()
(let ((g (cg-cribbage-game)) (deals 0))
(cg-put g :dealer 1)
(cl-flet ((ai-deal (g)
(cg-crib--deal g)
(let ((d0 (cg-crib--ai-discard g 0)) (d1 (cg-crib--ai-discard g 1)))
(cg-crib--set-hand g 0 (cl-set-difference (cg-crib--hand g 0) d0 :test #'equal))
(cg-crib--set-hand g 1 (cl-set-difference (cg-crib--hand g 1) d1 :test #'equal))
(cg-put g :crib (append d0 d1)))
(cg-crib--start-play g)
(let ((guard 0))
(while (and (eq (cg-get g :phase) 'play) (not (cg-crib--peg-over-p g))
(< guard 400))
(cl-incf guard)
(let ((s (cg-get g :pturn)))
(if (cg-crib--legal g s) (cg-crib--ai-play g s) (cg-crib--peg-go g s)))))
(when (and (eq (cg-get g :phase) 'play) (cg-crib--peg-over-p g))
(cg-crib--show g))))
(while (and (not (eq (cg-get g :phase) 'game-over)) (< deals 300))
(cg-put g :dealer (- 1 (cg-get g :dealer)))
(ai-deal g) (cl-incf deals)))
(should (eq (cg-get g :phase) 'game-over))
(should (stringp (cg-render g)))))
;;;; Fishing games (Scopa, Casino)
(ert-deftest cgt-fish-capture ()
(let ((g (cg-scopa-game)))
(cg-put g :table '((0 . 0)(1 . 1)(2 . 3)))
(should (equal (sort (mapcar #'cdr (cg-fish--capture g '(3 . 4))) #'<) '(0 3))))
(let ((g (cg-casino-game)))
(cg-put g :table '((0 . 12)(1 . 12)(2 . 5)))
(should (= 1 (length (cg-fish--capture g '(3 . 12)))))))
(ert-deftest cgt-fish-full ()
(dolist (mk (list #'cg-scopa-game #'cg-casino-game))
(let ((g (funcall mk)) (rounds 0))
(cg-fish--deal-round g)
(while (and (not (eq (cg-get g :phase) 'game-over)) (< rounds 200))
(if (eq (cg-get g :phase) 'round-over)
(cg-fish--deal-round g)
(cg-fish--ai-play g (cg-get g :turn)) (cl-incf rounds)))
(should (eq (cg-get g :phase) 'game-over))
(should (stringp (cg-render g))))))
;;;; Trick extensions (Euchre, Pitch, Briscola)
(ert-deftest cgt-euchre-bowers ()
(should (> (cg-euchre--power '(0 . 9) 0 0) (cg-euchre--power '(1 . 9) 0 0)))
(should (> (cg-euchre--power '(1 . 9) 0 0) (cg-euchre--power '(0 . 12) 0 0)))
(should (= 120 (let ((s 0)) (dolist (su '(0 1 2 3))
(dolist (r cg-briscola--ranks)
(setq s (+ s (cg-bris--points (cons su r)))))) s))))
(ert-deftest cgt-trick-ext-full ()
(dolist (class '(cg-briscola-game cg-pitch-game cg-euchre-game))
(let ((g (make-instance class)) (guard 0))
(cg-trick--new g)
(while (and (not (eq (cg-get g :phase) 'game-over)) (< guard 50000))
(cl-incf guard)
(if (cg-trick--hand-over-p g)
(cg-trick--finish-hand g)
(let ((s (cg-get g :turn)))
(cg-trick--play g s (cg-trick--ai-play g s)))))
(should (eq (cg-get g :phase) 'game-over))
(should (stringp (cg-render g))))))
;;;; Spite & Malice
(ert-deftest cgt-spite-legal ()
(let ((g (cg-spite-game)))
(cg-spite--deal g) (cg-put g :center (make-vector 4 nil))
(should (eql 0 (cg-spite--legal-center g '(0 . 0)))) ; Ace starts a pile
(should (null (cg-spite--legal-center g '(0 . 1)))) ; a Two cannot
(should (eql 0 (cg-spite--legal-center g '(0 . 12)))) ; King is wild
(cg-spite--put-center g '(0 . 0) 0)
(should (= 1 (cg-spite--needed g 0)))))
(ert-deftest cgt-spite-full ()
(let ((cg-spite-goal-size 10) (g (cg-spite-game)) (turns 0))
(cg-spite--deal g)
(while (and (eq (cg-get g :phase) 'play) (< turns 6000))
(cl-incf turns) (cg-spite--ai-turn g (cg-get g :turn)))
(should (eq (cg-get g :phase) 'game-over))
(should (stringp (cg-render g)))))