aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2002-03-08 08:11:21 +0000
committerEli Zaretskii2002-03-08 08:11:21 +0000
commitd93196b3280ec201d8b61ec926af15ffc3254944 (patch)
tree25cd77089253b70fb2b02b0d2e2916525857e410
parent6d63dcf565fe44b713223e09ea7ed093968f1403 (diff)
downloademacs-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.el449
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
90multiplication displayed inside the `*Mult Puzzle*' buffer. 124multiplication displayed inside the `*Mult Puzzle*' buffer.
91 125
92You may enter a guess for a letter's value by typing first the letter, 126You may enter a guess for a letter's value by typing first the letter,
93then the digit. Thus, to guess that A=3, type A 3. 127then the digit. Thus, to guess that A=3, type `A 3'.
94 128
95To leave the game to do other editing work, just switch buffers. 129To leave the game to do other editing work, just switch buffers.
96Then you may resume the game with M-x mpuz. 130Then you may resume the game with M-x mpuz.
97You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." 131You 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