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