diff --git a/NEWS b/NEWS index e9790b4..07cb880 100644 --- a/NEWS +++ b/NEWS @@ -81,6 +81,12 @@ 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 diff --git a/card-games.el b/card-games.el index 9b7d654..a5f91e7 100644 --- a/card-games.el +++ b/card-games.el @@ -134,6 +134,40 @@ "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))) @@ -190,7 +224,14 @@ Press RET (or click) on a game to start it." '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\n" 'face 'shadow)) + (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 diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 92a362c..ccb113b 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -1580,3 +1580,19 @@ (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))))