Corwin Brust
b5410e1830
Console UNICODE games on the cg-core EIEIO engine, all ERT-tested (88/88): - Tableau solitaire (cg-solitaire.el): Klondike, FreeCell, Spider, Yukon, Canfield, Forty Thieves, Scorpion. - Pile solitaire (cg-patience.el): Golf, TriPeaks, Pyramid. - Trick-taking (cg-trick.el): Hearts, Spades, Whist, Oh Hell. - Shedding/climbing: Crazy Eights (cg-eights.el), President (cg-president.el). Wire all into the card-game chooser, Makefile, and README; add known-games.org research collation; bump every file to 1.0.60.
172 lines
6.5 KiB
EmacsLisp
172 lines
6.5 KiB
EmacsLisp
;;; card-games.el --- Play card games in Emacs (console + SVG) -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2026 Corwin Brust
|
|
|
|
;; Author: Corwin Brust <corwin@bru.st>
|
|
;; Maintainer: Corwin Brust <corwin@bru.st>
|
|
;; Version: 1.0.60
|
|
;; Package-Requires: ((emacs "26.1"))
|
|
;; Keywords: games
|
|
;; URL: https://code.bru.st/corwin/card-game.el
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Card games for Emacs, rendered as UNICODE text in a terminal and as
|
|
;; SVG cards on a graphical display. This file is the umbrella: it
|
|
;; pulls in the individual games and offers a chooser.
|
|
;;
|
|
;; Run `M-x card-game' for a menu, or start a game directly:
|
|
;;
|
|
;; `cg-bid' -- 500, the four-handed partnership trick-taking game,
|
|
;; played against three computer opponents.
|
|
;; `cg-gaps' -- Gaps / Montana / "Hell's Half-Acre" solitaire.
|
|
;;
|
|
;; New games register themselves by adding to `card-games-list'.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cg-core)
|
|
(require 'cg-render)
|
|
(require 'cg-net)
|
|
(require 'cg-gaps)
|
|
(require 'cg-bid-ui)
|
|
(require 'cg-bid-net)
|
|
(require 'cg-solitaire)
|
|
(require 'cg-trick)
|
|
(require 'cg-eights)
|
|
(require 'cg-patience)
|
|
(require 'cg-president)
|
|
|
|
(defvar card-games-list
|
|
'(("500 (Bid)" cg-bid
|
|
"Four-handed partnership trick-taking versus three AI opponents.")
|
|
("Gaps (Montana)" cg-montana
|
|
"Solitaire: a Two anchors each row; build up 2 through King.")
|
|
("Hell's Half-Acre" cg-hells-half-acre
|
|
"Solitaire: a King anchors each row; build down King through 2.")
|
|
("Klondike" cg-klondike
|
|
"Solitaire: the classic; build the foundations up by suit from the Ace.")
|
|
("FreeCell" cg-freecell
|
|
"Solitaire: every card in view, four free cells, a game of skill.")
|
|
("Spider" cg-spider
|
|
"Solitaire: two decks; build down and clear eight same-suit runs.")
|
|
("Yukon" cg-yukon
|
|
"Solitaire: Klondike's layout, all face up; move any buried group.")
|
|
("Hearts" cg-hearts
|
|
"Trick-taking: dodge every heart and the Queen of Spades.")
|
|
("Spades" cg-spades
|
|
"Trick-taking: partnership bidding to 500; spades are always trump.")
|
|
("Crazy Eights" cg-eights
|
|
"Shedding: match the suit or rank; eights are wild.")
|
|
("Canfield" cg-canfield
|
|
"Solitaire: a 13-card reserve and a shifting foundation base rank.")
|
|
("Forty Thieves" cg-forty-thieves
|
|
"Solitaire: two decks, ten columns, eight foundations, no redeal.")
|
|
("Scorpion" cg-scorpion
|
|
"Solitaire: build down by suit and free four buried King-to-Ace runs.")
|
|
("Golf" cg-golf
|
|
"Solitaire: clear the layout one rank at a time onto the waste.")
|
|
("TriPeaks" cg-tripeaks
|
|
"Solitaire: clear three peaks with Ace-King wrapping chains.")
|
|
("Pyramid" cg-pyramid
|
|
"Solitaire: remove pairs of cards that sum to thirteen.")
|
|
("Whist" cg-whist
|
|
"Trick-taking: fixed trump, no bidding, race past the book of six.")
|
|
("Oh Hell" cg-ohhell
|
|
"Trick-taking: shrinking hands; bid the exact tricks you will take.")
|
|
("President" cg-president
|
|
"Climbing: shed your hand; first out rules, last out scrubs."))
|
|
"Registry of playable games.
|
|
Each entry is (NAME COMMAND DESCRIPTION); `card-game' lists them.")
|
|
|
|
(defun card-game--launch (button)
|
|
"Start the game whose command is stored on BUTTON."
|
|
(let ((cmd (button-get button 'card-game-command)))
|
|
(quit-window)
|
|
(call-interactively cmd)))
|
|
|
|
(defvar card-game-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map special-mode-map)
|
|
(define-key map "n" #'forward-button)
|
|
(define-key map "p" #'backward-button)
|
|
(define-key map (kbd "TAB") #'forward-button)
|
|
(define-key map (kbd "<backtab>") #'backward-button)
|
|
map)
|
|
"Keymap for `card-game-mode'.")
|
|
|
|
(define-derived-mode card-game-mode special-mode "Card-Games"
|
|
"Major mode for the `card-game' chooser."
|
|
(setq-local cursor-type nil))
|
|
|
|
;;;###autoload
|
|
(defun card-game ()
|
|
"Open a chooser listing the available card games.
|
|
Press RET (or click) on a game to start it."
|
|
(interactive)
|
|
(let ((buf (get-buffer-create "*Card Games*")))
|
|
(with-current-buffer buf
|
|
(card-game-mode)
|
|
(let ((inhibit-read-only t))
|
|
(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\n"
|
|
'face 'shadow))
|
|
(dolist (g card-games-list)
|
|
(insert " ")
|
|
(insert-text-button
|
|
(format "%-26s" (nth 0 g))
|
|
'face 'link
|
|
'help-echo (nth 2 g)
|
|
'card-game-command (nth 1 g)
|
|
'action #'card-game--launch)
|
|
(insert (propertize (concat " " (nth 2 g) "\n") 'face 'shadow)))
|
|
(insert "\n")))
|
|
(switch-to-buffer buf)
|
|
(goto-char (point-min))
|
|
(forward-button 1)))
|
|
|
|
;;;###autoload
|
|
(defalias 'card-games #'card-game
|
|
"Alias for `card-game'.")
|
|
|
|
(defconst card-games-themes
|
|
'((classic :felt "#15692f" :theme t)
|
|
(dark :felt "#23272e" :back "#3b4252" :highlight "#88c0d0" :theme nil)
|
|
(contrast :felt "#0a0a0a" :back "#000000" :highlight "#ffd400" :theme nil))
|
|
"Named table/card colour presets for `card-games-set-theme'.")
|
|
|
|
;;;###autoload
|
|
(defun card-games-set-theme (name)
|
|
"Apply the card-games colour preset NAME (see `card-games-themes')."
|
|
(interactive
|
|
(list (intern (completing-read
|
|
"Card-games theme: "
|
|
(mapcar (lambda (e) (symbol-name (car e))) card-games-themes)
|
|
nil t))))
|
|
(let ((p (alist-get name card-games-themes)))
|
|
(unless p (user-error "No such card-games theme: %s" name))
|
|
(setq cg-bid-felt-color (plist-get p :felt))
|
|
(when (plist-member p :theme)
|
|
(setq cg-svg-theme-colors (plist-get p :theme)))
|
|
(when (plist-get p :back) (setq cg-svg-back-color (plist-get p :back)))
|
|
(when (plist-get p :highlight)
|
|
(setq cg-svg-highlight-color (plist-get p :highlight)))
|
|
(message "card-games theme: %s" name)))
|
|
|
|
(provide 'card-games)
|
|
;;; card-games.el ends here
|