Compare commits

...

2 commits

11 changed files with 304 additions and 63 deletions

View file

@ -3,7 +3,7 @@ EMACS ?= emacs
PKG = card-games PKG = card-games
VERSION = 1.0.50 VERSION = 1.0.50
# Source files in dependency order (cg-core first). # Source files in dependency order (cg-core first).
EL = cg-core.el cg-svg.el cg-bid.el cg-gaps.el cg-bid-ui.el card-games.el EL = cg-core.el cg-svg.el cg-render.el cg-bid.el cg-gaps.el cg-bid-ui.el card-games.el
ELC = $(EL:.el=.elc) ELC = $(EL:.el=.elc)
PKGDESC = $(PKG)-pkg.el PKGDESC = $(PKG)-pkg.el
TARDIR = $(PKG)-$(VERSION) TARDIR = $(PKG)-$(VERSION)

View file

@ -9,24 +9,28 @@ configuring ~card-game-symbols~.
* Games * Games
- *500 (Bid)* -- the four-handed partnership trick-taking game, against - *500 (Bid)* -- the four-handed partnership trick-taking game, against
three computer opponents (=M-x cg-bid=). three computer opponents (~M-x cg-bid~).
- *Gaps / Hell's Half-Acre* -- solitaire; sort each row into one suit - *Gaps / Hell's Half-Acre* -- solitaire; sort each row into one suit
running 2..K (=M-x cg-gaps=). running 2..K (~M-x cg-gaps~).
To launch the game-menu press =M-x card-game= or launch a game To open the game menu type ~M-x card-game~, or start a game directly
directly by calling it's launcher command. Launcher commands take the with its command:
form ~cg-GAME~ where ~GAME~ is one of - ~cg-montana~ -- Montana (also called Gaps). Each row is anchored by a
- montana - Montana: <SHORT_RULES> Two and built upward in one suit, 2 through King; slide cards into the
- gap - Gap: <SHORT_RULES> gaps until all four rows are sorted.
- hha - Hells Half Acre: <SHORT_RULES> - ~cg-gaps~ -- an alias for ~cg-montana~.
- bid - Bid, (or 500 Bid): <SHORT_RULES> - ~cg-hells-half-acre~ -- the build-down variant: each row is anchored by
a King and built downward, King through 2.
- ~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.
* TODO * TODO
- [ ] documentation - [X] make the suit symbols customizable (~cg-symbols~) and obey them
- [ ] create ~card-game-symbols~ and obey it - [ ] a Texinfo manual
- [ ] refactor to allow games to subclass components (svg) - [ ] renderer "skins": let games subclass the display components (text,
- [ ] add manual-control silder for card size (svgfull) SVG, full-window SVG)
- [ ] mor games - [ ] a manual card-size control for the full-window SVG UI
- [ ] more games
* Install * Install
** From the package tarball ** From the package tarball
@ -55,8 +59,11 @@ graphical display.
- 500: ~b~ bid, ~p~ pass, arrows + ~RET~ to play (or click a card), - 500: ~b~ bid, ~p~ pass, arrows + ~RET~ to play (or click a card),
~n~ next hand / new game, ~?~ help. ~n~ next hand / new game, ~?~ help.
- Gaps: arrows or ~hjkl~ to move, ~RET~ to fill a gap (or click it), - Gaps: arrows to move (or ~hjkl~ when ~cg-keys~ is ~classic~), ~RET~ to
~r~ redeal, ~u~ undo, ~n~ new, ~?~ help. fill a gap (or click it), ~r~ redeal, ~u~ undo, ~n~ new, ~?~ help.
On a graphical display, ~v~ toggles the full-window SVG table and
~+~ / ~-~ / ~0~ (Emacs ~text-scale-adjust~) resize the cards.
* Customization * Customization
~M-x customize-group RET cg-svg~ and ~RET card-games~: ~M-x customize-group RET cg-svg~ and ~RET card-games~:
@ -66,6 +73,11 @@ graphical display.
- ~cg-svg-card-width~, ~cg-svg-card-height~, ~cg-svg-card-shadow~, - ~cg-svg-card-width~, ~cg-svg-card-height~, ~cg-svg-card-shadow~,
~cg-svg-font-family~ -- card appearance. ~cg-svg-font-family~ -- card appearance.
- ~cg-svg-card-back~ -- card-back pattern: dots, rings, or solid. - ~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).
- ~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 - ~cg-bid-animate~, ~cg-bid-ai-delay~, ~cg-bid-trick-pause~ -- pace the
500 AI so play is watchable and completed tricks linger. 500 AI so play is watchable and completed tricks linger.
- ~M-x card-games-set-theme~ -- apply a preset (classic, dark, contrast). - ~M-x card-games-set-theme~ -- apply a preset (classic, dark, contrast).

View file

@ -3,7 +3,7 @@
"Play card games in Emacs (console UNICODE and graphical SVG)." "Play card games in Emacs (console UNICODE and graphical SVG)."
'((emacs "26.1")) '((emacs "26.1"))
:keywords '("games") :keywords '("games")
:url "https://github.com/corwin/card-games" :url "https://code.bru.st/corwin/card-game.el"
:authors '(("Corwin Brust" . "corwin@bru.st")) :authors '(("Corwin Brust" . "corwin@bru.st"))
:maintainer '("Corwin Brust" . "corwin@bru.st")) :maintainer '("Corwin Brust" . "corwin@bru.st"))
;;; card-games-pkg.el ends here ;;; card-games-pkg.el ends here

View file

@ -7,7 +7,7 @@
;; Version: 1.0.50 ;; Version: 1.0.50
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: games ;; Keywords: games
;; URL: https://github.com/corwin/card-games ;; URL: https://code.bru.st/corwin/card-game.el
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -39,6 +39,7 @@
;;; Code: ;;; Code:
(require 'cg-core) (require 'cg-core)
(require 'cg-render)
(require 'cg-gaps) (require 'cg-gaps)
(require 'cg-bid-ui) (require 'cg-bid-ui)

View file

@ -7,7 +7,7 @@
;; Version: 1.0.50 ;; Version: 1.0.50
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: games ;; Keywords: games
;; URL: https://github.com/corwin/card-games ;; URL: https://code.bru.st/corwin/card-game.el
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -33,6 +33,7 @@
(require 'cg-core) (require 'cg-core)
(require 'cg-bid) (require 'cg-bid)
(require 'cg-svg) (require 'cg-svg)
(require 'cg-render)
(require 'svg) (require 'svg)
(require 'color) (require 'color)
@ -388,17 +389,37 @@ Folds the controls into the single action-button row (see
(cg-bid--button "[Help]" #'cg-bid-help "Show help") (cg-bid--button "[Help]" #'cg-bid-help "Show help")
(insert "\n")) (insert "\n"))
(cl-defmethod cg-renderer-draw ((_renderer cg-text-renderer) (game cg-bid-game))
"Draw the 500 GAME as UNICODE text with the action buttons."
(insert (cg-render game))
(cg-bid--insert-buttons game))
(cl-defmethod cg-renderer-draw ((_renderer cg-svg-renderer) (game cg-bid-game))
"Draw the 500 GAME as an SVG table with the action buttons."
(cg-bid--insert-graphical game)
(cg-bid--insert-buttons game))
(cl-defmethod cg-renderer-draw ((_renderer cg-svg-fill-renderer) (game cg-bid-game))
"Draw the 500 GAME as a frameless full-window SVG table."
(cg-bid--insert-svg-ui game))
(defun cg-bid--treatment ()
"Return the display treatment symbol for the current 500 buffer.
Honours `cg-bid-svg-ui' and whether the display is graphical."
(cond ((and cg-bid-svg-ui (display-graphic-p)) 'svg-fill)
((display-graphic-p) 'svg)
(t 'text)))
(defun cg-bid--redisplay () (defun cg-bid--redisplay ()
"Redraw the current 500 buffer (SVG table on a graphical display)." "Redraw the current 500 buffer through its renderer.
(let ((inhibit-read-only t) (game cg-bid--game)) The treatment is chosen by `cg-bid--treatment' and dispatched with
`cg-renderer-draw'."
(let* ((inhibit-read-only t)
(game cg-bid--game)
(renderer (cg-render-set-treatment game (cg-bid--treatment))))
(setq-local mode-line-process (cg-bid--mode-line game)) (setq-local mode-line-process (cg-bid--mode-line game))
(erase-buffer) (erase-buffer)
(if (and cg-bid-svg-ui (display-graphic-p)) (cg-renderer-draw renderer game)
(cg-bid--insert-svg-ui game)
(if (display-graphic-p)
(cg-bid--insert-graphical game)
(insert (cg-render game)))
(cg-bid--insert-buttons game))
(goto-char (point-min)))) (goto-char (point-min))))
(defun cg-bid--refresh () (defun cg-bid--refresh ()

View file

@ -7,7 +7,7 @@
;; Version: 1.0.50 ;; Version: 1.0.50
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: games ;; Keywords: games
;; URL: https://github.com/corwin/card-games ;; URL: https://code.bru.st/corwin/card-game.el
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -65,7 +65,7 @@
(cond (cond
((null card) "--") ((null card) "--")
((cg-bid-joker-p card) "Jk") ((cg-bid-joker-p card) "Jk")
(t (concat (aref cg-bid-ranks (cdr card)) (aref cg-suits (car card)))))) (t (concat (aref cg-bid-ranks (cdr card)) (cg-suit-glyph (car card))))))
(defun cg-bid--full-deck () (defun cg-bid--full-deck ()
"Return the 45-card deck as a list of cards." "Return the 45-card deck as a list of cards."

View file

@ -7,7 +7,7 @@
;; Version: 1.0.50 ;; Version: 1.0.50
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: games ;; Keywords: games
;; URL: https://github.com/corwin/card-games ;; URL: https://code.bru.st/corwin/card-game.el
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -60,7 +60,9 @@ and SPC as an action key. Takes effect the next time a game starts."
((name :initarg :name :initform "game" :type string ((name :initarg :name :initform "game" :type string
:documentation "Human-readable game name.") :documentation "Human-readable game name.")
(env :initarg :env :initform nil (env :initarg :env :initform nil
:documentation "Mutable per-game data, stored as a plist.")) :documentation "Mutable per-game data, stored as a plist.")
(renderer :initarg :renderer :initform nil
:documentation "Current `cg-renderer', or nil for the default."))
"Abstract base class for card games." "Abstract base class for card games."
:abstract t) :abstract t)
@ -80,13 +82,78 @@ and SPC as an action key. Takes effect the next time a game starts."
value) value)
;;;; Renderer "skins"
;; A renderer (a "skin") is a display treatment: it knows how to draw a
;; game and how to map a click back to a game action. Treatments are
;; EIEIO classes registered by name in `cg-renderers'; a game holds the
;; one it is currently drawn with. This lets a single game be shown as
;; plain text, as SVG, or as a full-window SVG table without subclassing
;; the game itself once per treatment. Concrete treatments and the
;; game-specific drawing methods live in cg-render.el and the games.
(defclass cg-renderer ()
((name :initarg :name :initform 'text :type symbol
:documentation "Symbol naming this treatment."))
"Abstract base class for a display treatment (a \"skin\")."
:abstract t)
(cl-defgeneric cg-renderer-draw (renderer game)
"Draw GAME under RENDERER by inserting into the current buffer.")
(cl-defgeneric cg-renderer-hit (renderer game position)
"Map POSITION under RENDERER to an action on GAME.
Return non-nil when the click was handled.")
(cl-defmethod cg-renderer-draw ((renderer cg-renderer) (game cg-game))
"Default method: report that no drawing method exists for this pair."
(error "No `cg-renderer-draw' for %s under the `%s' renderer"
(eieio-object-class-name game) (oref renderer name)))
(cl-defmethod cg-renderer-hit ((_renderer cg-renderer) (_game cg-game) _position)
"Default method: treat the click as unhandled."
nil)
(defvar cg-renderers nil
"Alist mapping a treatment name (a symbol) to a `cg-renderer' subclass.
Populate it with `cg-register-renderer' and look entries up with
`cg-make-renderer'.")
(defun cg-register-renderer (name class)
"Register renderer CLASS (an EIEIO class) under the treatment NAME."
(setf (alist-get name cg-renderers) class))
(defun cg-make-renderer (name)
"Return a fresh renderer instance for treatment NAME, or nil if unknown."
(let ((class (alist-get name cg-renderers)))
(and class (make-instance class :name name))))
(defun cg-renderer-names ()
"Return the registered treatment names."
(mapcar #'car cg-renderers))
;;;; Cards and colours ;;;; Cards and colours
(defconst cg-suits ["" "" "" ""] (defcustom cg-symbols
"Suit glyphs indexed 0..3: spades, clubs, diamonds, hearts.") '((0 . "") (1 . "") (2 . "") (3 . "") (joker . ""))
"Glyphs used to draw suits, both as text and inside the SVG cards.
The value is an alist mapping a suit index (0 spades, 1 clubs,
2 diamonds, 3 hearts) or the symbol `joker' to the string drawn for it.
Customize this to use alternative Unicode symbols, for example the
outlined suits \"\" \"\" \"\" \"\"."
:type '(alist :key-type sexp :value-type string)
:group 'card-games)
(defconst cg-suit-names ["Spades" "Clubs" "Diamonds" "Hearts"] (defconst cg-suit-names ["Spades" "Clubs" "Diamonds" "Hearts"]
"Suit names indexed to match `cg-suits'.") "Suit names indexed 0..3 to match the suit indices used throughout.")
(defun cg-suit-glyph (suit)
"Return the glyph drawn for SUIT, a suit index 0-3 or the symbol `joker'.
The glyphs are taken from `cg-symbols'."
(or (cdr (assoc suit cg-symbols))
(and (integerp suit) (aref cg-suit-names suit))
"?"))
(defsubst cg-red-suit-p (suit) (defsubst cg-red-suit-p (suit)
"Return non-nil when SUIT index denotes a red suit." "Return non-nil when SUIT index denotes a red suit."

View file

@ -7,7 +7,7 @@
;; Version: 1.0.50 ;; Version: 1.0.50
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: games ;; Keywords: games
;; URL: https://github.com/corwin/card-games ;; URL: https://code.bru.st/corwin/card-game.el
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -49,6 +49,7 @@
(require 'cg-core) (require 'cg-core)
(require 'cg-svg) (require 'cg-svg)
(require 'cg-render)
;;;; Cards ;;;; Cards
@ -73,7 +74,7 @@
(if (null card) (if (null card)
"·" "·"
(concat (aref cg-gaps-ranks (cdr card)) (concat (aref cg-gaps-ranks (cdr card))
(aref cg-suits (car card))))) (cg-suit-glyph (car card)))))
;;;; Games — an abstract base and two subclasses ;;;; Games — an abstract base and two subclasses
@ -419,23 +420,37 @@ buttons (the keyboard hint *is* the button)."
(cg-gaps--key-button "?" "help" #'cg-gaps-help "Show the rules and keys") (cg-gaps--key-button "?" "help" #'cg-gaps-help "Show the rules and keys")
(insert "\n")) (insert "\n"))
(cl-defmethod cg-renderer-draw ((_renderer cg-text-renderer) (game cg-gaps-game))
"Draw the Gaps GAME as UNICODE text with the control line."
(insert (cg-render game))
(cg-gaps--insert-controls))
(cl-defmethod cg-renderer-draw ((_renderer cg-svg-renderer) (game cg-gaps-game))
"Draw the Gaps GAME as an inline SVG board with the control line."
(cg-gaps--insert-graphical game)
(cg-gaps--insert-controls))
(cl-defmethod cg-renderer-draw ((_renderer cg-svg-fill-renderer) (game cg-gaps-game))
"Draw the Gaps GAME as a full-window SVG table."
(cg-gaps--insert-svg-ui game))
(defun cg-gaps--treatment ()
"Return the display treatment symbol for the current Gaps buffer.
Honours `cg-gaps-svg-ui' and whether the display is graphical."
(cond ((and cg-gaps-svg-ui (display-graphic-p)) 'svg-fill)
((display-graphic-p) 'svg)
(t 'text)))
(defun cg-gaps--redisplay () (defun cg-gaps--redisplay ()
"Redraw the current Gaps buffer. "Redraw the current Gaps buffer through its renderer.
Full-buffer SVG when `cg-gaps-svg-ui'; otherwise an inline SVG board (or The treatment is chosen by `cg-gaps--treatment' and dispatched with
UNICODE text on a terminal), each followed by the single control line." `cg-renderer-draw'."
(let ((game cg-gaps--game) (let* ((game cg-gaps--game)
(inhibit-read-only t)) (inhibit-read-only t)
(renderer (cg-render-set-treatment game (cg-gaps--treatment))))
(setq-local mode-line-process (cg-gaps--mode-line game)) (setq-local mode-line-process (cg-gaps--mode-line game))
(erase-buffer) (erase-buffer)
(cond (cg-renderer-draw renderer game)
((and cg-gaps-svg-ui (display-graphic-p))
(cg-gaps--insert-svg-ui game))
((display-graphic-p)
(cg-gaps--insert-graphical game)
(cg-gaps--insert-controls))
(t
(insert (cg-render game))
(cg-gaps--insert-controls)))
(if (display-graphic-p) (if (display-graphic-p)
(goto-char (point-min)) (goto-char (point-min))
(let ((cur (cg-get game :cursor))) (let ((cur (cg-get game :cursor)))

98
cg-render.el Normal file
View file

@ -0,0 +1,98 @@
;;; cg-render.el --- Renderer "skins" for card games -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Corwin Brust
;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.50
;; 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:
;; Concrete display treatments ("skins") built on the `cg-renderer'
;; protocol from cg-core. Each treatment is a small EIEIO class that
;; registers itself by name:
;;
;; text plain UNICODE text (works in a terminal and on Android)
;; svg SVG cards on a graphical display
;; svg-fill a full-window SVG table that grows with the window
;;
;; A game draws itself by calling `cg-render-game', which selects the
;; game's current renderer (falling back to a default treatment chosen
;; for the display) and dispatches `cg-renderer-draw'. The actual,
;; game-specific drawing is supplied as methods specialised on a
;; (TREATMENT GAME) pair in the individual game files.
;;; Code:
(require 'cg-core)
(defgroup cg-render nil
"Display treatments (\"skins\") for card games."
:group 'card-games
:prefix "cg-render-")
(defclass cg-text-renderer (cg-renderer)
((name :initform 'text))
"Plain UNICODE text treatment.")
(defclass cg-svg-renderer (cg-renderer)
((name :initform 'svg))
"SVG cards on a graphical display.")
(defclass cg-svg-fill-renderer (cg-svg-renderer)
((name :initform 'svg-fill))
"Full-window SVG table that grows to fill the window.")
(cg-register-renderer 'text 'cg-text-renderer)
(cg-register-renderer 'svg 'cg-svg-renderer)
(cg-register-renderer 'svg-fill 'cg-svg-fill-renderer)
(defcustom cg-render-default-treatment 'auto
"Default display treatment for games.
The value `auto' chooses `svg' on a graphical display and `text'
otherwise. It may instead name a treatment registered in
`cg-renderers', such as `text', `svg', or `svg-fill'."
:type '(choice (const :tag "Automatic (svg if graphical, else text)" auto)
(const text) (const svg) (const svg-fill)
(symbol :tag "Other registered treatment"))
:group 'cg-render)
(defun cg-render-resolve-treatment (&optional name)
"Return a concrete treatment name, resolving `auto' and NAME for this display.
NAME defaults to `cg-render-default-treatment'."
(let ((n (or name cg-render-default-treatment)))
(if (eq n 'auto)
(if (display-graphic-p) 'svg 'text)
n)))
(defun cg-render-game (game)
"Draw GAME with its current renderer, creating a default one if needed.
The default treatment comes from `cg-render-resolve-treatment'."
(let ((r (or (oref game renderer)
(let ((new (cg-make-renderer (cg-render-resolve-treatment))))
(oset game renderer new)
new))))
(cg-renderer-draw r game)))
(defun cg-render-set-treatment (game name)
"Switch GAME to the treatment NAME and return its new renderer."
(oset game renderer (cg-make-renderer name)))
(provide 'cg-render)
;;; cg-render.el ends here

View file

@ -7,7 +7,7 @@
;; Version: 1.0.50 ;; Version: 1.0.50
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: games ;; Keywords: games
;; URL: https://github.com/corwin/card-games ;; URL: https://code.bru.st/corwin/card-game.el
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -79,8 +79,9 @@
:type 'string :group 'cg-svg) :type 'string :group 'cg-svg)
(defcustom cg-svg-theme-colors t (defcustom cg-svg-theme-colors t
"When non-nil, derive the highlight ring and card back from the "Derive the highlight ring and card back from the active theme.
active Emacs theme (with the colour variables below as fallbacks)." When non-nil, colours are taken from the active Emacs theme, with the
colour variables below as fallbacks."
:type 'boolean :group 'cg-svg) :type 'boolean :group 'cg-svg)
(defcustom cg-svg-card-back 'dots (defcustom cg-svg-card-back 'dots
@ -88,8 +89,9 @@ active Emacs theme (with the colour variables below as fallbacks)."
:type '(choice (const dots) (const rings) (const solid)) :group 'cg-svg) :type '(choice (const dots) (const rings) (const solid)) :group 'cg-svg)
(defcustom cg-svg-four-color nil (defcustom cg-svg-four-color nil
"When non-nil use a four-colour deck: clubs green, diamonds blue-purple "Use a four-colour deck when non-nil.
\(spades stay black, hearts red)." Clubs are drawn green and diamonds blue-purple; spades stay black and
hearts red."
:type 'boolean :group 'cg-svg) :type 'boolean :group 'cg-svg)
(defconst cg-svg-corner-radius 6 (defconst cg-svg-corner-radius 6
@ -164,8 +166,9 @@ Pips with a Y fraction above 0.5 are drawn rotated 180 degrees.")
(t cg-svg-black-color))) (t cg-svg-black-color)))
(defun cg-svg--suit-glyph (suit) (defun cg-svg--suit-glyph (suit)
"Return the glyph for SUIT (0-3 or the symbol `joker')." "Return the glyph for SUIT (0-3 or the symbol `joker').
(if (eq suit 'joker) "" (aref cg-suits suit))) Defers to `cg-suit-glyph', so it honours `cg-symbols'."
(cg-suit-glyph suit))
(defun cg-svg--text (svg str x y size color &optional bold transform) (defun cg-svg--text (svg str x y size color &optional bold transform)
"Add centred text STR to SVG at X, Y with SIZE, COLOR, BOLD, TRANSFORM." "Add centred text STR to SVG at X, Y with SIZE, COLOR, BOLD, TRANSFORM."
@ -178,7 +181,8 @@ Pips with a Y fraction above 0.5 are drawn rotated 180 degrees.")
(defun cg-svg--index (svg x y w h rank glyph color flip) (defun cg-svg--index (svg x y w h rank glyph color flip)
"Draw a stacked RANK/GLYPH index in COLOR on SVG. "Draw a stacked RANK/GLYPH index in COLOR on SVG.
Top-left normally; bottom-right and upside-down when FLIP is non-nil." X, Y and W, H give the card's top-left corner and size. The index sits
top-left normally, and bottom-right and upside-down when FLIP is non-nil."
(let* ((rs (max 8 (round (* h 0.18)))) (let* ((rs (max 8 (round (* h 0.18))))
(gs (max 7 (round (* h 0.15)))) (gs (max 7 (round (* h 0.15))))
(ix (+ x (round (* w 0.16)))) (ix (+ x (round (* w 0.16))))
@ -207,14 +211,16 @@ Top-left normally; bottom-right and upside-down when FLIP is non-nil."
ps glyph color (> (cdr pos) 0.5))))) ps glyph color (> (cdr pos) 0.5)))))
(defun cg-svg--draw-ace (svg x y w h glyph color) (defun cg-svg--draw-ace (svg x y w h glyph color)
"Draw a single large central pip (an ace) in COLOR on SVG." "Draw a single large central pip (an ace) of GLYPH in COLOR on SVG.
X, Y and W, H give the card's top-left corner and size."
(cg-svg--pip svg (+ x (/ w 2.0)) (+ y (/ h 2.0)) (round (* h 0.42)) (cg-svg--pip svg (+ x (/ w 2.0)) (+ y (/ h 2.0)) (round (* h 0.42))
glyph color nil)) glyph color nil))
(defun cg-svg--draw-court (svg x y w h rank glyph color suit) (defun cg-svg--draw-court (svg x y w h rank glyph color suit)
"Draw a framed court card (RANK letter + GLYPH) of SUIT in COLOR on SVG. "Draw a framed court card (RANK letter + GLYPH) of SUIT in COLOR on SVG.
The inner panel has a quarter-circle scallop cut into each corner; the X, Y and W, H give the card's top-left corner and size. The inner panel
scallop radius is 8.5% of the panel height (17% diameter)." has a quarter-circle scallop cut into each corner; the scallop radius is
8.5% of the panel height (17% diameter)."
(let* ((mx (round (* w 0.15))) (my (round (* h 0.16))) (let* ((mx (round (* w 0.15))) (my (round (* h 0.16)))
(bx (+ x mx)) (by (+ y my)) (bx (+ x mx)) (by (+ y my))
(bw (- w (* 2 mx))) (bh (- h (* 2 my))) (bw (- w (* 2 mx))) (bh (- h (* 2 my)))
@ -238,7 +244,8 @@ scallop radius is 8.5% of the panel height (17% diameter)."
(cg-svg--text svg glyph (+ x (/ w 2.0)) (+ y (* h 0.76)) (* h 0.20) color))) (cg-svg--text svg glyph (+ x (/ w 2.0)) (+ y (* h 0.76)) (* h 0.20) color)))
(defun cg-svg--draw-joker (svg x y w h color) (defun cg-svg--draw-joker (svg x y w h color)
"Draw the joker face in COLOR on SVG." "Draw the joker face in COLOR on SVG.
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 "" (+ 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)) (cg-svg--text svg "JOKER" (+ x (/ w 2.0)) (+ y (* h 0.74)) (* h 0.135) color t))

View file

@ -15,6 +15,26 @@
(ert-deftest cgt-core-color-fallback () (ert-deftest cgt-core-color-fallback ()
(should (equal "#123456" (cg-color 'no-such-face-xyzzy :background "#123456")))) (should (equal "#123456" (cg-color 'no-such-face-xyzzy :background "#123456"))))
(ert-deftest cgt-core-suit-glyph ()
(let ((cg-symbols '((0 . "S") (1 . "C") (2 . "D") (3 . "H") (joker . "JK"))))
(should (equal "S" (cg-suit-glyph 0)))
(should (equal "JK" (cg-suit-glyph 'joker))))
(should (equal "" (cg-suit-glyph 0))))
;;;; Renderer skins
(ert-deftest cgt-render-registry ()
(should (memq 'text (cg-renderer-names)))
(should (memq 'svg (cg-renderer-names)))
(should (memq 'svg-fill (cg-renderer-names)))
(should (object-of-class-p (cg-make-renderer 'svg) 'cg-svg-renderer))
(should (object-of-class-p (cg-make-renderer 'svg-fill) 'cg-svg-renderer))
(should-not (cg-make-renderer 'no-such-treatment)))
(ert-deftest cgt-render-resolve ()
(should (eq 'text (cg-render-resolve-treatment 'text)))
(should (memq (cg-render-resolve-treatment 'auto) '(text svg))))
;;;; Gaps ;;;; Gaps
(ert-deftest cgt-gaps-deal () (ert-deftest cgt-gaps-deal ()