diff options
| author | Eli Zaretskii | 2002-03-08 08:11:21 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2002-03-08 08:11:21 +0000 |
| commit | d93196b3280ec201d8b61ec926af15ffc3254944 (patch) | |
| tree | 25cd77089253b70fb2b02b0d2e2916525857e410 | |
| parent | 6d63dcf565fe44b713223e09ea7ed093968f1403 (diff) | |
| download | emacs-d93196b3280ec201d8b61ec926af15ffc3254944.tar.gz emacs-d93196b3280ec201d8b61ec926af15ffc3254944.zip | |
(mpuz-unsolved-face, mpuz-solved-face)
(mpuz-trivial-face, mpuz-text-face, mpuz-solve-when-trivial)
(mpuz-allow-double-multiplicator): new options for nicer look and
new features.
(mpuz-put-number-on-board, mpuz-paint-number, mpuz-solve): new
functions.
(mpuz-check-all-solved, mpuz-random-puzzle)
(mpuz-paint-statistics, mpuz-paint-digit, mpuz-close-game)
(mpuz-show-solution): functions streamlined and removed french
style space before punctuation, added face support and optional
solving of trivial results.
| -rw-r--r-- | lisp/play/mpuz.el | 449 |
1 files changed, 255 insertions, 194 deletions
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index 9d7a1d7a165..a021ddd3544 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el | |||
| @@ -1,8 +1,9 @@ | |||
| 1 | ;;; mpuz.el --- multiplication puzzle for GNU Emacs | 1 | ;;; mpuz.el --- multiplication puzzle for GNU Emacs |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990, 2002 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> | 5 | ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> |
| 6 | ;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org> | ||
| 6 | ;; Keywords: games | 7 | ;; Keywords: games |
| 7 | 8 | ||
| 8 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -24,10 +25,10 @@ | |||
| 24 | 25 | ||
| 25 | ;;; Commentary: | 26 | ;;; Commentary: |
| 26 | 27 | ||
| 27 | ;; When this package is loaded, `M-x mpuz' generates a random multiplication | 28 | ;; `M-x mpuz' generates a random multiplication puzzle. This is a |
| 28 | ;; puzzle. This is a multiplication example in which each digit has been | 29 | ;; multiplication example in which each digit has been consistently replaced |
| 29 | ;; consistently replaced with some letter. Your job is to reconstruct | 30 | ;; with some letter. Your job is to reconstruct the original digits. Type |
| 30 | ;; the original digits. Type `?' while the mode is active for detailed help. | 31 | ;; `?' while the mode is active for detailed help. |
| 31 | 32 | ||
| 32 | ;;; Code: | 33 | ;;; Code: |
| 33 | 34 | ||
| @@ -38,14 +39,47 @@ | |||
| 38 | 39 | ||
| 39 | (random t) ; randomize | 40 | (random t) ; randomize |
| 40 | 41 | ||
| 41 | (defcustom mpuz-silent nil | 42 | (defcustom mpuz-silent 'error |
| 42 | "*Set this to t if you don't want dings on inputs." | 43 | "*Set this to `nil' if you want dings on inputs. |
| 44 | `t' means never ding, and `error' means only ding on wrong input." | ||
| 45 | :type '(choice (const :tag "No" nil) | ||
| 46 | (const :tag "Yes" t) | ||
| 47 | (const :tag "If correct" error)) | ||
| 48 | :group 'mpuz) | ||
| 49 | |||
| 50 | (defcustom mpuz-solve-when-trivial t | ||
| 51 | "*Solve any row that can be trivially calculated from what you've found." | ||
| 43 | :type 'boolean | 52 | :type 'boolean |
| 44 | :group 'mpuz) | 53 | :group 'mpuz) |
| 45 | 54 | ||
| 46 | (defun mpuz-ding () | 55 | (defcustom mpuz-allow-double-multiplicator nil |
| 47 | "Dings, unless global variable `mpuz-silent' forbids it." | 56 | "*Allow 2nd factors like 33 or 77." |
| 48 | (or mpuz-silent (ding t))) | 57 | :type 'boolean |
| 58 | :group 'mpuz) | ||
| 59 | |||
| 60 | (defcustom mpuz-unsolved-face | ||
| 61 | `(,(facemenu-get-face 'fg:red) bold) | ||
| 62 | "*Face to use for letters to be solved." | ||
| 63 | :type '(repeat face) | ||
| 64 | :group 'mpuz) | ||
| 65 | |||
| 66 | (defcustom mpuz-solved-face | ||
| 67 | `(,(facemenu-get-face 'fg:green) bold) | ||
| 68 | "*Face to use for solved digits." | ||
| 69 | :type '(repeat face) | ||
| 70 | :group 'mpuz) | ||
| 71 | |||
| 72 | (defcustom mpuz-trivial-face | ||
| 73 | `(,(facemenu-get-face 'fg:blue) bold) | ||
| 74 | "*Face to use for trivial digits solved for you." | ||
| 75 | :type '(repeat face) | ||
| 76 | :group 'mpuz) | ||
| 77 | |||
| 78 | (defcustom mpuz-text-face | ||
| 79 | '(variable-pitch) | ||
| 80 | "*Face to use for text on right." | ||
| 81 | :type '(repeat face) | ||
| 82 | :group 'mpuz) | ||
| 49 | 83 | ||
| 50 | 84 | ||
| 51 | ;; Mpuz mode and keymaps | 85 | ;; Mpuz mode and keymaps |
| @@ -59,29 +93,29 @@ | |||
| 59 | "Local keymap to use in Mult Puzzle.") | 93 | "Local keymap to use in Mult Puzzle.") |
| 60 | 94 | ||
| 61 | (if mpuz-mode-map nil | 95 | (if mpuz-mode-map nil |
| 62 | (setq mpuz-mode-map (make-sparse-keymap)) | 96 | (setq mpuz-mode-map (make-sparse-keymap)) |
| 63 | (define-key mpuz-mode-map "a" 'mpuz-try-letter) | 97 | (define-key mpuz-mode-map "a" 'mpuz-try-letter) |
| 64 | (define-key mpuz-mode-map "b" 'mpuz-try-letter) | 98 | (define-key mpuz-mode-map "b" 'mpuz-try-letter) |
| 65 | (define-key mpuz-mode-map "c" 'mpuz-try-letter) | 99 | (define-key mpuz-mode-map "c" 'mpuz-try-letter) |
| 66 | (define-key mpuz-mode-map "d" 'mpuz-try-letter) | 100 | (define-key mpuz-mode-map "d" 'mpuz-try-letter) |
| 67 | (define-key mpuz-mode-map "e" 'mpuz-try-letter) | 101 | (define-key mpuz-mode-map "e" 'mpuz-try-letter) |
| 68 | (define-key mpuz-mode-map "f" 'mpuz-try-letter) | 102 | (define-key mpuz-mode-map "f" 'mpuz-try-letter) |
| 69 | (define-key mpuz-mode-map "g" 'mpuz-try-letter) | 103 | (define-key mpuz-mode-map "g" 'mpuz-try-letter) |
| 70 | (define-key mpuz-mode-map "h" 'mpuz-try-letter) | 104 | (define-key mpuz-mode-map "h" 'mpuz-try-letter) |
| 71 | (define-key mpuz-mode-map "i" 'mpuz-try-letter) | 105 | (define-key mpuz-mode-map "i" 'mpuz-try-letter) |
| 72 | (define-key mpuz-mode-map "j" 'mpuz-try-letter) | 106 | (define-key mpuz-mode-map "j" 'mpuz-try-letter) |
| 73 | (define-key mpuz-mode-map "A" 'mpuz-try-letter) | 107 | (define-key mpuz-mode-map "A" 'mpuz-try-letter) |
| 74 | (define-key mpuz-mode-map "B" 'mpuz-try-letter) | 108 | (define-key mpuz-mode-map "B" 'mpuz-try-letter) |
| 75 | (define-key mpuz-mode-map "C" 'mpuz-try-letter) | 109 | (define-key mpuz-mode-map "C" 'mpuz-try-letter) |
| 76 | (define-key mpuz-mode-map "D" 'mpuz-try-letter) | 110 | (define-key mpuz-mode-map "D" 'mpuz-try-letter) |
| 77 | (define-key mpuz-mode-map "E" 'mpuz-try-letter) | 111 | (define-key mpuz-mode-map "E" 'mpuz-try-letter) |
| 78 | (define-key mpuz-mode-map "F" 'mpuz-try-letter) | 112 | (define-key mpuz-mode-map "F" 'mpuz-try-letter) |
| 79 | (define-key mpuz-mode-map "G" 'mpuz-try-letter) | 113 | (define-key mpuz-mode-map "G" 'mpuz-try-letter) |
| 80 | (define-key mpuz-mode-map "H" 'mpuz-try-letter) | 114 | (define-key mpuz-mode-map "H" 'mpuz-try-letter) |
| 81 | (define-key mpuz-mode-map "I" 'mpuz-try-letter) | 115 | (define-key mpuz-mode-map "I" 'mpuz-try-letter) |
| 82 | (define-key mpuz-mode-map "J" 'mpuz-try-letter) | 116 | (define-key mpuz-mode-map "J" 'mpuz-try-letter) |
| 83 | (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort) | 117 | (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort) |
| 84 | (define-key mpuz-mode-map "?" 'describe-mode)) | 118 | (define-key mpuz-mode-map "?" 'describe-mode)) |
| 85 | 119 | ||
| 86 | (defun mpuz-mode () | 120 | (defun mpuz-mode () |
| 87 | "Multiplication puzzle mode. | 121 | "Multiplication puzzle mode. |
| @@ -90,14 +124,15 @@ You have to guess which letters stand for which digits in the | |||
| 90 | multiplication displayed inside the `*Mult Puzzle*' buffer. | 124 | multiplication displayed inside the `*Mult Puzzle*' buffer. |
| 91 | 125 | ||
| 92 | You may enter a guess for a letter's value by typing first the letter, | 126 | You may enter a guess for a letter's value by typing first the letter, |
| 93 | then the digit. Thus, to guess that A=3, type A 3. | 127 | then the digit. Thus, to guess that A=3, type `A 3'. |
| 94 | 128 | ||
| 95 | To leave the game to do other editing work, just switch buffers. | 129 | To leave the game to do other editing work, just switch buffers. |
| 96 | Then you may resume the game with M-x mpuz. | 130 | Then you may resume the game with M-x mpuz. |
| 97 | You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | 131 | You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." |
| 98 | (interactive) | 132 | (interactive) |
| 99 | (setq major-mode 'mpuz-mode | 133 | (setq major-mode 'mpuz-mode |
| 100 | mode-name "Mult Puzzle") | 134 | mode-name "Mult Puzzle" |
| 135 | tab-width 30) | ||
| 101 | (use-local-map mpuz-mode-map) | 136 | (use-local-map mpuz-mode-map) |
| 102 | (run-hooks 'mpuz-mode-hook)) | 137 | (run-hooks 'mpuz-mode-hook)) |
| 103 | 138 | ||
| @@ -119,11 +154,15 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 119 | (defvar mpuz-in-progress nil | 154 | (defvar mpuz-in-progress nil |
| 120 | "True if a game is currently in progress.") | 155 | "True if a game is currently in progress.") |
| 121 | 156 | ||
| 122 | (defvar mpuz-found-digits (make-vector 10 nil) | 157 | (defvar mpuz-found-digits (make-bool-vector 10 nil) |
| 123 | "A vector recording which digits have been decrypted.") | 158 | "A vector recording which digits have been decrypted.") |
| 124 | 159 | ||
| 160 | (defvar mpuz-trivial-digits (make-bool-vector 10 nil) | ||
| 161 | "A vector recording which digits have been solved for you.") | ||
| 162 | |||
| 125 | (defmacro mpuz-digit-solved-p (digit) | 163 | (defmacro mpuz-digit-solved-p (digit) |
| 126 | (list 'aref 'mpuz-found-digits digit)) | 164 | `(or (aref mpuz-found-digits ,digit) |
| 165 | (aref mpuz-trivial-digits ,digit))) | ||
| 127 | 166 | ||
| 128 | 167 | ||
| 129 | ;; A puzzle uses a permutation of [0..9] into itself. | 168 | ;; A puzzle uses a permutation of [0..9] into itself. |
| @@ -160,20 +199,54 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 160 | (defvar mpuz-board (make-vector 10 nil) | 199 | (defvar mpuz-board (make-vector 10 nil) |
| 161 | "The board associates to any digit the list of squares where it appears.") | 200 | "The board associates to any digit the list of squares where it appears.") |
| 162 | 201 | ||
| 163 | (defun mpuz-put-digit-on-board (number square) | 202 | (defun mpuz-put-number-on-board (number row &rest l) |
| 164 | "Put (last digit of) NUMBER on SQUARE of the puzzle board." | 203 | "Put (last digit of) NUMBER on ROW and COLUMNS of the puzzle board." |
| 165 | ;; i.e. push SQUARE on NUMBER square-list | 204 | (let (digit) |
| 166 | (setq number (% number 10)) | 205 | (while l |
| 167 | (aset mpuz-board number (cons square (aref mpuz-board number)))) | 206 | (setq digit (% number 10) |
| 207 | number (/ number 10)) | ||
| 208 | (aset mpuz-board digit `((,row . ,(car l)) ,@(aref mpuz-board digit))) | ||
| 209 | (setq l (cdr l))))) | ||
| 168 | 210 | ||
| 169 | (defun mpuz-check-all-solved () | 211 | (defun mpuz-check-all-solved (&optional row col) |
| 170 | "Check whether all digits have been solved. Return t if yes." | 212 | "Check whether all digits have been solved. Return t if yes." |
| 171 | (catch 'found | 213 | (catch 'solved |
| 172 | (let ((digit -1)) | 214 | (let (A B1 B2 C D E squares) |
| 173 | (while (> 10 (setq digit (1+ digit))) | 215 | (and mpuz-solve-when-trivial |
| 174 | (if (and (not (mpuz-digit-solved-p digit)) ; unsolved | 216 | (not row) |
| 175 | (aref mpuz-board digit)) ; and appearing in the puzzle ! | 217 | (while |
| 176 | (throw 'found nil)))) | 218 | (cond ((or (and (setq B1 (or B1 (mpuz-check-all-solved 4 7)) |
| 219 | B2 (or B2 (mpuz-check-all-solved 4 9)) | ||
| 220 | E (or E (mpuz-check-all-solved 10)) | ||
| 221 | A (or A (mpuz-check-all-solved 2))) | ||
| 222 | B1 B2) | ||
| 223 | (and E (or A (and B1 B2)))) | ||
| 224 | (mpuz-solve) | ||
| 225 | (mpuz-paint-board) | ||
| 226 | (throw 'solved t)) | ||
| 227 | ((and (setq D (or D (mpuz-check-all-solved 8)) | ||
| 228 | C (or C (mpuz-check-all-solved 6))) | ||
| 229 | D (not E)) | ||
| 230 | (mpuz-solve 10)) | ||
| 231 | ((and E (not (eq C D))) | ||
| 232 | (mpuz-solve (if D 6 8))) | ||
| 233 | ((and A (not (eq B2 C))) | ||
| 234 | (mpuz-solve (if C 4 6) (if C 9))) | ||
| 235 | ((and A (not (eq B1 D))) | ||
| 236 | (mpuz-solve (if D 4 8) (if D 7))) | ||
| 237 | ((and (not A) (or (and B2 C) (and B1 D))) | ||
| 238 | (mpuz-solve 2))))) | ||
| 239 | (mpuz-paint-board) | ||
| 240 | (mapc (lambda (digit) | ||
| 241 | (and (not (mpuz-digit-solved-p digit)) ; unsolved | ||
| 242 | (setq squares (aref mpuz-board digit)) | ||
| 243 | (if row | ||
| 244 | (if col | ||
| 245 | (member (cons row col) squares) | ||
| 246 | (assq row squares)) | ||
| 247 | squares) ; and appearing in the puzzle! | ||
| 248 | (throw 'solved nil))) | ||
| 249 | [0 1 2 3 4 5 6 7 8 9])) | ||
| 177 | t)) | 250 | t)) |
| 178 | 251 | ||
| 179 | 252 | ||
| @@ -186,118 +259,105 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 186 | "Draw random values to be multiplied in a puzzle." | 259 | "Draw random values to be multiplied in a puzzle." |
| 187 | (mpuz-build-random-perm) | 260 | (mpuz-build-random-perm) |
| 188 | (fillarray mpuz-board nil) ; erase the board | 261 | (fillarray mpuz-board nil) ; erase the board |
| 189 | (let (A B C D E) | 262 | ;; A,B,C,D & E, are the five rows of our multiplication. |
| 190 | ;; A,B,C,D & E, are the five rows of our multiplication. | 263 | ;; Choose random values, discarding cases with leading zeros in C or D. |
| 191 | ;; Choose random values, discarding uninteresting cases. | 264 | (let* ((A (+ 112 (random 888))) |
| 192 | (while (progn | 265 | (min (1+ (/ 1000 A))) |
| 193 | (setq A (random 1000) | 266 | (B1 (+ min (random (- 10 min)))) |
| 194 | B (random 100) | 267 | B2 C D E) |
| 195 | C (* A (% B 10)) | 268 | (while (if (= B1 (setq B2 (+ min (random (- 10 min))))) |
| 196 | D (* A (/ B 10)) | 269 | (not mpuz-allow-double-multiplicator))) |
| 197 | E (* A B)) | 270 | (setq C (* A B2) |
| 198 | (or (< C 1000) (< D 1000)))) ; forbid leading zeros in C or D | 271 | D (* A B1) |
| 272 | E (+ C (* D 10))) | ||
| 199 | ;; Individual digits are now put on their respective squares. | 273 | ;; Individual digits are now put on their respective squares. |
| 200 | ;; [NB: A square is a pair <row,column> of the screen.] | 274 | ;; [NB: A square is a pair (row . column) of the screen.] |
| 201 | (mpuz-put-digit-on-board A '(2 . 9)) | 275 | (mpuz-put-number-on-board A 2 9 7 5) |
| 202 | (mpuz-put-digit-on-board (/ A 10) '(2 . 7)) | 276 | (mpuz-put-number-on-board (+ (* B1 10) B2) 4 9 7) |
| 203 | (mpuz-put-digit-on-board (/ A 100) '(2 . 5)) | 277 | (mpuz-put-number-on-board C 6 9 7 5 3) |
| 204 | (mpuz-put-digit-on-board B '(4 . 9)) | 278 | (mpuz-put-number-on-board D 8 7 5 3 1) |
| 205 | (mpuz-put-digit-on-board (/ B 10) '(4 . 7)) | 279 | (mpuz-put-number-on-board E 10 9 7 5 3 1))) |
| 206 | (mpuz-put-digit-on-board C '(6 . 9)) | ||
| 207 | (mpuz-put-digit-on-board (/ C 10) '(6 . 7)) | ||
| 208 | (mpuz-put-digit-on-board (/ C 100) '(6 . 5)) | ||
| 209 | (mpuz-put-digit-on-board (/ C 1000) '(6 . 3)) | ||
| 210 | (mpuz-put-digit-on-board D '(8 . 7)) | ||
| 211 | (mpuz-put-digit-on-board (/ D 10) '(8 . 5)) | ||
| 212 | (mpuz-put-digit-on-board (/ D 100) '(8 . 3)) | ||
| 213 | (mpuz-put-digit-on-board (/ D 1000) '(8 . 1)) | ||
| 214 | (mpuz-put-digit-on-board E '(10 . 9)) | ||
| 215 | (mpuz-put-digit-on-board (/ E 10) '(10 . 7)) | ||
| 216 | (mpuz-put-digit-on-board (/ E 100) '(10 . 5)) | ||
| 217 | (mpuz-put-digit-on-board (/ E 1000) '(10 . 3)) | ||
| 218 | (mpuz-put-digit-on-board (/ E 10000) '(10 . 1)))) | ||
| 219 | 280 | ||
| 220 | ;; Display | 281 | ;; Display |
| 221 | ;;-------- | 282 | ;;-------- |
| 222 | (defconst mpuz-framework | 283 | (defconst mpuz-framework |
| 223 | " | 284 | " |
| 224 | . . . | 285 | . . . |
| 225 | Number of errors (this game): 0 | 286 | Number of errors (this game): 0 |
| 226 | x . . | 287 | x . . |
| 227 | ------- | 288 | ------- |
| 228 | . . . . | 289 | . . . . |
| 229 | Number of completed games: 0 | 290 | Number of completed games: 0 |
| 230 | . . . . | 291 | . . . . |
| 231 | --------- Average number of errors: 0.00 | 292 | --------- Average number of errors: 0.00 |
| 232 | . . . . ." | 293 | . . . . ." |
| 233 | "The general picture of the puzzle screen, as a string.") | 294 | "The general picture of the puzzle screen, as a string.") |
| 234 | 295 | ||
| 235 | (defun mpuz-create-buffer () | 296 | (defun mpuz-create-buffer () |
| 236 | "Create (or recreate) the puzzle buffer. Return it." | 297 | "Create (or recreate) the puzzle buffer. Return it." |
| 237 | (let ((buff (get-buffer-create "*Mult Puzzle*"))) | 298 | (let ((buf (get-buffer-create "*Mult Puzzle*")) |
| 299 | (face `(face ,mpuz-text-face)) | ||
| 300 | buffer-read-only) | ||
| 238 | (save-excursion | 301 | (save-excursion |
| 239 | (set-buffer buff) | 302 | (set-buffer buf) |
| 240 | (let ((buffer-read-only nil)) | 303 | (erase-buffer) |
| 241 | (erase-buffer) | 304 | (insert mpuz-framework) |
| 242 | (insert mpuz-framework) | 305 | (set-text-properties 13 42 face) |
| 243 | (mpuz-paint-board) | 306 | (set-text-properties 79 105 face) |
| 244 | (mpuz-paint-errors) | 307 | (set-text-properties 128 153 face) |
| 245 | (mpuz-paint-statistics))) | 308 | (mpuz-paint-board) |
| 246 | buff)) | 309 | (mpuz-paint-errors) |
| 310 | (mpuz-paint-statistics)) | ||
| 311 | buf)) | ||
| 312 | |||
| 313 | (defun mpuz-paint-number (n &optional eol words) | ||
| 314 | (end-of-line eol) | ||
| 315 | (let (buffer-read-only) | ||
| 316 | (delete-region (point) | ||
| 317 | (progn (backward-word (or words 1)) (point))) | ||
| 318 | (insert n))) | ||
| 247 | 319 | ||
| 248 | (defun mpuz-paint-errors () | 320 | (defun mpuz-paint-errors () |
| 249 | "Paint error count on the puzzle screen." | 321 | "Paint error count on the puzzle screen." |
| 250 | (mpuz-switch-to-window) | 322 | (mpuz-switch-to-window) |
| 251 | (let ((buffer-read-only nil)) | 323 | (goto-line 3) |
| 252 | (goto-line 3) | 324 | (mpuz-paint-number (prin1-to-string mpuz-nb-errors))) |
| 253 | (move-to-column 49) | ||
| 254 | (mpuz-delete-line) | ||
| 255 | (insert (prin1-to-string mpuz-nb-errors)))) | ||
| 256 | 325 | ||
| 257 | (defun mpuz-paint-statistics () | 326 | (defun mpuz-paint-statistics () |
| 258 | "Paint statistics about previous games on the puzzle screen." | 327 | "Paint statistics about previous games on the puzzle screen." |
| 259 | (let* ((mean (if (zerop mpuz-nb-completed-games) 0 | 328 | (goto-line 7) |
| 260 | (/ (+ mpuz-nb-completed-games (* 200 mpuz-nb-cumulated-errors)) | 329 | (mpuz-paint-number (prin1-to-string mpuz-nb-completed-games)) |
| 261 | (* 2 mpuz-nb-completed-games)))) | 330 | (mpuz-paint-number |
| 262 | (frac-part (% mean 100))) | 331 | (format "%.2f" |
| 263 | (let ((buffer-read-only nil)) | 332 | (if (zerop mpuz-nb-completed-games) |
| 264 | (goto-line 7) | 333 | 0 |
| 265 | (move-to-column 51) | 334 | (/ (+ 0.0 mpuz-nb-cumulated-errors) |
| 266 | (mpuz-delete-line) | 335 | mpuz-nb-completed-games))) |
| 267 | (insert (prin1-to-string mpuz-nb-completed-games)) | 336 | 3 2)) |
| 268 | (goto-line 9) | ||
| 269 | (move-to-column 50) | ||
| 270 | (mpuz-delete-line) | ||
| 271 | (insert (format "%d.%d%d" (/ mean 100) (/ frac-part 10) (% frac-part 10)))))) | ||
| 272 | 337 | ||
| 273 | (defun mpuz-paint-board () | 338 | (defun mpuz-paint-board () |
| 274 | "Paint board situation on the puzzle screen." | 339 | "Paint board situation on the puzzle screen." |
| 275 | (mpuz-switch-to-window) | 340 | (mpuz-switch-to-window) |
| 276 | (let ((letter -1)) | 341 | (mapc 'mpuz-paint-digit [0 1 2 3 4 5 6 7 8 9]) |
| 277 | (while (> 10 (setq letter (1+ letter))) | ||
| 278 | (mpuz-paint-digit (mpuz-to-digit letter)))) | ||
| 279 | (goto-char (point-min))) | 342 | (goto-char (point-min))) |
| 280 | 343 | ||
| 281 | (defun mpuz-paint-digit (digit) | 344 | (defun mpuz-paint-digit (digit) |
| 282 | "Paint all occurrences of DIGIT on the puzzle board." | 345 | "Paint all occurrences of DIGIT on the puzzle board." |
| 283 | ;; (mpuz-switch-to-window) | ||
| 284 | (let ((char (if (mpuz-digit-solved-p digit) | 346 | (let ((char (if (mpuz-digit-solved-p digit) |
| 285 | (+ digit ?0) | 347 | (+ digit ?0) |
| 286 | (+ (mpuz-to-letter digit) ?A))) | 348 | (+ (mpuz-to-letter digit) ?A))) |
| 287 | (square-l (aref mpuz-board digit))) | 349 | (face `(face |
| 288 | (let ((buffer-read-only nil)) | 350 | ,(cond ((aref mpuz-trivial-digits digit) mpuz-trivial-face) |
| 289 | (while square-l | 351 | ((aref mpuz-found-digits digit) mpuz-solved-face) |
| 290 | (goto-line (car (car square-l))) ; line before column ! | 352 | (mpuz-unsolved-face)))) |
| 291 | (move-to-column (cdr (car square-l))) | 353 | buffer-read-only) |
| 292 | (insert char) | 354 | (mapc (lambda (square) |
| 293 | (delete-char 1) | 355 | (goto-line (car square)) ; line before column! |
| 294 | (backward-char 1) | 356 | (move-to-column (cdr square)) |
| 295 | (setq square-l (cdr square-l)))))) | 357 | (insert char) |
| 296 | 358 | (set-text-properties (1- (point)) (point) face) | |
| 297 | (defun mpuz-delete-line () | 359 | (delete-char 1)) |
| 298 | "Clear from point to next newline." ; & put nothing in the kill ring | 360 | (aref mpuz-board digit)))) |
| 299 | (while (not (= ?\n (char-after (point)))) | ||
| 300 | (delete-char 1))) | ||
| 301 | 361 | ||
| 302 | (defun mpuz-get-buffer () | 362 | (defun mpuz-get-buffer () |
| 303 | "Get the puzzle buffer if it exists." | 363 | "Get the puzzle buffer if it exists." |
| @@ -305,42 +365,28 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 305 | 365 | ||
| 306 | (defun mpuz-switch-to-window () | 366 | (defun mpuz-switch-to-window () |
| 307 | "Find or create the Mult-Puzzle buffer, and display it." | 367 | "Find or create the Mult-Puzzle buffer, and display it." |
| 308 | (let ((buff (mpuz-get-buffer))) | 368 | (let ((buf (mpuz-get-buffer))) |
| 309 | (or buff (setq buff (mpuz-create-buffer))) | 369 | (or buf (setq buf (mpuz-create-buffer))) |
| 310 | (switch-to-buffer buff) | 370 | (switch-to-buffer buf) |
| 311 | (or buffer-read-only (toggle-read-only)) | 371 | (or buffer-read-only (toggle-read-only)) |
| 312 | (mpuz-mode))) | 372 | (mpuz-mode))) |
| 313 | 373 | ||
| 314 | 374 | ||
| 315 | ;; Game control | 375 | ;; Game control |
| 316 | ;;------------- | 376 | ;;------------- |
| 317 | (defun mpuz-abort-game () | ||
| 318 | "Abort any puzzle in progress." | ||
| 319 | (message "Mult Puzzle aborted.") | ||
| 320 | (setq mpuz-in-progress nil | ||
| 321 | mpuz-nb-errors 0) | ||
| 322 | (fillarray mpuz-board nil) | ||
| 323 | (let ((buff (mpuz-get-buffer))) | ||
| 324 | (if buff (kill-buffer buff)))) | ||
| 325 | |||
| 326 | (defun mpuz-start-new-game () | 377 | (defun mpuz-start-new-game () |
| 327 | "Start a new puzzle." | 378 | "Start a new puzzle." |
| 328 | (message "Here we go...") | 379 | (message "Here we go...") |
| 329 | (setq mpuz-nb-errors 0 | 380 | (setq mpuz-nb-errors 0 |
| 330 | mpuz-in-progress t) | 381 | mpuz-in-progress t) |
| 331 | (fillarray mpuz-found-digits nil) ; initialize mpuz-found-digits | 382 | (fillarray mpuz-found-digits nil) ; initialize mpuz-found-digits |
| 383 | (fillarray mpuz-trivial-digits nil) | ||
| 332 | (mpuz-random-puzzle) | 384 | (mpuz-random-puzzle) |
| 333 | (mpuz-switch-to-window) | 385 | (mpuz-switch-to-window) |
| 334 | (mpuz-paint-board) | 386 | (mpuz-paint-board) |
| 335 | (mpuz-paint-errors) | 387 | (mpuz-paint-errors) |
| 336 | (mpuz-ask-for-try)) | 388 | (mpuz-ask-for-try)) |
| 337 | 389 | ||
| 338 | (defun mpuz-offer-new-game () | ||
| 339 | "Ask if user wants to start a new puzzle." | ||
| 340 | (if (y-or-n-p "Start a new game ") | ||
| 341 | (mpuz-start-new-game) | ||
| 342 | (message "OK. I won't."))) | ||
| 343 | |||
| 344 | ;;;###autoload | 390 | ;;;###autoload |
| 345 | (defun mpuz () | 391 | (defun mpuz () |
| 346 | "Multiplication puzzle with GNU Emacs." | 392 | "Multiplication puzzle with GNU Emacs." |
| @@ -349,18 +395,29 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 349 | (mpuz-switch-to-window) | 395 | (mpuz-switch-to-window) |
| 350 | (if mpuz-in-progress | 396 | (if mpuz-in-progress |
| 351 | (mpuz-offer-abort) | 397 | (mpuz-offer-abort) |
| 352 | (mpuz-start-new-game))) | 398 | (mpuz-start-new-game))) |
| 353 | 399 | ||
| 354 | (defun mpuz-offer-abort () | 400 | (defun mpuz-offer-abort () |
| 355 | "Ask if user wants to abort current puzzle." | 401 | "Ask if user wants to abort current puzzle." |
| 356 | (interactive) | 402 | (interactive) |
| 357 | (if (y-or-n-p "Abort game ") | 403 | (if (y-or-n-p "Abort game ") |
| 358 | (mpuz-abort-game) | 404 | (let ((buf (mpuz-get-buffer))) |
| 359 | (mpuz-ask-for-try))) | 405 | (message "Mult Puzzle aborted.") |
| 406 | (setq mpuz-in-progress nil | ||
| 407 | mpuz-nb-errors 0) | ||
| 408 | (fillarray mpuz-board nil) | ||
| 409 | (if buf (kill-buffer buf))) | ||
| 410 | (mpuz-ask-for-try))) | ||
| 360 | 411 | ||
| 361 | (defun mpuz-ask-for-try () | 412 | (defun mpuz-ask-for-try () |
| 362 | "Ask for user proposal in puzzle." | 413 | "Ask for user proposal in puzzle." |
| 363 | (message "Your try ?")) | 414 | (message "Your try?")) |
| 415 | |||
| 416 | (defun mpuz-ding (error) | ||
| 417 | "Dings, unless global variable `mpuz-silent' forbids it." | ||
| 418 | (cond ((eq mpuz-silent t)) | ||
| 419 | ((not mpuz-silent) (ding t)) | ||
| 420 | (error (ding t)))) | ||
| 364 | 421 | ||
| 365 | (defun mpuz-try-letter () | 422 | (defun mpuz-try-letter () |
| 366 | "Propose a digit for a letter in puzzle." | 423 | "Propose a digit for a letter in puzzle." |
| @@ -370,9 +427,11 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 370 | (setq letter-char (upcase last-command-char) | 427 | (setq letter-char (upcase last-command-char) |
| 371 | digit (mpuz-to-digit (- letter-char ?A))) | 428 | digit (mpuz-to-digit (- letter-char ?A))) |
| 372 | (cond ((mpuz-digit-solved-p digit) | 429 | (cond ((mpuz-digit-solved-p digit) |
| 373 | (message "%c already solved." letter-char)) | 430 | (message "%c already solved." letter-char) |
| 431 | (mpuz-ding t)) | ||
| 374 | ((null (aref mpuz-board digit)) | 432 | ((null (aref mpuz-board digit)) |
| 375 | (message "%c does not appear." letter-char)) | 433 | (message "%c does not appear." letter-char) |
| 434 | (mpuz-ding t)) | ||
| 376 | ((progn (message "%c = " letter-char) | 435 | ((progn (message "%c = " letter-char) |
| 377 | ;; <char> has been entered. | 436 | ;; <char> has been entered. |
| 378 | ;; Print "<char> =" and | 437 | ;; Print "<char> =" and |
| @@ -380,78 +439,80 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." | |||
| 380 | (setq digit-char (read-char)) | 439 | (setq digit-char (read-char)) |
| 381 | (if (eq digit-char ?=) | 440 | (if (eq digit-char ?=) |
| 382 | (setq digit-char (read-char))) | 441 | (setq digit-char (read-char))) |
| 383 | (message "%c = %c" letter-char digit-char) | ||
| 384 | (or (> digit-char ?9) (< digit-char ?0))) ; bad input | 442 | (or (> digit-char ?9) (< digit-char ?0))) ; bad input |
| 385 | (ding t)) | 443 | (message "%c = %c" letter-char digit-char) |
| 444 | (mpuz-ding t)) | ||
| 386 | (t | 445 | (t |
| 387 | (mpuz-try-proposal letter-char digit-char)))) | 446 | (mpuz-try-proposal letter-char digit-char)))) |
| 388 | (mpuz-offer-new-game))) | 447 | (if (y-or-n-p "Start a new game ") |
| 448 | (mpuz-start-new-game) | ||
| 449 | (message "OK. I won't.")))) | ||
| 389 | 450 | ||
| 390 | (defun mpuz-try-proposal (letter-char digit-char) | 451 | (defun mpuz-try-proposal (letter-char digit-char) |
| 391 | "Propose LETTER-CHAR as code for DIGIT-CHAR." | 452 | "Propose LETTER-CHAR as code for DIGIT-CHAR." |
| 392 | (let* ((letter (- letter-char ?A)) | 453 | (let* ((letter (- letter-char ?A)) |
| 393 | (digit (- digit-char ?0)) | 454 | (digit (- digit-char ?0)) |
| 394 | (correct-digit (mpuz-to-digit letter))) | 455 | (correct-digit (mpuz-to-digit letter)) |
| 456 | (game mpuz-nb-completed-games)) | ||
| 395 | (cond ((mpuz-digit-solved-p correct-digit) | 457 | (cond ((mpuz-digit-solved-p correct-digit) |
| 396 | (message "%c has already been found." (+ correct-digit ?0))) | 458 | (message "%c has already been found." (+ correct-digit ?0))) |
| 397 | ((mpuz-digit-solved-p digit) | 459 | ((mpuz-digit-solved-p digit) |
| 398 | (message "%c has already been placed." digit-char)) | 460 | (message "%c has already been placed." digit-char)) |
| 399 | ((= digit correct-digit) | 461 | ((= digit correct-digit) |
| 400 | (message "%c = %c correct !" letter-char digit-char) | 462 | (message "%c = %c correct!" letter-char digit-char) |
| 401 | (mpuz-ding) | 463 | (mpuz-ding nil) |
| 402 | (mpuz-correct-guess digit)) | 464 | (aset mpuz-found-digits digit t) ; Mark digit as solved |
| 465 | (and (mpuz-check-all-solved) | ||
| 466 | (mpuz-close-game))) | ||
| 403 | (t ;;; incorrect guess | 467 | (t ;;; incorrect guess |
| 404 | (message "%c = %c incorrect !" letter-char digit-char) | 468 | (message "%c = %c incorrect!" letter-char digit-char) |
| 405 | (mpuz-ding) | 469 | (mpuz-ding t) |
| 406 | (setq mpuz-nb-errors (1+ mpuz-nb-errors)) | 470 | (setq mpuz-nb-errors (1+ mpuz-nb-errors)) |
| 407 | (mpuz-paint-errors))))) | 471 | (mpuz-paint-errors))))) |
| 408 | 472 | ||
| 409 | (defun mpuz-correct-guess (digit) | ||
| 410 | "Handle correct guessing of DIGIT." | ||
| 411 | (aset mpuz-found-digits digit t) ; Mark digit as solved | ||
| 412 | (mpuz-paint-digit digit) ; Repaint it (now as a digit) | ||
| 413 | (if (mpuz-check-all-solved) | ||
| 414 | (mpuz-close-game))) | ||
| 415 | |||
| 416 | (defun mpuz-close-game () | 473 | (defun mpuz-close-game () |
| 417 | "Housecleaning when puzzle has been solved." | 474 | "Housecleaning when puzzle has been solved." |
| 418 | (setq mpuz-in-progress nil | 475 | (setq mpuz-in-progress nil |
| 419 | mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors) | 476 | mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors) |
| 420 | mpuz-nb-completed-games (1+ mpuz-nb-completed-games)) | 477 | mpuz-nb-completed-games (1+ mpuz-nb-completed-games)) |
| 421 | (mpuz-paint-statistics) | 478 | (mpuz-paint-statistics) |
| 422 | (let ((message (mpuz-congratulate))) | 479 | (let ((message (format "Puzzle solved with %d error%s. That's %s" |
| 480 | mpuz-nb-errors | ||
| 481 | (if (= mpuz-nb-errors 1) "" "s") | ||
| 482 | (cond ((= mpuz-nb-errors 0) "perfect!") | ||
| 483 | ((= mpuz-nb-errors 1) "very good!") | ||
| 484 | ((= mpuz-nb-errors 2) "good.") | ||
| 485 | ((= mpuz-nb-errors 3) "not bad.") | ||
| 486 | ((= mpuz-nb-errors 4) "not too bad...") | ||
| 487 | ((< mpuz-nb-errors 10) "bad!") | ||
| 488 | ((< mpuz-nb-errors 15) "awful.") | ||
| 489 | (t "not serious."))))) | ||
| 423 | (message message) | 490 | (message message) |
| 424 | (sit-for 4) | 491 | (sit-for 4) |
| 425 | (if (y-or-n-p (concat message " Start a new game ")) | 492 | (if (y-or-n-p (concat message " Start a new game ")) |
| 426 | (mpuz-start-new-game) | 493 | (mpuz-start-new-game) |
| 427 | (message "Good Bye !")))) | 494 | (message "Good Bye!")))) |
| 428 | 495 | ||
| 429 | (defun mpuz-congratulate () | 496 | (defun mpuz-solve (&optional row col) |
| 430 | "Build a congratulation message when puzzle is solved." | 497 | "Find solution for autosolving." |
| 431 | (format "Puzzle solved with %d error%s. %s" | 498 | (mapc (lambda (digit) |
| 432 | mpuz-nb-errors | 499 | (or (mpuz-digit-solved-p digit) |
| 433 | (if (= mpuz-nb-errors 1) "" "s") | 500 | (if row |
| 434 | (cond ((= mpuz-nb-errors 0) "That's perfect !") | 501 | (not (if col |
| 435 | ((= mpuz-nb-errors 1) "That's very good !") | 502 | (member (cons row col) (aref mpuz-board digit)) |
| 436 | ((= mpuz-nb-errors 2) "That's good.") | 503 | (assq row (aref mpuz-board digit))))) |
| 437 | ((= mpuz-nb-errors 3) "That's not bad.") | 504 | (aset mpuz-trivial-digits digit t))) |
| 438 | ((= mpuz-nb-errors 4) "That's not too bad...") | 505 | [0 1 2 3 4 5 6 7 8 9]) |
| 439 | ((and (>= mpuz-nb-errors 5) | 506 | t) |
| 440 | (< mpuz-nb-errors 10)) "That's bad !") | 507 | |
| 441 | ((and (>= mpuz-nb-errors 10) | 508 | (defun mpuz-show-solution (row) |
| 442 | (< mpuz-nb-errors 15)) "That's awful.") | ||
| 443 | ((>= mpuz-nb-errors 15) "That's not serious.")))) | ||
| 444 | |||
| 445 | (defun mpuz-show-solution () | ||
| 446 | "Display solution for debugging purposes." | 509 | "Display solution for debugging purposes." |
| 447 | (interactive) | 510 | (interactive "P") |
| 448 | (mpuz-switch-to-window) | 511 | (mpuz-switch-to-window) |
| 449 | (let (digit list) | 512 | (mpuz-solve (if row (* 2 (prefix-numeric-value row)))) |
| 450 | (setq digit -1) | 513 | (mpuz-paint-board) |
| 451 | (while (> 10 (setq digit (1+ digit))) | 514 | (if (mpuz-check-all-solved) |
| 452 | (or (mpuz-digit-solved-p digit) | 515 | (mpuz-close-game))) |
| 453 | (setq list (cons digit list)))) | ||
| 454 | (mapcar 'mpuz-correct-guess list))) | ||
| 455 | 516 | ||
| 456 | (provide 'mpuz) | 517 | (provide 'mpuz) |
| 457 | 518 | ||