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

Compare commits

base: corwin:7918daf7ef6ab2ea4d4fc6391e49fde696cb5856
Branches Tags
corwin:master
corwin:1.0.91
..
compare: corwin:2ee802f52d8b78c1d2848222b591b0a7026e1492
Branches Tags
corwin:master
corwin:1.0.91

No commits in common. "7918daf7ef6ab2ea4d4fc6391e49fde696cb5856" and "2ee802f52d8b78c1d2848222b591b0a7026e1492" have entirely different histories.
7918daf7ef ... 2ee802f52d

37 changed files with 89 additions and 2663 deletions
Download patch file Download diff file Expand all files Collapse all files

15
.gitignore vendored
View file

@ -4,18 +4,3 @@
/card-games-*-src.tar.gz
*.sketch
*~
# Generated documentation (built from doc/card-games.texi with makeinfo)
/doc/card-games.info
/doc/card-games.html
/doc/card-games.pdf
/doc/card-games.aux
/doc/card-games.log
/doc/card-games.toc
/doc/card-games.cp
/doc/card-games.cps
/doc/card-games.fn
/doc/card-games.fns
/doc/card-games.ky
/doc/card-games.pg
/doc/card-games.tp
/doc/card-games.vr

77
Makefile
View file

@ -1,7 +1,7 @@
# Makefile for card-games -- byte-compile, test, and package.
EMACS ?= emacs
PKG = card-games
VERSION = 1.0.91
VERSION = 1.0.90
# Source files in dependency order (cg-core first).
EL = cg-core.el cg-svg.el cg-render.el cg-net.el cg-bid.el cg-gaps.el cg-bid-ui.el cg-bid-net.el cg-solitaire.el cg-trick.el cg-eights.el cg-patience.el cg-president.el cg-rummy.el cg-rum500.el cg-handfoot.el cg-match.el cg-cribbage.el cg-scopa.el cg-trick-ext.el cg-spite.el cg-bridge.el cg-crapette.el card-games.el
ELC = $(EL:.el=.elc)
@ -11,17 +11,9 @@ TAR = $(TARDIR).tar
SRCTAR = $(PKG)-$(VERSION)-src.tar.gz
DIST = dist
BATCH = $(EMACS) -Q --batch -L .
MANUAL = doc/card-games.texi
VERTEXI = doc/version.texi
INFO = doc/card-games.info
IMAGES = doc/images/klondike.png doc/images/hearts.png
MAKEINFO ?= makeinfo
TEXI2PDF ?= texi2pdf
README = README.md
EXTRA = README.org $(README) $(PKGDESC) $(MANUAL) $(VERTEXI) $(IMAGES)
EXTRA = README.org $(PKGDESC)
.PHONY: all compile test clean distclean checkdoc lint package tarball elpa release help \
info info-emacs html pdf docclean version readme hooks
.PHONY: all compile test clean distclean checkdoc lint package tarball elpa release help
help:
@echo "card-games $(VERSION) -- make targets:"
@ -29,13 +21,6 @@ help:
@echo " test run the ERT test suite"
@echo " checkdoc run checkdoc on all sources"
@echo " lint run package-lint (if installed)"
@echo " version regenerate $(VERTEXI) from VERSION"
@echo " readme export README.org -> README.md (Emacs batch)"
@echo " hooks install the git pre-commit hook"
@echo " info build the Info manual ($(INFO)) with makeinfo"
@echo " info-emacs build the Info manual with Emacs alone (fallback)"
@echo " html build the one-file HTML manual"
@echo " pdf build the PDF manual (needs a TeX installation)"
@echo " package build the installable package tarball ($(TAR))"
@echo " elpa build a one-package ELPA archive in $(DIST)/"
@echo " release clean + test + package + source tarball"
@ -81,8 +66,8 @@ elpa: tarball
# Source snapshot for a GitHub release. Archive an explicit file list
# (not ".") so the growing output tarball and editor lock files are never
# read mid-write -- which is what caused "tar: .: file changed as we read it".
SRCFILES = $(EL) $(EXTRA) build.el hooks Makefile .gitignore test
release: distclean version readme test tarball
SRCFILES = $(EL) $(EXTRA) Makefile .gitignore test
release: distclean test tarball
rm -f $(SRCTAR)
tar --transform 's,^,$(TARDIR)/,' \
--exclude='*.elc' --exclude='*.tar' --exclude='*.tar.gz' \
@ -90,58 +75,8 @@ release: distclean version readme test tarball
-czf $(SRCTAR) $(SRCFILES)
@echo "Built $(SRCTAR) and $(TAR) for release $(VERSION)"
# Documentation. The Texinfo source lives in doc/; the Info manual is
# built from it with makeinfo. doc/version.texi carries the version and
# is committed; `make version' regenerates it from VERSION (run at release).
version:
@printf '@set VERSION %s\n@set UPDATED %s\n@set YEAR %s\n' \
"$(VERSION)" "$$(date '+%-d %B %Y')" "$$(date +%Y)" > $(VERTEXI)
@echo "Wrote $(VERTEXI) (VERSION $(VERSION))"
# README: Org is the source; GitHub and MELPA render Markdown better than
# Org, so we export README.org -> README.md with Emacs batch (ox-md). The
# git pre-commit hook (make hooks) keeps README.md in step automatically.
readme: $(README)
$(README): README.org build.el
$(BATCH) -l build.el
# Install the pre-commit hook into this checkout's .git/hooks.
hooks:
@if [ -d .git ]; then \
cp hooks/pre-commit .git/hooks/pre-commit && \
chmod +x .git/hooks/pre-commit && \
echo "Installed .git/hooks/pre-commit"; \
else \
echo "No .git directory here; skipping hook install."; \
fi
info: $(INFO)
$(INFO): $(MANUAL) $(VERTEXI)
$(MAKEINFO) -o $@ $(MANUAL)
# Fallback: build the Info manual with Emacs alone (no makeinfo needed).
# Handy on Windows/MSYS2 where Emacs is present but texinfo may not be.
# The native formatter is lower fidelity than makeinfo, so `make info'
# stays the default; this is only for a makeinfo-less environment.
info-emacs: $(MANUAL) $(VERTEXI)
cd doc && $(EMACS) -Q --batch --eval "(require 'texinfmt)" \
-f batch-texinfo-format card-games.texi
html: $(MANUAL) $(VERTEXI)
$(MAKEINFO) --html --no-split -o doc/card-games.html $(MANUAL)
pdf: $(MANUAL) $(VERTEXI)
cd doc && $(TEXI2PDF) -q card-games.texi
docclean:
rm -f $(INFO) doc/card-games.html doc/card-games.pdf \
doc/card-games.aux doc/card-games.cp doc/card-games.cps \
doc/card-games.fn doc/card-games.ky doc/card-games.log \
doc/card-games.pg doc/card-games.toc doc/card-games.tp \
doc/card-games.vr doc/card-games.fns
clean:
rm -f $(ELC)
distclean: clean docclean
distclean: clean
rm -rf $(DIST) $(TARDIR) $(TAR) $(SRCTAR)

55
NEWS
View file

@ -1,18 +1,6 @@
card-games NEWS -- user-visible changes
========================================
* Version 1.0.91 (pretest2: playtest)
** Documentation
- A complete Info manual now ships with the package: ~C-h i~ and choose
*Card Games* (or ~M-x info RET (card-games) RET~). It is built with
makeinfo (~make info~); ~make info-emacs~ builds it with Emacs alone
for environments without a texinfo installation.
- The README is generated from ~README.org~ to ~README.md~ with Emacs
batch (~ox-md~), so GitHub and MELPA render it faithfully; a
~pre-commit~ hook (~make hooks~) keeps ~README.md~ in step. Added
board screenshots and refreshed the game list and customization notes.
* Version 1.0.90 (pre-test snapshot)
This release grows the package from the five-game 1.0.60 candidate to a
@ -51,16 +39,6 @@ the mouse as well as the keyboard.
the middle, and your fanned hand, with the legal cards you may play
ringed. Click a card to play it. Set ~cg-trick-svg-cards~ to nil
for the plain-text board.
- The Emacs emblem in the full-window (SVG) UIs is now switchable via
~cg-svg-emacs-logo~: it embeds a real logo that ships with Emacs --
the modern icon (default), the classic icon, a GNU head, or the
splash image -- or the small built-in drawn emblem, or none.
- More card backs, and a random default. ~cg-svg-card-back~ now offers
~dots~, ~rings~, ~solid~, ~lattice~, ~waves~, ~diamond~, and four
backs stamped with an Emacs logo (~emacs~, ~emacs-classic~, ~gnu~,
~splash~). It defaults to ~random~, which picks a back for the
session; ~M-x cg-svg-shuffle-card-back~ (or reopening the game menu)
rolls a new one.
- Full SVG board for the rummy games (Gin Rummy, Rummy, Rummy 500):
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
@ -68,15 +46,6 @@ the mouse as well as the keyboard.
- 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).
- SVG boards for Crazy Eights (the discard, the suit in play, and the
stock), Spite & Malice (the four centre piles, your goal and discard
piles), and Old Maid (the opponents and your hand; click one of the
next player's face-down cards to draw it).
- SVG boards for Cribbage (a peg-track for each player, the starter, the
pegging count and cards, and the crib at the show) and Bridge (the
rubber and contract, all four seats with the dummy exposed, the trick
in the middle, and the hand you are playing). With these every game
in the collection now has a full graphical board.
** Rummy-family rules completed
- Rummy 500: take a card from anywhere in the discard pile (key ~T~) --
@ -93,30 +62,6 @@ the mouse as well as the keyboard.
"Next hand" button and the hand fan.
- Live multiplayer 500 over TCP (~M-x cg-bid-host~ / ~M-x cg-bid-join~).
** Pick how the games are drawn
- From the ~M-x card-game~ menu (or ~M-x card-games-set-treatment~) you
can switch all the games between ~text~ (UNICODE cards), ~svg~ (drawn
cards), and ~full~ (the full-window SVG table where a game has one,
Gaps and 500).
** Adjustable computer opponents
- A new ~cg-ai-level~ (easy, normal, hard) sets how hard the computer
plays, and you can change it right from the ~M-x card-game~ menu (or
with ~M-x card-games-set-ai-level~). Russian Bank (Crapette) plays
all three levels; the trick-taking games play a random legal card on
easy. Other games ignore it for now.
** A craftier Russian Bank (Crapette) opponent
- On normal and hard the computer empties its reserve first (the pile
you must clear to win) and prefers loading its cards onto you; on hard
it also looks a move ahead to rearrange the houses when doing so frees
a card it could not otherwise place. Easy keeps the old simple play.
** Bug fixes
- Alternating-colour building (the tableau solitaires and Russian Bank)
wrongly treated a diamond and a heart as opposite colours, so a red
card could be built on another red card. Both are red; fixed.
** Playtest fixes
- ~q~ now returns to the ~M-x card-game~ menu from any game, instead of
burying the buffer and leaving the previous buffer on screen.

306
README.md
View file

@ -1,306 +0,0 @@
Card games for Emacs: about thirty of them, from Klondike and FreeCell
to Hearts, 500, Gin, Cribbage, and two-player Russian Bank against the
computer. Every game plays with the keyboard everywhere and with the
mouse on a graphical display.
![img](doc/images/klondike.png)
On a graphical display the cards are drawn as SVG; in a terminal they
fall back to UNICODE glyphs (customize `card-game-symbols`). You can
switch how every game is drawn from the menu – `text` (UNICODE),
`svg` (drawn cards), or `full` (a full-window SVG table) – and dial the
computer opponents between `easy`, `normal`, and `hard`.
A full Info manual ships with the package: after installing, `C-h i` and
choose **Card Games**, or `M-x info RET (card-games) RET`.
# Games
To open the game menu type `M-x card-game`, or start a game directly
with its command. From the menu you can also switch the card treatment
(text / SVG / full-window) and the AI difficulty.
## Trick-taking
- `cg-bid` – 500 (Bid). Win the auction, name the trump suit, then take
tricks with your partner to reach 500 points before the opposing pair.
Also playable live over the network (`M-x cg-bid-host` / `cg-bid-join`).
- `cg-hearts` – Hearts. Avoid taking hearts and the Queen of Spades, or
take them all to "shoot the moon"; lowest score loses.
- `cg-spades` – Spades. Partnership bidding to 500; spades are always
trump. Make your side's combined bid, mind the bags, dare a nil.
- `cg-whist` – Whist. Trump is the turned card, there is no bidding;
score one point for each trick past the book of six.
- `cg-ohhell` – Oh Hell. The hand shrinks each round; bid the exact
number of tricks you will take, no more and no fewer.
## Solitaire
- `cg-montana` – Montana (also called Gaps). Each row is anchored by a
Two and built upward in one suit, 2 through King; slide cards into the
gaps until all four rows are sorted.
- `cg-gaps` – an alias for `cg-montana`.
- `cg-hells-half-acre` – the build-down variant: each row is anchored by
a King and built downward, King through 2.
- `cg-klondike` – Klondike, the classic "Solitaire": build the four
foundations up by suit from the Ace.
- `cg-freecell` – FreeCell: every card in view, four free cells, a game
of nearly pure skill.
- `cg-spider` – Spider (two decks): build down regardless of suit, but
only same-suit runs move; clear eight King-to-Ace runs.
- `cg-yukon` – Yukon: Klondike's layout dealt mostly face up, with any
buried group movable and no stock.
- `cg-canfield` – Canfield: a 13-card reserve and a foundation base rank
set by the deal; foundations wrap King to Ace.
- `cg-forty-thieves` – Forty Thieves: two decks, ten columns, eight
foundations, build down by suit, and no second pass through the stock.
- `cg-scorpion` – Scorpion: build down by suit and free any buried group
to assemble four King-to-Ace runs.
- `cg-golf` – Golf: clear the layout by playing exposed cards one rank
above or below the waste top.
- `cg-tripeaks` – TriPeaks: the same, on three overlapping peaks, with
Ace-King wrapping for long chains.
- `cg-pyramid` – Pyramid: remove pairs of exposed cards whose ranks sum
to thirteen; Kings go alone.
## Shedding and climbing
- `cg-eights` – Crazy Eights. Match the suit or rank of the discard;
eights are wild and let you name the next suit.
- `cg-president` – President (Scum). Climb: play one to four of a rank,
beat it or pass; first out rules, last out scrubs, and the roles trade
cards on the next deal.
## Rummy
- `cg-gin` – Gin Rummy. A two-handed duel: draw or take the discard,
build sets and runs, and knock once your deadwood is ten or less, or go
gin with none; your opponent then lays off and may undercut you. First
to 100 wins.
- `cg-rummy-basic` – Rummy. Meld sets and runs onto the table and lay
cards off onto them; empty your hand to go out and score the cards left
in the other hands.
- `cg-rum500` – Rummy 500. As above, but you score the cards you lay
down and lose the cards left in your hand; first past 500 wins. Take a
buried discard card with `T`: you take it and every card above it, and
meld the chosen card at once.
- `cg-handfoot` – Hand & Foot. A partnership Canasta cousin: play a hand
and then a foot, build books of a rank with Twos and Jokers wild, and go
out once your side has completed two of them. Each round opens with a
rising go-down minimum (50, 90, 120, 150); red threes are bonus cards;
and you can pick up the discard pile (`p`) by melding its top card with
two matching naturals.
## Matching
- `cg-go-fish` – Go Fish. Ask another player for a rank you hold;
collect all four to lay down a book, and make the most books.
- `cg-old-maid` – Old Maid. One Queen is set aside; discard pairs and
draw blind from your neighbour, and do not be left with the odd Queen.
## Pegging
- `cg-cribbage` – Cribbage. Lay two cards to the crib, cut a starter,
peg toward 31, then count fifteens, pairs, runs, flushes, and his nobs.
Two-handed to 121.
## Capturing
- `cg-scopa` – Scopa. A 40-card deck; capture table cards by value and
sweep the board for a scopa. Score cards, coins, the sette bello, and
primiera to 11.
- `cg-casino` – Casino. The full deck; capture by pairs and sums and
score cards, spades, the casinos, and aces to 21.
## More trick-taking
- `cg-euchre` – Euchre. A 24-card deck with the two bowers; order up or
call trump and take three of five tricks. Partnership to 10.
- `cg-pitch` – Auction Pitch. Bid for the pitch; your first lead sets
trump. Score High, Low, Jack, and Game; first to 7.
- `cg-briscola` – Briscola. A fixed trump turned from the deal and no
obligation to follow suit; capture the Aces and Threes. Partnership to
61 of the 120 points.
## Climbing patience
- `cg-spite` – Spite & Malice. Race the computer to empty your goal
pile onto shared centre piles that build Ace to Queen; Kings are wild.
## Bridge
- `cg-bridge` – Contract Bridge. A full auction (bids, pass, double,
redouble), play with the dummy exposed, and classic rubber scoring with
vulnerability. You are South; when you declare you play the dummy too.
The bidding AI is a small natural system, sensible but no expert.
## Two-player patience
- `cg-russian-bank` / `cg-crapette` – Russian Bank (Crapette). A race
against the computer: build the eight shared foundations up by suit,
build the shared houses down in alternating colour, and empty your
reserve to win. Load your cards onto your opponent's piles when the
rank and suit line up, mind the "stop" rule that ends your turn if you
skip a foundation play, and sequence house-to-house moves within the
free houses (`[` / `]` choose how many cards of a run to drop on an
empty house). The opponent plays all three difficulty levels.
# TODO
- [X] make the suit symbols customizable (`cg-symbols`) and obey them
- [X] a Texinfo manual
- [ ] finish `checkdoc` docstrings across the per-game files
(the shared engine files are clean; `make compile` is warning-free)
- [ ] renderer "skins": let games subclass the display components (text,
SVG, full-window SVG)
- [X] a manual card-size control for the full-window SVG UI
- [ ] more games
# Install
## From the package tarball
make package # builds card-games-1.0.91.tar
Then in Emacs: `M-x package-install-file RET card-games-1.0.91.tar`.
## With `use-package`
Once the package is on your `load-path` (installed from the tarball or an
ELPA archive), the whole collection loads from the single `card-games`
feature:
(use-package card-games
:commands (card-game cg-klondike cg-bid cg-hearts cg-gin cg-crapette))
Then `M-x card-game` for the menu.
## From a local ELPA archive
make elpa # builds dist/ (archive-contents + tar)
(add-to-list 'package-archives '("cg" . "/path/to/dist/"))
(package-refresh-contents)
(package-install 'card-games)
## Manually
Put the `cg-*.el` and `card-games.el` files on your `load-path` and
`(require 'card-games)`.
# Manual
A complete Info manual is included. After installing, `C-h i` and pick
**Card Games**, or `M-x info RET (card-games) RET`. To build it from a
source checkout:
make info # builds doc/card-games.info with makeinfo
The manual text is licensed CC-BY-4.0; the code is GPL-3.0-or-later.
# Playing
Every game works with the keyboard everywhere and with the mouse on a
graphical display.
- 500: `b` bid, `p` pass, arrows + `RET` to play (or click a card),
`n` next hand / new game, `?` help.
- Gaps: arrows to move (or `hjkl` when `cg-keys` is `classic`), `RET` to
fill a gap (or click it), `r` redeal, `u` undo, `n` new, `?` help.
- Klondike / FreeCell / Spider / Yukon: arrows move between piles, `RET`
picks up a movable run and drops it, `f` sends a card to a foundation,
`a` auto-plays everything it can, `u` undo, `n` new, `?` help. On the
stock pile, `RET` deals or recycles.
- Hearts / Spades: arrows choose a card, `RET` plays it (in Hearts, `RET`
marks a card to pass and `p` sends the three), `n` new match, `?` help.
- Crazy Eights: arrows choose, `RET` plays, `d` draws, `x` passes, `n`
new deal, `?` help.
On a graphical display, `v` toggles the full-window SVG table. A
**Card size** slider (and the `+` / `-` / `0` keys) resizes the cards, and
in 500 the `? Help / Rules` button explains play. Every game accepts the
mouse: click cards, board slots, buttons, and the slider.
![img](doc/images/hearts.png)
# Testing
This is a 1.0.91 pre-test snapshot. To try it:
1. `make compile && make test` – should be warning-free and all green.
2. `M-x card-game` opens the menu, or jump straight in, e.g.
`M-x cg-klondike`, `M-x cg-bid` (500), `M-x cg-gin`, `M-x cg-handfoot`.
3. On a graphical display, press `v` in 500 for the full-window SVG
table and play entirely with the mouse: click a bid, click five kitty
cards and the **Discard** button, click cards to play, move the **Card
size** slider, and open `? Help / Rules`.
Feedback most wanted: anything a mouse-only player who is new to Emacs
finds confusing or unreachable, rules bugs, and rendering glitches.
# Customization
`M-x customize-group RET cg-svg` and `RET card-games`:
- `cg-ai-level` – how hard the computer plays: `easy`, `normal`, or
`hard` (also on the `M-x card-game` menu, or `M-x
card-games-set-ai-level`).
- `card-games-treatment` – how the games are drawn: `text`, `svg`, or
`full` (also on the menu, or `M-x card-games-set-treatment`).
- `cg-svg-theme-colors` – derive the highlight ring and card backs
from your theme (on by default).
- `cg-svg-highlight-color` – the cursor/selection ring (gold by default).
- `cg-bid-felt-color` – the 500 table felt.
- `cg-svg-card-width`, `cg-svg-card-height`, `cg-svg-card-shadow`,
`cg-svg-font-family` – card appearance.
- `cg-svg-card-back` – the card-back design: `dots`, `rings`, `solid`,
`lattice`, `waves`, `diamond`, an Emacs-logo back (`emacs`,
`emacs-classic`, `gnu`, `splash`), or `random` (the default – picks
one for the session; `M-x cg-svg-shuffle-card-back` rolls a new one).
- `cg-svg-emacs-logo` – the emblem on the full-window table:
`modern` (default), `classic`, `gnu`, `splash`, `drawn`, or `none`.
- `cg-symbols` – the Unicode suit glyphs (and the joker) drawn on cards.
- `cg-svg-four-color` – draw a four-colour deck (clubs green, diamonds
blue-purple).
- `cg-keys` – `emacs` (default) or `classic` (adds vi-style `hjkl` and
`SPC`).
- `cg-bid-animate`, `cg-bid-ai-delay`, `cg-bid-trick-pause` – pace the
500 AI so play is watchable and completed tricks linger.
- `M-x card-games-set-theme` – apply a preset (classic, dark, contrast).
# Development
make compile # byte-compile (should be warning-free)
make test # run the ERT suite
make checkdoc # documentation lint
make release # clean + test + package + source tarball
# License
GPL-3.0-or-later. See the file headers; add a COPYING file with the
full GPLv3 text for distribution.

76
README.org
View file

@ -1,28 +1,16 @@
#+TITLE: card-games -- Play card games in Emacs
#+AUTHOR: Corwin Brust
#+OPTIONS: toc:nil
Card games for Emacs: about thirty of them, from Klondike and FreeCell
to Hearts, 500, Gin, Cribbage, and two-player Russian Bank against the
computer. Every game plays with the keyboard everywhere and with the
mouse on a graphical display.
Card games for Emacs.
[[file:doc/images/klondike.png]]
On a graphical display the cards are drawn as SVG; in a terminal they
fall back to UNICODE glyphs (customize ~card-game-symbols~). You can
switch how every game is drawn from the menu -- ~text~ (UNICODE),
~svg~ (drawn cards), or ~full~ (a full-window SVG table) -- and dial the
computer opponents between ~easy~, ~normal~, and ~hard~.
A full Info manual ships with the package: after installing, ~C-h i~ and
choose *Card Games*, or ~M-x info RET (card-games) RET~.
Renders SVG by default when ~display-graphic-p~ is t and rsvg is
available. The default (UNICODE) symbols maybe customized by
configuring ~card-game-symbols~.
* Games
To open the game menu type ~M-x card-game~, or start a game directly
with its command. From the menu you can also switch the card treatment
(text / SVG / full-window) and the AI difficulty.
with its command.
** Trick-taking
- ~cg-bid~ -- 500 (Bid). Win the auction, name the trump suit, then take
@ -128,19 +116,9 @@ with its command. From the menu you can also switch the card treatment
vulnerability. You are South; when you declare you play the dummy too.
The bidding AI is a small natural system, sensible but no expert.
** Two-player patience
- ~cg-russian-bank~ / ~cg-crapette~ -- Russian Bank (Crapette). A race
against the computer: build the eight shared foundations up by suit,
build the shared houses down in alternating colour, and empty your
reserve to win. Load your cards onto your opponent's piles when the
rank and suit line up, mind the "stop" rule that ends your turn if you
skip a foundation play, and sequence house-to-house moves within the
free houses (~[~ / ~]~ choose how many cards of a run to drop on an
empty house). The opponent plays all three difficulty levels.
* TODO
- [X] make the suit symbols customizable (~cg-symbols~) and obey them
- [X] a Texinfo manual
- [ ] a Texinfo manual
- [ ] finish ~checkdoc~ docstrings across the per-game files
(the shared engine files are clean; ~make compile~ is warning-free)
- [ ] renderer "skins": let games subclass the display components (text,
@ -151,19 +129,9 @@ with its command. From the menu you can also switch the card treatment
* Install
** From the package tarball
#+begin_src
make package # builds card-games-1.0.91.tar
make package # builds card-games-1.0.90.tar
#+end_src
Then in Emacs: ~M-x package-install-file RET card-games-1.0.91.tar~.
** With ~use-package~
Once the package is on your ~load-path~ (installed from the tarball or an
ELPA archive), the whole collection loads from the single ~card-games~
feature:
#+begin_src emacs-lisp
(use-package card-games
:commands (card-game cg-klondike cg-bid cg-hearts cg-gin cg-crapette))
#+end_src
Then ~M-x card-game~ for the menu.
Then in Emacs: ~M-x package-install-file RET card-games-1.0.90.tar~.
** From a local ELPA archive
#+begin_src
@ -179,17 +147,8 @@ make elpa # builds dist/ (archive-contents + tar)
Put the ~cg-*.el~ and ~card-games.el~ files on your ~load-path~ and
~(require 'card-games)~.
* Manual
A complete Info manual is included. After installing, ~C-h i~ and pick
*Card Games*, or ~M-x info RET (card-games) RET~. To build it from a
source checkout:
#+begin_src
make info # builds doc/card-games.info with makeinfo
#+end_src
The manual text is licensed CC-BY-4.0; the code is GPL-3.0-or-later.
* Playing
Every game works with the keyboard everywhere and with the mouse on a
Both games work with the keyboard everywhere and with the mouse on a
graphical display.
- 500: ~b~ bid, ~p~ pass, arrows + ~RET~ to play (or click a card),
@ -210,10 +169,8 @@ On a graphical display, ~v~ toggles the full-window SVG table. A
in 500 the ~? Help / Rules~ button explains play. Every game accepts the
mouse: click cards, board slots, buttons, and the slider.
[[file:doc/images/hearts.png]]
* Testing
This is a 1.0.91 pre-test snapshot. To try it:
This is a 1.0.90 pre-test snapshot. To try it:
1. ~make compile && make test~ -- should be warning-free and all green.
2. ~M-x card-game~ opens the menu, or jump straight in, e.g.
~M-x cg-klondike~, ~M-x cg-bid~ (500), ~M-x cg-gin~, ~M-x cg-handfoot~.
@ -227,23 +184,12 @@ finds confusing or unreachable, rules bugs, and rendering glitches.
* Customization
~M-x customize-group RET cg-svg~ and ~RET card-games~:
- ~cg-ai-level~ -- how hard the computer plays: ~easy~, ~normal~, or
~hard~ (also on the ~M-x card-game~ menu, or ~M-x
card-games-set-ai-level~).
- ~card-games-treatment~ -- how the games are drawn: ~text~, ~svg~, or
~full~ (also on the menu, or ~M-x card-games-set-treatment~).
- ~cg-svg-theme-colors~ -- derive the highlight ring and card backs
from your theme (on by default).
- ~cg-svg-highlight-color~ -- the cursor/selection ring (gold by default).
- ~cg-bid-felt-color~ -- the 500 table felt.
- ~cg-svg-card-width~, ~cg-svg-card-height~, ~cg-svg-card-shadow~,
~cg-svg-font-family~ -- card appearance.
- ~cg-svg-card-back~ -- the card-back design: ~dots~, ~rings~, ~solid~,
~lattice~, ~waves~, ~diamond~, an Emacs-logo back (~emacs~,
~emacs-classic~, ~gnu~, ~splash~), or ~random~ (the default -- picks
one for the session; ~M-x cg-svg-shuffle-card-back~ rolls a new one).
- ~cg-svg-emacs-logo~ -- the emblem on the full-window table:
~modern~ (default), ~classic~, ~gnu~, ~splash~, ~drawn~, or ~none~.
- ~cg-svg-card-back~ -- card-back pattern: dots, rings, or solid.
- ~cg-symbols~ -- the Unicode suit glyphs (and the joker) drawn on cards.
- ~cg-svg-four-color~ -- draw a four-colour deck (clubs green, diamonds
blue-purple).

77
build.el
View file

@ -1,77 +0,0 @@
;;; build.el --- Batch Org -> Markdown export for card-games -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Corwin Brust
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; A very small Emacs-batch exporter. It renders the project's Org
;; sources to Markdown siblings (foo.org -> foo.md) using the built-in
;; `ox-md' backend, so GitHub and MELPA -- which render Markdown more
;; faithfully than Org -- can display them.
;;
;; Run it by hand, from the Makefile, or from the git pre-commit hook:
;;
;; emacs -Q --batch -l build.el
;;
;; By default it exports the files named in `build-org-files' (README.org).
;; Set the CARD_GAMES_ORG environment variable to a space-separated list
;; to override that, e.g. to export more documents. It never touches
;; known-games.org (an internal research list) unless you ask for it.
;;; Code:
(require 'org)
(require 'ox-md)
;; Keep batch mode from blocking on prompts.
(setq org-confirm-babel-evaluate nil
org-export-show-temporary-export-buffer nil
;; A stray or not-yet-committed image link must never abort the run.
org-export-with-broken-links 'mark
make-backup-files nil)
(defvar build-org-files '("README.org")
"Default list of Org files to export to Markdown.
Overridden by the CARD_GAMES_ORG environment variable when set.")
(defvar build-inhibit-run nil
"When non-nil, loading build.el defines helpers but does not export.
ERT or an interactive session can bind this to exercise the helpers.")
(defun build--targets ()
"Return the list of Org files to export.
Honours the CARD_GAMES_ORG environment variable; falls back to
`build-org-files'."
(let ((env (getenv "CARD_GAMES_ORG")))
(if (and env (not (string-empty-p (string-trim env))))
(split-string (string-trim env) "[ \t\n]+" t)
build-org-files)))
(defun build--export-one (orgfile)
"Export ORGFILE to a Markdown sibling.
Log the outcome; never signal, so one bad file cannot abort the run."
(cond
((not (file-readable-p orgfile))
(message "build: SKIP %s (not readable)" orgfile))
(t
(message "build: exporting %s -> markdown" orgfile)
(with-current-buffer (find-file-noselect orgfile)
(condition-case err
(let ((out (org-md-export-to-markdown)))
(message "build: wrote %s" out))
(error
(message "build: ERROR exporting %s: %s"
orgfile (error-message-string err))))))))
(defun build--run ()
"Export every file in `build--targets' to Markdown."
(dolist (orgfile (build--targets))
(build--export-one orgfile))
(message "build: done"))
(unless (bound-and-true-p build-inhibit-run)
(build--run))
(provide 'build)
;;; build.el ends here

2
card-games-pkg.el
View file

@ -1,5 +1,5 @@
;;; card-games-pkg.el --- Package metadata -*- no-byte-compile: t; -*-
(define-package "card-games" "1.0.91"
(define-package "card-games" "1.0.90"
"Play card games in Emacs (console UNICODE and graphical SVG)."
'((emacs "26.1"))
:keywords '("games")

68
card-games.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -134,53 +134,6 @@
"Registry of playable games.
Each entry is (NAME COMMAND DESCRIPTION); `card-game' lists them.")
(defvar card-games--svg-card-vars
'(cg-sol-svg-cards cg-trick-svg-cards cg-rummy-svg-cards cg-eights-svg-cards
cg-bridge-svg-cards cg-crapette-svg-cards cg-pat-svg-cards cg-pres-svg-cards)
"Per-game SVG-cards toggles that `card-games-set-treatment' flips together.")
(defvar card-games--full-svg-vars
'(cg-gaps-svg-ui cg-bid-svg-ui)
"Full-window SVG toggles (Gaps and 500) used by the `full' treatment.")
(defvar card-games-treatment 'svg
"Display treatment chosen from the menu: `text', `svg', or `full'.")
;;;###autoload
(defun card-games-set-treatment (treatment)
"Set how games are drawn: `text' (UNICODE), `svg' (cards), or `full'.
`full' also uses the full-window SVG table where a game has one (Gaps and
500). Takes effect the next time a game is drawn -- press g to redraw an
open game. Gaps and 500 are always graphical on a window system."
(interactive
(list (intern (completing-read "Treatment: " '("text" "svg" "full") nil t))))
(setq card-games-treatment treatment)
(let ((cards (and (memq treatment '(svg full)) t))
(full (and (eq treatment 'full) t)))
(dolist (v card-games--svg-card-vars) (when (boundp v) (set v cards)))
(dolist (v card-games--full-svg-vars) (when (boundp v) (set v full))))
(when (called-interactively-p 'interactive)
(message "Display treatment: %s" treatment)))
(defun card-game--cycle-treatment (_button)
"Cycle the display treatment and refresh the chooser."
(card-games-set-treatment
(pcase card-games-treatment ('text 'svg) ('svg 'full) (_ 'text)))
(card-game))
(defun card-game--cycle-ai (_button)
"Cycle the AI difficulty (`cg-ai-level') and refresh the chooser."
(setq cg-ai-level (pcase cg-ai-level ('easy 'normal) ('normal 'hard) (_ 'easy)))
(card-game))
;;;###autoload
(defun card-games-set-ai-level (level)
"Set the computer-opponent difficulty to LEVEL (easy, normal, or hard)."
(interactive
(list (intern (completing-read "AI level: " '("easy" "normal" "hard") nil t))))
(setq cg-ai-level level)
(message "AI level: %s" level))
(defun card-game--launch (button)
"Start the game whose command is stored on BUTTON."
(let ((cmd (button-get button 'card-game-command)))
@ -206,9 +159,6 @@ open game. Gaps and 500 are always graphical on a window system."
"Open a chooser listing the available card games.
Press RET (or click) on a game to start it."
(interactive)
(when (and (boundp 'cg-svg-card-back) (eq cg-svg-card-back 'random)
(fboundp 'cg-svg--roll-back))
(cg-svg--roll-back)) ; a fresh random back per menu visit
(let ((buf (get-buffer-create "*Card Games*")))
(with-current-buffer buf
(card-game-mode)
@ -216,22 +166,8 @@ Press RET (or click) on a game to start it."
(erase-buffer)
(insert (propertize " Card Games for Emacs\n" 'face 'bold))
(insert (propertize
" Choose a game with RET or the mouse. q to quit.\n"
" Choose a game with RET or the mouse. q to quit.\n\n"
'face 'shadow))
(insert " AI opponents: ")
(insert-text-button
(symbol-name cg-ai-level)
'face 'link
'help-echo "Click to change the AI difficulty (easy/normal/hard)"
'action #'card-game--cycle-ai)
(insert (propertize " (click to cycle easy/normal/hard)\n" 'face 'shadow))
(insert " Cards: ")
(insert-text-button
(symbol-name card-games-treatment)
'face 'link
'help-echo "Click to cycle the display: text / svg / full"
'action #'card-game--cycle-treatment)
(insert (propertize " (click to cycle text/svg/full)\n\n" 'face 'shadow))
(dolist (g card-games-list)
(insert " ")
(insert-text-button

2
cg-bid-net.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

13
cg-bid-ui.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -842,9 +842,14 @@ FS scales the N/S/E/W label fonts."
(svg-circle svg cx cy 3 :fill "#cfeccf")))
(defun cg-bid--draw-logo (svg cx cy &optional fs)
"Draw the configured Emacs emblem centred at CX, CY on SVG, scaled by FS.
The emblem is chosen with `cg-svg-emacs-logo'."
(cg-svg-draw-logo svg cx cy fs))
"Draw a GNU Emacs emblem centred at CX, CY on SVG, scaled by FS."
(let ((fs (or fs 1.0)))
(svg-gradient svg "cg-logo" 'linear '((0 . "#8056c8") (100 . "#3f1f9e")))
(svg-circle svg cx cy (round (* 26 fs)) :gradient "cg-logo"
:stroke "#2a1370" :stroke-width 2)
(cg-svg--text svg "e" cx (+ cy (round (* 10 fs))) (round (* 30 fs)) "#ffffff" t)
(cg-svg--text svg "GNU Emacs" cx (+ cy (round (* 42 fs)))
(max 10 (round (* 11 fs))) "#c7bbe6")))
(defun cg-bid--grid-cell (bid gx gy cw ch g)
"Return (X Y W H) for BID in a grid at GX,GY with cells CW by CH, gutter G.

2
cg-bid.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

104
cg-bridge.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -498,108 +498,8 @@ vulnerability, and TRICKS the declarer side's trick count. Keys:
(max 0 (- cg-svg-card-width 26)) 0)
:region-tag region-tag))
(defun cg-bridge--draw-backs (svg x y n)
"Draw up to three overlapped 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-bridge--svg (game)
"Return an SVG board for the Bridge GAME (four seats, dummy exposed)."
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
(phase (cg-get game :phase)) (cursor (cg-get game :cursor))
(turn (cg-get game :turn)) (dummy (cg-get game :dummy))
(exposed (cg-get game :exposed)) (trick (cg-get game :trick))
(act (if (and (eq phase 'play) (memq turn (cg-bridge--controls game))) turn 0))
(ahand (cg-bridge--sort (cg-bridge--hand game act)))
(n (length ahand))
(overlap (cond ((> n 11) (- w 26)) ((> 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)) 760))
(cx (/ width 2))
(y-title 6) (y-info 24) (y-north 62)
(y-tn (+ y-north h 20))
(cyc (+ y-tn (round (* h 0.5))))
(y-ts (+ cyc (round (* h 0.15))))
(y-hand (+ y-ts h 42))
(height (+ y-hand h 30))
(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"))))
(seat (s x y)
(if (and exposed (eql s dummy) (/= s act))
(let ((cs (cg-bridge--sort (cg-bridge--hand game s))) (xx x))
(dolist (c cs)
(let ((sp (cg-bridge--spec c)))
(cg-svg-card svg xx y :rank (car sp) :suit (cdr sp)))
(setq xx (+ xx 15))))
(cg-bridge--draw-backs svg x (+ y 6) (length (cg-bridge--hand game s))))
(txt (format "%s%s%s" (aref cg-bridge-seat-names s)
(if (eql s dummy) " (dummy)" "")
(if (= turn s) " <-" ""))
x y 11))
(trick-card (s x y)
(let ((play (assq s trick)))
(when play
(let ((sp (cg-bridge--spec (cdr play))))
(cg-svg-card svg x y :rank (car sp) :suit (cdr sp)))))))
(txt "Bridge" pad (+ y-title 12) 13 t)
(txt (format "Games N-S %d E-W %d Below %d/%d Above %d/%d"
(aref (cg-get game :games) 0) (aref (cg-get game :games) 1)
(aref (cg-get game :below) 0) (aref (cg-get game :below) 1)
(aref (cg-get game :above) 0) (aref (cg-get game :above) 1))
pad (+ y-info 8) 11)
(pcase phase
('auction
(txt (format "Auction: %s" (cg-bridge--auction-string game)) pad (+ y-info 24) 11)
(txt (format "Your bid: %d %s (arrows compose, RET bids)"
(cg-get game :bid-level)
(aref cg-bridge-strains (cg-get game :bid-strain)))
pad (+ y-info 40) 11))
((or 'play 'scored 'passed-out)
(txt (format "Contract: %s by %s Declarer tricks: %d"
(cg-bridge--contract-string game)
(if (cg-get game :declarer)
(aref cg-bridge-seat-names (cg-get game :declarer)) "--")
(cg-get game :tricks))
pad (+ y-info 24) 11)))
(seat 2 (- cx 40) y-north)
(seat 1 pad cyc)
(seat 3 (- width pad 110) cyc)
(when (eq phase 'play)
(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 (- cyc (* h 0.25))))
(trick-card 3 (+ cx (round (* w 0.4))) (round (- cyc (* h 0.25)))))
(txt (format "%s%s" (aref cg-bridge-seat-names act)
(cond ((eq phase 'auction) " (you)")
((= act 0) " (you)")
(t " (dummy -- you play)")))
pad (- y-hand 6) 11)
(let ((x (max pad (- (/ width 2) (/ fanw 2)))) (i 0)
(legalp (and (eq phase 'play) (= turn act))))
(dolist (c ahand)
(let ((sp (cg-bridge--spec c)) (curp (= i cursor))
(hintp (and legalp (cg-bridge--legal-play-p game act c))))
(cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp)
:highlight curp :hint hintp)
(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-bridge-game))
"Return a depiction of the Bridge GAME: SVG board if graphical, else text."
(if (and cg-bridge-svg-cards (display-graphic-p))
(cg-bridge--svg game)
(cg-bridge--render-text game)))
(defun cg-bridge--render-text (game)
"Return a plain-text depiction of the Bridge GAME."
"Return a propertized depiction of the Bridge GAME."
(let* ((out '()) (phase (cg-get game :phase)) (cursor (cg-get game :cursor)))
(push " Bridge\n" out)
(push (format " Rubber: You/North games %d East/West games %d%s\n"

19
cg-core.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -73,17 +73,6 @@ and SPC as an action key. Takes effect the next time a game starts."
(const :tag "Classic (adds hjkl, SPC)" classic))
:group 'card-games)
(defcustom cg-ai-level 'normal
"Difficulty of the computer opponents, where a game supports it.
`easy' plays a quick, simple game, `normal' plays soundly, and `hard'
thinks a little harder. Honoured by Russian Bank (Crapette) and the
trick-taking games so far; other games ignore it for now. Change it from
the `card-game' menu or with `card-games-set-ai-level'."
:type '(choice (const :tag "Easy" easy)
(const :tag "Normal" normal)
(const :tag "Hard" hard))
:group 'card-games)
(defclass cg-game ()
((name :initarg :name :initform "game" :type string
:documentation "Human-readable game name.")
@ -207,10 +196,8 @@ The glyphs are taken from `cg-symbols'."
"?"))
(defsubst cg-red-suit-p (suit)
"Return t when SUIT index denotes a red suit, else nil.
Normalised to a boolean so callers may compare two results with `eq'
\(diamonds and hearts are both red but `memq' returns different tails)."
(and (memq suit '(2 3)) t))
"Return non-nil when SUIT index denotes a red suit."
(memq suit '(2 3)))
(defsubst cg-sister-suit (suit)
"Return the other suit index of the same colour as SUIT."

76
cg-crapette.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -56,11 +56,9 @@
;; somewhere you keep going, otherwise it goes to your waste and your turn
;; ends.
;;
;; The AI observes foundation priority, empties its reserve first (the
;; bottleneck), prefers loading its cards onto you, and looks one move
;; ahead to rearrange the houses when that frees a stuck reserve or waste
;; card. It never breaks foundation priority, so in practice only you can
;; be "stopped".
;; SIMPLIFICATION (documented): the AI is a straightforward greedy player
;; and always observes foundation priority, so in practice only you can be
;; "stopped".
;;; Code:
@ -435,56 +433,11 @@ Return non-nil when the offending action must be abandoned by its caller."
for fi = (and card (cg-crap--found-for game card))
when fi return (cons spot (cons 'found fi))))
(defun cg-crap--ai-unload-move (game)
"Return the best AI (SOURCE . DEST) move that empties its reserve or waste.
Emptying the RESERVE is the goal of the game, so it outscores the waste;
LOADING a card onto you (which also burdens you) outscores building a
house. Every such move reduces the AI's own cards, so its turn ends."
(let ((best nil) (bestscore 0))
(dolist (spot (list (cons 'res 1) (cons 'was 1)))
(let ((card (cg-crap--spot-top game spot))
(base (if (eq (car spot) 'res) 40 0))) ; the reserve is the bottleneck
(when card
(dolist (dst (list (cons 'res 0) (cons 'was 0)))
(when (cg-crap--load-accepts (cg-crap--spot-top game dst) card)
(let ((sc (+ base 60))) ; loading: rid a card AND burden you
(when (> sc bestscore)
(setq bestscore sc best (cons spot dst))))))
(cl-loop for i below 8
when (cg-crap--house-accepts game i card)
do (let ((sc (+ base 50))) ; else build it onto a house
(when (> sc bestscore)
(setq bestscore sc best (cons spot (cons 'house i)))))
(cl-return)))))
best))
(defun cg-crap--ai-enabling-move (game)
"Return a single-card house->house move that unlocks an unload, or nil.
This is the crafty bit: when the AI cannot place its reserve or waste top
anywhere, it looks one move ahead for a house rearrangement that would
make such a placement legal. It only fires when no direct unload exists,
and only when the shuffle genuinely opens one, so the turn still ends."
(when (null (cg-crap--ai-unload-move game))
(catch 'found
(dotimes (i 8)
(dotimes (j 8)
(let ((pilei (cg-crap--house game i)) (pilej (cg-crap--house game j)))
(when (and (/= i j) pilei)
(let ((card (cg-crap--top pilei)))
(when (cg-crap--house-accepts game j card)
(aset (cg-get game :houses) i (butlast pilei 1))
(aset (cg-get game :houses) j (append pilej (list card)))
(let ((opens (cg-crap--ai-unload-move game)))
(aset (cg-get game :houses) i pilei)
(aset (cg-get game :houses) j pilej)
(when opens
(throw 'found (cons (cons 'house i) (cons 'house j)))))))))))
nil)))
(defun cg-crap--ai-greedy-move (game)
"A simple first-fit unload move -- the `easy' AI.
Empties the reserve or waste top onto the first legal spot, without the
scoring or the house-rearranging lookahead of the tougher levels."
(defun cg-crap--ai-useful-move (game)
"Return an AI (SOURCE . DEST) move that empties its reserve or waste, or nil.
The AI only moves its own reserve/waste tops -- onto your piles (loading)
or onto a house -- so every such move reduces the AI's cards and its turn
is guaranteed to end."
(catch 'm
(dolist (spot (list (cons 'res 1) (cons 'was 1)))
(let ((card (cg-crap--spot-top game spot)))
@ -498,17 +451,14 @@ scoring or the house-rearranging lookahead of the tougher levels."
nil))
(defun cg-crap--ai-play (game)
"Play the AI opponent's whole turn on GAME, per `cg-ai-level'."
(let ((guard 0) (level cg-ai-level))
"Play the AI opponent's whole turn on GAME."
(let ((guard 0))
(catch 'done
(while t
(when (> (setq guard (1+ guard)) 800) (throw 'done nil))
(when (> (setq guard (1+ guard)) 400) (throw 'done nil))
(when (cg-crap--won-p game 1) (throw 'done nil))
(let ((mv (or (cg-crap--ai-found-move game)
(if (eq level 'easy)
(cg-crap--ai-greedy-move game)
(cg-crap--ai-unload-move game))
(and (eq level 'hard) (cg-crap--ai-enabling-move game)))))
(cg-crap--ai-useful-move game))))
(cond
(mv (cg-crap--move game (car mv) (cdr mv) 1))
((cg-crap--hand game 1)

79
cg-cribbage.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -297,83 +297,8 @@ TOTAL is the running count after the play."
(defvar-local cg-crib--game nil "The Cribbage game in the current buffer.")
(defun cg-crib--svg (game)
"Return an SVG board for the Cribbage GAME (with a peg-track)."
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
(phase (cg-get game :phase)) (scores (cg-get game :scores))
(hand (if (eq phase 'play) (cg-crib--play game 0) (cg-crib--hand game 0)))
(n (length hand)) (cursor (cg-get game :cursor)) (marks (cg-get game :marks))
(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))
(target cg-cribbage-target) (barw 220) (peg-h 14) (peg-gap 8)
(y-title 6) (y-peg 26)
(y-mid (+ y-peg (* 2 (+ peg-h peg-gap)) 18))
(y-hand (+ y-mid h 44))
(height (+ y-hand h 30))
(width (max (+ fanw (* 2 pad)) (+ pad 90 barw 120) 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"))))
(peg (label sc y)
(txt label pad (+ y 11) 12)
(let ((bx (+ pad 90)))
(svg-rectangle svg bx y barw peg-h :rx 4 :fill "none"
:stroke lc :stroke-width 1)
(svg-rectangle svg bx y
(round (* barw (/ (float (min sc target)) target)))
peg-h :rx 4 :fill "#3aa15a")
(txt (format "%d" sc) (+ bx barw 8) (+ y 11) 12)))
(crow (cards x y)
(let ((xx x))
(dolist (c cards)
(let ((sp (cg-rummy--card-spec c)))
(cg-svg-card svg xx y :rank (car sp) :suit (cdr sp)))
(setq xx (+ xx (round (* w 0.5))))))))
(txt (format "Cribbage (to %d)" target) pad (+ y-title 12) 13 t)
(peg "You" (aref scores 0) y-peg)
(peg "Computer" (aref scores 1) (+ y-peg peg-h peg-gap))
(txt (format "%s deals" (cg-crib--who (cg-get game :dealer)))
(+ pad 90 barw 60) (+ y-peg 11) 11)
(let ((mx pad))
(when (cg-get game :starter)
(let ((sp (cg-rummy--card-spec (cg-get game :starter))))
(cg-svg-card svg mx y-mid :rank (car sp) :suit (cdr sp))
(txt "Starter" mx (+ y-mid h 13) 11)
(setq mx (+ mx w gap 24))))
(cond
((eq phase 'play)
(txt (format "Count: %d" (cg-get game :total)) mx (- y-mid 4) 12)
(crow (reverse (cg-get game :seq)) mx y-mid))
((memq phase '(show game-over))
(when (cg-get game :crib)
(txt (format "Crib (%s)" (cg-crib--who (cg-get game :dealer))) mx (- y-mid 4) 11)
(crow (cg-get game :crib) mx y-mid)))))
(txt (format "Your %s" (if (eq phase 'play) "cards" "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))
(markp (and marks (memq i marks))))
(cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp) :highlight curp)
(when markp
(svg-rectangle svg (- x 3) (- y-hand 3) (+ w 6) (+ h 6)
:rx 8 :fill "none" :stroke "#4a90d9" :stroke-width 3))
(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-cribbage-game))
"Return a depiction of the Cribbage GAME: SVG board if graphical, else text."
(if (and cg-rummy-svg-cards (display-graphic-p))
(cg-crib--svg game)
(cg-crib--render-text game)))
(defun cg-crib--render-text (game)
"Return a plain-text depiction of the Cribbage GAME."
"Return a propertized depiction of the Cribbage GAME."
(let* ((out '()) (scores (cg-get game :scores)) (phase (cg-get game :phase))
(cursor (cg-get game :cursor)))
(push (format " Cribbage to %d\n\n" cg-cribbage-target) out)

61
cg-eights.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -213,65 +213,8 @@ Return the drawn card, or nil when none is available."
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
(cons (aref cg-eights-ranks (cdr card)) (car card)))
(defun cg-eights--board-svg (game)
"Return an SVG board for the Crazy Eights GAME."
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
(hand (cg-eights--hand game 0)) (n (length hand))
(cursor (cg-get game :cursor))
(top (cg-eights--top game)) (suit (cg-get game :suit))
(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))
(np (cg-get game :nplayers)) (nstock (length (cg-get game :stock)))
(y-title 6) (y-info 26)
(y-mid (+ y-info (* (1- np) 16) 14))
(y-hand (+ y-mid h 42))
(height (+ y-hand h 30))
(width (max (+ fanw (* 2 pad)) 560))
(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")))))
(txt "Crazy Eights" pad (+ y-title 12) 13 t)
(let ((yy (+ y-info 4)))
(dotimes (s np)
(unless (= s 0)
(txt (format "Player %d: %d cards (score %d)" s
(length (cg-eights--hand game s)) (aref (cg-get game :scores) s))
pad yy 12)
(setq yy (+ yy 16)))))
(cg-svg-card svg pad y-mid :down (> nstock 0) :gap (= nstock 0))
(txt (format "Stock %d" nstock) pad (+ y-mid h 13) 11)
(let ((dx (+ pad w gap 28)) (sp (cg-eights--spec top)))
(cg-svg-card svg dx y-mid :rank (car sp) :suit (cdr sp))
(txt "Discard" dx (+ y-mid h 13) 11)
(let ((sx (+ dx w gap 34))
(col (if (cg-red-suit-p suit) "#c0392b" "#2c3e50")))
(txt "Suit in play" sx (- y-mid 4) 11)
(svg-text svg (cg-suit-glyph suit) :x (+ sx 12) :y (+ y-mid 46)
:font-size 44 :fill col :font-family cg-svg-font-family)))
(txt "Your hand" pad (- y-hand 6) 11)
(let ((x (max pad (- (/ width 2) (/ fanw 2)))) (i 0))
(dolist (c hand)
(let ((sp (cg-eights--spec c)) (curp (= i cursor))
(hintp (cg-eights--legal-p game c)))
(cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp)
:highlight curp :hint hintp)
(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-eights-game))
"Return a depiction of GAME: an SVG board if graphical, else text."
(if (and cg-eights-svg-cards (display-graphic-p))
(cg-eights--board-svg game)
(cg-eights--render-text game)))
(defun cg-eights--render-text (game)
"Return a plain-text depiction of GAME."
"Return a propertized string depicting GAME for a text display."
(let* ((out (list)) (top (cg-eights--top game))
(hand (cg-eights--hand game 0)) (cursor (cg-get game :cursor)))
(push (format " Crazy Eights\n\n") out)

2
cg-gaps.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-handfoot.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

71
cg-match.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -452,69 +452,8 @@ instead of hunting for one overlapped card in a big hand."
(defvar-local cg-om--game nil "The Old Maid game in the current buffer.")
(defun cg-om--svg (game)
"Return an SVG board for the Old Maid GAME."
(let* ((w cg-svg-card-width) (h cg-svg-card-height) (gap cg-svg-card-gap) (pad 16)
(hand (cg-om--hand game 0)) (n (length hand))
(target (cg-om--target game 0)) (pick (or (cg-get game :pick) 0))
(yourp (and target (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0)))
(np (cg-get game :nplayers))
(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))
(bstep 20)
(tn (and target (length (cg-om--hand game target))))
(y-title 6) (y-info 26)
(y-target (+ y-info (* (1- np) 16) 18))
(y-hand (+ y-target h 42))
(targetw (if (and yourp tn (> tn 0)) (+ (* (1- tn) bstep) w) 0))
(height (+ y-hand h 30))
(width (max (+ fanw (* 2 pad)) (+ targetw (* 2 pad)) 560))
(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")))))
(txt "Old Maid" pad (+ y-title 12) 13 t)
(let ((yy (+ y-info 4)))
(dotimes (s np)
(unless (= s 0)
(txt (format "Player %d: %d cards%s" s (length (cg-om--hand game s))
(if (eql s target) " <- draw from here" ""))
pad yy 12)
(setq yy (+ yy 16)))))
(when (and yourp tn (> tn 0))
(txt (format "Pick a card from Player %d:" target) pad (- y-target 6) 11)
(let ((x pad))
(dotimes (i tn)
(cg-svg-card svg x y-target :down t :highlight (= i pick))
(push (cons (list x y-target (if (= i (1- tn)) w bstep) h) (cons 'pick i))
regions)
(setq x (+ x bstep)))))
(txt "Your hand" pad (- y-hand 6) 11)
(let ((x (max pad (- (/ width 2) (/ fanw 2)))))
(dolist (c hand)
(let ((sp (cg-rummy--card-spec c)))
(cg-svg-card svg x y-hand :rank (car sp) :suit (cdr sp)))
(setq x (+ x step))))
(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-apply ((g cg-old-maid-game) action)
"Apply a click ACTION: pick that card from the target and draw it."
(pcase action
(`(pick . ,i) (cg-put g :pick i) (cg-om-draw))
(_ (cl-call-next-method))))
(cl-defmethod cg-render ((game cg-old-maid-game))
"Return a depiction of the Old Maid GAME: SVG board if graphical, else text."
(if (and cg-rummy-svg-cards (display-graphic-p))
(cg-om--svg game)
(cg-om--render-text game)))
(defun cg-om--render-text (game)
"Return a plain-text depiction of the Old Maid GAME."
"Return a propertized depiction of the Old Maid GAME."
(let* ((out '()) (target (cg-om--target game 0)))
(push " Old Maid\n\n" out)
(dotimes (s (cg-get game :nplayers))
@ -533,7 +472,6 @@ instead of hunting for one overlapped card in a big hand."
(defun cg-om--redisplay ()
(let ((game cg-om--game) (inhibit-read-only t))
(setq cg-current-game game cg-redisplay-function #'cg-om--redisplay)
(setq-local mode-line-process (format " [%s]" (cg-get game :phase)))
(erase-buffer) (insert (cg-render game)) (goto-char (point-min))))
@ -572,11 +510,6 @@ instead of hunting for one overlapped card in a big hand."
(defvar cg-old-maid-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 "<left>") #'cg-om-left)
(define-key map (kbd "<right>") #'cg-om-right)
(define-key map (kbd "RET") #'cg-om-draw)

2
cg-net.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-patience.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-president.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-render.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-rum500.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-rummy.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-scopa.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

2
cg-solitaire.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

70
cg-spite.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -273,74 +273,8 @@
(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 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."
"Return a propertized 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"

171
cg-svg.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -86,47 +86,9 @@ not themed this way -- see `cg-svg--highlight' -- so it never picks up a
theme's `region' colour."
:type 'boolean :group 'cg-svg)
(defcustom cg-svg-card-back 'random
"Pattern drawn on a face-down card back.
The `emacs', `emacs-classic', `gnu' and `splash' backs stamp the card with
a logo that ships with Emacs. `random' picks one of the concrete backs
for the session (reshuffle with `cg-svg-shuffle-card-back')."
:type '(choice (const dots) (const rings) (const solid)
(const lattice) (const waves) (const diamond)
(const emacs) (const emacs-classic) (const gnu) (const splash)
(const random))
:group 'cg-svg)
(defconst cg-svg--card-backs
'(dots rings solid lattice waves diamond emacs emacs-classic gnu splash)
"Concrete card backs that `random' chooses among.")
(defvar cg-svg--random-back nil
"The concrete back currently chosen for the `random' setting.")
(defun cg-svg--roll-back ()
"Choose a fresh concrete back for `random' and return it."
(setq cg-svg--random-back
(nth (random (length cg-svg--card-backs)) cg-svg--card-backs)))
;;;###autoload
(defun cg-svg-shuffle-card-back ()
"Pick a new random card back (used when `cg-svg-card-back' is `random')."
(interactive)
(cg-svg--roll-back)
(when (called-interactively-p 'interactive)
(message "Card back: %s" cg-svg--random-back)))
(defun cg-svg--effective-back ()
"Return the concrete back to draw, resolving `random'."
(if (eq cg-svg-card-back 'random)
(or cg-svg--random-back (cg-svg--roll-back))
cg-svg-card-back))
(defun cg-svg--back-logo-name (back)
"Map a logo card-back BACK to a `cg-svg--logo-files' key."
(pcase back ('emacs 'modern) ('emacs-classic 'classic)
('gnu 'gnu) ('splash 'splash)))
(defcustom cg-svg-card-back 'dots
"Pattern drawn on a face-down card back."
:type '(choice (const dots) (const rings) (const solid)) :group 'cg-svg)
(defcustom cg-svg-four-color nil
"Use a four-colour deck when non-nil.
@ -293,60 +255,6 @@ X, Y and W, H give the card's top-left corner and size."
(cg-svg--text svg "★" (+ x (/ w 2.0)) (+ y (* h 0.52)) (* h 0.40) color)
(cg-svg--text svg "JOKER" (+ x (/ w 2.0)) (+ y (* h 0.74)) (* h 0.135) color t))
(defun cg-svg--back-dots (svg x y w h)
"Draw the dotted-medallion back pattern."
(let ((gy (+ y 10)))
(while (< gy (- (+ y h) 8))
(let ((gx (+ x 10)))
(while (< gx (- (+ x w) 8))
(svg-circle svg gx gy 1.1 :fill cg-svg-back-trim)
(setq gx (+ gx 9))))
(setq gy (+ gy 9)))))
(defun cg-svg--back-lattice (svg x y w h)
"Draw a small-cross lattice back pattern."
(let ((gy (+ y 13)))
(while (< gy (- (+ y h) 10))
(let ((gx (+ x 13)))
(while (< gx (- (+ x w) 10))
(svg-line svg (- gx 2) (- gy 2) (+ gx 2) (+ gy 2)
:stroke cg-svg-back-trim :stroke-width 1)
(svg-line svg (- gx 2) (+ gy 2) (+ gx 2) (- gy 2)
:stroke cg-svg-back-trim :stroke-width 1)
(setq gx (+ gx 11))))
(setq gy (+ gy 11)))))
(defun cg-svg--back-waves (svg x y w h)
"Draw a staggered-dash (brickwork) back pattern."
(let ((gy (+ y 12)) (row 0))
(while (< gy (- (+ y h) 9))
(let ((gx (+ x (if (cl-evenp row) 9 15))))
(while (< gx (- (+ x w) 9))
(svg-line svg gx gy (+ gx 6) gy :stroke cg-svg-back-trim :stroke-width 1.4)
(setq gx (+ gx 12))))
(setq gy (+ gy 8) row (1+ row)))))
(defun cg-svg--back-diamond (svg x y w h)
"Draw concentric diamonds as the back pattern."
(let ((cx (+ x (/ w 2.0))) (cy (+ y (/ h 2.0))))
(dolist (f '(0.40 0.28 0.16))
(let ((dw (* w f)) (dh (* h f)))
(svg-polygon svg (list (cons cx (- cy dh)) (cons (+ cx dw) cy)
(cons cx (+ cy dh)) (cons (- cx dw) cy))
:fill "none" :stroke cg-svg-back-trim :stroke-width 1)))))
(defun cg-svg--back-logo (svg x y w h back)
"Stamp the Emacs logo for BACK centred on the card, or dots if unavailable."
(let ((file (and (fboundp 'svg-embed)
(cg-svg--logo-file (cg-svg--back-logo-name back)))))
(if (null file)
(cg-svg--back-dots svg x y w h)
(let ((size (round (* h 0.52))))
(svg-embed svg file "image/png" nil
:x (round (+ x (/ (- w size) 2.0)))
:y (round (+ y (/ (- h size) 2.0)))
:width size :height size)))))
(defun cg-svg--draw-back (svg x y w h r)
"Draw a face-down card back on SVG at X, Y (W by H, corner R).
The pattern is controlled by `cg-svg-card-back'."
@ -354,20 +262,21 @@ The pattern is controlled by `cg-svg-card-back'."
:stroke cg-svg-border-color :stroke-width 1)
(svg-rectangle svg (+ x 4) (+ y 4) (- w 8) (- h 8) :rx 4 :fill "none"
:stroke cg-svg-back-trim :stroke-width 1)
(let ((back (cg-svg--effective-back)))
(pcase back
(pcase cg-svg-card-back
('solid nil)
('rings
(svg-rectangle svg (+ x 8) (+ y 8) (- w 16) (- h 16) :rx 5 :fill "none"
:stroke cg-svg-back-trim :stroke-width 1)
(svg-rectangle svg (+ x 12) (+ y 12) (- w 24) (- h 24) :rx 4 :fill "none"
:stroke cg-svg-back-trim :stroke-width 1))
('lattice (cg-svg--back-lattice svg x y w h))
('waves (cg-svg--back-waves svg x y w h))
('diamond (cg-svg--back-diamond svg x y w h))
((or 'emacs 'emacs-classic 'gnu 'splash)
(cg-svg--back-logo svg x y w h back))
(_ (cg-svg--back-dots svg x y w h)))))
(_
(let ((gy (+ y 10)))
(while (< gy (- (+ y h) 8))
(let ((gx (+ x 10)))
(while (< gx (- (+ x w) 8))
(svg-circle svg gx gy 1.1 :fill cg-svg-back-trim)
(setq gx (+ gx 9))))
(setq gy (+ gy 9)))))))
(defun cg-svg--draw-face (svg x y w h r rank suit)
"Draw a face-up card (RANK of SUIT) on SVG at X, Y (W by H, corner R)."
@ -562,59 +471,5 @@ card-size slider beneath the row."
(cg-svg-slider-draw svg pad (+ pad h 8) cg-card-scale)))
(propertize "*" 'display (cg-svg-image svg (cg-scale)) 'cg-regions regions))))
(defcustom cg-svg-emacs-logo 'modern
"Which Emacs emblem to show in the full-window (svg-fill) games.
The image choices embed a logo that ships with Emacs, falling back to the
drawn emblem when the file is unavailable. `drawn' is a small built-in
emblem and `none' shows nothing."
:type '(choice (const :tag "Modern Emacs icon" modern)
(const :tag "Classic Emacs icon" classic)
(const :tag "GNU head (Gnus)" gnu)
(const :tag "GNU Emacs splash" splash)
(const :tag "Drawn emblem" drawn)
(const :tag "None" none))
:group 'cg-svg)
(defconst cg-svg--logo-files
'((modern . ("images/icons/hicolor/48x48/apps/emacs.png"
"images/icons/hicolor/128x128/apps/emacs.png"))
(classic . ("images/icons/hicolor/48x48/apps/emacs23.png"
"images/icons/hicolor/128x128/apps/emacs23.png"))
(gnu . ("images/gnus/gnus.png"))
(splash . ("images/splash.png")))
"Map a logo name to candidate image files relative to `data-directory'.")
(defun cg-svg--logo-file (name)
"Return the first readable image file for logo NAME, or nil."
(cl-loop for rel in (cdr (assq name cg-svg--logo-files))
for f = (expand-file-name rel data-directory)
when (file-readable-p f) return f))
(defun cg-svg--draw-logo-emblem (svg cx cy fs)
"Draw the built-in purple GNU Emacs emblem centred at CX, CY, scaled FS."
(svg-gradient svg "cg-logo" 'linear '((0 . "#8056c8") (100 . "#3f1f9e")))
(svg-circle svg cx cy (round (* 26 fs)) :gradient "cg-logo"
:stroke "#2a1370" :stroke-width 2)
(cg-svg--text svg "e" cx (+ cy (round (* 10 fs))) (round (* 30 fs)) "#ffffff" t)
(cg-svg--text svg "GNU Emacs" cx (+ cy (round (* 42 fs)))
(max 10 (round (* 11 fs))) "#c7bbe6"))
(defun cg-svg-draw-logo (svg cx cy &optional fs)
"Draw the configured Emacs emblem (`cg-svg-emacs-logo') centred at CX, CY.
FS scales it. Embeds a real Emacs logo image when one is available, and
otherwise draws the built-in emblem."
(let ((fs (or fs 1.0)) (choice cg-svg-emacs-logo))
(pcase choice
('none nil)
('drawn (cg-svg--draw-logo-emblem svg cx cy fs))
(_ (let ((file (and (fboundp 'svg-embed) (cg-svg--logo-file choice))))
(if (null file)
(cg-svg--draw-logo-emblem svg cx cy fs)
(let ((size (round (* 56 fs))))
(svg-embed svg file "image/png" nil
:x (round (- cx (/ size 2)))
:y (round (- cy (/ size 2)))
:width size :height size))))))))
(provide 'cg-svg)
;;; cg-svg.el ends here

2
cg-trick-ext.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

8
cg-trick.el
View file

@ -4,7 +4,7 @@
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Version: 1.0.90
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el
@ -394,11 +394,7 @@
"Play a whole hand with AI for every seat (used by tests)."
(while (not (cg-trick--hand-over-p game))
(let ((seat (cg-get game :turn)))
(cg-trick--play game seat
(if (eq cg-ai-level 'easy)
(let ((moves (cg-trick--legal-moves game seat)))
(nth (random (length moves)) moves))
(cg-trick--ai-play game seat)))))
(cg-trick--play game seat (cg-trick--ai-play game seat))))
(cg-trick--score-hand game))
;;;; New-game / hand lifecycle

1182
doc/card-games.texi
View file

File diff suppressed because it is too large Load diff

BIN
doc/images/hearts.png
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 89 KiB

BIN
doc/images/klondike.png
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 64 KiB

3
doc/version.texi
View file

@ -1,3 +0,0 @@
@set VERSION 1.0.91
@set UPDATED 1 July 2026
@set YEAR 2026

37
hooks/pre-commit
View file

@ -1,37 +0,0 @@
#!/usr/bin/env sh
# hooks/pre-commit -- regenerate README.md from README.org on commit.
#
# When README.org (or build.el) is part of the commit, re-run the batch
# Org -> Markdown export and stage the refreshed README.md so it travels
# in the same commit. GitHub and MELPA render Markdown better than Org.
#
# Lightweight by design: no sentinel file, no post-commit --amend. If
# nothing relevant changed, the hook exits immediately.
#
# Install: make hooks (or: ln -s ../../hooks/pre-commit .git/hooks/pre-commit)
#
# Set EMACS in the environment if the Emacs binary is not named "emacs"
# on the PATH git sees (common on Windows/MSYS2).
set -e
REPO_ROOT="$(git rev-parse --show-toplevel)"
cd "$REPO_ROOT"
# Only act when README.org or the exporter itself is staged.
if ! git diff --cached --name-only | grep -Eq '^(README\.org|build\.el)$'; then
exit 0
fi
EMACS_BIN="${EMACS:-emacs}"
if ! command -v "$EMACS_BIN" >/dev/null 2>&1; then
echo "pre-commit: WARNING: '$EMACS_BIN' not found; README.md not regenerated." >&2
echo "pre-commit: set EMACS to your Emacs binary, or run 'make readme'." >&2
exit 0
fi
echo "pre-commit: regenerating README.md from README.org"
"$EMACS_BIN" -Q --batch -l build.el
git add README.md
exit 0

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

@ -760,48 +760,6 @@
(let ((cg-crap--recording nil)) (cg-crap--ai-play g))
(should (eq (cg-get g :winner) 1)))) ; plays its last card, wins
(ert-deftest cgt-crap-ai-enabling ()
;; reserve 5D cannot be placed until the AI shifts 6H off 6S (crafty rearrange)
(let ((g (cg-crap--deal (cg-crapette-game))))
(aset (cg-get g :reserve) 1 (list '(2 . 4))) ; 5 of diamonds
(aset (cg-get g :waste) 1 nil) (aset (cg-get g :hand) 1 nil)
(aset (cg-get g :reserve) 0 nil) (aset (cg-get g :waste) 0 nil)
(aset (cg-get g :found) 0 nil)
(aset (cg-get g :houses) 0 (list '(0 . 5) '(3 . 5))) ; 6S (bottom), 6H (top)
(aset (cg-get g :houses) 1 (list '(1 . 6))) ; 7C
(dotimes (k 6) (aset (cg-get g :houses) (+ 2 k) (list '(2 . 6)))) ; 7D fillers, none empty
(cg-put g :turn 1)
(let ((cg-ai-level 'hard) (cg-crap--recording nil)) (cg-crap--ai-play g))
(should (null (cg-crap--reserve g 1))))) ; hard unstuck and unloaded
(ert-deftest cgt-crap-ai-loads-you ()
;; reserve 6D loads onto your reserve top 7D; the AI should prefer that
(let ((g (cg-crap--deal (cg-crapette-game))))
(aset (cg-get g :reserve) 1 (list '(2 . 5))) ; 6D
(aset (cg-get g :waste) 1 nil) (aset (cg-get g :hand) 1 nil)
(aset (cg-get g :reserve) 0 (list '(2 . 6))) ; your reserve top 7D
(aset (cg-get g :waste) 0 nil) (aset (cg-get g :found) 0 nil)
(dotimes (k 8) (aset (cg-get g :houses) k (list '(1 . 10)))) ; nowhere on a house, none empty
(cg-put g :turn 1)
(let ((cg-crap--recording nil)) (cg-crap--ai-play g))
(should (null (cg-crap--reserve g 1)))
(should (member '(2 . 5) (cg-crap--reserve g 0))))) ; loaded onto you
(ert-deftest cgt-svg-logo-smoke ()
(dolist (choice '(modern classic gnu splash drawn none nonexistent))
(let ((cg-svg-emacs-logo choice) (svg (svg-create 200 120)))
(cg-svg-draw-logo svg 100 60 1.0)
(should (imagep (svg-image svg))))))
(ert-deftest cgt-svg-card-back-smoke ()
(dolist (b '(dots rings solid lattice waves diamond
emacs emacs-classic gnu splash random))
(let ((cg-svg-card-back b) (svg (svg-create 80 100)))
(cg-svg-card svg 12 10 :down t)
(should (imagep (svg-image svg)))))
(cg-svg--roll-back)
(should (memq cg-svg--random-back cg-svg--card-backs)))
(ert-deftest cgt-crap-house-run ()
(let ((g (cg-crap--deal (cg-crapette-game))))
(aset (cg-get g :houses) 0 (list '(2 . 8) '(0 . 7) '(3 . 6))) ; 9D 8S 7H
@ -936,65 +894,6 @@
(should (rassoc '(hand . 0)
(get-text-property 0 'cg-regions (cg-fish--svg g))))))
(ert-deftest cgt-eights-svg-smoke ()
(let ((g (cg-eights-game)))
(cg-put g :nplayers 3) (cg-put g :scores (make-vector 3 0))
(cg-eights--deal g) (cg-put g :cursor 0) (cg-put g :message "x")
(should (stringp (cg-eights--render-text g)))
(let ((regs (get-text-property 0 'cg-regions (cg-eights--board-svg g))))
(should (rassoc '(hand . 0) regs))
(should (cl-every (lambda (r) (= 4 (length (car r)))) regs)))))
(ert-deftest cgt-spite-svg-smoke ()
(let ((g (cg-spite-game)))
(cg-put g :nplayers 2) (cg-put g :scores (make-vector 2 0))
(cg-spite--deal g) (cg-put g :cursor 0) (cg-put g :message "x")
(aset (cg-get g :center) 0 (cons 3 (list '(1 . 3))))
(should (stringp (cg-spite--render-text g)))
(should (rassoc '(hand . 0)
(get-text-property 0 'cg-regions (cg-spite--board-svg g))))))
(ert-deftest cgt-om-svg-smoke ()
(let ((g (cg-old-maid-game)))
(cg-om--deal g)
(cg-put g :phase 'play) (cg-put g :turn 0) (cg-put g :message "x")
(should (stringp (cg-om--render-text g)))
(should (stringp (cg-om--svg g)))))
(ert-deftest cgt-crib-svg-smoke ()
(let ((g (cg-cribbage-game)))
(cg-put g :scores (make-vector 2 0))
(cg-crib--deal g)
(cg-put g :cursor 0) (cg-put g :message "x")
(should (stringp (cg-crib--render-text g)))
(let ((regs (get-text-property 0 'cg-regions (cg-crib--svg g))))
(should (rassoc '(hand . 0) regs))
(should (cl-every (lambda (r) (= 4 (length (car r)))) regs))))
(let ((g (cg-cribbage-game)))
(cg-put g :scores (vector 60 90))
(cg-crib--deal g)
(cg-put g :phase 'play) (cg-put g :starter '(2 . 4)) (cg-put g :total 15)
(cg-put g :play (vector (cg-crib--hand g 0) (cg-crib--hand g 1)))
(cg-put g :seq (list '(0 . 6) '(3 . 8))) (cg-put g :message "x")
(should (stringp (cg-crib--svg g)))))
(ert-deftest cgt-bridge-svg-smoke ()
(let ((g (cg-bridge-game)))
(cg-bridge--deal g)
(cg-put g :cursor 0) (cg-put g :turn 0) (cg-put g :bid-level 1) (cg-put g :bid-strain 0)
(cg-put g :message "x")
(should (stringp (cg-bridge--render-text g)))
(should (rassoc '(hand . 0)
(get-text-property 0 'cg-regions (cg-bridge--svg g)))))
(let ((g (cg-bridge-game)))
(cg-bridge--deal g)
(cg-put g :phase 'play) (cg-put g :turn 0) (cg-put g :cursor 0)
(cg-put g :declarer 0) (cg-put g :dummy 2) (cg-put g :exposed t) (cg-put g :tricks 0)
(cg-put g :contract '(3 . 3)) (cg-put g :doubled nil)
(cg-put g :trick (list (cons 1 (car (cg-bridge--hand g 1)))))
(cg-put g :message "x")
(should (stringp (cg-bridge--svg g)))))
(ert-deftest cgt-pat-golf-deal ()
(let ((g (cg-pat--deal (cg-golf-game))))
(should (= 35 (length (cg-get g :cards))))
@ -1553,46 +1452,3 @@
(should (plist-get rg :help-close))
(should (plist-get rg :help-classic))
(should (plist-get rg :help-quit)))))
(ert-deftest cgt-red-suit-boolean ()
"Two red suits compare equal by colour (the diamond/heart eq bug)."
(should (eq (cg-red-suit-p 2) (cg-red-suit-p 3))) ; both red -> eq
(should (eq (cg-red-suit-p 0) (cg-red-suit-p 1))) ; both black -> eq
(should-not (eq (cg-red-suit-p 2) (cg-red-suit-p 0))) ; red vs black
;; a diamond may NOT sit on a heart in a house (both red)
(let ((g (cg-crap--deal (cg-crapette-game))))
(aset (cg-get g :houses) 0 (list '(3 . 5))) ; 6 of hearts
(should-not (cg-crap--house-accepts g 0 '(2 . 4))) ; 5 of diamonds (both red)
(aset (cg-get g :houses) 0 (list '(0 . 5))) ; 6 of spades (black)
(should (cg-crap--house-accepts g 0 '(2 . 4))))) ; 5 of diamonds ok
(ert-deftest cgt-ai-level-easy-crapette ()
"The easy Crapette AI does not rearrange houses, so a stuck card stays."
(let ((g (cg-crap--deal (cg-crapette-game))))
(aset (cg-get g :reserve) 1 (list '(2 . 4)))
(aset (cg-get g :waste) 1 nil) (aset (cg-get g :hand) 1 nil)
(aset (cg-get g :reserve) 0 nil) (aset (cg-get g :waste) 0 nil)
(aset (cg-get g :found) 0 nil)
(aset (cg-get g :houses) 0 (list '(0 . 5) '(3 . 5)))
(aset (cg-get g :houses) 1 (list '(1 . 6)))
(dotimes (k 6) (aset (cg-get g :houses) (+ 2 k) (list '(2 . 6))))
(cg-put g :turn 1)
(let ((cg-ai-level 'easy) (cg-crap--recording nil)) (cg-crap--ai-play g))
(should (cg-crap--reserve g 1))))
(ert-deftest cgt-treatment-set ()
(let ((saved (mapcar (lambda (v) (cons v (symbol-value v)))
(append card-games--svg-card-vars card-games--full-svg-vars)))
(savedt card-games-treatment))
(unwind-protect
(progn
(card-games-set-treatment 'text)
(should-not cg-sol-svg-cards) (should-not cg-crapette-svg-cards)
(card-games-set-treatment 'full)
(should cg-sol-svg-cards) (should cg-bid-svg-ui) (should cg-gaps-svg-ui)
(card-games-set-treatment 'svg)
(should cg-sol-svg-cards) (should-not cg-bid-svg-ui))
(dolist (pr saved) (set (car pr) (cdr pr)))
(setq card-games-treatment savedt))))