annotate lisp/play/solitaire.el @ 34792:294c98d5718b

(lm): Use interactive spec `P'. (toplevel): Don't set debug-on-error.
author Gerd Moellmann <gerd@gnu.org>
date Thu, 21 Dec 2000 16:13:06 +0000
parents c8fa861cb852
children 5545a62c342c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 12766
diff changeset
1 ;;; solitaire.el --- game of solitaire in Emacs Lisp
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Jan Schormann <Jan.Schormann@informatik.uni-oldenburg.de>
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Created: Fri afternoon, Jun 3, 1994
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Keywords: games
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; any later version.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
14183
c7b389ac75e9 Update comment preamble.
Erik Naggum <erik@naggum.no>
parents: 13337
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
c7b389ac75e9 Update comment preamble.
Erik Naggum <erik@naggum.no>
parents: 13337
diff changeset
23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
c7b389ac75e9 Update comment preamble.
Erik Naggum <erik@naggum.no>
parents: 13337
diff changeset
24 ;; Boston, MA 02111-1307, USA.
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;;; Commentary:
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; This mode is for playing a well-known game of solitaire
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; in which you jump pegs across other pegs.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; The game itself is somehow self-explanatory. Read the help text to
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;; solitaire, and try it.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;;; Code:
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
36 (defgroup solitaire nil
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
37 "Game of solitaire."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
38 :prefix "solitaire-"
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
39 :group 'games)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
40
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 (defvar solitaire-mode-map nil
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 "Keymap for playing solitaire.")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
44 (defcustom solitaire-mode-hook nil
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
45 "Hook to run upon entry to solitaire."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
46 :type 'hook
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
47 :group 'solitaire)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
48
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (if solitaire-mode-map
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 (setq solitaire-mode-map (make-sparse-keymap))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 (suppress-keymap solitaire-mode-map t)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (define-key solitaire-mode-map "\C-f" 'solitaire-right)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (define-key solitaire-mode-map "\C-b" 'solitaire-left)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (define-key solitaire-mode-map "\C-p" 'solitaire-up)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (define-key solitaire-mode-map "\C-n" 'solitaire-down)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (define-key solitaire-mode-map [return] 'solitaire-move)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (substitute-key-definition 'undo 'solitaire-undo
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 solitaire-mode-map global-map)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (define-key solitaire-mode-map " " 'solitaire-do-check)
21098
c5a14d40e00e (solitaire-quit): Function deleted.
Richard M. Stallman <rms@gnu.org>
parents: 16419
diff changeset
61 (define-key solitaire-mode-map "q" 'quit-window)
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 (define-key solitaire-mode-map [right] 'solitaire-right)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (define-key solitaire-mode-map [left] 'solitaire-left)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 (define-key solitaire-mode-map [up] 'solitaire-up)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 (define-key solitaire-mode-map [down] 'solitaire-down)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 (define-key solitaire-mode-map [S-right] 'solitaire-move-right)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (define-key solitaire-mode-map [S-left] 'solitaire-move-left)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (define-key solitaire-mode-map [S-up] 'solitaire-move-up)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (define-key solitaire-mode-map [S-down] 'solitaire-move-down)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (define-key solitaire-mode-map [kp-6] 'solitaire-right)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (define-key solitaire-mode-map [kp-4] 'solitaire-left)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 (define-key solitaire-mode-map [kp-8] 'solitaire-up)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (define-key solitaire-mode-map [kp-2] 'solitaire-down)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (define-key solitaire-mode-map [kp-5] 'solitaire-center-point)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (define-key solitaire-mode-map [S-kp-6] 'solitaire-move-right)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (define-key solitaire-mode-map [S-kp-4] 'solitaire-move-left)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (define-key solitaire-mode-map [S-kp-8] 'solitaire-move-up)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (define-key solitaire-mode-map [S-kp-2] 'solitaire-move-down)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (define-key solitaire-mode-map [kp-enter] 'solitaire-move)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (define-key solitaire-mode-map [kp-0] 'solitaire-undo)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 ;; spoil it with s ;)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (define-key solitaire-mode-map [?s] 'solitaire-solve)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 ;; (define-key solitaire-mode-map [kp-0] 'solitaire-hint) - Not yet provided ;)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 )
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 ;; Solitaire mode is suitable only for specially formatted data.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (put 'solitaire-mode 'mode-class 'special)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (defun solitaire-mode ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 "Major mode for playing solitaire.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 To learn how to play solitaire, see the documentation for function
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 `solitaire'.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 \\<solitaire-mode-map>
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 The usual mnemonic keys move the cursor around the board; in addition,
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 \\[solitaire-move] is a prefix character for actually moving a stone on the board."
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 (kill-all-local-variables)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 (use-local-map solitaire-mode-map)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 (setq truncate-lines t)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (setq major-mode 'solitaire-mode)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 (setq mode-name "Solitaire")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (run-hooks 'solitaire-mode-hook))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 (defvar solitaire-stones 0
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 "Counter for the stones that are still there.")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (defvar solitaire-center nil
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 "Center of the board.")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (defvar solitaire-start nil
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 "Upper left corner of the board.")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (defvar solitaire-start-x nil)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (defvar solitaire-start-y nil)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 (defvar solitaire-end nil
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 "Lower right corner of the board.")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (defvar solitaire-end-x nil)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (defvar solitaire-end-y nil)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
129 (defcustom solitaire-auto-eval t
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 "*Non-nil means check for possible moves after each major change.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 This takes a while, so switch this on if you like to be informed when
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
132 the game is over, or off, if you are working on a slow machine."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
133 :type 'boolean
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
134 :group 'solitaire)
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (defconst solitaire-valid-directions
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 '(solitaire-left solitaire-right solitaire-up solitaire-down))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 ;;;###autoload
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (defun solitaire (arg)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 "Play Solitaire.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 To play Solitaire, type \\[solitaire].
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 \\<solitaire-mode-map>
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 Move around the board using the cursor keys.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 Move stones using \\[solitaire-move] followed by a direction key.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 Undo moves using \\[solitaire-undo].
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 Check for possible moves using \\[solitaire-do-check].
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 21098
diff changeset
149 \(The variable `solitaire-auto-eval' controls whether to automatically
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 check after each move or undo)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 What is Solitaire?
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 I don't know who invented this game, but it seems to be rather old and
22169
6de2236eab5f (solitaire): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21363
diff changeset
155 its origin seems to be northern Africa. Here's how to play:
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 Initially, the board will look similar to this:
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 Le Solitaire
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 ============
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 o o o o o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 o o o . o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 o o o o o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 Let's call the o's stones and the .'s holes. One stone fits into one
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 hole. As you can see, all holes but one are occupied by stones. The
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 aim of the game is to get rid of all but one stone, leaving that last
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 one in the middle of the board if you're cool.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 A stone can be moved if there is another stone next to it, and a hole
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 after that one. Thus there must be three fields in a row, either
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 horizontally or vertically, up, down, left or right, which look like
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 this: o o .
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 Then the first stone is moved to the hole, jumping over the second,
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 which therefore is taken away. The above thus `evaluates' to: . . o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 That's all. Here's the board after two moves:
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 . o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 o o . o o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 o . o o o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 o o o o o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 o o o
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 Pick your favourite shortcuts:
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 \\{solitaire-mode-map}"
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (interactive "P")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (switch-to-buffer "*Solitaire*")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 (solitaire-mode)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (setq buffer-read-only t)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 (setq solitaire-stones 32)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (solitaire-insert-board)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 (solitaire-build-modeline)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 (goto-char (point-max))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 (setq solitaire-center (search-backward "."))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (setq buffer-undo-list (list (point)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 (set-buffer-modified-p nil))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 (defun solitaire-build-modeline ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (setq mode-line-format
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 (list "" "---" 'mode-line-buffer-identification
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 (if (< 1 solitaire-stones)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (format "--> There are %d stones left <--" solitaire-stones)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 "------")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 'global-mode-string " %[(" 'mode-name 'minor-mode-alist "%n"
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 ")%]-%-"))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 (force-mode-line-update))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 (defun solitaire-insert-board ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 (let* ((buffer-read-only nil)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (w (window-width))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 (h (window-height))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (hsep (cond ((> w 26) " ")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 ((> w 20) " ")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (t "")))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (vsep (cond ((> h 17) "\n\n")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (t "\n")))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\ )))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 (erase-buffer)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (insert (make-string (/ (- h 7 (if (> h 12) 3 0)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 (* 6 (1- (length vsep)))) 2) ?\n))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 (if (or (string= vsep "\n\n") (> h 12))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 (progn
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 (insert (format "%sLe Solitaire\n" indent))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 (insert (format "%s============\n\n" indent))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (insert indent)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (setq solitaire-start (point))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (setq solitaire-start-x (current-column))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 (setq solitaire-start-y (solitaire-current-line))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (insert (format " %s %so%so%so%s" hsep hsep hsep hsep vsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (insert (format "%s %s %so%so%so%s" indent hsep hsep hsep hsep vsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (insert (format "%so%so%so%so%so%so%so%s" indent hsep hsep hsep hsep hsep hsep vsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (insert (format "%so%so%so%s" indent hsep hsep hsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (setq solitaire-center (point))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (insert (format ".%so%so%so%s" hsep hsep hsep vsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (insert (format "%so%so%so%so%so%so%so%s" indent hsep hsep hsep hsep hsep hsep vsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 (insert (format "%s %s %so%so%so%s" indent hsep hsep hsep hsep vsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 (insert (format "%s %s %so%so%so%s %s " indent hsep hsep hsep hsep hsep hsep))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 (setq solitaire-end (point))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 (setq solitaire-end-x (current-column))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 (setq solitaire-end-y (solitaire-current-line))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 ))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 (defun solitaire-right ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 (let ((start (point)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 (forward-char)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 (while (= ?\ (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 (forward-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 (if (or (= 0 (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 (= ?\ (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 (= ?\n (following-char)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 (goto-char start))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 (defun solitaire-left ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (let ((start (point)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 (backward-char)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 (while (= ?\ (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 (backward-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 (if (or (= 0 (preceding-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 (= ?\ (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 (= ?\n (following-char)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (goto-char start))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 (defun solitaire-up ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 (let ((start (point))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 (c (current-column)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (forward-line -1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (move-to-column c)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 (while (and (= ?\n (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 (forward-line -1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (move-to-column c)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 (not (bolp))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 (if (or (= 0 (preceding-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (= ?\ (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (= ?\= (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 (= ?\n (following-char)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 (goto-char start)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 )))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 (defun solitaire-down ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 (let ((start (point))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (c (current-column)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (forward-line 1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (move-to-column c)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 (while (and (= ?\n (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (forward-line 1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (move-to-column c)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 (not (eolp))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (if (or (= 0 (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315 (= ?\ (following-char))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 (= ?\n (following-char)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 (goto-char start))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 (defun solitaire-center-point ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 (goto-char solitaire-center))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 (defun solitaire-move-right () (interactive) (solitaire-move '[right]))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324 (defun solitaire-move-left () (interactive) (solitaire-move '[left]))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325 (defun solitaire-move-up () (interactive) (solitaire-move '[up]))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326 (defun solitaire-move-down () (interactive) (solitaire-move '[down]))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 (defun solitaire-possible-move (movesymbol)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 "Check if a move is possible from current point in the specified direction.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 MOVESYMBOL specifies the direction.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 Returns either a string, indicating cause of contraindication, or a
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 list containing three numbers: starting field, skipped field (from
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 which a stone will be taken away) and target."
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 (save-excursion
22211
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
336 (if (memq movesymbol solitaire-valid-directions)
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
337 (let ((start (point))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
338 (skip (progn (funcall movesymbol) (point)))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
339 (target (progn (funcall movesymbol) (point))))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
340 (if (= skip target)
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
341 "Off Board!"
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
342 (if (or (/= ?o (char-after start))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
343 (/= ?o (char-after skip))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
344 (/= ?. (char-after target)))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
345 "Wrong move!"
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
346 (list start skip target))))
c8fa861cb852 (solitaire-possible-move): Use funcall to invoke movesymbol.
Richard M. Stallman <rms@gnu.org>
parents: 22169
diff changeset
347 "Not a valid direction")))
12766
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (defun solitaire-move (dir)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350 "Pseudo-prefix command to move a stone in Solitaire."
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 (interactive "kMove where? ")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 (let* ((class (solitaire-possible-move (lookup-key solitaire-mode-map dir)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 (buffer-read-only nil))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (if (stringp class)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 (error class)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 (let ((start (car class))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 (skip (car (cdr class)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 (target (car (cdr (cdr class)))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 (goto-char start)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 (delete-char 1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 (insert ?.)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 (goto-char skip)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 (delete-char 1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (insert ?.)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 (goto-char target)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 (delete-char 1)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 (insert ?o)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 (goto-char target)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 (setq solitaire-stones (1- solitaire-stones))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 (solitaire-build-modeline)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (if solitaire-auto-eval (solitaire-do-check))))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 (defun solitaire-undo (arg)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 "Undo a move in Solitaire."
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 (interactive "P")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (let ((buffer-read-only nil))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 (undo arg))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 (save-excursion
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 (setq solitaire-stones
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 (let ((count 0))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381 (goto-char solitaire-end)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (while (search-backward "o" solitaire-start 'done)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 (and (>= (current-column) solitaire-start-x)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 (<= (current-column) solitaire-end-x)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 (>= (solitaire-current-line) solitaire-start-y)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (<= (solitaire-current-line) solitaire-end-y)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 (setq count (1+ count))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 count)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389 (solitaire-build-modeline)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 (if solitaire-auto-eval (solitaire-do-check)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (defun solitaire-check ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (save-excursion
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 (if (= 1 solitaire-stones)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 0
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 (goto-char solitaire-end)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397 (let ((count 0))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398 (while (search-backward "o" solitaire-start 'done)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 (and (>= (current-column) solitaire-start-x)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 (<= (current-column) solitaire-end-x)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 (>= (solitaire-current-line) solitaire-start-y)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 (<= (solitaire-current-line) solitaire-end-y)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 (mapcar
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 (lambda (movesymbol)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 (if (listp (solitaire-possible-move movesymbol))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406 (setq count (1+ count))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 solitaire-valid-directions)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 count))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410 (defun solitaire-do-check (&optional arg)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 "Check for any possible moves in Solitaire."
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
412 (interactive "P")
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413 (let ((moves (solitaire-check)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 (cond ((= 1 solitaire-stones)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415 (message "Yeah! You made it! Only the King is left!"))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416 ((zerop moves)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417 (message "Sorry, no more possible moves."))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
418 ((= 1 moves)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 (message "There is one possible move."))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 (t (message "There are %d possible moves." moves)))))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (defun solitaire-current-line ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 "Return the vertical position of point.
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 Seen in info on text lines."
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 (+ (count-lines (point-min) (point))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 (if (= (current-column) 0) 1 0)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 -1))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 ;; And here's the spoiler:)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430 (defun solitaire-solve ()
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 "Spoil solitaire by solving the game for you - nearly ...
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
432 ... stops with five stones left ;)"
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
433 (interactive)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
434 (let ((allmoves [up up S-down up left left S-right up up left S-down
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
435 up up right right S-left down down down S-up up
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
436 S-down down down down S-up left left down
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
437 S-right left left up up S-down right right right
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
438 S-left left S-right right right right S-left
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
439 right down down S-up down down left left S-right
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
440 up up up S-down down S-up up up up S-down up
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
441 right right S-left down right right down S-up
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
442 left left left S-right right S-left down down
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
443 left S-right S-up S-left S-left S-down S-right
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
444 up S-right left left])
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
445 ;; down down S-up left S-right
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
446 ;; right S-left
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
447 (solitaire-auto-eval nil))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
448 (solitaire-center-point)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
449 (mapcar (lambda (op)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
450 (if (memq op '(S-left S-right S-up S-down))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
451 (sit-for 0.2))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
452 (execute-kbd-macro (vector op))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
453 (if (memq op '(S-left S-right S-up S-down))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
454 (sit-for 0.4)))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
455 allmoves))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
456 (solitaire-do-check))
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
457
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
458 (provide 'solitaire)
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
459
eed43624bc00 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
460 ;;; solitaire.el ends here