Mercurial > hg > xemacs-beta

comparison lisp/games/xmine.el @ 118:7d55a9ba150c r20-1b11

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