;;; solitaire.el --- game of solitaire in Emacs Lisp
-;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2016 Free Software Foundation, Inc.
;; Author: Jan Schormann <Jan.Schormann@rechen-gilde.de>
;; Created: Fri afternoon, Jun 3, 1994
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(defgroup solitaire nil
- "Game of solitaire."
+ "Game of Solitaire."
:prefix "solitaire-"
:group 'games)
-(defvar solitaire-mode-map nil
- "Keymap for playing solitaire.")
-
(defcustom solitaire-mode-hook nil
- "Hook to run upon entry to solitaire."
+ "Hook to run upon entry to Solitaire."
:type 'hook
:group 'solitaire)
-(if solitaire-mode-map
- ()
- (setq solitaire-mode-map (make-sparse-keymap))
- (suppress-keymap solitaire-mode-map t)
- (define-key solitaire-mode-map "\C-f" 'solitaire-right)
- (define-key solitaire-mode-map "\C-b" 'solitaire-left)
- (define-key solitaire-mode-map "\C-p" 'solitaire-up)
- (define-key solitaire-mode-map "\C-n" 'solitaire-down)
- (define-key solitaire-mode-map [return] 'solitaire-move)
- (define-key solitaire-mode-map [remap undo] 'solitaire-undo)
- (define-key solitaire-mode-map " " 'solitaire-do-check)
- (define-key solitaire-mode-map "q" 'quit-window)
-
- (define-key solitaire-mode-map [right] 'solitaire-right)
- (define-key solitaire-mode-map [left] 'solitaire-left)
- (define-key solitaire-mode-map [up] 'solitaire-up)
- (define-key solitaire-mode-map [down] 'solitaire-down)
-
- (define-key solitaire-mode-map [S-right] 'solitaire-move-right)
- (define-key solitaire-mode-map [S-left] 'solitaire-move-left)
- (define-key solitaire-mode-map [S-up] 'solitaire-move-up)
- (define-key solitaire-mode-map [S-down] 'solitaire-move-down)
-
- (define-key solitaire-mode-map [kp-6] 'solitaire-right)
- (define-key solitaire-mode-map [kp-4] 'solitaire-left)
- (define-key solitaire-mode-map [kp-8] 'solitaire-up)
- (define-key solitaire-mode-map [kp-2] 'solitaire-down)
- (define-key solitaire-mode-map [kp-5] 'solitaire-center-point)
-
- (define-key solitaire-mode-map [S-kp-6] 'solitaire-move-right)
- (define-key solitaire-mode-map [S-kp-4] 'solitaire-move-left)
- (define-key solitaire-mode-map [S-kp-8] 'solitaire-move-up)
- (define-key solitaire-mode-map [S-kp-2] 'solitaire-move-down)
-
- (define-key solitaire-mode-map [kp-enter] 'solitaire-move)
- (define-key solitaire-mode-map [kp-0] 'solitaire-undo)
-
- ;; spoil it with s ;)
- (define-key solitaire-mode-map [?s] 'solitaire-solve)
-
- ;; (define-key solitaire-mode-map [kp-0] 'solitaire-hint) - Not yet provided ;)
- )
+(defvar solitaire-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+
+ (define-key map "\C-f" 'solitaire-right)
+ (define-key map "\C-b" 'solitaire-left)
+ (define-key map "\C-p" 'solitaire-up)
+ (define-key map "\C-n" 'solitaire-down)
+ (define-key map "\r" 'solitaire-move)
+ (define-key map [remap undo] 'solitaire-undo)
+ (define-key map " " 'solitaire-do-check)
+
+ (define-key map [right] 'solitaire-right)
+ (define-key map [left] 'solitaire-left)
+ (define-key map [up] 'solitaire-up)
+ (define-key map [down] 'solitaire-down)
+
+ (define-key map [S-right] 'solitaire-move-right)
+ (define-key map [S-left] 'solitaire-move-left)
+ (define-key map [S-up] 'solitaire-move-up)
+ (define-key map [S-down] 'solitaire-move-down)
+
+ (define-key map [kp-6] 'solitaire-right)
+ (define-key map [kp-4] 'solitaire-left)
+ (define-key map [kp-8] 'solitaire-up)
+ (define-key map [kp-2] 'solitaire-down)
+ (define-key map [kp-5] 'solitaire-center-point)
+
+ (define-key map [S-kp-6] 'solitaire-move-right)
+ (define-key map [S-kp-4] 'solitaire-move-left)
+ (define-key map [S-kp-8] 'solitaire-move-up)
+ (define-key map [S-kp-2] 'solitaire-move-down)
+
+ (define-key map [kp-enter] 'solitaire-move)
+ (define-key map [kp-0] 'solitaire-undo)
+
+ ;; spoil it with s ;)
+ (define-key map [?s] 'solitaire-solve)
+
+ ;; (define-key map [kp-0] 'solitaire-hint) - Not yet provided ;)
+ map)
+ "Keymap for playing Solitaire.")
;; Solitaire mode is suitable only for specially formatted data.
(put 'solitaire-mode 'mode-class 'special)
-(defun solitaire-mode ()
- "Major mode for playing solitaire.
-To learn how to play solitaire, see the documentation for function
+(define-derived-mode solitaire-mode special-mode "Solitaire"
+ "Major mode for playing Solitaire.
+To learn how to play Solitaire, see the documentation for function
`solitaire'.
\\<solitaire-mode-map>
The usual mnemonic keys move the cursor around the board; in addition,
\\[solitaire-move] is a prefix character for actually moving a stone on the board."
- (interactive)
- (kill-all-local-variables)
- (use-local-map solitaire-mode-map)
(setq truncate-lines t)
- (setq major-mode 'solitaire-mode)
- (setq mode-name "Solitaire")
- (run-mode-hooks 'solitaire-mode-hook))
+ (setq show-trailing-whitespace nil))
(defvar solitaire-stones 0
"Counter for the stones that are still there.")
(defvar solitaire-end-y nil)
(defcustom solitaire-auto-eval t
- "*Non-nil means check for possible moves after each major change.
+ "Non-nil means check for possible moves after each major change.
This takes a while, so switch this on if you like to be informed when
the game is over, or off, if you are working on a slow machine."
:type 'boolean
'(solitaire-left solitaire-right solitaire-up solitaire-down))
;;;###autoload
-(defun solitaire (arg)
+(defun solitaire (_arg)
"Play Solitaire.
To play Solitaire, type \\[solitaire].
Undo moves using \\[solitaire-undo].
Check for possible moves using \\[solitaire-do-check].
\(The variable `solitaire-auto-eval' controls whether to automatically
-check after each move or undo)
+check after each move or undo.)
What is Solitaire?
o o o
-Pick your favourite shortcuts:
+Pick your favorite shortcuts:
\\{solitaire-mode-map}"
(interactive "P")
(switch-to-buffer "*Solitaire*")
- (solitaire-mode)
- (setq buffer-read-only t)
- (setq solitaire-stones 32)
- (solitaire-insert-board)
- (solitaire-build-modeline)
- (goto-char (point-max))
- (setq solitaire-center (search-backward "."))
- (setq buffer-undo-list (list (point)))
- (set-buffer-modified-p nil))
-
-(defun solitaire-build-modeline ()
+ (let ((inhibit-read-only t))
+ (solitaire-mode)
+ (setq buffer-read-only t)
+ (setq solitaire-stones 32)
+ (solitaire-insert-board)
+ (solitaire-build-mode-line)
+ (goto-char (point-max))
+ (setq solitaire-center (search-backward "."))
+ (setq buffer-undo-list (list (point)))))
+
+(defun solitaire-build-mode-line ()
(setq mode-line-format
(list "" "---" 'mode-line-buffer-identification
(if (< 1 solitaire-stones)
(t "")))
(vsep (cond ((> h 17) "\n\n")
(t "\n")))
- (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\ )))
+ (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\s)))
(erase-buffer)
(insert (make-string (/ (- h 7 (if (> h 12) 3 0)
(* 6 (1- (length vsep)))) 2) ?\n))
- (if (or (string= vsep "\n\n") (> h 12))
- (progn
- (insert (format "%sLe Solitaire\n" indent))
- (insert (format "%s============\n\n" indent))))
+ (when (or (string= vsep "\n\n") (> h 12))
+ (insert (format "%sLe Solitaire\n" indent))
+ (insert (format "%s============\n\n" indent)))
(insert indent)
(setq solitaire-start (point))
(setq solitaire-start-x (current-column))
(insert (format "%s %s %so%so%so%s %s " indent hsep hsep hsep hsep hsep hsep))
(setq solitaire-end (point))
(setq solitaire-end-x (current-column))
- (setq solitaire-end-y (solitaire-current-line))
- ))
+ (setq solitaire-end-y (solitaire-current-line))))
(defun solitaire-right ()
(interactive)
(let ((start (point)))
(forward-char)
- (while (= ?\ (following-char))
+ (while (= ?\s (following-char))
(forward-char))
- (if (or (= 0 (following-char))
- (= ?\ (following-char))
- (= ?\n (following-char)))
- (goto-char start))))
+ (when (or (= 0 (following-char))
+ (= ?\s (following-char))
+ (= ?\n (following-char)))
+ (goto-char start))))
(defun solitaire-left ()
(interactive)
(let ((start (point)))
(backward-char)
- (while (= ?\ (following-char))
+ (while (= ?\s (following-char))
(backward-char))
- (if (or (= 0 (preceding-char))
- (= ?\ (following-char))
- (= ?\n (following-char)))
- (goto-char start))))
+ (when (or (= 0 (preceding-char))
+ (= ?\s (following-char))
+ (= ?\n (following-char)))
+ (goto-char start))))
(defun solitaire-up ()
(interactive)
(forward-line -1)
(move-to-column c)
(not (bolp))))
- (if (or (= 0 (preceding-char))
- (= ?\ (following-char))
- (= ?\= (following-char))
- (= ?\n (following-char)))
- (goto-char start)
- )))
+ (when (or (= 0 (preceding-char))
+ (= ?\s (following-char))
+ (= ?\= (following-char))
+ (= ?\n (following-char)))
+ (goto-char start))))
(defun solitaire-down ()
(interactive)
(forward-line 1)
(move-to-column c)
(not (eolp))))
- (if (or (= 0 (following-char))
- (= ?\ (following-char))
- (= ?\n (following-char)))
- (goto-char start))))
+ (when (or (= 0 (following-char))
+ (= ?\s (following-char))
+ (= ?\n (following-char)))
+ (goto-char start))))
(defun solitaire-center-point ()
(interactive)
(insert ?o)
(goto-char target)
(setq solitaire-stones (1- solitaire-stones))
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(if solitaire-auto-eval (solitaire-do-check))))))
(defun solitaire-undo (arg)
(<= (solitaire-current-line) solitaire-end-y)
(setq count (1+ count))))
count)))
- (solitaire-build-modeline)
- (if solitaire-auto-eval (solitaire-do-check)))
+ (solitaire-build-mode-line)
+ (when solitaire-auto-eval (solitaire-do-check)))
(defun solitaire-check ()
(save-excursion
(<= (solitaire-current-line) solitaire-end-y)
(mapc
(lambda (movesymbol)
- (if (listp (solitaire-possible-move movesymbol))
- (setq count (1+ count))))
+ (when (listp (solitaire-possible-move movesymbol))
+ (setq count (1+ count))))
solitaire-valid-directions)))
count))))
-(defun solitaire-do-check (&optional arg)
+(defun solitaire-do-check (&optional _arg)
"Check for any possible moves in Solitaire."
(interactive "P")
(let ((moves (solitaire-check)))
;; And here's the spoiler:)
(defun solitaire-solve ()
- "Spoil solitaire by solving the game for you - nearly ...
+ "Spoil Solitaire by solving the game for you - nearly ...
... stops with five stones left ;)"
(interactive)
+ (when (< solitaire-stones 32)
+ (error "Cannot solve game in progress"))
(let ((allmoves [up up S-down up left left S-right up up left S-down
up up right right S-left down down down S-up up
S-down down down down S-up left left down
(solitaire-auto-eval nil))
(solitaire-center-point)
(mapc (lambda (op)
- (if (memq op '(S-left S-right S-up S-down))
- (sit-for 0.2))
+ (when (memq op '(S-left S-right S-up S-down))
+ (sit-for 0.2))
(execute-kbd-macro (vector op))
- (if (memq op '(S-left S-right S-up S-down))
- (sit-for 0.4)))
+ (when (memq op '(S-left S-right S-up S-down))
+ (sit-for 0.4)))
allmoves))
(solitaire-do-check))
(provide 'solitaire)
-;;; arch-tag: 1b18ee1c-1e79-4a5b-8658-9560b82e63dd
;;; solitaire.el ends here