118
+ − 1 ;;; xmine.el --- Mine game for XEmacs
+ − 2
+ − 3 ;; Author: Jens Lautenbacher <jens@lemming0.lem.uni-karlsruhe.de>
+ − 4 ;; Keywords: games
124
+ − 5 ;; Version: 1.7
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
124
+ − 47 (defconst xmine-version-number "1.7" "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
+ − 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
120
+ − 342 (xmine-unhide-sound)
118
+ − 343 (xmine-field-repaint ext)
124
+ − 344 (if (and (xmine-game-solved-p)
+ − 345 (not (xmine-mine-button-p ext)))
+ − 346 (xmine-end-game)))))))
118
+ − 347
+ − 348 (defun xmine-action2 (ext)
+ − 349 "This unhides all hidden neighbours of a button.
+ − 350 It is meant as convenience function you can use if you're sure that
+ − 351 you've marked all mines around the button correctly (or you're sure
+ − 352 there isn't one)"
+ − 353 (let ((list (xmine-get-neighbours ext))
120
+ − 354 (xmine-no-unhide-sound t)
118
+ − 355 next)
120
+ − 356 (if list (xmine-unhide-many-sound))
118
+ − 357 (while (setq next (pop list))
+ − 358 (if (not (xmine-flat-button-p next)) (xmine-action1 next)))))
+ − 359
+ − 360 (defun xmine-action3 (ext)
+ − 361 "This toggles the flagged status of a button.
+ − 362 You flag a button if you know - or think - that there's a mine under it"
120
+ − 363 (if (extent-property ext 'xmine-flagged)
118
+ − 364 (progn
+ − 365 (set-annotation-glyph ext (xmine-up-glyph ext))
+ − 366 (set-extent-property ext 'action1 'xmine-action1)
+ − 367 (set-extent-property ext 'xmine-flagged nil)
+ − 368 (setq xmine-number-of-flagged (1- xmine-number-of-flagged))
120
+ − 369 (xmine-flag-sound)
118
+ − 370 (set-annotation-glyph xmine-count-ann
+ − 371 (make-glyph
+ − 372 (format "Mines: %2d"
+ − 373 (- xmine-number-of-mines
+ − 374 xmine-number-of-flagged)))))
+ − 375 (if (= xmine-number-of-flagged xmine-number-of-mines)
+ − 376 (progn
+ − 377 (beep)
+ − 378 (message
+ − 379 "Impossible. You seem to have marked too many tiles as mines?"))
+ − 380 (set-annotation-glyph ext (xmine-flagged-glyph ext))
+ − 381 (set-extent-property ext 'action1 nil)
+ − 382 (set-extent-property ext 'xmine-flagged t)
+ − 383 (setq xmine-number-of-flagged (1+ xmine-number-of-flagged))
120
+ − 384 (xmine-flag-sound)
118
+ − 385 (if (xmine-game-solved-p) (xmine-end-game)
+ − 386 (set-annotation-glyph xmine-count-ann
+ − 387 (make-glyph
+ − 388 (format "Mines: %2d"
+ − 389 (- xmine-number-of-mines
+ − 390 xmine-number-of-flagged))))))))
+ − 391
+ − 392
120
+ − 393 ;;; the sounds...
+ − 394 (defcustom xmine-play-sounds nil
+ − 395 "If XMine should play some sounds for various events to happen."
+ − 396 :group 'xmine
+ − 397 :type 'boolean)
+ − 398
+ − 399 (defun xmine-play-sounds-p ()
+ − 400 (and xmine-play-sounds
+ − 401 (or (featurep 'native-sound)
+ − 402 (featurep 'nas-sound))
+ − 403 (or (device-sound-enabled-p)
+ − 404 (and (featurep 'native-sound)
+ − 405 (not native-sound-only-on-console)
+ − 406 (eq (device-type) 'x)))))
+ − 407
+ − 408
+ − 409 (defcustom xmine-flag-sound (concat data-directory "sounds/click.au")
+ − 410 "The sound played when flagging/un-flagging a tile"
+ − 411 :group 'xmine
+ − 412 :type 'file)
+ − 413
+ − 414 (defcustom xmine-unhide-sound (concat data-directory "sounds/drip.au")
+ − 415 "The sound played when unhiding a tile"
+ − 416 :group 'xmine
+ − 417 :type 'file)
+ − 418
+ − 419 (defcustom xmine-unhide-many-sound (concat data-directory "sounds/boing.au")
+ − 420 "The sound played when unhiding all neighbours of a tile"
+ − 421 :group 'xmine
+ − 422 :type 'file)
+ − 423
+ − 424 (defcustom xmine-explode-sound (concat xmine-glyph-dir "explosion3.au")
+ − 425 "The sound played when you unhide a mine"
+ − 426 :group 'xmine
+ − 427 :type 'file)
+ − 428
+ − 429 (defcustom xmine-solved-sound (concat data-directory "sounds/im_so_happy.au")
+ − 430 "The sound played if you managed to win the game."
+ − 431 :group 'xmine
+ − 432 :type 'file)
+ − 433
+ − 434 (defun xmine-flag-sound ()
+ − 435 (if (xmine-play-sounds-p)
+ − 436 (play-sound-file xmine-flag-sound)))
+ − 437
+ − 438 (defvar xmine-no-unhide-sound nil)
+ − 439
+ − 440 (defun xmine-unhide-sound ()
+ − 441 (if (and (xmine-play-sounds-p)
+ − 442 (not xmine-no-unhide-sound))
+ − 443 (play-sound-file xmine-unhide-sound)))
+ − 444
+ − 445 (defun xmine-unhide-many-sound ()
+ − 446 (if (xmine-play-sounds-p)
+ − 447 (play-sound-file xmine-unhide-many-sound)))
+ − 448
+ − 449 (defun xmine-explode-sound ()
+ − 450 (if (xmine-play-sounds-p)
+ − 451 (play-sound-file xmine-explode-sound)
+ − 452 (beep)))
+ − 453
+ − 454 (defun xmine-solved-sound ()
+ − 455 (if (xmine-play-sounds-p)
+ − 456 (play-sound-file xmine-solved-sound)
+ − 457 (beep)))
+ − 458
+ − 459
118
+ − 460 ;;; what to do after a button is unhidden: We (maybe) have to repaint
+ − 461 ;;; parts of the board. This is done here recursively.
+ − 462
+ − 463 (defun xmine-field-repaint (ext)
+ − 464 (let* ((flatp (xmine-flat-button-p ext))
+ − 465 (minep (xmine-mine-button-p ext))
+ − 466 (neighbours (xmine-get-neighbours ext))
+ − 467 (max-lisp-eval-depth (* 8 xmine-width xmine-height))
+ − 468 next-ext ext-list)
+ − 469 (cond (flatp
+ − 470 (while (setq next-ext (pop neighbours))
+ − 471 (if (extent-property next-ext 'xmine-hidden)
+ − 472 (progn
+ − 473 (xmine-action1 next-ext 'no-repaint)
+ − 474 (and (equal "0" (extent-property next-ext 'xmine-type))
+ − 475 (push next-ext ext-list)))))
+ − 476 (while ext-list
+ − 477 (setq next-ext (pop ext-list))
+ − 478 (xmine-field-repaint next-ext)))
+ − 479 (minep
+ − 480 (set-extent-property ext 'xmine-glyph xmine-trapped-glyph)
+ − 481 (set-extent-property ext 'xmine-sel-glyph xmine-trapped-glyph)
+ − 482 (xmine-show-all)
+ − 483 (xmine-end-game-trapped)))))
+ − 484
+ − 485
+ − 486 (defun xmine-get-neighbours (ext)
+ − 487 "This gives back a list of all neighbours of a button, correctly
+ − 488 handling buttons at the side or corner of course"
+ − 489 (let* ((x (extent-property ext 'xmine-x))
+ − 490 (y (extent-property ext 'xmine-y))
+ − 491 next-coord next list
+ − 492 (neighbours (list (list (1- x) (1+ y))
+ − 493 (list x (1+ y))
+ − 494 (list (1+ x) (1+ y))
+ − 495 (list (1- x) (1- y))
+ − 496 (list x (1- y))
+ − 497 (list (1+ x) (1- y))
+ − 498 (list (1+ x) y)
+ − 499 (list (1- x) y))))
+ − 500 (while (setq next-coord (pop neighbours))
+ − 501 (if (setq next (xmine-field-button-at (car next-coord)
+ − 502 (cadr next-coord)))
+ − 503 (push next list)))
+ − 504 list))
+ − 505
+ − 506
+ − 507 ;;; the next four functions are used to know if we're at the end of
+ − 508 ;;; the game (either successfully or exploded) and do the approbate
+ − 509 ;;; action
+ − 510
+ − 511 (defun xmine-game-solved-p ()
+ − 512 "You have solved the game successfully if the number of flagged
+ − 513 mines plus the number of unhidden buttons equals width*height of the field"
+ − 514 (equal (+ xmine-number-of-flagged xmine-number-of-opened)
+ − 515 (* xmine-width xmine-height)))
+ − 516
+ − 517 (defun xmine-end-game ()
+ − 518 (set-annotation-glyph xmine-count-ann
120
+ − 519 (make-glyph " Solved. "))
+ − 520 (sit-for 0)
+ − 521 (xmine-solved-sound))
118
+ − 522
+ − 523 (defun xmine-end-game-trapped ()
120
+ − 524 (xmine-explode-sound)
118
+ − 525 (set-annotation-glyph xmine-count-ann
+ − 526 (make-glyph "++ RIP ++")))
+ − 527
+ − 528 (defun xmine-show-all ()
+ − 529 (let ((list (append xmine-field nil))
+ − 530 next)
+ − 531 (while (setq next (pop list))
+ − 532 (xmine-action1 next 'no-repaint 'force))))
+ − 533
+ − 534
+ − 535 (defun xmine-field-button-at (x y)
+ − 536 "This function gives back the button at a given coordinate pair (x y)
+ − 537 It is only used during creation of the board and when getting the
+ − 538 neighbours of a button (and for keyboard handling...), as we don't
+ − 539 want to use coordinates in the main loop, only the button object
+ − 540 itself should be referenced. Of course the use of this function could
+ − 541 be avoided in xmine-get-neighbours by storing the neighbour buttons
+ − 542 directly in the button, but this seems to be a bit oversized for this
+ − 543 little game."
+ − 544 (if (or (> x xmine-width) (< x 1)
+ − 545 (> y xmine-height) (< y 1)) nil
+ − 546 (aref xmine-field (+ (* (1- y) xmine-width) (1- x)))))
+ − 547
120
+ − 548 ;;;###autoload
118
+ − 549 (defun xmine-mode ()
+ − 550 "A mode for playing the well known mine searching game.
+ − 551
+ − 552 `\\<annotation-local-map-default>\\[xmine-activate-function-button1]' or `\\<xmine-keymap>\\[xmine-key-action1]' unhides a tile,
+ − 553 `\\<annotation-local-map-default>\\[xmine-activate-function-button2]' or `\\<xmine-keymap>\\[xmine-key-action2]' unhides all neighbours of a tile,
+ − 554 `\\<annotation-local-map-default>\\[xmine-activate-function-button3]' or `\\<xmine-keymap>\\[xmine-key-action3]' (un)flagges a tile to hold a mine.
+ − 555
+ − 556 `\\[xmine-key-new]' starts a new game.
+ − 557 `\\[xmine-key-quit]' ends a game.
+ − 558
+ − 559 All keybindings (with alternatives) currently in effect:
+ − 560 \\{xmine-keymap}
+ − 561
+ − 562 The rules are quite easy: You start by unhiding (random) tiles. An unhidden
+ − 563 tile showing a number tells you something about the number of mines in it's
+ − 564 neighborhood, where the neighborhood are all 8 tiles (or less if it's
+ − 565 at a border) around the tile.
+ − 566
+ − 567 E.g. a \"1\" shows you that there is only one mine in the neighborhood of
+ − 568 this tile. Empty tiles have no mines around them, and empty tiles in
+ − 569 the neighborhood of another empty tile are all automatically unhidden
+ − 570 if you unhide one of them. You need to find a strategy to use the
+ − 571 information you have from the numbers to \"flag\" the tiles with mines
+ − 572 under them and unhide all other tiles. If you correctly made this
+ − 573 without accidently unhiding a mine, you've won.
+ − 574
+ − 575 If you are sure you have correctly flagged all mines around a unhidden tile,
+ − 576 you can use Button-2 or \\[xmine-key-action2] on it to unhide all it's
+ − 577 neighbors. But beware: If you made a mistake by flagging the wrong mines,
+ − 578 you'll blow up!
+ − 579
+ − 580 Have Fun."
+ − 581 (interactive)
+ − 582 (xmine-field-create))
+ − 583
120
+ − 584 ;;;###autoload
118
+ − 585 (fset 'xmine 'xmine-mode)
+ − 586
+ − 587 (defun xmine-field-create ()
+ − 588 "We create the playing board here."
+ − 589 (let ((width 1)
+ − 590 (height 1)
+ − 591 (pop-up-windows nil)
+ − 592 total)
+ − 593 (xmine-buffer-init)
+ − 594 (pop-to-buffer xmine-buffer)
+ − 595 (setq total (* xmine-height xmine-width))
+ − 596 (setq xmine-field (make-vector total nil))
+ − 597 (xmine-init-mines
+ − 598 (setq xmine-number-of-mines
+ − 599 (min 99 (round (* (/ (float xmine-%-of-mines) 100) total)))))
+ − 600 (insert "\n ")
+ − 601 (set-extent-end-glyph (make-extent (point) (point)) xmine-title-glyph)
+ − 602 (insert "\n\n")
+ − 603 (while (<= height xmine-height)
+ − 604 (insert " ")
+ − 605 (while (<= width xmine-width)
+ − 606 (if (xmine-field-button-at width height)
+ − 607 (xmine-button-create width height "mine")
+ − 608 (xmine-button-create width height "0"))
+ − 609 (setq width (+ width 1)))
+ − 610 (insert " \n")
+ − 611 (setq width 1)
+ − 612 (setq height (+ height 1)))
+ − 613 (insert "\n ")
+ − 614 (set-extent-begin-glyph (make-extent (point) (point)) xmine-pad-glyph)
+ − 615 (setq xmine-new-ann
+ − 616 (make-annotation xmine-new-up nil
+ − 617 'text nil nil xmine-new-down nil))
+ − 618 (set-extent-property xmine-new-ann 'action1 '(lambda (&rest egal)
+ − 619 (xmine-field-create)))
+ − 620 (set-extent-property xmine-new-ann 'action2 nil)
+ − 621 (set-extent-property xmine-new-ann 'action3 nil)
+ − 622 (set-extent-property xmine-new-ann 'end-open t)
+ − 623 (set-extent-begin-glyph (make-extent (point) (point)) xmine-pad-glyph)
+ − 624 (setq xmine-count-ann
+ − 625 (make-annotation xmine-count-glyph nil
+ − 626 'text nil nil nil nil))
+ − 627 (set-extent-begin-glyph (make-extent (point) (point)) xmine-pad-glyph)
+ − 628 (setq xmine-quit-ann
+ − 629 (make-annotation xmine-quit-up nil
+ − 630 'text nil nil xmine-quit-down nil))
+ − 631 (set-extent-property xmine-quit-ann 'action1
+ − 632 '(lambda (&rest egal)
+ − 633 (kill-buffer (current-buffer))))
+ − 634 (set-extent-property xmine-quit-ann 'action2 nil)
+ − 635 (set-extent-property xmine-quit-ann 'action3 nil)
+ − 636 (set-extent-property xmine-quit-ann 'end-open t)
+ − 637 (xmine-attach-numbers)
+ − 638 (setq xmine-number-of-flagged 0)
+ − 639 (setq xmine-number-of-opened 0)
+ − 640 (set-annotation-glyph xmine-count-ann
+ − 641 (make-glyph
+ − 642 (format "Mines: %2d" xmine-number-of-mines)))
+ − 643 (goto-char (point-min))
+ − 644 (setq buffer-read-only 't)
+ − 645 (if (eq window-system 'x)
+ − 646 (set-specifier (face-background 'default)
+ − 647 xmine-background xmine-buffer))
+ − 648 (set-specifier (face-background 'text-cursor)
+ − 649 xmine-background xmine-buffer)
+ − 650 (setq xmine-key-sel-button nil)
+ − 651 (xmine-select-button (xmine-field-button-at (/ xmine-width 2)
+ − 652 (/ xmine-height 2)))))
+ − 653
+ − 654
+ − 655 (defun xmine-init-mines (num)
+ − 656 "A subroutine for xmine-field create.
+ − 657 We randomly set a part of the nil-filled board vector with t to
+ − 658 indicate the places where mines should reside."
+ − 659 (let (x y elem)
+ − 660 (random t)
+ − 661 (while (> num 0)
+ − 662 (setq x (1+ (random xmine-width)))
+ − 663 (setq y (1+ (random xmine-height)))
+ − 664 (setq elem (xmine-field-button-at x y))
+ − 665 (if (not elem)
+ − 666 (progn
+ − 667 (aset xmine-field (+ (* (1- y) xmine-width) (1- x)) t)
+ − 668 (setq num (1- num)))))))
+ − 669
+ − 670 (defun xmine-attach-numbers ()
+ − 671 "A subroutine for xmine-field-create.
+ − 672 The board is populated by now with empty buttons and mines. Here we
+ − 673 change the correct empty buttons to \"numbered\" buttons"
+ − 674 (let
+ − 675 ((buttons (append xmine-field nil))
+ − 676 ext)
+ − 677 (while (setq ext (pop buttons))
+ − 678 (let ((num 0)
+ − 679 (minep (xmine-mine-button-p ext))
+ − 680 (neighbours (xmine-get-neighbours ext))
+ − 681 next)
+ − 682 (if (not minep)
+ − 683 (progn
+ − 684 (while (setq next (pop neighbours))
+ − 685 (if (xmine-mine-button-p next) (setq num (1+ num))))
+ − 686 (if (> num 0)
+ − 687 (xmine-button-change-type ext (number-to-string num)))))))))
+ − 688
+ − 689
+ − 690 (defun xmine-buffer-init ()
+ − 691 "A subroutine for xmine-create-field.
+ − 692 We set up the XMine buffer, set up the keymap and so on."
+ − 693 (if xmine-buffer (kill-buffer xmine-buffer))
+ − 694 (setq xmine-buffer (get-buffer-create "XEmacs Mine"))
+ − 695 (save-excursion
+ − 696 (set-buffer xmine-buffer)
+ − 697 (kill-all-local-variables)
+ − 698 (make-local-variable 'annotation-local-map-default)
+ − 699 (setq truncate-lines 't)
+ − 700 (setq major-mode 'xmine-mode)
+ − 701 (setq mode-name "XMine")
+ − 702 (put 'xmine-mode 'mode-class 'special)
+ − 703 (use-local-map xmine-keymap)
+ − 704 (buffer-disable-undo (current-buffer))
+ − 705 (setq annotation-local-map-default
+ − 706 (let ((map (make-sparse-keymap)))
+ − 707 (set-keymap-name map 'annotation-local-map)
+ − 708 (define-key map 'button1 'xmine-activate-function-button)
+ − 709 (define-key map 'button2 'xmine-activate-function-button)
+ − 710 (define-key map 'button3 'xmine-activate-function-button)
+ − 711 map))
+ − 712 (run-hooks 'xmine-mode-hook)))
+ − 713
+ − 714 ;;; The keyboard navigation.
+ − 715
+ − 716 (defun xmine-select-button (ext)
+ − 717 (let ((flagged (extent-property ext 'xmine-flagged))
+ − 718 (hidden (extent-property ext 'xmine-hidden))
+ − 719 sel-glyph)
+ − 720 (setq sel-glyph (if hidden
+ − 721 (if flagged xmine-flagged-sel-glyph
+ − 722 xmine-up-sel-glyph)
+ − 723 (extent-property ext 'xmine-sel-glyph)))
+ − 724 (if xmine-key-sel-button
+ − 725 (set-annotation-glyph xmine-key-sel-button
+ − 726 (extent-property xmine-key-sel-button
+ − 727 'xmine-non-selected-glyph)))
+ − 728 (set-extent-property ext 'xmine-non-selected-glyph
+ − 729 (annotation-glyph ext))
+ − 730 (set-annotation-glyph ext sel-glyph)
+ − 731 (setq xmine-key-sel-button ext)))
+ − 732
+ − 733 (defun xmine-key-action1 ()
+ − 734 (interactive)
+ − 735 (let ((action (extent-property xmine-key-sel-button 'action1)))
+ − 736 (if action
+ − 737 (funcall action xmine-key-sel-button))))
+ − 738
+ − 739 (defun xmine-key-action2 ()
+ − 740 (interactive)
+ − 741 (let ((action (extent-property xmine-key-sel-button 'action2)))
+ − 742 (if action
+ − 743 (funcall action xmine-key-sel-button))))
+ − 744
+ − 745 (defun xmine-key-action3 ()
+ − 746 (interactive)
+ − 747 (let ((action (extent-property xmine-key-sel-button 'action3)))
+ − 748 (if action
+ − 749 (funcall action xmine-key-sel-button))))
+ − 750
+ − 751 (defun xmine-key-quit ()
+ − 752 (interactive)
+ − 753 (kill-buffer (current-buffer)))
+ − 754
+ − 755 (defun xmine-key-new ()
+ − 756 (interactive)
+ − 757 (xmine-field-create))
+ − 758
+ − 759 (defun xmine-key-down-right ()
+ − 760 (interactive)
+ − 761 (xmine-key-down)
+ − 762 (xmine-key-right))
+ − 763
+ − 764 (defun xmine-key-down-left ()
+ − 765 (interactive)
+ − 766 (xmine-key-down)
+ − 767 (xmine-key-left))
+ − 768
+ − 769 (defun xmine-key-up-right ()
+ − 770 (interactive)
+ − 771 (xmine-key-up)
+ − 772 (xmine-key-right))
+ − 773
+ − 774 (defun xmine-key-up-left ()
+ − 775 (interactive)
+ − 776 (xmine-key-up)
+ − 777 (xmine-key-left))
+ − 778
+ − 779 (defun xmine-key-down ()
+ − 780 (interactive)
+ − 781 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
+ − 782 (y (extent-property xmine-key-sel-button 'xmine-y))
+ − 783 (ext (xmine-field-button-at x (1+ y))))
+ − 784 (if ext (xmine-select-button ext)
+ − 785 (xmine-select-button (xmine-field-button-at x 1)))))
+ − 786
+ − 787 (defun xmine-key-up ()
+ − 788 (interactive)
+ − 789 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
+ − 790 (y (extent-property xmine-key-sel-button 'xmine-y))
+ − 791 (ext (xmine-field-button-at x (1- y))))
+ − 792 (if ext (xmine-select-button ext)
+ − 793 (xmine-select-button (xmine-field-button-at x xmine-height)))))
+ − 794
+ − 795 (defun xmine-key-right ()
+ − 796 (interactive)
+ − 797 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
+ − 798 (y (extent-property xmine-key-sel-button 'xmine-y))
+ − 799 (ext (xmine-field-button-at (1+ x) y)))
+ − 800 (if ext (xmine-select-button ext)
+ − 801 (xmine-select-button (xmine-field-button-at 1 y)))))
+ − 802
+ − 803 (defun xmine-key-left ()
+ − 804 (interactive)
+ − 805 (let* ((x (extent-property xmine-key-sel-button 'xmine-x))
+ − 806 (y (extent-property xmine-key-sel-button 'xmine-y))
+ − 807 (ext (xmine-field-button-at (1- x) y)))
+ − 808 (if ext (xmine-select-button ext)
+ − 809 (xmine-select-button (xmine-field-button-at xmine-width y)))))
+ − 810
+ − 811 (provide 'xmine)
+ − 812
