;;; solitaire.el --- game of solitaire in Emacs Lisp
-;; Copyright (C) 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007 Free Software Foundation, Inc.
-;; Author: Jan Schormann <Jan.Schormann@informatik.uni-oldenburg.de>
+;; Author: Jan Schormann <Jan.Schormann@rechen-gilde.de>
;; Created: Fri afternoon, Jun 3, 1994
;; Keywords: games
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+(defgroup solitaire nil
+ "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."
+ :type 'hook
+ :group 'solitaire)
+
(if solitaire-mode-map
()
(setq solitaire-mode-map (make-sparse-keymap))
(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)
- (substitute-key-definition 'undo 'solitaire-undo
- solitaire-mode-map global-map)
+ (define-key solitaire-mode-map [remap undo] 'solitaire-undo)
(define-key solitaire-mode-map " " 'solitaire-do-check)
- (define-key solitaire-mode-map "q" 'solitaire-quit)
+ (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 [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 [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)
(setq truncate-lines t)
(setq major-mode 'solitaire-mode)
(setq mode-name "Solitaire")
- (run-hooks 'solitaire-mode-hook))
+ (run-mode-hooks 'solitaire-mode-hook))
(defvar solitaire-stones 0
"Counter for the stones that are still there.")
(defvar solitaire-end-x nil)
(defvar solitaire-end-y nil)
-(defvar solitaire-auto-eval t
+(defcustom solitaire-auto-eval t
"*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.")
+the game is over, or off, if you are working on a slow machine."
+ :type 'boolean
+ :group 'solitaire)
(defconst solitaire-valid-directions
'(solitaire-left solitaire-right solitaire-up solitaire-down))
Move stones using \\[solitaire-move] followed by a direction key.
Undo moves using \\[solitaire-undo].
Check for possible moves using \\[solitaire-do-check].
-\(The variable solitaire-auto-eval controls whether to automatically
+\(The variable `solitaire-auto-eval' controls whether to automatically
check after each move or undo)
What is Solitaire?
I don't know who invented this game, but it seems to be rather old and
-it's origin seems be northern Africa. Here's how to play:
+its origin seems to be northern Africa. Here's how to play:
Initially, the board will look similar to this:
- Le Solitaire
- ============
-
- o o o
-
- o o o
-
+ Le Solitaire
+ ============
+
+ o o o
+
+ o o o
+
o o o o o o o
-
+
o o o . o o o
-
+
o o o o o o o
-
- o o o
-
- o o o
+
+ o o o
+
+ o o o
Let's call the o's stones and the .'s holes. One stone fits into one
hole. As you can see, all holes but one are occupied by stones. The
That's all. Here's the board after two moves:
- o o o
-
- . o o
-
+ o o o
+
+ . o o
+
o o . o o o o
-
+
o . o o o o o
-
+
o o o o o o o
-
- o o o
-
+
+ o o o
+
o o o
Pick your favourite shortcuts:
(not (eolp))))
(if (or (= 0 (following-char))
(= ?\ (following-char))
- (= ?\n (following-char)))
+ (= ?\n (following-char)))
(goto-char start))))
(defun solitaire-center-point ()
which a stone will be taken away) and target."
(save-excursion
- (let (move)
- (fset 'move movesymbol)
- (if (memq movesymbol solitaire-valid-directions)
- (let ((start (point))
- (skip (progn (move) (point)))
- (target (progn (move) (point))))
- (if (= skip target)
- "Off Board!"
- (if (or (/= ?o (char-after start))
- (/= ?o (char-after skip))
- (/= ?. (char-after target)))
- "Wrong move!"
- (list start skip target))))
- "Not a valid direction"))))
+ (if (memq movesymbol solitaire-valid-directions)
+ (let ((start (point))
+ (skip (progn (funcall movesymbol) (point)))
+ (target (progn (funcall movesymbol) (point))))
+ (if (= skip target)
+ "Off Board!"
+ (if (or (/= ?o (char-after start))
+ (/= ?o (char-after skip))
+ (/= ?. (char-after target)))
+ "Wrong move!"
+ (list start skip target))))
+ "Not a valid direction")))
(defun solitaire-move (dir)
"Pseudo-prefix command to move a stone in Solitaire."
(error class)
(let ((start (car class))
(skip (car (cdr class)))
- (target (car (cdr (cdr class)))))
+ (target (car (cdr (cdr class)))))
(goto-char start)
(delete-char 1)
(insert ?.)
(<= (solitaire-current-line) solitaire-end-y)
(setq count (1+ count))))
count)))
- (solitaire-build-modeline)
+ (solitaire-build-modeline)
(if solitaire-auto-eval (solitaire-do-check)))
(defun solitaire-check ()
(<= (current-column) solitaire-end-x)
(>= (solitaire-current-line) solitaire-start-y)
(<= (solitaire-current-line) solitaire-end-y)
- (mapcar
+ (mapc
(lambda (movesymbol)
(if (listp (solitaire-possible-move movesymbol))
(setq count (1+ count))))
(if (= (current-column) 0) 1 0)
-1))
-(defun solitaire-quit ()
- "Quit playing Solitaire."
- (interactive)
- (kill-buffer "*Solitaire*"))
-
;; And here's the spoiler:)
(defun solitaire-solve ()
"Spoil solitaire by solving the game for you - nearly ...
;; right S-left
(solitaire-auto-eval nil))
(solitaire-center-point)
- (mapcar (lambda (op)
- (if (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)))
- allmoves))
+ (mapc (lambda (op)
+ (if (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)))
+ allmoves))
(solitaire-do-check))
(provide 'solitaire)
+;;; arch-tag: 1b18ee1c-1e79-4a5b-8658-9560b82e63dd
;;; solitaire.el ends here