1 ;;; mpuz.el --- multiplication puzzle for GNU Emacs
3 ;;; by Philippe Schnoebelen <phs@lifia.imag.fr>
4 ;;; Last modified on 11 Nov 1990
5 ;;; Copyright (C) 1990 Free Software Foundation, Inc.
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY. No author or distributor
11 ;; accepts responsibility to anyone for the consequences of using it
12 ;; or for whether it serves any particular purpose or works at all,
13 ;; unless he says so in writing. Refer to the GNU Emacs General Public
14 ;; License for full details.
16 ;; Everyone is granted permission to copy, modify and redistribute
17 ;; GNU Emacs, but only under the conditions described in the
18 ;; GNU Emacs General Public License. A copy of this license is
19 ;; supposed to have been given to you along with GNU Emacs so you
20 ;; can know your rights and responsibilities. It should be in a
21 ;; file named COPYING. Among other things, the copyright notice
22 ;; and this notice must be preserved on all copies.
24 (random t
) ; randomize
26 (defun mpuz-random (n)
27 "Return a random integer between 0 and N - 1 inclusive."
28 (setq n
(%
(random) n
))
31 (defvar mpuz-silent nil
32 "*Set this to T if you don't want dings on inputs.")
35 "Dings, unless global variable `mpuz-silent' forbids it."
36 (or mpuz-silent
(ding t
)))
39 ;; Mpuz mode and keymaps
40 ;;----------------------
41 (defvar mpuz-mode-hook nil
)
43 (defvar mpuz-mode-map nil
44 "Local keymap to use in Mult Puzzle.")
46 (defvar mpuz-read-map nil
47 "Local keymap to use (sometimes) in Mult Puzzle.")
50 (setq mpuz-mode-map
(make-sparse-keymap))
51 (define-key mpuz-mode-map
"a" 'mpuz-try-letter
)
52 (define-key mpuz-mode-map
"b" 'mpuz-try-letter
)
53 (define-key mpuz-mode-map
"c" 'mpuz-try-letter
)
54 (define-key mpuz-mode-map
"d" 'mpuz-try-letter
)
55 (define-key mpuz-mode-map
"e" 'mpuz-try-letter
)
56 (define-key mpuz-mode-map
"f" 'mpuz-try-letter
)
57 (define-key mpuz-mode-map
"g" 'mpuz-try-letter
)
58 (define-key mpuz-mode-map
"h" 'mpuz-try-letter
)
59 (define-key mpuz-mode-map
"i" 'mpuz-try-letter
)
60 (define-key mpuz-mode-map
"j" 'mpuz-try-letter
)
61 (define-key mpuz-mode-map
"A" 'mpuz-try-letter
)
62 (define-key mpuz-mode-map
"B" 'mpuz-try-letter
)
63 (define-key mpuz-mode-map
"C" 'mpuz-try-letter
)
64 (define-key mpuz-mode-map
"D" 'mpuz-try-letter
)
65 (define-key mpuz-mode-map
"E" 'mpuz-try-letter
)
66 (define-key mpuz-mode-map
"F" 'mpuz-try-letter
)
67 (define-key mpuz-mode-map
"G" 'mpuz-try-letter
)
68 (define-key mpuz-mode-map
"H" 'mpuz-try-letter
)
69 (define-key mpuz-mode-map
"I" 'mpuz-try-letter
)
70 (define-key mpuz-mode-map
"J" 'mpuz-try-letter
)
71 (define-key mpuz-mode-map
"\C-g" 'mpuz-offer-abort
)
72 (define-key mpuz-mode-map
"?" 'describe-mode
))
75 (setq mpuz-read-map
(make-keymap))
76 (fillarray mpuz-read-map
'exit-minibuffer
))
79 "Multiplication puzzle with GNU Emacs.
81 You have to guess which letters stand for which digits in the
82 multiplication displayed inside the *Mult Puzzle* buffer.
84 You may enter a proposal (e.g. A=3) by hitting first the letter A,
85 then the digit 3, on your keyboard.
87 At any time you may leave the game to do other editing work. :-)
88 Then you may resume the game with M-x mult-puzzle.
89 You may abort a game by hitting \\[keyboard-quit]."
91 (setq major-mode
'mpuz-mode
92 mode-name
"Mult Puzzle")
93 (use-local-map mpuz-mode-map
)
94 (run-hooks 'mpuz-mode-hook
))
97 ;; Some variables for statistics
98 ;;------------------------------
99 (defvar mpuz-nb-errors
0
100 "Number of errors made in current game.")
102 (defvar mpuz-nb-completed-games
0
103 "Number of games completed.")
105 (defvar mpuz-nb-cumulated-errors
0
106 "Number of errors made in previous games.")
109 ;; Some variables for game tracking
110 ;;---------------------------------
111 (defvar mpuz-in-progress nil
112 "True if a game is currently in progress.")
114 (defvar mpuz-found-digits
(make-vector 10 nil
)
115 "A vector recording which digits have been decrypted.")
117 (defmacro mpuz-digit-solved-p
(digit)
118 (list 'aref
'mpuz-found-digits digit
))
121 ;; A puzzle uses a permutation of [0..9] into itself.
122 ;; We use both the permutation and its inverse.
123 ;;---------------------------------------------------
124 (defvar mpuz-digit-to-letter
(make-vector 10 0)
125 "A permutation from [0..9] to [0..9].")
127 (defvar mpuz-letter-to-digit
(make-vector 10 0)
128 "The inverse of mpuz-digit-to-letter.")
130 (defmacro mpuz-to-digit
(letter)
131 (list 'aref
'mpuz-letter-to-digit letter
))
133 (defmacro mpuz-to-letter
(digit)
134 (list 'aref
'mpuz-digit-to-letter digit
))
136 (defun mpuz-build-random-perm ()
137 "Initialize puzzle coding with a random permutation."
138 (let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq
142 (setq elem
(nth (mpuz-random index
) letters
)
143 letters
(delq elem letters
)
145 (aset mpuz-digit-to-letter index elem
)
146 (aset mpuz-letter-to-digit elem index
))))
149 ;; A puzzle also uses a board displaying a mulplication.
150 ;; Every digit appears in the board, crypted or not.
151 ;;------------------------------------------------------
152 (defvar mpuz-board
(make-vector 10 nil
)
153 "The board associates ot any digit the list of squares where it appears.")
155 (defun mpuz-put-digit-on-board (number square
)
156 "Put (last digit of) NUMBER on SQUARE of the puzzle board."
157 ;; i.e. push SQUARE on NUMBER square-list
158 (setq number
(% number
10))
159 (aset mpuz-board number
(cons square
(aref mpuz-board number
))))
161 (defun mpuz-check-all-solved ()
162 "Check whether all digits have been solved. Return t if yes."
165 (while (> 10 (setq digit
(1+ digit
)))
166 (if (and (not (mpuz-digit-solved-p digit
)) ; unsolved
167 (aref mpuz-board digit
)) ; and appearing in the puzzle !
168 (throw 'found nil
))))
172 ;; To build a puzzle, we take two random numbers and multiply them.
173 ;; We also take a random permutation for encryption.
174 ;; The random numbers are only use to see which digit appears in which square
175 ;; of the board. Everything is stored in individual squares.
176 ;;---------------------------------------------------------------------------
177 (defun mpuz-random-puzzle ()
178 "Draw random values to be multiplied in a puzzle."
179 (mpuz-build-random-perm)
180 (fillarray mpuz-board nil
) ; erase the board
182 ;; A,B,C,D & E, are the five rows of our multiplication.
183 ;; Choose random values, discarding uninteresting cases.
185 (setq A
(mpuz-random 1000)
190 (or (< C
1000) (< D
1000)))) ; forbid leading zeros in C or D
191 ;; Individual digits are now put on their respectives squares.
192 ;; [NB: A square is a pair <row,column> of the screen.]
193 (mpuz-put-digit-on-board A
'(2 .
9))
194 (mpuz-put-digit-on-board (/ A
10) '(2 .
7))
195 (mpuz-put-digit-on-board (/ A
100) '(2 .
5))
196 (mpuz-put-digit-on-board B
'(4 .
9))
197 (mpuz-put-digit-on-board (/ B
10) '(4 .
7))
198 (mpuz-put-digit-on-board C
'(6 .
9))
199 (mpuz-put-digit-on-board (/ C
10) '(6 .
7))
200 (mpuz-put-digit-on-board (/ C
100) '(6 .
5))
201 (mpuz-put-digit-on-board (/ C
1000) '(6 .
3))
202 (mpuz-put-digit-on-board D
'(8 .
7))
203 (mpuz-put-digit-on-board (/ D
10) '(8 .
5))
204 (mpuz-put-digit-on-board (/ D
100) '(8 .
3))
205 (mpuz-put-digit-on-board (/ D
1000) '(8 .
1))
206 (mpuz-put-digit-on-board E
'(10 .
9))
207 (mpuz-put-digit-on-board (/ E
10) '(10 .
7))
208 (mpuz-put-digit-on-board (/ E
100) '(10 .
5))
209 (mpuz-put-digit-on-board (/ E
1000) '(10 .
3))
210 (mpuz-put-digit-on-board (/ E
10000) '(10 .
1))))
214 (defconst mpuz-framework
217 Number of errors (this game): 0
221 Number of completed games: 0
223 --------- Average number of errors: 0.00
225 "The general picture of the puzzle screen, as a string.")
227 (defun mpuz-create-buffer ()
228 "Create (or recreate) the puzzle buffer. Return it."
229 (let ((buff (get-buffer-create "*Mult Puzzle*")))
232 (let ((buffer-read-only nil
))
234 (insert mpuz-framework
)
237 (mpuz-paint-statistics)))
240 (defun mpuz-paint-errors ()
241 "Paint error count on the puzzle screen."
242 (mpuz-switch-to-window)
243 (let ((buffer-read-only nil
))
247 (insert (prin1-to-string mpuz-nb-errors
))))
249 (defun mpuz-paint-statistics ()
250 "Paint statistics about previous games on the puzzle screen."
251 (let* ((mean (if (zerop mpuz-nb-completed-games
) 0
252 (/ (+ mpuz-nb-completed-games
(* 200 mpuz-nb-cumulated-errors
))
253 (* 2 mpuz-nb-completed-games
))))
254 (frac-part (% mean
100)))
255 (let ((buffer-read-only nil
))
259 (insert (prin1-to-string mpuz-nb-completed-games
))
263 (insert (format "%d.%d%d" (/ mean
100) (/ frac-part
10) (% frac-part
10))))))
265 (defun mpuz-paint-board ()
266 "Paint board situation on the puzzle screen."
267 (mpuz-switch-to-window)
269 (while (> 10 (setq letter
(1+ letter
)))
270 (mpuz-paint-digit (mpuz-to-digit letter
))))
271 (goto-char (point-min)))
273 (defun mpuz-paint-digit (digit)
274 "Paint all occurrences of DIGIT on the puzzle board."
275 ;; (mpuz-switch-to-window)
276 (let ((char (if (mpuz-digit-solved-p digit
)
278 (+ (mpuz-to-letter digit
) ?A
)))
279 (square-l (aref mpuz-board digit
)))
280 (let ((buffer-read-only nil
))
282 (goto-line (car (car square-l
))) ; line before column !
283 (move-to-column (cdr (car square-l
)))
287 (setq square-l
(cdr square-l
))))))
289 (defun mpuz-delete-line ()
290 "Clear from point to next newline." ; & put nothing in the kill ring
291 (while (not (= ?
\n (char-after (point))))
294 (defun mpuz-get-buffer ()
295 "Get the puzzle buffer if it exists."
296 (get-buffer "*Mult Puzzle*"))
298 (defun mpuz-switch-to-window ()
299 "Find or create the Mult-Puzzle buffer, and display it."
300 (let ((buff (mpuz-get-buffer)))
301 (or buff
(setq buff
(mpuz-create-buffer)))
302 (switch-to-buffer buff
)
303 (or buffer-read-only
(toggle-read-only))
309 (defun mpuz-abort-game ()
310 "Abort any puzzle in progess."
311 (message "Mult Puzzle aborted.")
312 (setq mpuz-in-progress nil
314 (fillarray mpuz-board nil
)
315 (let ((buff (mpuz-get-buffer)))
316 (if buff
(kill-buffer buff
))))
318 (defun mpuz-start-new-game ()
319 "Start a new puzzle."
320 (message "Here we go...")
321 (setq mpuz-nb-errors
0
323 (fillarray mpuz-found-digits nil
) ; initialize mpuz-found-digits
325 (mpuz-switch-to-window)
330 (defun mpuz-offer-new-game ()
331 "Ask if user wants to start a new puzzle."
332 (if (y-or-n-p "Start a new game ")
333 (mpuz-start-new-game)
334 (message "OK. I won't.")))
336 (defun mult-puzzle ()
337 "Multiplication puzzle with GNU Emacs."
340 (mpuz-switch-to-window)
343 (mpuz-start-new-game)))
345 (defun mpuz-offer-abort ()
346 "Ask if user wants to abort current puzzle."
348 (if (y-or-n-p "Abort game ")
352 (defun mpuz-ask-for-try ()
353 "Ask for user proposal in puzzle."
354 (message "Your try ?"))
356 (defun mpuz-try-letter ()
357 "Propose a digit for a letter in puzzle."
360 (let (letter-char digit digit-char message
)
361 (setq letter-char
(if (or (< last-command-char ?a
)
362 (> last-command-char ?z
))
364 (- last-command-char
32))
365 digit
(mpuz-to-digit (- letter-char ?A
)))
366 (cond ((mpuz-digit-solved-p digit
)
367 (message "%c already solved." letter-char
))
368 ((null (aref mpuz-board digit
))
369 (message "%c does not appear." letter-char
))
370 ((progn (setq message
(format "%c = " letter-char
))
371 ;; <char> has been entered.
372 ;; Print "<char> =" and
373 ;; read <num> or = <num>
374 (read-from-minibuffer message nil mpuz-read-map
)
375 (if (= last-input-char ?\
=)
376 (read-from-minibuffer message nil mpuz-read-map
))
377 (setq digit-char last-input-char
)
378 (message "%c = %c" letter-char digit-char
)
379 (or (> digit-char ?
9) (< digit-char ?
0))) ; bad input
382 (mpuz-try-proposal letter-char digit-char
))))
383 (mpuz-offer-new-game)))
385 (defun mpuz-try-proposal (letter-char digit-char
)
386 "Propose LETTER-CHAR as code for DIGIT-CHAR."
387 (let* ((letter (- letter-char ?A
))
388 (digit (- digit-char ?
0))
389 (correct-digit (mpuz-to-digit letter
)))
390 (cond ((mpuz-digit-solved-p correct-digit
)
391 (message "%c has already been found."))
392 ((= digit correct-digit
)
393 (message "%c = %c correct !" letter-char digit-char
)
395 (mpuz-correct-guess digit
))
396 (t ;;; incorrect guess
397 (message "%c = %c incorrect !" letter-char digit-char
)
399 (setq mpuz-nb-errors
(1+ mpuz-nb-errors
))
400 (mpuz-paint-errors)))))
402 (defun mpuz-correct-guess (digit)
403 "Handle correct guessing of DIGIT."
404 (aset mpuz-found-digits digit t
) ; Mark digit as solved
405 (mpuz-paint-digit digit
) ; Repaint it (now as a digit)
406 (if (mpuz-check-all-solved)
409 (defun mpuz-close-game ()
410 "Housecleaning when puzzle has been solved."
411 (setq mpuz-in-progress nil
412 mpuz-nb-cumulated-errors
(+ mpuz-nb-cumulated-errors mpuz-nb-errors
)
413 mpuz-nb-completed-games
(1+ mpuz-nb-completed-games
))
414 (mpuz-paint-statistics)
415 (let ((message (mpuz-congratulate)))
418 (if (y-or-n-p (concat message
" Start a new game "))
419 (mpuz-start-new-game)
420 (message "Good Bye !"))))
422 (defun mpuz-congratulate ()
423 "Build a congratulation message when puzzle is solved."
424 (format "Puzzle solved with %d errors. %s"
426 (cond ((= mpuz-nb-errors
0) "That's perfect !")
427 ((= mpuz-nb-errors
1) "That's very good !")
428 ((= mpuz-nb-errors
2) "That's good.")
429 ((= mpuz-nb-errors
3) "That's not bad.")
430 ((= mpuz-nb-errors
4) "That's not too bad...")
431 ((and (>= mpuz-nb-errors
5)
432 (< mpuz-nb-errors
10)) "That's bad !")
433 ((and (>= mpuz-nb-errors
10)
434 (< mpuz-nb-errors
15)) "That's awful.")
435 ((>= mpuz-nb-errors
15) "That's not serious."))))
437 (defun mpuz-show-solution ()
438 "Display solution for debugging purposes."
440 (mpuz-switch-to-window)
443 (while (> 10 (setq digit
(1+ digit
)))
444 (or (mpuz-digit-solved-p digit
)
445 (setq list
(cons digit list
))))
446 (mapcar 'mpuz-correct-guess list
)))
448 ;;; mpuz.el ends here