|
118
|
1 ;;; xmine.el --- Mine game for XEmacs
|
|
|
2
|
|
|
3 ;; Author: Jens Lautenbacher <jens@lemming0.lem.uni-karlsruhe.de>
|
|
|
4 ;; Keywords: games
|
|
138
|
5 ;; Version: 1.8
|
|
118
|
6
|
|
|
7 ;; This file is part of XEmacs.
|
|
|
8
|
|
|
9 ;; XEmacs is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; XEmacs is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
|
23
|
|
|
24 ;; Commentary: This is a complete reimplementation of the classical
|
|
|
25 ;; mine searching game known from various OS/GUIs under names like
|
|
|
26 ;; xmine, minesweeper etc.
|
|
|
27
|
|
|
28 ;; The idea to implement this in elisp is from
|
|
|
29 ;; Jacques Duthen <duthen@cegelec-red.fr>,
|
|
|
30 ;; the author of the original mine game for GNU Emacs. This version
|
|
|
31 ;; has to the best of my knowledge no code in common with his version,
|
|
|
32 ;; but cudos go to him for first starting this...
|
|
|
33 ;;
|
|
|
34 ;; I mainly wrote this as an example how graphics handling in XEmacs
|
|
|
35 ;; is possible. I think I did it the right way, using an extension to
|
|
|
36 ;; the annotation mechanism and via extensive use of `slots' (realized
|
|
|
37 ;; as properties of extents) to hold the data in the object itself.
|
|
|
38 ;; (Of course this is not true. The keyboard handling is controlled from
|
|
|
39 ;; the "outside" of the objects. But at one time during development
|
|
|
40 ;; before hacking the keyboard controls the code really _was_ nice...
|
|
|
41 ;; now it's a bad messing with slots and controls from the outside)
|
|
|
42 ;;
|
|
|
43 ;; Code:
|
|
|
44 ;;
|
|
|
45 ;;; First of all we'll define the needed varibles.
|
|
|
46
|
|
138
|
47 (defconst xmine-version-number "1.8" "XEmacs Mine version number.")
|
|
120
|
48 (defconst xmine-version (format "XEmacs Mine v%s by Jens Lautenbacher © 1997"
|
|
|
49 xmine-version-number)
|
|
|
50 "Full XEmacs Mine version number.")
|
|
|
51
|
|
118
|
52 (defgroup xmine nil
|
|
|
53 "The well known mine searching game."
|
|
|
54 :group 'games)
|
|
|
55
|
|
|
56 (defcustom xmine-width 25
|
|
|
57 "The width of the mine field"
|
|
|
58 :group 'xmine
|
|
|
59 :type 'integer)
|
|
|
60
|
|
|
61 (defcustom xmine-height 20
|
|
|
62 "The height of the mine field"
|
|
|
63 :group 'xmine
|
|
|
64 :type 'integer)
|
|
|
65
|
|
|
66 (defcustom xmine-glyph-dir (concat data-directory "mine/")
|
|
|
67 "The directory where the mine glyphs reside"
|
|
|
68 :group 'xmine
|
|
|
69 :type 'directory)
|
|
|
70
|
|
|
71 (defface xmine-hidden-face
|
|
|
72 '((t
|
|
|
73 (:background "blue")))
|
|
|
74 "The face used for hidden tiles on ttys"
|
|
|
75 :group 'xmine)
|
|
|
76
|
|
|
77 (defface xmine-flagged-face
|
|
|
78 '((t
|
|
|
79 (:background "red")))
|
|
|
80 "The face used for flagged tiles on ttys"
|
|
|
81 :group 'xmine)
|
|
|
82
|
|
|
83 (defface xmine-number-face
|
|
|
84 '((t
|
|
|
85 (:background "green")))
|
|
|
86 "The face used for unhidden, numbered tiles on ttys"
|
|
|
87 :group 'xmine)
|
|
|
88
|
|
|
89
|
|
|
90 (defvar xmine-pad-glyph
|
|
|
91 (make-glyph
|
|
|
92 (if (and (eq window-system 'x) (featurep 'xpm))
|
|
|
93 (concat xmine-glyph-dir "pad.xpm")
|
|
|
94 " ")))
|
|
|
95
|
|
|
96 (defvar xmine-title-glyph
|
|
|
97 (make-glyph
|
|
|
98 (if (and (eq window-system 'x) (featurep 'xpm))
|
|
|
99 (concat xmine-glyph-dir "splash.xpm")
|
|
|
100 "------------------ XEmacs XMine ------------------")))
|
|
|
101
|
|
|
102 (defvar xmine-glyph-production-list
|
|
138
|
103 '(("xmine-new-up" "new_up.gif" "new" nil)
|
|
|
104 ("xmine-new-down" "new_down.gif" "NEW" nil)
|
|
|
105 ("xmine-quit-up" "quit_up.gif" "quit" nil)
|
|
|
106 ("xmine-quit-down" "quit_down.gif" "QUIT" nil)
|
|
|
107 ("xmine-up-glyph" "empty_16_up.gif" "@ " xmine-hidden-face)
|
|
|
108 ("xmine-up-sel-glyph" "empty_16_up_sel.gif" "@<" xmine-hidden-face)
|
|
|
109 ("xmine-down-glyph" "empty_16_down.gif" "? " nil)
|
|
118
|
110 ("xmine-flagged-glyph" "flagged_16_up.gif" "! " xmine-flagged-face)
|
|
|
111 ("xmine-flagged-sel-glyph" "flagged_16_up_sel.gif" "!<" xmine-flagged-face)
|
|
138
|
112 ("xmine-mine-glyph" "bomb_16_flat.gif" "* " nil)
|
|
|
113 ("xmine-mine-sel-glyph" "bomb_16_flat.gif" "*<" nil)
|
|
|
114 ("xmine-trapped-glyph" "bomb_trapped_16_flat.gif" "X " nil)
|
|
|
115 ("xmine-0-glyph" "empty_16_flat.gif" ". " nil)
|
|
|
116 ("xmine-0-sel-glyph" "empty_16_flat_sel.gif" ".<" nil)
|
|
|
117 ("xmine-1-glyph" "1_16_flat.gif" "1 " xmine-number-face)
|
|
|
118 ("xmine-1-sel-glyph" "1_16_flat_sel.gif" "1<" xmine-number-face)
|
|
|
119 ("xmine-2-glyph" "2_16_flat.gif" "2 " xmine-number-face)
|
|
|
120 ("xmine-2-sel-glyph" "2_16_flat_sel.gif" "2<" xmine-number-face)
|
|
|
121 ("xmine-3-glyph" "3_16_flat.gif" "3 " xmine-number-face)
|
|
|
122 ("xmine-3-sel-glyph" "3_16_flat_sel.gif" "3<" xmine-number-face)
|
|
|
123 ("xmine-4-glyph" "4_16_flat.gif" "4 " xmine-number-face)
|
|
|
124 ("xmine-4-sel-glyph" "4_16_flat_sel.gif" "4<" xmine-number-face)
|
|
|
125 ("xmine-5-glyph" "5_16_flat.gif" "5 " xmine-number-face)
|
|
|
126 ("xmine-5-sel-glyph" "5_16_flat_sel.gif" "5<" xmine-number-face)
|
|
|
127 ("xmine-6-glyph" "6_16_flat.gif" "6 " xmine-number-face)
|
|
|
128 ("xmine-6-sel-glyph" "6_16_flat_sel.gif" "6<" xmine-number-face)
|
|
|
129 ("xmine-7-glyph" "7_16_flat.gif" "7 " xmine-number-face)
|
|
|
130 ("xmine-7-sel-glyph" "7_16_flat_sel.gif" "7<" xmine-number-face)
|
|
|
131 ("xmine-8-glyph" "8_16_flat.gif" "8 " xmine-number-face)
|
|
|
132 ("xmine-8-sel-glyph" "8_16_flat_sel.gif" "8<" xmine-number-face)))
|
|
|
133
|
|
|
134 (defvar xmine-force-textual nil
|
|
|
135 "This is for debugging purposes only. No need to set it. Really.")
|
|
118
|
136
|
|
|
137 (defun xmine-generate-glyphs ()
|
|
|
138 (let ((list xmine-glyph-production-list)
|
|
|
139 elem var gif text face)
|
|
|
140 (while (setq elem (pop list))
|
|
|
141 (setq var (car elem)
|
|
|
142 gif (cadr elem)
|
|
|
143 text (caddr elem)
|
|
|
144 face (cadddr elem))
|
|
|
145 (set (intern var)
|
|
138
|
146 (make-glyph (if (and (not xmine-force-textual)
|
|
|
147 (eq window-system 'x))
|
|
118
|
148 (concat xmine-glyph-dir gif)
|
|
|
149 text)))
|
|
|
150 (if face
|
|
|
151 (set-glyph-face (eval (intern-soft var)) face)))))
|
|
|
152
|
|
|
153 (xmine-generate-glyphs)
|
|
|
154
|
|
|
155 (defvar xmine-key-sel-button nil)
|
|
|
156
|
|
|
157 (defun xmine-up-glyph (ext)
|
|
|
158 (if (equal ext xmine-key-sel-button)
|
|
|
159 (progn
|
|
|
160 (set-extent-property ext 'xmine-non-selected-glyph xmine-up-glyph)
|
|
|
161 xmine-up-sel-glyph)
|
|
|
162 xmine-up-glyph))
|
|
|
163
|
|
|
164 (defun xmine-flagged-glyph (ext)
|
|
|
165 (if (equal ext xmine-key-sel-button)
|
|
|
166 (progn
|
|
|
167 (set-extent-property ext 'xmine-non-selected-glyph xmine-flagged-glyph)
|
|
|
168 xmine-flagged-sel-glyph)
|
|
|
169 xmine-flagged-glyph))
|
|
|
170
|
|
|
171 (defcustom xmine-%-of-mines 12
|
|
|
172 "The percentage of tiles that should be mines."
|
|
|
173 :group 'xmine
|
|
|
174 :type 'integer)
|
|
|
175
|
|
|
176 (defcustom xmine-balloon-list (list "What are you waiting for?"
|
|
|
177 "Push me!"
|
|
|
178 "Come on. Don't sleep."
|
|
|
179 "Are you sure?"
|
|
|
180 "Are you sleeping?"
|
|
|
181 "Yes! Do it!"
|
|
|
182 "I'm getting bored."
|
|
|
183 "You will NEVER beat me.")
|
|
|
184 "(Random) texts for the balloon-help property of the tiles"
|
|
|
185 :group 'xmine
|
|
|
186 :type '(repeat (string)))
|
|
|
187
|
|
|
188 (defcustom xmine-background "white"
|
|
|
189 "The background color of XMine's buffer.
|
|
|
190 Many colors will not blend nicely with the logo. Shades of light grey are
|
|
|
191 preferred if you don't want to use white."
|
|
|
192 :group 'xmine
|
|
|
193 :type 'color)
|
|
|
194
|
|
|
195 (defvar xmine-keymap nil)
|
|
|
196
|
|
|
197 (if xmine-keymap ()
|
|
|
198 (setq xmine-keymap (make-sparse-keymap))
|
|
|
199 (suppress-keymap xmine-keymap)
|
|
|
200 (define-key xmine-keymap [up] 'xmine-key-up)
|
|
|
201 (define-key xmine-keymap [down] 'xmine-key-down)
|
|
|
202 (define-key xmine-keymap [right] 'xmine-key-right)
|
|
|
203 (define-key xmine-keymap [left] 'xmine-key-left)
|
|
|
204 (define-key xmine-keymap "e" 'xmine-key-up)
|
|
|
205 (define-key xmine-keymap "c" 'xmine-key-down)
|
|
|
206 (define-key xmine-keymap "f" 'xmine-key-right)
|
|
|
207 (define-key xmine-keymap "s" 'xmine-key-left)
|
|
|
208 (define-key xmine-keymap "w" 'xmine-key-up-left)
|
|
|
209 (define-key xmine-keymap "x" 'xmine-key-down-left)
|
|
|
210 (define-key xmine-keymap "r" 'xmine-key-up-right)
|
|
|
211 (define-key xmine-keymap "v" 'xmine-key-down-right)
|
|
|
212 (define-key xmine-keymap [return] 'xmine-key-action3)
|
|
|
213 (define-key xmine-keymap "d" 'xmine-key-action3)
|
|
|
214 (define-key xmine-keymap [(shift space)] 'xmine-key-action2)
|
|
|
215 (define-key xmine-keymap "a" 'xmine-key-action2)
|
|
|
216 (define-key xmine-keymap [space] 'xmine-key-action1)
|
|
|
217 (define-key xmine-keymap [Q] 'xmine-key-quit)
|
|
|
218 (define-key xmine-keymap [N] 'xmine-key-new))
|
|
|
219
|
|
|
220 (defvar xmine-number-of-flagged 0)
|
|
|
221
|
|
|
222 (defvar xmine-number-of-opened 0)
|
|
|
223
|
|
|
224 (defvar xmine-number-of-mines 0)
|
|
|
225
|
|
|
226 (defvar xmine-field nil)
|
|
|
227
|
|
|
228 (defvar xmine-buffer nil)
|
|
|
229
|
|
|
230 (defvar xmine-quit-ann nil)
|
|
|
231
|
|
|
232 (defvar xmine-new-ann nil)
|
|
|
233
|
|
|
234 (defvar xmine-count-ann nil)
|
|
|
235
|
|
|
236 (defvar xmine-count-glyph (make-glyph "Mines: 00"))
|
|
|
237
|
|
|
238 (defvar xmine-mode-hook nil
|
|
|
239 "*Hook called by `xmine-mode-hook'.")
|
|
|
240
|
|
|
241 ;; the next function is more or less stolen from annotation.el and
|
|
|
242 ;; modified to fit in our scheme were all three buttons should trigger
|
|
|
243 ;; actions
|
|
|
244
|
|
|
245 (defun xmine-activate-function-button (event)
|
|
|
246 (interactive "e")
|
|
|
247 (let* ((extent (event-glyph-extent event))
|
|
138
|
248 (button (number-to-string (event-button event)))
|
|
|
249 (action (intern (concat "action" button)))
|
|
|
250 (down-action (intern (concat "down-action" button)))
|
|
|
251 (restore-down-action (intern (concat "restore-down-action" button)))
|
|
118
|
252 (mouse-down t)
|
|
138
|
253 (action-do-it t)
|
|
|
254 up-glyph)
|
|
118
|
255 ;; make the glyph look pressed
|
|
|
256 (cond ((annotation-down-glyph extent)
|
|
|
257 (setq up-glyph (annotation-glyph extent))
|
|
|
258 (set-annotation-glyph extent (annotation-down-glyph extent))))
|
|
138
|
259 (if (extent-property extent down-action)
|
|
|
260 (setq action-do-it
|
|
|
261 (funcall (extent-property extent down-action) extent)))
|
|
118
|
262 (while mouse-down
|
|
|
263 (setq event (next-event event))
|
|
|
264 (if (button-release-event-p event)
|
|
|
265 (setq mouse-down nil)))
|
|
|
266 ;; make the glyph look released
|
|
|
267 (cond ((annotation-down-glyph extent)
|
|
|
268 (set-annotation-glyph extent up-glyph)))
|
|
|
269 (if (eq extent (event-glyph-extent event))
|
|
138
|
270 (if (and (extent-property extent action) action-do-it)
|
|
|
271 (funcall (extent-property extent action) extent)
|
|
|
272 (if (extent-property extent restore-down-action)
|
|
|
273 (funcall (extent-property extent restore-down-action) extent)))
|
|
|
274 (if (extent-property extent restore-down-action)
|
|
|
275 (funcall (extent-property extent restore-down-action) extent)))))
|
|
118
|
276
|
|
|
277 ;;; Here we define the button object's constructor function
|
|
|
278
|
|
|
279 (defun xmine-button-create (x y type)
|
|
|
280 (let ((ext (make-annotation
|
|
|
281 xmine-up-glyph nil 'text nil nil xmine-down-glyph nil)))
|
|
|
282 (set-extent-property ext 'action1 'xmine-action1)
|
|
|
283 (set-extent-property ext 'action2 'xmine-beep)
|
|
|
284 (set-extent-property ext 'action3 'xmine-action3)
|
|
138
|
285 (set-extent-property ext 'down-action2 'xmine-down-action2)
|
|
|
286 (set-extent-property ext 'restore-down-action2 'xmine-restore-down-action2)
|
|
118
|
287 (set-extent-property ext 'xmine-glyph (xmine-type-to-glyph type))
|
|
|
288 (set-extent-property ext 'xmine-sel-glyph (xmine-type-to-sel-glyph type))
|
|
|
289 (set-extent-property ext 'xmine-type type)
|
|
|
290 (set-extent-property ext 'xmine-x x)
|
|
|
291 (set-extent-property ext 'xmine-y y)
|
|
|
292 (set-extent-property ext 'xmine-flagged nil)
|
|
|
293 (set-extent-property ext 'xmine-hidden t)
|
|
|
294 (set-extent-property ext 'end-open t)
|
|
|
295 (set-extent-property ext 'balloon-help (xmine-balloon-text))
|
|
|
296 (aset xmine-field (+ (* (1- y) xmine-width) (1- x)) ext)))
|
|
|
297
|
|
|
298 ;;; ...and this is the second global function to change a
|
|
|
299 ;;; button object. It is only needed during creation of the board.
|
|
|
300
|
|
|
301 (defun xmine-button-change-type (ext type)
|
|
|
302 (set-extent-property ext 'xmine-glyph (xmine-type-to-glyph type))
|
|
|
303 (set-extent-property ext 'xmine-sel-glyph (xmine-type-to-sel-glyph type))
|
|
|
304 (set-extent-property ext 'xmine-type type))
|
|
|
305
|
|
|
306 ;;; some needed predicates.
|
|
|
307
|
|
|
308 (defun xmine-flat-button-p (ext)
|
|
|
309 (and ext
|
|
|
310 (not (extent-property ext 'xmine-hidden))
|
|
|
311 (equal "0" (extent-property ext 'xmine-type))))
|
|
|
312
|
|
138
|
313 (defun xmine-enough-flagged-p (ext)
|
|
|
314 (let ((list (xmine-get-neighbours ext))
|
|
|
315 (number (extent-property ext 'xmine-type))
|
|
|
316 (flagged 0) elem res)
|
|
|
317 (if (not (or (equal number "mine")
|
|
|
318 (equal number "0")))
|
|
|
319 (progn
|
|
|
320 (setq number (string-to-number number))
|
|
|
321 (while (setq elem (pop list))
|
|
|
322 (if (extent-property elem 'xmine-flagged)
|
|
|
323 (setq flagged (1+ flagged))))
|
|
|
324 (setq res (>= flagged number))
|
|
|
325 ))
|
|
|
326 res))
|
|
|
327
|
|
|
328
|
|
118
|
329 (defun xmine-mine-button-p (ext)
|
|
|
330 (and ext
|
|
|
331 (equal "mine" (extent-property ext 'xmine-type))))
|
|
|
332
|
|
|
333 ;;; the next three functions are helper functions used inside a button
|
|
|
334 ;;; object.
|
|
|
335
|
|
|
336 (defun xmine-balloon-text ()
|
|
|
337 (nth (random (length xmine-balloon-list)) xmine-balloon-list))
|
|
|
338
|
|
|
339 (defun xmine-beep (&rest forget)
|
|
|
340 (beep))
|
|
|
341
|
|
|
342 (defun xmine-type-to-glyph (type)
|
|
|
343 (eval (intern-soft (concat "xmine-" type "-glyph"))))
|
|
|
344
|
|
|
345 (defun xmine-type-to-sel-glyph (type)
|
|
|
346 (eval (intern-soft (concat "xmine-" type "-sel-glyph"))))
|
|
|
347
|
|
138
|
348 ;;; the next 3 functions are the main functions that are used
|
|
118
|
349 ;;; inside the button objects and which are bound to the 'action1,
|
|
|
350 ;;; 'action2 and 'action3 slots respectively
|
|
|
351
|
|
|
352 (defun xmine-action1 (ext &optional no-repaint force)
|
|
|
353 "This unhides a hidden button"
|
|
|
354 (if (or force
|
|
|
355 (not (extent-property ext 'xmine-flagged)))
|
|
|
356 (progn
|
|
|
357 (if (and (not force)
|
|
|
358 (extent-property ext 'xmine-hidden))
|
|
|
359 (setq xmine-number-of-opened (1+ xmine-number-of-opened)))
|
|
|
360 (set-extent-property ext 'xmine-hidden nil)
|
|
|
361 (set-annotation-glyph ext (if (equal ext xmine-key-sel-button)
|
|
|
362 (progn
|
|
|
363 (set-extent-property
|
|
|
364 ext 'xmine-non-selected-glyph
|
|
|
365 (extent-property ext 'xmine-glyph))
|
|
|
366 (extent-property ext 'xmine-sel-glyph))
|
|
|
367 (extent-property ext 'xmine-glyph)))
|
|
|
368 (set-extent-property ext 'action3 nil)
|
|
|
369 (set-extent-property ext 'action1 nil)
|
|
|
370 (set-extent-property ext 'balloon-help nil)
|
|
|
371 (set-extent-property ext 'action2 'xmine-action2)
|
|
|
372 (if (not no-repaint)
|
|
|
373 (progn
|
|
120
|
374 (xmine-unhide-sound)
|
|
118
|
375 (xmine-field-repaint ext)
|
|
124
|
376 (if (and (xmine-game-solved-p)
|
|
|
377 (not (xmine-mine-button-p ext)))
|
|
|
378 (xmine-end-game)))))))
|
|
118
|
379
|
|
|
380 (defun xmine-action2 (ext)
|
|
|
381 "This unhides all hidden neighbours of a button.
|
|
|
382 It is meant as convenience function you can use if you're sure that
|
|
|
383 you've marked all mines around the button correctly (or you're sure
|
|
|
384 there isn't one)"
|
|
|
385 (let ((list (xmine-get-neighbours ext))
|
|
120
|
386 (xmine-no-unhide-sound t)
|
|
118
|
387 next)
|
|
138
|
388 ;; (xmine-restore-down-action2 ext)
|
|
120
|
389 (if list (xmine-unhide-many-sound))
|
|
118
|
390 (while (setq next (pop list))
|
|
|
391 (if (not (xmine-flat-button-p next)) (xmine-action1 next)))))
|
|
|
392
|
|
|
393 (defun xmine-action3 (ext)
|
|
|
394 "This toggles the flagged status of a button.
|
|
|
395 You flag a button if you know - or think - that there's a mine under it"
|
|
120
|
396 (if (extent-property ext 'xmine-flagged)
|
|
118
|
397 (progn
|
|
|
398 (set-annotation-glyph ext (xmine-up-glyph ext))
|
|
|
399 (set-extent-property ext 'action1 'xmine-action1)
|
|
|
400 (set-extent-property ext 'xmine-flagged nil)
|
|
|
401 (setq xmine-number-of-flagged (1- xmine-number-of-flagged))
|
|
120
|
402 (xmine-flag-sound)
|
|
118
|
403 (set-annotation-glyph xmine-count-ann
|
|
|
404 (make-glyph
|
|
|
405 (format "Mines: %2d"
|
|
|
406 (- xmine-number-of-mines
|
|
|
407 xmine-number-of-flagged)))))
|
|
|
408 (if (= xmine-number-of-flagged xmine-number-of-mines)
|
|
|
409 (progn
|
|
|
410 (beep)
|
|
|
411 (message
|
|
|
412 "Impossible. You seem to have marked too many tiles as mines?"))
|
|
|
413 (set-annotation-glyph ext (xmine-flagged-glyph ext))
|
|
|
414 (set-extent-property ext 'action1 nil)
|
|
|
415 (set-extent-property ext 'xmine-flagged t)
|
|
|
416 (setq xmine-number-of-flagged (1+ xmine-number-of-flagged))
|
|
120
|
417 (xmine-flag-sound)
|
|
118
|
418 (if (xmine-game-solved-p) (xmine-end-game)
|
|
|
419 (set-annotation-glyph xmine-count-ann
|
|
|
420 (make-glyph
|
|
|
421 (format "Mines: %2d"
|
|
|
422 (- xmine-number-of-mines
|
|
|
423 xmine-number-of-flagged))))))))
|
|
|
424
|
|
|
425
|
|
138
|
426 (defun xmine-down-action2 (ext)
|
|
|
427 (let ((list (xmine-get-neighbours ext))
|
|
|
428 (do-it (xmine-enough-flagged-p ext))
|
|
|
429 elem)
|
|
|
430 (if (not do-it)
|
|
|
431 (while (setq elem (pop list))
|
|
|
432 (set-extent-property elem 'xmine-temp-glyph (annotation-glyph elem))
|
|
|
433 (set-annotation-glyph elem (annotation-down-glyph elem))))
|
|
|
434 do-it))
|
|
|
435
|
|
|
436 (defun xmine-restore-down-action2 (ext)
|
|
|
437 (let ((list (xmine-get-neighbours ext))
|
|
|
438 elem)
|
|
|
439 (while (setq elem (pop list))
|
|
|
440 (set-annotation-glyph elem (extent-property elem 'xmine-temp-glyph)))))
|
|
|
441
|
|
120
|
442 ;;; the sounds...
|
|
|
443 (defcustom xmine-play-sounds nil
|
|
|
444 "If XMine should play some sounds for various events to happen."
|
|
|
445 :group 'xmine
|
|
|
446 :type 'boolean)
|
|
|
447
|
|
|
448 (defun xmine-play-sounds-p ()
|
|
|
449 (and xmine-play-sounds
|
|
|
450 (or (featurep 'native-sound)
|
|
|
451 (featurep 'nas-sound))
|
|
|
452 (or (device-sound-enabled-p)
|
|
|
453 (and (featurep 'native-sound)
|
|
|
454 (not native-sound-only-on-console)
|
|
|
455 (eq (device-type) 'x)))))
|
|
|
456
|
|
|
457
|
|
|
458 (defcustom xmine-flag-sound (concat data-directory "sounds/click.au")
|
|
|
459 "The sound played when flagging/un-flagging a tile"
|
|
|
460 :group 'xmine
|
|
|
461 :type 'file)
|
|
|
462
|
|
|
463 (defcustom xmine-unhide-sound (concat data-directory "sounds/drip.au")
|
|
|
464 "The sound played when unhiding a tile"
|
|
|
465 :group 'xmine
|
|
|
466 :type 'file)
|
|
|
467
|
|
|
468 (defcustom xmine-unhide-many-sound (concat data-directory "sounds/boing.au")
|
|
|
469 "The sound played when unhiding all neighbours of a tile"
|
|
|
470 :group 'xmine
|
|
|
471 :type 'file)
|
|
|
472
|
|
|
473 (defcustom xmine-explode-sound (concat xmine-glyph-dir "explosion3.au")
|
|
|
474 "The sound played when you unhide a mine"
|
|
|
475 :group 'xmine
|
|
|
476 :type 'file)
|
|
|
477
|
|
|
478 (defcustom xmine-solved-sound (concat data-directory "sounds/im_so_happy.au")
|
|
|
479 "The sound played if you managed to win the game."
|
|
|
480 :group 'xmine
|
|
|
481 :type 'file)
|
|
|
482
|
|
|
483 (defun xmine-flag-sound ()
|
|
|
484 (if (xmine-play-sounds-p)
|
|
|
485 (play-sound-file xmine-flag-sound)))
|
|
|
486
|
|
|
487 (defvar xmine-no-unhide-sound nil)
|
|
|
488
|
|
|
489 (defun xmine-unhide-sound ()
|
|
|
490 (if (and (xmine-play-sounds-p)
|
|
|
491 (not xmine-no-unhide-sound))
|
|
|
492 (play-sound-file xmine-unhide-sound)))
|
|
|
493
|
|
|
494 (defun xmine-unhide-many-sound ()
|
|
|
495 (if (xmine-play-sounds-p)
|
|
|
496 (play-sound-file xmine-unhide-many-sound)))
|
|
|
497
|
|
|
498 (defun xmine-explode-sound ()
|
|
|
499 (if (xmine-play-sounds-p)
|
|
|
500 (play-sound-file xmine-explode-sound)
|
|
|
501 (beep)))
|
|
|
502
|
|
|
503 (defun xmine-solved-sound ()
|
|
|
504 (if (xmine-play-sounds-p)
|
|
|
505 (play-sound-file xmine-solved-sound)
|
|
|
506 (beep)))
|
|
|
507
|
|
|
508
|
|
118
|
509 ;;; what to do after a button is unhidden: We (maybe) have to repaint
|
|
|
510 ;;; parts of the board. This is done here recursively.
|
|
|
511
|
|
|
512 (defun xmine-field-repaint (ext)
|
|
|
513 (let* ((flatp (xmine-flat-button-p ext))
|
|
|
514 (minep (xmine-mine-button-p ext))
|
|
|
515 (neighbours (xmine-get-neighbours ext))
|
|
|
516 (max-lisp-eval-depth (* 8 xmine-width xmine-height))
|
|
|
517 next-ext ext-list)
|
|
|
518 (cond (flatp
|
|
|
519 (while (setq next-ext (pop neighbours))
|
|
|
520 (if (extent-property next-ext 'xmine-hidden)
|
|
|
521 (progn
|
|
|
522 (xmine-action1 next-ext 'no-repaint)
|
|
|
523 (and (equal "0" (extent-property next-ext 'xmine-type))
|
|
|
524 (push next-ext ext-list)))))
|
|
|
525 (while ext-list
|
|
|
526 (setq next-ext (pop ext-list))
|
|
|
527 (xmine-field-repaint next-ext)))
|
|
|
528 (minep
|
|
|
529 (set-extent-property ext 'xmine-glyph xmine-trapped-glyph)
|
|
|
530 (set-extent-property ext 'xmine-sel-glyph xmine-trapped-glyph)
|
|
|
531 (xmine-show-all)
|
|
|
532 (xmine-end-game-trapped)))))
|
|
|
533
|
|
|
534
|
|
|
535 (defun xmine-get-neighbours (ext)
|
|
|
536 "This gives back a list of all neighbours of a button, correctly
|
|
|
537 handling buttons at the side or corner of course"
|
|
|
538 (let* ((x (extent-property ext 'xmine-x))
|
|
|
539 (y (extent-property ext 'xmine-y))
|
|
|
540 next-coord next list
|
|
|
541 (neighbours (list (list (1- x) (1+ y))
|
|
|
542 (list x (1+ y))
|
|
|
543 (list (1+ x) (1+ y))
|
|
|
544 (list (1- x) (1- y))
|
|
|
545 (list x (1- y))
|
|
|
546 (list (1+ x) (1- y))
|
|
|
547 (list (1+ x) y)
|
|
|
548 (list (1- x) y))))
|
|
|
549 (while (setq next-coord (pop neighbours))
|
|
|
550 (if (setq next (xmine-field-button-at (car next-coord)
|
|
|
551 (cadr next-coord)))
|
|
|
552 (push next list)))
|
|
|
553 list))
|
|
|
554
|
|
|
555
|
|
|
556 ;;; the next four functions are used to know if we're at the end of
|
|
|
557 ;;; the game (either successfully or exploded) and do the approbate
|
|
|
558 ;;; action
|
|
|
559
|
|
|
560 (defun xmine-game-solved-p ()
|
|
|
561 "You have solved the game successfully if the number of flagged
|
|
|
562 mines plus the number of unhidden buttons equals width*height of the field"
|
|
|
563 (equal (+ xmine-number-of-flagged xmine-number-of-opened)
|
|
|
564 (* xmine-width xmine-height)))
|
|
|
565
|
|
|
566 (defun xmine-end-game ()
|
|
|
567 (set-annotation-glyph xmine-count-ann
|
|
120
|
568 (make-glyph " Solved. "))
|
|
|
569 (sit-for 0)
|
|
|
570 (xmine-solved-sound))
|
|
118
|
571
|
|
|
572 (defun xmine-end-game-trapped ()
|
|
120
|
573 (xmine-explode-sound)
|
|
118
|
574 (set-annotation-glyph xmine-count-ann
|
|
|
575 (make-glyph "++ RIP ++")))
|
|
|
576
|
|
|
577 (defun xmine-show-all ()
|
|
|
578 (let ((list (append xmine-field nil))
|
|
|
579 next)
|
|
|
580 (while (setq next (pop list))
|
|
|
581 (xmine-action1 next 'no-repaint 'force))))
|
|
|
582
|
|
|
583
|
|
|
584 (defun xmine-field-button-at (x y)
|
|
|
585 "This function gives back the button at a given coordinate pair (x y)
|
|
|
586 It is only used during creation of the board and when getting the
|
|
|
587 neighbours of a button (and for keyboard handling...), as we don't
|
|
|
588 want to use coordinates in the main loop, only the button object
|
|
|
589 itself should be referenced. Of course the use of this function could
|
|
|
590 be avoided in xmine-get-neighbours by storing the neighbour buttons
|
|
|
591 directly in the button, but this seems to be a bit oversized for this
|
|
|
592 little game."
|
|
|
593 (if (or (> x xmine-width) (< x 1)
|
|
|
594 (> y xmine-height) (< y 1)) nil
|
|
|
595 (aref xmine-field (+ (* (1- y) xmine-width) (1- x)))))
|
|
|
596
|
|
120
|
597 ;;;###autoload
|
|
118
|
598 (defun xmine-mode ()
|
|
|
599 "A mode for playing the well known mine searching game.
|
|
|
600
|
|
|
601 `\\<annotation-local-map-default>\\[xmine-activate-function-button1]' or `\\<xmine-keymap>\\[xmine-key-action1]' unhides a tile,
|
|
|
602 `\\<annotation-local-map-default>\\[xmine-activate-function-button2]' or `\\<xmine-keymap>\\[xmine-key-action2]' unhides all neighbours of a tile,
|
|
|
603 `\\<annotation-local-map-default>\\[xmine-activate-function-button3]' or `\\<xmine-keymap>\\[xmine-key-action3]' (un)flagges a tile to hold a mine.
|
|
|
604
|
|
|
605 `\\[xmine-key-new]' starts a new game.
|
|
|
606 `\\[xmine-key-quit]' ends a game.
|
|
|
607
|
|
|
608 All keybindings (with alternatives) currently in effect:
|
|
|
609 \\{xmine-keymap}
|
|
|
610
|
|
|
611 The rules are quite easy: You start by unhiding (random) tiles. An unhidden
|
|
|
612 tile showing a number tells you something about the number of mines in it's
|
|
|
613 neighborhood, where the neighborhood are all 8 tiles (or less if it's
|
|
|
614 at a border) around the tile.
|
|
|
615
|
|
|
616 E.g. a \"1\" shows you that there is only one mine in the neighborhood of
|
|
|
617 this tile. Empty tiles have no mines around them, and empty tiles in
|
|
|
618 the neighborhood of another empty tile are all automatically unhidden
|
|
|
619 if you unhide one of them. You need to find a strategy to use the
|
|
|
620 information you have from the numbers to \"flag\" the tiles with mines
|
|
|
621 under them and unhide all other tiles. If you correctly made this
|
|
|
622 without accidently unhiding a mine, you've won.
|
|
|
623
|
|
|
624 If you are sure you have correctly flagged all mines around a unhidden tile,
|
|
|
625 you can use Button-2 or \\[xmine-key-action2] on it to unhide all it's
|
|
|
626 neighbors. But beware: If you made a mistake by flagging the wrong mines,
|
|
|
627 you'll blow up!
|
|
|
628
|
|
|
629 Have Fun."
|
|
|
630 (interactive)
|
|
|
631 (xmine-field-create))
|
|
|
632
|
|
120
|
633 ;;;###autoload
|
|
118
|
634 (fset 'xmine 'xmine-mode)
|
|
|
635
|
|
|
636 (defun xmine-field-create ()
|
|
|
637 "We create the playing board here."
|
|
|
638 (let ((width 1)
|
|
|
639 (height 1)
|
|
|
640 (pop-up-windows nil)
|
|
|
641 total)
|
|
|
642 (xmine-buffer-init)
|
|
|
643 (pop-to-buffer xmine-buffer)
|
|
|
644 (setq total (* xmine-height xmine-width))
|
|
|
645 (setq xmine-field (make-vector total nil))
|
|
|
646 (xmine-init-mines
|
|
|
647 (setq xmine-number-of-mines
|
|
|
648 (min 99 (round (* (/ (float xmine-%-of-mines) 100) total)))))
|
|
|
649 (insert "\n ")
|
|
|
650 (set-extent-end-glyph (make-extent (point) (point)) xmine-title-glyph)
|
|
|
651 (insert "\n\n")
|
|
|
652 (while (<= height xmine-height)
|
|
|
653 (insert " ")
|
|
|
654 (while (<= width xmine-width)
|
|
|
655 (if (xmine-field-button-at width height)
|
|
|
656 (xmine-button-create width height "mine")
|
|
|
657 (xmine-button-create width height "0"))
|
|
|
658 (setq width (+ width 1)))
|
|
|
659 (insert " \n")
|
|
|
660 (setq width 1)
|
|
|
661 (setq height (+ height 1)))
|
|
|
662 (insert "\n ")
|
|
|
663 (set-extent-begin-glyph (make-extent (point) (point)) xmine-pad-glyph)
|
|
|
664 (setq xmine-new-ann
|
|
|
665 (make-annotation xmine-new-up nil
|
|
|
666 'text nil nil xmine-new-down nil))
|
|
|
667 (set-extent-property xmine-new-ann 'action1 '(lambda (&rest egal)
|
|
|
668 (xmine-field-create)))
|
|
|
669 (set-extent-property xmine-new-ann 'action2 nil)
|
|
|
670 (set-extent-property xmine-new-ann 'action3 nil)
|
|
|
671 (set-extent-property xmine-new-ann 'end-open t)
|
|
|
672 (set-extent-begin-glyph (make-extent (point) (point)) xmine-pad-glyph)
|
|
|
673 (setq xmine-count-ann
|
|
|
674 (make-annotation xmine-count-glyph nil
|
|
|
675 'text nil nil nil nil))
|
|
|
676 (set-extent-begin-glyph (make-extent (point) (point)) xmine-pad-glyph)
|
|
|
677 (setq xmine-quit-ann
|
|
|
678 (make-annotation xmine-quit-up nil
|
|
|
679 'text nil nil xmine-quit-down nil))
|
|
|
680 (set-extent-property xmine-quit-ann 'action1
|
|
|
681 '(lambda (&rest egal)
|
|
|
682 (kill-buffer (current-buffer))))
|
|
|
683 (set-extent-property xmine-quit-ann 'action2 nil)
|
|
|
684 (set-extent-property xmine-quit-ann 'action3 nil)
|
|
|
685 (set-extent-property xmine-quit-ann 'end-open t)
|
|
|
686 (xmine-attach-numbers)
|
|
|
687 (setq xmine-number-of-flagged 0)
|
|
|
688 (setq xmine-number-of-opened 0)
|
|
|
689 (set-annotation-glyph xmine-count-ann
|
|
|
690 (make-glyph
|
|
|
691 (format "Mines: %2d" xmine-number-of-mines)))
|
|
|
692 (goto-char (point-min))
|
|
|
693 (setq buffer-read-only 't)
|
|
|
694 (if (eq window-system 'x)
|
|
|
695 (set-specifier (face-background 'default)
|
|
|
696 xmine-background xmine-buffer))
|
|
|
697 (set-specifier (face-background 'text-cursor)
|
|
|
698 xmine-background xmine-buffer)
|
|
|
699 (setq xmine-key-sel-button nil)
|
|
|
700 (xmine-select-button (xmine-field-button-at (/ xmine-width 2)
|
|
|
701 (/ xmine-height 2)))))
|
|
|
702
|
|
|
703
|
|
|
704 (defun xmine-init-mines (num)
|
|
|
705 "A subroutine for xmine-field create.
|
|
|
706 We randomly set a part of the nil-filled board vector with t to
|
|
|
707 indicate the places where mines should reside."
|
|
|
708 (let (x y elem)
|
|
|
709 (random t)
|
|
|
710 (while (> num 0)
|
|
|
711 (setq x (1+ (random xmine-width)))
|
|
|
712 (setq y (1+ (random xmine-height)))
|
|
|
713 (setq elem (xmine-field-button-at x y))
|
|
|
714 (if (not elem)
|
|
|
715 (progn
|
|
|
716 (aset xmine-field (+ (* (1- y) xmine-width) (1- x)) t)
|
|
|
717 (setq num (1- num)))))))
|
|
|
718
|
|
|
719 (defun xmine-attach-numbers ()
|
|
|
720 "A subroutine for xmine-field-create.
|
|
|
721 The board is populated by now with empty buttons and mines. Here we
|
|
|
722 change the correct empty buttons to \"numbered\" buttons"
|
|
|
723 (let
|
|
|
724 ((buttons (append xmine-field nil))
|
|
|
725 ext)
|
|
|
726 (while (setq ext (pop buttons))
|
|
|
727 (let ((num 0)
|
|
|
728 (minep (xmine-mine-button-p ext))
|
|
|
729 (neighbours (xmine-get-neighbours ext))
|
|
|
730 next)
|
|
|
731 (if (not minep)
|
|
|
732 (progn
|
|
|
733 (while (setq next (pop neighbours))
|
|
|
734 (if (xmine-mine-button-p next) (setq num (1+ num))))
|
|
|
735 (if (> num 0)
|
|
|
736 (xmine-button-change-type ext (number-to-string num)))))))))
|
|
|
737
|
|
|
738
|
|
|
739 (defun xmine-buffer-init ()
|
|
|
740 "A subroutine for xmine-create-field.
|
|
|
741 We set up the XMine buffer, set up the keymap and so on."
|
|
|
742 (if xmine-buffer (kill-buffer xmine-buffer))
|
|
|
743 (setq xmine-buffer (get-buffer-create "XEmacs Mine"))
|
|
|
744 (save-excursion
|
|
|
745 (set-buffer xmine-buffer)
|
|
|
746 (kill-all-local-variables)
|
|
|
747 (make-local-variable 'annotation-local-map-default)
|
|
|
748 (setq truncate-lines 't)
|
|
|
749 (setq major-mode 'xmine-mode)
|
|
|
750 (setq mode-name "XMine")
|
|
|
751 (put 'xmine-mode 'mode-class 'special)
|
|
|
752 (use-local-map xmine-keymap)
|
|
|
753 (buffer-disable-undo (current-buffer))
|
|
|
754 (setq annotation-local-map-default
|
|
|
755 (let ((map (make-sparse-keymap)))
|
|
|
756 (set-keymap-name map 'annotation-local-map)
|
|
|
757 (define-key map 'button1 'xmine-activate-function-button)
|
|
|
758 (define-key map 'button2 'xmine-activate-function-button)
|
|
|
759 (define-key map 'button3 'xmine-activate-function-button)
|
|
|
760 map))
|
|
|
761 (run-hooks 'xmine-mode-hook)))
|
|
|
762
|
|
|
763 ;;; The keyboard navigation.
|
|
|
764
|
|
|
765 (defun xmine-select-button (ext)
|
|
|
766 (let ((flagged (extent-property ext 'xmine-flagged))
|
|
|
767 (hidden (extent-property ext 'xmine-hidden))
|
|
|
768 sel-glyph)
|
|
|
769 (setq sel-glyph (if hidden
|
|
|
770 (if flagged xmine-flagged-sel-glyph
|
|
|
771 xmine-up-sel-glyph)
|
|
|
772 (extent-property ext 'xmine-sel-glyph)))
|
|
|
773 (if xmine-key-sel-button
|
|
|
774 (set-annotation-glyph xmine-key-sel-button
|
|
|
775 (extent-property xmine-key-sel-button
|
|
|
776 'xmine-non-selected-glyph)))
|
|
|
777 (set-extent-property ext 'xmine-non-selected-glyph
|
|
|
778 (annotation-glyph ext))
|
|
|
779 (set-annotation-glyph ext sel-glyph)
|
|
|
780 (setq xmine-key-sel-button ext)))
|
|
|
781
|
|
|
782 (defun xmine-key-action1 ()
|
|
|
783 (interactive)
|
|
|
784 (let ((action (extent-property xmine-key-sel-button 'action1)))
|
|
|
785 (if action
|
|
|
786 (funcall action xmine-key-sel-button))))
|
|
|
787
|
|
|
788 (defun xmine-key-action2 ()
|
|
|
789 (interactive)
|
|
|
790 (let ((action (extent-property xmine-key-sel-button 'action2)))
|
|
138
|
791 (if (and action (xmine-enough-flagged-p xmine-key-sel-button))
|
|
|
792 (funcall action xmine-key-sel-button)
|
|
|
793 (beep))))
|
|
118
|
794
|
|
|
795 (defun xmine-key-action3 ()
|
|
|
796 (interactive)
|
|
|
797 (let ((action (extent-property xmine-key-sel-button 'action3)))
|
|
|
798 (if action
|
|
|
799 (funcall action xmine-key-sel-button))))
|
|
|
800
|
|
|
801 (defun xmine-key-quit ()
|
|
|
802 (interactive)
|
|
|
803 (kill-buffer (current-buffer)))
|
|
|
804
|
|
|
805 (defun xmine-key-new ()
|
|
|
806 (interactive)
|
|
|
807 (xmine-field-create))
|
|
|
808
|
|
|
809 (defun xmine-key-down-right ()
|
|
|
810 (interactive)
|
|
|
811 (xmine-key-down)
|
|
|
812 (xmine-key-right))
|
|
|
813
|
|
|
814 (defun xmine-key-down-left ()
|
|
|
815 (interactive)
|
|
|
816 (xmine-key-down)
|
|
|
817 (xmine-key-left))
|
|
|
818
|
|
|
819 (defun xmine-key-up-right ()
|
|
|
820 (interactive)
|
|
|
821 (xmine-key-up)
|
|
|
822 (xmine-key-right))
|
|
|
823
|
|
|
824 (defun xmine-key-up-left ()
|
|
|
825 (interactive)
|
|
|
826 (xmine-key-up)
|
|
|
827 (xmine-key-left))
|
|
|
828
|
|
|
829 (defun xmine-key-down ()
|
|
|
830 (interactive)
|
|
|
831 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
|
|
|
832 (y (extent-property xmine-key-sel-button 'xmine-y))
|
|
|
833 (ext (xmine-field-button-at x (1+ y))))
|
|
|
834 (if ext (xmine-select-button ext)
|
|
|
835 (xmine-select-button (xmine-field-button-at x 1)))))
|
|
|
836
|
|
|
837 (defun xmine-key-up ()
|
|
|
838 (interactive)
|
|
|
839 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
|
|
|
840 (y (extent-property xmine-key-sel-button 'xmine-y))
|
|
|
841 (ext (xmine-field-button-at x (1- y))))
|
|
|
842 (if ext (xmine-select-button ext)
|
|
|
843 (xmine-select-button (xmine-field-button-at x xmine-height)))))
|
|
|
844
|
|
|
845 (defun xmine-key-right ()
|
|
|
846 (interactive)
|
|
|
847 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
|
|
|
848 (y (extent-property xmine-key-sel-button 'xmine-y))
|
|
|
849 (ext (xmine-field-button-at (1+ x) y)))
|
|
|
850 (if ext (xmine-select-button ext)
|
|
|
851 (xmine-select-button (xmine-field-button-at 1 y)))))
|
|
|
852
|
|
|
853 (defun xmine-key-left ()
|
|
|
854 (interactive)
|
|
|
855 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
|
|
|
856 (y (extent-property xmine-key-sel-button 'xmine-y))
|
|
|
857 (ext (xmine-field-button-at (1- x) y)))
|
|
|
858 (if ext (xmine-select-button ext)
|
|
|
859 (xmine-select-button (xmine-field-button-at xmine-width y)))))
|
|
|
860
|
|
|
861 (provide 'xmine)
|
|
|
862
|
