Mercurial > hg > xemacs-beta
diff lisp/games/xmine.el @ 138:6608ceec7cf8 r20-2b3
Import from CVS: tag r20-2b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:31:46 +0200 |
parents | 9b50b4588a93 |
children |
line wrap: on
line diff
--- a/lisp/games/xmine.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/games/xmine.el Mon Aug 13 09:31:46 2007 +0200 @@ -2,7 +2,7 @@ ;; Author: Jens Lautenbacher <jens@lemming0.lem.uni-karlsruhe.de> ;; Keywords: games -;; Version: 1.7 +;; Version: 1.8 ;; This file is part of XEmacs. @@ -44,7 +44,7 @@ ;; ;;; First of all we'll define the needed varibles. -(defconst xmine-version-number "1.7" "XEmacs Mine version number.") +(defconst xmine-version-number "1.8" "XEmacs Mine version number.") (defconst xmine-version (format "XEmacs Mine v%s by Jens Lautenbacher © 1997" xmine-version-number) "Full XEmacs Mine version number.") @@ -100,36 +100,39 @@ "------------------ XEmacs XMine ------------------"))) (defvar xmine-glyph-production-list - '(("xmine-new-up" "new_up.gif" "new" nil ) - ("xmine-new-down" "new_down.gif" "NEW" nil ) - ("xmine-quit-up" "quit_up.gif" "quit" nil ) - ("xmine-quit-down" "quit_down.gif" "QUIT" nil ) - ("xmine-up-glyph" "empty_16_up.gif" "@ " xmine-hidden-face ) - ("xmine-up-sel-glyph" "empty_16_up_sel.gif" "@<" xmine-hidden-face ) - ("xmine-down-glyph" "empty_16_down.gif" "? " nil ) + '(("xmine-new-up" "new_up.gif" "new" nil) + ("xmine-new-down" "new_down.gif" "NEW" nil) + ("xmine-quit-up" "quit_up.gif" "quit" nil) + ("xmine-quit-down" "quit_down.gif" "QUIT" nil) + ("xmine-up-glyph" "empty_16_up.gif" "@ " xmine-hidden-face) + ("xmine-up-sel-glyph" "empty_16_up_sel.gif" "@<" xmine-hidden-face) + ("xmine-down-glyph" "empty_16_down.gif" "? " nil) ("xmine-flagged-glyph" "flagged_16_up.gif" "! " xmine-flagged-face) ("xmine-flagged-sel-glyph" "flagged_16_up_sel.gif" "!<" xmine-flagged-face) - ("xmine-mine-glyph" "bomb_16_flat.gif" "* " nil ) - ("xmine-mine-sel-glyph" "bomb_16_flat.gif" "*<" nil ) - ("xmine-trapped-glyph" "bomb_trapped_16_flat.gif" "X " nil ) - ("xmine-0-glyph" "empty_16_flat.gif" ". " nil ) - ("xmine-0-sel-glyph" "empty_16_flat_sel.gif" ".<" nil ) - ("xmine-1-glyph" "1_16_flat.gif" "1 " xmine-number-face ) - ("xmine-1-sel-glyph" "1_16_flat_sel.gif" "1<" xmine-number-face ) - ("xmine-2-glyph" "2_16_flat.gif" "2 " xmine-number-face ) - ("xmine-2-sel-glyph" "2_16_flat_sel.gif" "2<" xmine-number-face ) - ("xmine-3-glyph" "3_16_flat.gif" "3 " xmine-number-face ) - ("xmine-3-sel-glyph" "3_16_flat_sel.gif" "3<" xmine-number-face ) - ("xmine-4-glyph" "4_16_flat.gif" "4 " xmine-number-face ) - ("xmine-4-sel-glyph" "4_16_flat_sel.gif" "4<" xmine-number-face ) - ("xmine-5-glyph" "5_16_flat.gif" "5 " xmine-number-face ) - ("xmine-5-sel-glyph" "5_16_flat_sel.gif" "5<" xmine-number-face ) - ("xmine-6-glyph" "6_16_flat.gif" "6 " xmine-number-face ) - ("xmine-6-sel-glyph" "6_16_flat_sel.gif" "6<" xmine-number-face ) - ("xmine-7-glyph" "7_16_flat.gif" "7 " xmine-number-face ) - ("xmine-7-sel-glyph" "7_16_flat_sel.gif" "7<" xmine-number-face ) - ("xmine-8-glyph" "8_16_flat.gif" "8 " xmine-number-face ) - ("xmine-8-sel-glyph" "8_16_flat_sel.gif" "8<" xmine-number-face ))) + ("xmine-mine-glyph" "bomb_16_flat.gif" "* " nil) + ("xmine-mine-sel-glyph" "bomb_16_flat.gif" "*<" nil) + ("xmine-trapped-glyph" "bomb_trapped_16_flat.gif" "X " nil) + ("xmine-0-glyph" "empty_16_flat.gif" ". " nil) + ("xmine-0-sel-glyph" "empty_16_flat_sel.gif" ".<" nil) + ("xmine-1-glyph" "1_16_flat.gif" "1 " xmine-number-face) + ("xmine-1-sel-glyph" "1_16_flat_sel.gif" "1<" xmine-number-face) + ("xmine-2-glyph" "2_16_flat.gif" "2 " xmine-number-face) + ("xmine-2-sel-glyph" "2_16_flat_sel.gif" "2<" xmine-number-face) + ("xmine-3-glyph" "3_16_flat.gif" "3 " xmine-number-face) + ("xmine-3-sel-glyph" "3_16_flat_sel.gif" "3<" xmine-number-face) + ("xmine-4-glyph" "4_16_flat.gif" "4 " xmine-number-face) + ("xmine-4-sel-glyph" "4_16_flat_sel.gif" "4<" xmine-number-face) + ("xmine-5-glyph" "5_16_flat.gif" "5 " xmine-number-face) + ("xmine-5-sel-glyph" "5_16_flat_sel.gif" "5<" xmine-number-face) + ("xmine-6-glyph" "6_16_flat.gif" "6 " xmine-number-face) + ("xmine-6-sel-glyph" "6_16_flat_sel.gif" "6<" xmine-number-face) + ("xmine-7-glyph" "7_16_flat.gif" "7 " xmine-number-face) + ("xmine-7-sel-glyph" "7_16_flat_sel.gif" "7<" xmine-number-face) + ("xmine-8-glyph" "8_16_flat.gif" "8 " xmine-number-face) + ("xmine-8-sel-glyph" "8_16_flat_sel.gif" "8<" xmine-number-face))) + +(defvar xmine-force-textual nil + "This is for debugging purposes only. No need to set it. Really.") (defun xmine-generate-glyphs () (let ((list xmine-glyph-production-list) @@ -140,7 +143,8 @@ text (caddr elem) face (cadddr elem)) (set (intern var) - (make-glyph (if (eq window-system 'x) + (make-glyph (if (and (not xmine-force-textual) + (eq window-system 'x)) (concat xmine-glyph-dir gif) text))) (if face @@ -241,14 +245,20 @@ (defun xmine-activate-function-button (event) (interactive "e") (let* ((extent (event-glyph-extent event)) - (button (event-button event)) - (action (intern (concat "action" (number-to-string button)))) + (button (number-to-string (event-button event))) + (action (intern (concat "action" button))) + (down-action (intern (concat "down-action" button))) + (restore-down-action (intern (concat "restore-down-action" button))) (mouse-down t) - (up-glyph nil)) + (action-do-it t) + up-glyph) ;; make the glyph look pressed (cond ((annotation-down-glyph extent) (setq up-glyph (annotation-glyph extent)) (set-annotation-glyph extent (annotation-down-glyph extent)))) + (if (extent-property extent down-action) + (setq action-do-it + (funcall (extent-property extent down-action) extent))) (while mouse-down (setq event (next-event event)) (if (button-release-event-p event) @@ -257,8 +267,12 @@ (cond ((annotation-down-glyph extent) (set-annotation-glyph extent up-glyph))) (if (eq extent (event-glyph-extent event)) - (if (extent-property extent action) - (funcall (extent-property extent action) extent))))) + (if (and (extent-property extent action) action-do-it) + (funcall (extent-property extent action) extent) + (if (extent-property extent restore-down-action) + (funcall (extent-property extent restore-down-action) extent))) + (if (extent-property extent restore-down-action) + (funcall (extent-property extent restore-down-action) extent))))) ;;; Here we define the button object's constructor function @@ -268,6 +282,8 @@ (set-extent-property ext 'action1 'xmine-action1) (set-extent-property ext 'action2 'xmine-beep) (set-extent-property ext 'action3 'xmine-action3) + (set-extent-property ext 'down-action2 'xmine-down-action2) + (set-extent-property ext 'restore-down-action2 'xmine-restore-down-action2) (set-extent-property ext 'xmine-glyph (xmine-type-to-glyph type)) (set-extent-property ext 'xmine-sel-glyph (xmine-type-to-sel-glyph type)) (set-extent-property ext 'xmine-type type) @@ -294,6 +310,22 @@ (not (extent-property ext 'xmine-hidden)) (equal "0" (extent-property ext 'xmine-type)))) +(defun xmine-enough-flagged-p (ext) + (let ((list (xmine-get-neighbours ext)) + (number (extent-property ext 'xmine-type)) + (flagged 0) elem res) + (if (not (or (equal number "mine") + (equal number "0"))) + (progn + (setq number (string-to-number number)) + (while (setq elem (pop list)) + (if (extent-property elem 'xmine-flagged) + (setq flagged (1+ flagged)))) + (setq res (>= flagged number)) + )) + res)) + + (defun xmine-mine-button-p (ext) (and ext (equal "mine" (extent-property ext 'xmine-type)))) @@ -313,7 +345,7 @@ (defun xmine-type-to-sel-glyph (type) (eval (intern-soft (concat "xmine-" type "-sel-glyph")))) -;;; the next three functions are the main functions that are used +;;; the next 3 functions are the main functions that are used ;;; inside the button objects and which are bound to the 'action1, ;;; 'action2 and 'action3 slots respectively @@ -353,6 +385,7 @@ (let ((list (xmine-get-neighbours ext)) (xmine-no-unhide-sound t) next) +;; (xmine-restore-down-action2 ext) (if list (xmine-unhide-many-sound)) (while (setq next (pop list)) (if (not (xmine-flat-button-p next)) (xmine-action1 next))))) @@ -390,6 +423,22 @@ xmine-number-of-flagged)))))))) +(defun xmine-down-action2 (ext) + (let ((list (xmine-get-neighbours ext)) + (do-it (xmine-enough-flagged-p ext)) + elem) + (if (not do-it) + (while (setq elem (pop list)) + (set-extent-property elem 'xmine-temp-glyph (annotation-glyph elem)) + (set-annotation-glyph elem (annotation-down-glyph elem)))) + do-it)) + +(defun xmine-restore-down-action2 (ext) + (let ((list (xmine-get-neighbours ext)) + elem) + (while (setq elem (pop list)) + (set-annotation-glyph elem (extent-property elem 'xmine-temp-glyph))))) + ;;; the sounds... (defcustom xmine-play-sounds nil "If XMine should play some sounds for various events to happen." @@ -739,8 +788,9 @@ (defun xmine-key-action2 () (interactive) (let ((action (extent-property xmine-key-sel-button 'action2))) - (if action - (funcall action xmine-key-sel-button)))) + (if (and action (xmine-enough-flagged-p xmine-key-sel-button)) + (funcall action xmine-key-sel-button) + (beep)))) (defun xmine-key-action3 () (interactive)