1 ;;; mpuz.el --- multiplication puzzle for GNU Emacs
3 ;;; Copyright (C) 1990 Free Software Foundation, Inc.
5 ;; Author: Philippe Schnoebelen <phs@lifia.imag.fr>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;; When this package is loaded, `M-x mpuz' generates a random multiplication
27 ;; puzzle. This is a multiplication example in which each digit has been
28 ;; consistently replaced with some letter. Your job is to reconstruct
29 ;; the original digits. Type `?' while the mode is active for detailed help.
33 (random t
) ; randomize
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.")
51 (setq mpuz-mode-map
(make-sparse-keymap))
52 (define-key mpuz-mode-map
"a" 'mpuz-try-letter
)
53 (define-key mpuz-mode-map
"b" 'mpuz-try-letter
)
54 (define-key mpuz-mode-map
"c" 'mpuz-try-letter
)
55 (define-key mpuz-mode-map
"d" 'mpuz-try-letter
)
56 (define-key mpuz-mode-map
"e" 'mpuz-try-letter
)
57 (define-key mpuz-mode-map
"f" 'mpuz-try-letter
)
58 (define-key mpuz-mode-map
"g" 'mpuz-try-letter
)
59 (define-key mpuz-mode-map
"h" 'mpuz-try-letter
)
60 (define-key mpuz-mode-map
"i" 'mpuz-try-letter
)
61 (define-key mpuz-mode-map
"j" 'mpuz-try-letter
)
62 (define-key mpuz-mode-map
"A" 'mpuz-try-letter
)
63 (define-key mpuz-mode-map
"B" 'mpuz-try-letter
)
64 (define-key mpuz-mode-map
"C" 'mpuz-try-letter
)
65 (define-key mpuz-mode-map
"D" 'mpuz-try-letter
)
66 (define-key mpuz-mode-map
"E" 'mpuz-try-letter
)
67 (define-key mpuz-mode-map
"F" 'mpuz-try-letter
)
68 (define-key mpuz-mode-map
"G" 'mpuz-try-letter
)
69 (define-key mpuz-mode-map
"H" 'mpuz-try-letter
)
70 (define-key mpuz-mode-map
"I" 'mpuz-try-letter
)
71 (define-key mpuz-mode-map
"J" 'mpuz-try-letter
)
72 (define-key mpuz-mode-map
"\C-g" 'mpuz-offer-abort
)
73 (define-key mpuz-mode-map
"?" 'describe-mode
))
76 "Multiplication puzzle mode.
78 You have to guess which letters stand for which digits in the
79 multiplication displayed inside the `*Mult Puzzle*' buffer.
81 You may enter a guess for a letter's value by typing first the letter,
82 then the digit. Thus, to guess that A=3, type A 3.
84 To leave the game to do other editing work, just switch buffers.
85 Then you may resume the game with M-x mpuz.
86 You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
88 (setq major-mode
'mpuz-mode
89 mode-name
"Mult Puzzle")
90 (use-local-map mpuz-mode-map
)
91 (run-hooks 'mpuz-mode-hook
))
94 ;; Some variables for statistics
95 ;;------------------------------
96 (defvar mpuz-nb-errors
0
97 "Number of errors made in current game.")
99 (defvar mpuz-nb-completed-games
0
100 "Number of games completed.")
102 (defvar mpuz-nb-cumulated-errors
0
103 "Number of errors made in previous games.")
106 ;; Some variables for game tracking
107 ;;---------------------------------
108 (defvar mpuz-in-progress nil
109 "True if a game is currently in progress.")
111 (defvar mpuz-found-digits
(make-vector 10 nil
)
112 "A vector recording which digits have been decrypted.")
114 (defmacro mpuz-digit-solved-p
(digit)
115 (list 'aref
'mpuz-found-digits digit
))
118 ;; A puzzle uses a permutation of [0..9] into itself.
119 ;; We use both the permutation and its inverse.
120 ;;---------------------------------------------------
121 (defvar mpuz-digit-to-letter
(make-vector 10 0)
122 "A permutation from [0..9] to [0..9].")
124 (defvar mpuz-letter-to-digit
(make-vector 10 0)
125 "The inverse of mpuz-digit-to-letter.")
127 (defmacro mpuz-to-digit
(letter)
128 (list 'aref
'mpuz-letter-to-digit letter
))
130 (defmacro mpuz-to-letter
(digit)
131 (list 'aref
'mpuz-digit-to-letter digit
))
133 (defun mpuz-build-random-perm ()
134 "Initialize puzzle coding with a random permutation."
135 (let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq
139 (setq elem
(nth (random index
) letters
)
140 letters
(delq elem letters
)
142 (aset mpuz-digit-to-letter index elem
)
143 (aset mpuz-letter-to-digit elem index
))))
146 ;; A puzzle also uses a board displaying a multiplication.
147 ;; Every digit appears in the board, crypted or not.
148 ;;------------------------------------------------------
149 (defvar mpuz-board
(make-vector 10 nil
)
150 "The board associates to any digit the list of squares where it appears.")
152 (defun mpuz-put-digit-on-board (number square
)
153 "Put (last digit of) NUMBER on SQUARE of the puzzle board."
154 ;; i.e. push SQUARE on NUMBER square-list
155 (setq number
(% number
10))
156 (aset mpuz-board number
(cons square
(aref mpuz-board number
))))
158 (defun mpuz-check-all-solved ()
159 "Check whether all digits have been solved. Return t if yes."
162 (while (> 10 (setq digit
(1+ digit
)))
163 (if (and (not (mpuz-digit-solved-p digit
)) ; unsolved
164 (aref mpuz-board digit
)) ; and appearing in the puzzle !
165 (throw 'found nil
))))
169 ;; To build a puzzle, we take two random numbers and multiply them.
170 ;; We also take a random permutation for encryption.
171 ;; The random numbers are only use to see which digit appears in which square
172 ;; of the board. Everything is stored in individual squares.
173 ;;---------------------------------------------------------------------------
174 (defun mpuz-random-puzzle ()
175 "Draw random values to be multiplied in a puzzle."
176 (mpuz-build-random-perm)
177 (fillarray mpuz-board nil
) ; erase the board
179 ;; A,B,C,D & E, are the five rows of our multiplication.
180 ;; Choose random values, discarding uninteresting cases.
182 (setq A
(random 1000)
187 (or (< C
1000) (< D
1000)))) ; forbid leading zeros in C or D
188 ;; Individual digits are now put on their respectives squares.
189 ;; [NB: A square is a pair <row,column> of the screen.]
190 (mpuz-put-digit-on-board A
'(2 .
9))
191 (mpuz-put-digit-on-board (/ A
10) '(2 .
7))
192 (mpuz-put-digit-on-board (/ A
100) '(2 .
5))
193 (mpuz-put-digit-on-board B
'(4 .
9))
194 (mpuz-put-digit-on-board (/ B
10) '(4 .
7))
195 (mpuz-put-digit-on-board C
'(6 .
9))
196 (mpuz-put-digit-on-board (/ C
10) '(6 .
7))
197 (mpuz-put-digit-on-board (/ C
100) '(6 .
5))
198 (mpuz-put-digit-on-board (/ C
1000) '(6 .
3))
199 (mpuz-put-digit-on-board D
'(8 .
7))
200 (mpuz-put-digit-on-board (/ D
10) '(8 .
5))
201 (mpuz-put-digit-on-board (/ D
100) '(8 .
3))
202 (mpuz-put-digit-on-board (/ D
1000) '(8 .
1))
203 (mpuz-put-digit-on-board E
'(10 .
9))
204 (mpuz-put-digit-on-board (/ E
10) '(10 .
7))
205 (mpuz-put-digit-on-board (/ E
100) '(10 .
5))
206 (mpuz-put-digit-on-board (/ E
1000) '(10 .
3))
207 (mpuz-put-digit-on-board (/ E
10000) '(10 .
1))))
211 (defconst mpuz-framework
214 Number of errors (this game): 0
218 Number of completed games: 0
220 --------- Average number of errors: 0.00
222 "The general picture of the puzzle screen, as a string.")
224 (defun mpuz-create-buffer ()
225 "Create (or recreate) the puzzle buffer. Return it."
226 (let ((buff (get-buffer-create "*Mult Puzzle*")))
229 (let ((buffer-read-only nil
))
231 (insert mpuz-framework
)
234 (mpuz-paint-statistics)))
237 (defun mpuz-paint-errors ()
238 "Paint error count on the puzzle screen."
239 (mpuz-switch-to-window)
240 (let ((buffer-read-only nil
))
244 (insert (prin1-to-string mpuz-nb-errors
))))
246 (defun mpuz-paint-statistics ()
247 "Paint statistics about previous games on the puzzle screen."
248 (let* ((mean (if (zerop mpuz-nb-completed-games
) 0
249 (/ (+ mpuz-nb-completed-games
(* 200 mpuz-nb-cumulated-errors
))
250 (* 2 mpuz-nb-completed-games
))))
251 (frac-part (% mean
100)))
252 (let ((buffer-read-only nil
))
256 (insert (prin1-to-string mpuz-nb-completed-games
))
260 (insert (format "%d.%d%d" (/ mean
100) (/ frac-part
10) (% frac-part
10))))))
262 (defun mpuz-paint-board ()
263 "Paint board situation on the puzzle screen."
264 (mpuz-switch-to-window)
266 (while (> 10 (setq letter
(1+ letter
)))
267 (mpuz-paint-digit (mpuz-to-digit letter
))))
268 (goto-char (point-min)))
270 (defun mpuz-paint-digit (digit)
271 "Paint all occurrences of DIGIT on the puzzle board."
272 ;; (mpuz-switch-to-window)
273 (let ((char (if (mpuz-digit-solved-p digit
)
275 (+ (mpuz-to-letter digit
) ?A
)))
276 (square-l (aref mpuz-board digit
)))
277 (let ((buffer-read-only nil
))
279 (goto-line (car (car square-l
))) ; line before column !
280 (move-to-column (cdr (car square-l
)))
284 (setq square-l
(cdr square-l
))))))
286 (defun mpuz-delete-line ()
287 "Clear from point to next newline." ; & put nothing in the kill ring
288 (while (not (= ?
\n (char-after (point))))
291 (defun mpuz-get-buffer ()
292 "Get the puzzle buffer if it exists."
293 (get-buffer "*Mult Puzzle*"))
295 (defun mpuz-switch-to-window ()
296 "Find or create the Mult-Puzzle buffer, and display it."
297 (let ((buff (mpuz-get-buffer)))
298 (or buff
(setq buff
(mpuz-create-buffer)))
299 (switch-to-buffer buff
)
300 (or buffer-read-only
(toggle-read-only))
306 (defun mpuz-abort-game ()
307 "Abort any puzzle in progress."
308 (message "Mult Puzzle aborted.")
309 (setq mpuz-in-progress nil
311 (fillarray mpuz-board nil
)
312 (let ((buff (mpuz-get-buffer)))
313 (if buff
(kill-buffer buff
))))
315 (defun mpuz-start-new-game ()
316 "Start a new puzzle."
317 (message "Here we go...")
318 (setq mpuz-nb-errors
0
320 (fillarray mpuz-found-digits nil
) ; initialize mpuz-found-digits
322 (mpuz-switch-to-window)
327 (defun mpuz-offer-new-game ()
328 "Ask if user wants to start a new puzzle."
329 (if (y-or-n-p "Start a new game ")
330 (mpuz-start-new-game)
331 (message "OK. I won't.")))
335 "Multiplication puzzle with GNU Emacs."
338 (mpuz-switch-to-window)
341 (mpuz-start-new-game)))
343 (defun mpuz-offer-abort ()
344 "Ask if user wants to abort current puzzle."
346 (if (y-or-n-p "Abort game ")
350 (defun mpuz-ask-for-try ()
351 "Ask for user proposal in puzzle."
352 (message "Your try ?"))
354 (defun mpuz-try-letter ()
355 "Propose a digit for a letter in puzzle."
358 (let (letter-char digit digit-char message
)
359 (setq letter-char
(upcase last-command-char
)
360 digit
(mpuz-to-digit (- letter-char ?A
)))
361 (cond ((mpuz-digit-solved-p digit
)
362 (message "%c already solved." letter-char
))
363 ((null (aref mpuz-board digit
))
364 (message "%c does not appear." letter-char
))
365 ((progn (message "%c = " letter-char
)
366 ;; <char> has been entered.
367 ;; Print "<char> =" and
368 ;; read <num> or = <num>
369 (setq digit-char
(read-char))
370 (if (eq digit-char ?
=)
371 (setq digit-char
(read-char)))
372 (message "%c = %c" letter-char digit-char
)
373 (or (> digit-char ?
9) (< digit-char ?
0))) ; bad input
376 (mpuz-try-proposal letter-char digit-char
))))
377 (mpuz-offer-new-game)))
379 (defun mpuz-try-proposal (letter-char digit-char
)
380 "Propose LETTER-CHAR as code for DIGIT-CHAR."
381 (let* ((letter (- letter-char ?A
))
382 (digit (- digit-char ?
0))
383 (correct-digit (mpuz-to-digit letter
)))
384 (cond ((mpuz-digit-solved-p correct-digit
)
385 (message "%c has already been found."))
386 ((= digit correct-digit
)
387 (message "%c = %c correct !" letter-char digit-char
)
389 (mpuz-correct-guess digit
))
390 (t ;;; incorrect guess
391 (message "%c = %c incorrect !" letter-char digit-char
)
393 (setq mpuz-nb-errors
(1+ mpuz-nb-errors
))
394 (mpuz-paint-errors)))))
396 (defun mpuz-correct-guess (digit)
397 "Handle correct guessing of DIGIT."
398 (aset mpuz-found-digits digit t
) ; Mark digit as solved
399 (mpuz-paint-digit digit
) ; Repaint it (now as a digit)
400 (if (mpuz-check-all-solved)
403 (defun mpuz-close-game ()
404 "Housecleaning when puzzle has been solved."
405 (setq mpuz-in-progress nil
406 mpuz-nb-cumulated-errors
(+ mpuz-nb-cumulated-errors mpuz-nb-errors
)
407 mpuz-nb-completed-games
(1+ mpuz-nb-completed-games
))
408 (mpuz-paint-statistics)
409 (let ((message (mpuz-congratulate)))
412 (if (y-or-n-p (concat message
" Start a new game "))
413 (mpuz-start-new-game)
414 (message "Good Bye !"))))
416 (defun mpuz-congratulate ()
417 "Build a congratulation message when puzzle is solved."
418 (format "Puzzle solved with %d errors. %s"
420 (cond ((= mpuz-nb-errors
0) "That's perfect !")
421 ((= mpuz-nb-errors
1) "That's very good !")
422 ((= mpuz-nb-errors
2) "That's good.")
423 ((= mpuz-nb-errors
3) "That's not bad.")
424 ((= mpuz-nb-errors
4) "That's not too bad...")
425 ((and (>= mpuz-nb-errors
5)
426 (< mpuz-nb-errors
10)) "That's bad !")
427 ((and (>= mpuz-nb-errors
10)
428 (< mpuz-nb-errors
15)) "That's awful.")
429 ((>= mpuz-nb-errors
15) "That's not serious."))))
431 (defun mpuz-show-solution ()
432 "Display solution for debugging purposes."
434 (mpuz-switch-to-window)
437 (while (> 10 (setq digit
(1+ digit
)))
438 (or (mpuz-digit-solved-p digit
)
439 (setq list
(cons digit list
))))
440 (mapcar 'mpuz-correct-guess list
)))
442 ;;; mpuz.el ends here