[bpt/emacs.git] / lisp / play / mpuz.el

;;; mpuz.el --- multiplication puzzle for GNU Emacs

;; Copyright (C) 1990 Free Software Foundation, Inc.

;; Author: Philippe Schnoebelen <phs@lifia.imag.fr>
;; Keywords: games

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; When this package is loaded, `M-x mpuz' generates a random multiplication
;; puzzle.  This is a multiplication example in which each digit has been
;; consistently replaced with some letter.  Your job is to reconstruct
;; the original digits.  Type `?' while the mode is active for detailed help.

;;; Code:

(random t)				; randomize

(defvar mpuz-silent nil
  "*Set this to T if you don't want dings on inputs.")

(defun mpuz-ding ()
  "Dings, unless global variable `mpuz-silent' forbids it."
  (or mpuz-silent (ding t)))

\f
;; Mpuz mode and keymaps
;;----------------------
(defvar mpuz-mode-hook nil)

(defvar mpuz-mode-map nil
  "Local keymap to use in Mult Puzzle.")

(if mpuz-mode-map nil
    (setq mpuz-mode-map (make-sparse-keymap))
    (define-key mpuz-mode-map "a" 'mpuz-try-letter)
    (define-key mpuz-mode-map "b" 'mpuz-try-letter)
    (define-key mpuz-mode-map "c" 'mpuz-try-letter)
    (define-key mpuz-mode-map "d" 'mpuz-try-letter)
    (define-key mpuz-mode-map "e" 'mpuz-try-letter)
    (define-key mpuz-mode-map "f" 'mpuz-try-letter)
    (define-key mpuz-mode-map "g" 'mpuz-try-letter)
    (define-key mpuz-mode-map "h" 'mpuz-try-letter)
    (define-key mpuz-mode-map "i" 'mpuz-try-letter)
    (define-key mpuz-mode-map "j" 'mpuz-try-letter)
    (define-key mpuz-mode-map "A" 'mpuz-try-letter)
    (define-key mpuz-mode-map "B" 'mpuz-try-letter)
    (define-key mpuz-mode-map "C" 'mpuz-try-letter)
    (define-key mpuz-mode-map "D" 'mpuz-try-letter)
    (define-key mpuz-mode-map "E" 'mpuz-try-letter)
    (define-key mpuz-mode-map "F" 'mpuz-try-letter)
    (define-key mpuz-mode-map "G" 'mpuz-try-letter)
    (define-key mpuz-mode-map "H" 'mpuz-try-letter)
    (define-key mpuz-mode-map "I" 'mpuz-try-letter)
    (define-key mpuz-mode-map "J" 'mpuz-try-letter)
    (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort)
    (define-key mpuz-mode-map "?" 'describe-mode))

(defun mpuz-mode ()
  "Multiplication puzzle mode.

You have to guess which letters stand for which digits in the
multiplication displayed inside the `*Mult Puzzle*' buffer.

You may enter a guess for a letter's value by typing first the letter,
then the digit.  Thus, to guess that A=3, type A 3.

To leave the game to do other editing work, just switch buffers.
Then you may resume the game with M-x mpuz.
You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
  (interactive)
  (setq major-mode 'mpuz-mode
	mode-name  "Mult Puzzle")
  (use-local-map mpuz-mode-map)
  (run-hooks 'mpuz-mode-hook))

\f
;; Some variables for statistics
;;------------------------------
(defvar mpuz-nb-errors 0
  "Number of errors made in current game.")

(defvar mpuz-nb-completed-games 0
  "Number of games completed.")

(defvar mpuz-nb-cumulated-errors 0
  "Number of errors made in previous games.")


;; Some variables for game tracking
;;---------------------------------
(defvar mpuz-in-progress nil
  "True if a game is currently in progress.")

(defvar mpuz-found-digits (make-vector 10 nil)
  "A vector recording which digits have been decrypted.")

(defmacro mpuz-digit-solved-p (digit)
  (list 'aref 'mpuz-found-digits digit))


;; A puzzle uses a permutation of [0..9] into itself.
;; We use both the permutation and its inverse.
;;---------------------------------------------------
(defvar mpuz-digit-to-letter (make-vector 10 0)
  "A permutation from [0..9] to [0..9].")

(defvar mpuz-letter-to-digit (make-vector 10 0)
  "The inverse of mpuz-digit-to-letter.")

(defmacro mpuz-to-digit (letter)
  (list 'aref 'mpuz-letter-to-digit letter))

(defmacro mpuz-to-letter (digit)
  (list 'aref 'mpuz-digit-to-letter digit))

(defun mpuz-build-random-perm ()
  "Initialize puzzle coding with a random permutation."
  (let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq
	(index 10)
	elem)
    (while letters
      (setq elem    (nth (random index) letters)
	    letters (delq elem letters)
	    index   (1- index))
      (aset mpuz-digit-to-letter index elem)
      (aset mpuz-letter-to-digit elem index))))


;; A puzzle also uses a board displaying a multiplication.
;; Every digit appears in the board, crypted or not.
;;------------------------------------------------------
(defvar mpuz-board (make-vector 10 nil)
  "The board associates to any digit the list of squares where it appears.")

(defun mpuz-put-digit-on-board (number square)
  "Put (last digit of) NUMBER on SQUARE of the puzzle board."
  ;; i.e. push SQUARE on NUMBER square-list
  (setq number (% number 10))
  (aset mpuz-board number (cons square (aref mpuz-board number))))

(defun mpuz-check-all-solved ()
  "Check whether all digits have been solved. Return t if yes."
  (catch 'found
    (let ((digit -1))
      (while (> 10 (setq digit (1+ digit)))
	(if (and (not (mpuz-digit-solved-p digit)) ; unsolved
		 (aref mpuz-board digit)) ; and appearing in the puzzle !
	    (throw 'found nil))))
    t))


;; To build a puzzle, we take two random numbers and multiply them.
;; We also take a random permutation for encryption.
;; The random numbers are only use to see which digit appears in which square
;; of the board. Everything is stored in individual squares.
;;---------------------------------------------------------------------------
(defun mpuz-random-puzzle ()
  "Draw random values to be multiplied in a puzzle."
  (mpuz-build-random-perm)
  (fillarray mpuz-board nil)		; erase the board
  (let (A B C D E)
    ;; A,B,C,D & E, are the five rows of our multiplication.
    ;; Choose random values, discarding uninteresting cases.
    (while (progn
	     (setq A (random 1000)
		   B (random 100)
		   C (* A (% B 10))
		   D (* A (/ B 10))
		   E (* A B))
	     (or (< C 1000) (< D 1000)))) ; forbid leading zeros in C or D
    ;; Individual digits are now put on their respective squares.
    ;; [NB: A square is a pair <row,column> of the screen.]
    (mpuz-put-digit-on-board A		 '(2 . 9))
    (mpuz-put-digit-on-board (/ A 10)	 '(2 . 7))
    (mpuz-put-digit-on-board (/ A 100)	 '(2 . 5))
    (mpuz-put-digit-on-board B		 '(4 . 9))
    (mpuz-put-digit-on-board (/ B 10)	 '(4 . 7))
    (mpuz-put-digit-on-board C		 '(6 . 9))
    (mpuz-put-digit-on-board (/ C 10)	 '(6 . 7))
    (mpuz-put-digit-on-board (/ C 100)	 '(6 . 5))
    (mpuz-put-digit-on-board (/ C 1000)	 '(6 . 3))
    (mpuz-put-digit-on-board D		 '(8 . 7))
    (mpuz-put-digit-on-board (/ D 10)	 '(8 . 5))
    (mpuz-put-digit-on-board (/ D 100)	 '(8 . 3))
    (mpuz-put-digit-on-board (/ D 1000)	 '(8 . 1))
    (mpuz-put-digit-on-board E		 '(10 . 9))
    (mpuz-put-digit-on-board (/ E 10)	 '(10 . 7))
    (mpuz-put-digit-on-board (/ E 100)	 '(10 . 5))
    (mpuz-put-digit-on-board (/ E 1000)	 '(10 . 3))
    (mpuz-put-digit-on-board (/ E 10000) '(10 . 1))))
\f
;; Display
;;--------
(defconst mpuz-framework
  "
     . . .
                   Number of errors (this game): 0
    x  . .
   -------
   . . . .
                        Number of completed games: 0
 . . . .
 ---------              Average number of errors: 0.00
 . . . . ."
  "The general picture of the puzzle screen, as a string.")

(defun mpuz-create-buffer ()
  "Create (or recreate) the puzzle buffer. Return it."
  (let ((buff (get-buffer-create "*Mult Puzzle*")))
    (save-excursion
      (set-buffer buff)
      (let ((buffer-read-only nil))
	(erase-buffer)
	(insert mpuz-framework)
	(mpuz-paint-board)
	(mpuz-paint-errors)
	(mpuz-paint-statistics)))
    buff))

(defun mpuz-paint-errors ()
  "Paint error count on the puzzle screen."
  (mpuz-switch-to-window)
  (let ((buffer-read-only nil))
    (goto-line 3)
    (move-to-column 49)
    (mpuz-delete-line)
    (insert (prin1-to-string mpuz-nb-errors))))

(defun mpuz-paint-statistics ()
  "Paint statistics about previous games on the puzzle screen."
  (let* ((mean (if (zerop mpuz-nb-completed-games) 0
		   (/ (+ mpuz-nb-completed-games (* 200 mpuz-nb-cumulated-errors))
		      (* 2 mpuz-nb-completed-games))))
	 (frac-part (% mean 100)))
    (let ((buffer-read-only nil))
      (goto-line 7)
      (move-to-column 51)
      (mpuz-delete-line)
      (insert (prin1-to-string mpuz-nb-completed-games))
      (goto-line 9)
      (move-to-column 50)
      (mpuz-delete-line)
      (insert (format "%d.%d%d" (/ mean 100) (/ frac-part 10) (% frac-part 10))))))

(defun mpuz-paint-board ()
  "Paint board situation on the puzzle screen."
  (mpuz-switch-to-window)
  (let ((letter -1))
    (while (> 10 (setq letter (1+ letter)))
      (mpuz-paint-digit (mpuz-to-digit letter))))
  (goto-char (point-min)))

(defun mpuz-paint-digit (digit)
  "Paint all occurrences of DIGIT on the puzzle board."
  ;; (mpuz-switch-to-window)
  (let ((char (if (mpuz-digit-solved-p digit)
		  (+ digit ?0)
		  (+ (mpuz-to-letter digit) ?A)))
	(square-l (aref mpuz-board digit)))
    (let ((buffer-read-only nil))
      (while square-l
	(goto-line (car (car square-l)))	; line before column !
	(move-to-column (cdr (car square-l)))
	(insert char)
	(delete-char 1)
	(backward-char 1)
	(setq square-l (cdr square-l))))))

(defun mpuz-delete-line ()
  "Clear from point to next newline."	; & put nothing in the kill ring
  (while (not (= ?\n (char-after (point))))
    (delete-char 1)))

(defun mpuz-get-buffer ()
  "Get the puzzle buffer if it exists."
  (get-buffer "*Mult Puzzle*"))

(defun mpuz-switch-to-window ()
  "Find or create the Mult-Puzzle buffer, and display it."
  (let ((buff (mpuz-get-buffer)))
    (or buff (setq buff (mpuz-create-buffer)))
    (switch-to-buffer buff)
    (or buffer-read-only (toggle-read-only))
    (mpuz-mode)))

\f
;; Game control
;;-------------
(defun mpuz-abort-game ()
  "Abort any puzzle in progress."
  (message "Mult Puzzle aborted.")
  (setq mpuz-in-progress nil
	mpuz-nb-errors 0)
  (fillarray mpuz-board nil)
  (let ((buff (mpuz-get-buffer)))
    (if buff (kill-buffer buff))))

(defun mpuz-start-new-game ()
  "Start a new puzzle."
  (message "Here we go...")
  (setq mpuz-nb-errors 0
	mpuz-in-progress t)
  (fillarray mpuz-found-digits nil)	; initialize mpuz-found-digits
  (mpuz-random-puzzle)
  (mpuz-switch-to-window)
  (mpuz-paint-board)
  (mpuz-paint-errors)
  (mpuz-ask-for-try))

(defun mpuz-offer-new-game ()
  "Ask if user wants to start a new puzzle."
  (if (y-or-n-p "Start a new game ")
      (mpuz-start-new-game)
      (message "OK. I won't.")))

;;;###autoload
(defun mpuz ()
  "Multiplication puzzle with GNU Emacs."
  ;; Main entry point
  (interactive)
  (mpuz-switch-to-window)
  (if mpuz-in-progress
      (mpuz-offer-abort)
      (mpuz-start-new-game)))

(defun mpuz-offer-abort ()
  "Ask if user wants to abort current puzzle."
  (interactive)
  (if (y-or-n-p "Abort game ")
      (mpuz-abort-game)
      (mpuz-ask-for-try)))

(defun mpuz-ask-for-try ()
  "Ask for user proposal in puzzle."
  (message "Your try ?"))

(defun mpuz-try-letter ()
  "Propose a digit for a letter in puzzle."
  (interactive)
  (if mpuz-in-progress
      (let (letter-char digit digit-char message)
	(setq letter-char (upcase last-command-char)
	      digit (mpuz-to-digit (- letter-char ?A)))
	(cond ((mpuz-digit-solved-p digit)
	       (message "%c already solved." letter-char))
	      ((null (aref mpuz-board digit))
	       (message "%c does not appear." letter-char))
	      ((progn (message "%c = " letter-char)
		      ;; <char> has been entered.
		      ;; Print "<char> =" and
		      ;; read <num> or = <num>
		      (setq digit-char (read-char))
		      (if (eq digit-char ?=)
			  (setq digit-char (read-char)))
		      (message "%c = %c" letter-char digit-char)
		      (or (> digit-char ?9) (< digit-char ?0))) ; bad input
	       (ding t))
	      (t
	       (mpuz-try-proposal letter-char digit-char))))
      (mpuz-offer-new-game)))

(defun mpuz-try-proposal (letter-char digit-char)
  "Propose LETTER-CHAR as code for DIGIT-CHAR."
  (let* ((letter (- letter-char ?A))
	 (digit (- digit-char ?0))
	 (correct-digit (mpuz-to-digit letter)))
    (cond ((mpuz-digit-solved-p correct-digit)
	   (message "%c has already been found."))
	  ((= digit correct-digit)
	   (message "%c = %c correct !" letter-char digit-char)
	   (mpuz-ding)
	   (mpuz-correct-guess digit))
	  (t ;;; incorrect guess
	   (message "%c = %c incorrect !" letter-char digit-char)
	   (mpuz-ding)
	   (setq mpuz-nb-errors (1+ mpuz-nb-errors))
	   (mpuz-paint-errors)))))

(defun mpuz-correct-guess (digit)
  "Handle correct guessing of DIGIT."
  (aset mpuz-found-digits digit t)	; Mark digit as solved
  (mpuz-paint-digit digit)		; Repaint it (now as a digit)
  (if (mpuz-check-all-solved)
      (mpuz-close-game)))

(defun mpuz-close-game ()
  "Housecleaning when puzzle has been solved."
  (setq mpuz-in-progress nil
	mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors)
	mpuz-nb-completed-games (1+ mpuz-nb-completed-games))
  (mpuz-paint-statistics)
  (let ((message (mpuz-congratulate)))
    (message message)
    (sit-for 4)
    (if (y-or-n-p (concat message "  Start a new game "))
	(mpuz-start-new-game)
	(message "Good Bye !"))))

(defun mpuz-congratulate ()
  "Build a congratulation message when puzzle is solved."
  (format "Puzzle solved with %d errors. %s"
	   mpuz-nb-errors
	   (cond ((= mpuz-nb-errors 0)	      "That's perfect !")
		 ((= mpuz-nb-errors 1)	      "That's very good !")
		 ((= mpuz-nb-errors 2)	      "That's good.")
		 ((= mpuz-nb-errors 3)	      "That's not bad.")
		 ((= mpuz-nb-errors 4)	      "That's not too bad...")
		 ((and (>= mpuz-nb-errors 5)
		       (< mpuz-nb-errors 10)) "That's bad !")
		 ((and (>= mpuz-nb-errors 10)
		       (< mpuz-nb-errors 15)) "That's awful.")
		 ((>= mpuz-nb-errors 15)      "That's not serious."))))

(defun mpuz-show-solution ()
  "Display solution for debugging purposes."
  (interactive)
  (mpuz-switch-to-window)
  (let (digit list)
    (setq digit -1)
    (while (> 10 (setq digit (1+ digit)))
      (or (mpuz-digit-solved-p digit)
	  (setq list (cons digit list))))
    (mapcar 'mpuz-correct-guess list)))

;;; mpuz.el ends here
Commit	Line	Data
6594deb0 ER	1	;;; mpuz.el --- multiplication puzzle for GNU Emacs
6594deb0 ER	2
b578f267	3	;; Copyright (C) 1990 Free Software Foundation, Inc.
0aba61c5	4
84176303	5	;; Author: Philippe Schnoebelen <phs@lifia.imag.fr>
84176303 ER	6	;; Keywords: games
84176303 ER	7
5f7e5584 RS	8	;; This file is part of GNU Emacs.
5f7e5584 RS	9
59243403 RS	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)
	13	;; any later version.
	14
5f7e5584	15	;; GNU Emacs is distributed in the hope that it will be useful,
59243403 RS	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.
	19
	20	;; You should have received a copy of the GNU General Public License
b578f267 EN	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
5f7e5584	24
edbd2f74 ER	25	;;; Commentary:
	26
	27	;; When this package is loaded, `M-x mpuz' generates a random multiplication
	28	;; puzzle. This is a multiplication example in which each digit has been
	29	;; consistently replaced with some letter. Your job is to reconstruct
	30	;; the original digits. Type `?' while the mode is active for detailed help.
	31
84176303 ER	32	;;; Code:
84176303 ER	33
5f7e5584 RS	34	(random t) ; randomize
5f7e5584 RS	35
5f7e5584 RS	36	(defvar mpuz-silent nil
	37	"*Set this to T if you don't want dings on inputs.")
	38
	39	(defun mpuz-ding ()
a0963566	40	"Dings, unless global variable `mpuz-silent' forbids it."
5f7e5584 RS	41	(or mpuz-silent (ding t)))
	42
	43	\f
	44	;; Mpuz mode and keymaps
	45	;;----------------------
	46	(defvar mpuz-mode-hook nil)
	47
	48	(defvar mpuz-mode-map nil
	49	"Local keymap to use in Mult Puzzle.")
	50
5f7e5584 RS	51	(if mpuz-mode-map nil
	52	(setq mpuz-mode-map (make-sparse-keymap))
	53	(define-key mpuz-mode-map "a" 'mpuz-try-letter)
	54	(define-key mpuz-mode-map "b" 'mpuz-try-letter)
	55	(define-key mpuz-mode-map "c" 'mpuz-try-letter)
	56	(define-key mpuz-mode-map "d" 'mpuz-try-letter)
	57	(define-key mpuz-mode-map "e" 'mpuz-try-letter)
	58	(define-key mpuz-mode-map "f" 'mpuz-try-letter)
	59	(define-key mpuz-mode-map "g" 'mpuz-try-letter)
	60	(define-key mpuz-mode-map "h" 'mpuz-try-letter)
	61	(define-key mpuz-mode-map "i" 'mpuz-try-letter)
	62	(define-key mpuz-mode-map "j" 'mpuz-try-letter)
	63	(define-key mpuz-mode-map "A" 'mpuz-try-letter)
	64	(define-key mpuz-mode-map "B" 'mpuz-try-letter)
	65	(define-key mpuz-mode-map "C" 'mpuz-try-letter)
	66	(define-key mpuz-mode-map "D" 'mpuz-try-letter)
	67	(define-key mpuz-mode-map "E" 'mpuz-try-letter)
	68	(define-key mpuz-mode-map "F" 'mpuz-try-letter)
	69	(define-key mpuz-mode-map "G" 'mpuz-try-letter)
	70	(define-key mpuz-mode-map "H" 'mpuz-try-letter)
	71	(define-key mpuz-mode-map "I" 'mpuz-try-letter)
	72	(define-key mpuz-mode-map "J" 'mpuz-try-letter)
	73	(define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort)
	74	(define-key mpuz-mode-map "?" 'describe-mode))
	75
5f7e5584	76	(defun mpuz-mode ()
58c43274	77	"Multiplication puzzle mode.
5f7e5584	78
a0963566	79	You have to guess which letters stand for which digits in the
58c43274	80	multiplication displayed inside the `Mult Puzzle' buffer.
5f7e5584	81
58c43274 RS	82	You may enter a guess for a letter's value by typing first the letter,
58c43274 RS	83	then the digit. Thus, to guess that A=3, type A 3.
5f7e5584	84
58c43274 RS	85	To leave the game to do other editing work, just switch buffers.
	86	Then you may resume the game with M-x mpuz.
	87	You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
5f7e5584 RS	88	(interactive)
	89	(setq major-mode 'mpuz-mode
	90	mode-name "Mult Puzzle")
	91	(use-local-map mpuz-mode-map)
	92	(run-hooks 'mpuz-mode-hook))
	93
	94	\f
	95	;; Some variables for statistics
	96	;;------------------------------
	97	(defvar mpuz-nb-errors 0
a0963566	98	"Number of errors made in current game.")
5f7e5584 RS	99
5f7e5584 RS	100	(defvar mpuz-nb-completed-games 0
a0963566	101	"Number of games completed.")
5f7e5584 RS	102
	103	(defvar mpuz-nb-cumulated-errors 0
	104	"Number of errors made in previous games.")
	105
	106
	107	;; Some variables for game tracking
	108	;;---------------------------------
	109	(defvar mpuz-in-progress nil
	110	"True if a game is currently in progress.")
	111
	112	(defvar mpuz-found-digits (make-vector 10 nil)
	113	"A vector recording which digits have been decrypted.")
	114
	115	(defmacro mpuz-digit-solved-p (digit)
	116	(list 'aref 'mpuz-found-digits digit))
	117
	118
	119	;; A puzzle uses a permutation of [0..9] into itself.
	120	;; We use both the permutation and its inverse.
	121	;;---------------------------------------------------
	122	(defvar mpuz-digit-to-letter (make-vector 10 0)
	123	"A permutation from [0..9] to [0..9].")
	124
	125	(defvar mpuz-letter-to-digit (make-vector 10 0)
	126	"The inverse of mpuz-digit-to-letter.")
	127
	128	(defmacro mpuz-to-digit (letter)
	129	(list 'aref 'mpuz-letter-to-digit letter))
	130
	131	(defmacro mpuz-to-letter (digit)
	132	(list 'aref 'mpuz-digit-to-letter digit))
	133
	134	(defun mpuz-build-random-perm ()
	135	"Initialize puzzle coding with a random permutation."
	136	(let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq
	137	(index 10)
	138	elem)
	139	(while letters
c9575b25	140	(setq elem (nth (random index) letters)
5f7e5584 RS	141	letters (delq elem letters)
	142	index (1- index))
	143	(aset mpuz-digit-to-letter index elem)
	144	(aset mpuz-letter-to-digit elem index))))
	145
	146
eb8c3be9	147	;; A puzzle also uses a board displaying a multiplication.
5f7e5584 RS	148	;; Every digit appears in the board, crypted or not.
	149	;;------------------------------------------------------
	150	(defvar mpuz-board (make-vector 10 nil)
f582564f	151	"The board associates to any digit the list of squares where it appears.")
5f7e5584 RS	152
	153	(defun mpuz-put-digit-on-board (number square)
	154	"Put (last digit of) NUMBER on SQUARE of the puzzle board."
	155	;; i.e. push SQUARE on NUMBER square-list
	156	(setq number (% number 10))
	157	(aset mpuz-board number (cons square (aref mpuz-board number))))
	158
	159	(defun mpuz-check-all-solved ()
	160	"Check whether all digits have been solved. Return t if yes."
	161	(catch 'found
	162	(let ((digit -1))
	163	(while (> 10 (setq digit (1+ digit)))
	164	(if (and (not (mpuz-digit-solved-p digit)) ; unsolved
	165	(aref mpuz-board digit)) ; and appearing in the puzzle !
	166	(throw 'found nil))))
	167	t))
	168
	169
	170	;; To build a puzzle, we take two random numbers and multiply them.
	171	;; We also take a random permutation for encryption.
	172	;; The random numbers are only use to see which digit appears in which square
	173	;; of the board. Everything is stored in individual squares.
	174	;;---------------------------------------------------------------------------
	175	(defun mpuz-random-puzzle ()
	176	"Draw random values to be multiplied in a puzzle."
	177	(mpuz-build-random-perm)
	178	(fillarray mpuz-board nil) ; erase the board
	179	(let (A B C D E)
	180	;; A,B,C,D & E, are the five rows of our multiplication.
	181	;; Choose random values, discarding uninteresting cases.
	182	(while (progn
c9575b25 PE	183	(setq A (random 1000)
c9575b25 PE	184	B (random 100)
5f7e5584 RS	185	C (* A (% B 10))
	186	D (* A (/ B 10))
	187	E (* A B))
	188	(or (< C 1000) (< D 1000)))) ; forbid leading zeros in C or D
a7acbbe4	189	;; Individual digits are now put on their respective squares.
5f7e5584 RS	190	;; [NB: A square is a pair <row,column> of the screen.]
	191	(mpuz-put-digit-on-board A '(2 . 9))
	192	(mpuz-put-digit-on-board (/ A 10) '(2 . 7))
	193	(mpuz-put-digit-on-board (/ A 100) '(2 . 5))
	194	(mpuz-put-digit-on-board B '(4 . 9))
	195	(mpuz-put-digit-on-board (/ B 10) '(4 . 7))
	196	(mpuz-put-digit-on-board C '(6 . 9))
	197	(mpuz-put-digit-on-board (/ C 10) '(6 . 7))
	198	(mpuz-put-digit-on-board (/ C 100) '(6 . 5))
	199	(mpuz-put-digit-on-board (/ C 1000) '(6 . 3))
	200	(mpuz-put-digit-on-board D '(8 . 7))
	201	(mpuz-put-digit-on-board (/ D 10) '(8 . 5))
	202	(mpuz-put-digit-on-board (/ D 100) '(8 . 3))
	203	(mpuz-put-digit-on-board (/ D 1000) '(8 . 1))
	204	(mpuz-put-digit-on-board E '(10 . 9))
	205	(mpuz-put-digit-on-board (/ E 10) '(10 . 7))
	206	(mpuz-put-digit-on-board (/ E 100) '(10 . 5))
	207	(mpuz-put-digit-on-board (/ E 1000) '(10 . 3))
	208	(mpuz-put-digit-on-board (/ E 10000) '(10 . 1))))
	209	\f
	210	;; Display
	211	;;--------
	212	(defconst mpuz-framework
	213	"
	214	. . .
	215	Number of errors (this game): 0
	216	x . .
	217	-------
	218	. . . .
	219	Number of completed games: 0
	220	. . . .
	221	--------- Average number of errors: 0.00
	222	. . . . ."
	223	"The general picture of the puzzle screen, as a string.")
	224
	225	(defun mpuz-create-buffer ()
	226	"Create (or recreate) the puzzle buffer. Return it."
	227	(let ((buff (get-buffer-create "Mult Puzzle")))
	228	(save-excursion
	229	(set-buffer buff)
	230	(let ((buffer-read-only nil))
	231	(erase-buffer)
	232	(insert mpuz-framework)
	233	(mpuz-paint-board)
	234	(mpuz-paint-errors)
	235	(mpuz-paint-statistics)))
	236	buff))
	237
	238	(defun mpuz-paint-errors ()
	239	"Paint error count on the puzzle screen."
	240	(mpuz-switch-to-window)
	241	(let ((buffer-read-only nil))
	242	(goto-line 3)
	243	(move-to-column 49)
	244	(mpuz-delete-line)
	245	(insert (prin1-to-string mpuz-nb-errors))))
	246
	247	(defun mpuz-paint-statistics ()
	248	"Paint statistics about previous games on the puzzle screen."
	249	(let* ((mean (if (zerop mpuz-nb-completed-games) 0
	250	(/ (+ mpuz-nb-completed-games (* 200 mpuz-nb-cumulated-errors))
	251	(* 2 mpuz-nb-completed-games))))
	252	(frac-part (% mean 100)))
	253	(let ((buffer-read-only nil))
254	(goto-line 7)
255	(move-to-column 51)
256	(mpuz-delete-line)
257	(insert (prin1-to-string mpuz-nb-completed-games))
258	(goto-line 9)
259	(move-to-column 50)
260	(mpuz-delete-line)
261	(insert (format "%d.%d%d" (/ mean 100) (/ frac-part 10) (% frac-part 10))))))
262
263	(defun mpuz-paint-board ()
264	"Paint board situation on the puzzle screen."
265	(mpuz-switch-to-window)
266	(let ((letter -1))
267	(while (> 10 (setq letter (1+ letter)))
268	(mpuz-paint-digit (mpuz-to-digit letter))))
269	(goto-char (point-min)))
270
271	(defun mpuz-paint-digit (digit)
272	"Paint all occurrences of DIGIT on the puzzle board."
273	;; (mpuz-switch-to-window)
274	(let ((char (if (mpuz-digit-solved-p digit)
275	(+ digit ?0)
276	(+ (mpuz-to-letter digit) ?A)))
277	(square-l (aref mpuz-board digit)))
278	(let ((buffer-read-only nil))
279	(while square-l
280	(goto-line (car (car square-l))) ; line before column !
281	(move-to-column (cdr (car square-l)))
282	(insert char)
283	(delete-char 1)
284	(backward-char 1)
285	(setq square-l (cdr square-l))))))
286
287	(defun mpuz-delete-line ()
288	"Clear from point to next newline." ; & put nothing in the kill ring
289	(while (not (= ?\n (char-after (point))))
290	(delete-char 1)))
291
292	(defun mpuz-get-buffer ()
293	"Get the puzzle buffer if it exists."
294	(get-buffer "Mult Puzzle"))
295
296	(defun mpuz-switch-to-window ()
297	"Find or create the Mult-Puzzle buffer, and display it."
298	(let ((buff (mpuz-get-buffer)))
299	(or buff (setq buff (mpuz-create-buffer)))
300	(switch-to-buffer buff)
301	(or buffer-read-only (toggle-read-only))
302	(mpuz-mode)))
303
304	\f
305	;; Game control
306	;;-------------
307	(defun mpuz-abort-game ()
eb8c3be9	308	"Abort any puzzle in progress."
5f7e5584 RS	309	(message "Mult Puzzle aborted.")
	310	(setq mpuz-in-progress nil
	311	mpuz-nb-errors 0)
	312	(fillarray mpuz-board nil)
	313	(let ((buff (mpuz-get-buffer)))
	314	(if buff (kill-buffer buff))))
	315
	316	(defun mpuz-start-new-game ()
	317	"Start a new puzzle."
	318	(message "Here we go...")
	319	(setq mpuz-nb-errors 0
	320	mpuz-in-progress t)
	321	(fillarray mpuz-found-digits nil) ; initialize mpuz-found-digits
	322	(mpuz-random-puzzle)
	323	(mpuz-switch-to-window)
	324	(mpuz-paint-board)
	325	(mpuz-paint-errors)
	326	(mpuz-ask-for-try))
	327
	328	(defun mpuz-offer-new-game ()
	329	"Ask if user wants to start a new puzzle."
	330	(if (y-or-n-p "Start a new game ")
	331	(mpuz-start-new-game)
	332	(message "OK. I won't.")))
	333
58c43274 RS	334	;;;###autoload
58c43274 RS	335	(defun mpuz ()
5f7e5584 RS	336	"Multiplication puzzle with GNU Emacs."
	337	;; Main entry point
	338	(interactive)
	339	(mpuz-switch-to-window)
	340	(if mpuz-in-progress
	341	(mpuz-offer-abort)
	342	(mpuz-start-new-game)))
	343
	344	(defun mpuz-offer-abort ()
	345	"Ask if user wants to abort current puzzle."
	346	(interactive)
	347	(if (y-or-n-p "Abort game ")
	348	(mpuz-abort-game)
	349	(mpuz-ask-for-try)))
	350
	351	(defun mpuz-ask-for-try ()
	352	"Ask for user proposal in puzzle."
	353	(message "Your try ?"))
	354
	355	(defun mpuz-try-letter ()
	356	"Propose a digit for a letter in puzzle."
	357	(interactive)
	358	(if mpuz-in-progress
	359	(let (letter-char digit digit-char message)
315b2369	360	(setq letter-char (upcase last-command-char)
5f7e5584 RS	361	digit (mpuz-to-digit (- letter-char ?A)))
	362	(cond ((mpuz-digit-solved-p digit)
	363	(message "%c already solved." letter-char))
	364	((null (aref mpuz-board digit))
	365	(message "%c does not appear." letter-char))
315b2369	366	((progn (message "%c = " letter-char)
5f7e5584 RS	367	;; <char> has been entered.
	368	;; Print "<char> =" and
	369	;; read <num> or = <num>
315b2369 RS	370	(setq digit-char (read-char))
	371	(if (eq digit-char ?=)
	372	(setq digit-char (read-char)))
5f7e5584 RS	373	(message "%c = %c" letter-char digit-char)
	374	(or (> digit-char ?9) (< digit-char ?0))) ; bad input
	375	(ding t))
	376	(t
	377	(mpuz-try-proposal letter-char digit-char))))
	378	(mpuz-offer-new-game)))
	379
	380	(defun mpuz-try-proposal (letter-char digit-char)
	381	"Propose LETTER-CHAR as code for DIGIT-CHAR."
	382	(let* ((letter (- letter-char ?A))
	383	(digit (- digit-char ?0))
	384	(correct-digit (mpuz-to-digit letter)))
	385	(cond ((mpuz-digit-solved-p correct-digit)
	386	(message "%c has already been found."))
	387	((= digit correct-digit)
	388	(message "%c = %c correct !" letter-char digit-char)
	389	(mpuz-ding)
	390	(mpuz-correct-guess digit))
	391	(t ;;; incorrect guess
	392	(message "%c = %c incorrect !" letter-char digit-char)
	393	(mpuz-ding)
	394	(setq mpuz-nb-errors (1+ mpuz-nb-errors))
	395	(mpuz-paint-errors)))))
	396
	397	(defun mpuz-correct-guess (digit)
	398	"Handle correct guessing of DIGIT."
	399	(aset mpuz-found-digits digit t) ; Mark digit as solved
	400	(mpuz-paint-digit digit) ; Repaint it (now as a digit)
	401	(if (mpuz-check-all-solved)
	402	(mpuz-close-game)))
	403
	404	(defun mpuz-close-game ()
	405	"Housecleaning when puzzle has been solved."
	406	(setq mpuz-in-progress nil
	407	mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors)
	408	mpuz-nb-completed-games (1+ mpuz-nb-completed-games))
	409	(mpuz-paint-statistics)
	410	(let ((message (mpuz-congratulate)))
	411	(message message)
	412	(sit-for 4)
	413	(if (y-or-n-p (concat message " Start a new game "))
	414	(mpuz-start-new-game)
	415	(message "Good Bye !"))))
	416
	417	(defun mpuz-congratulate ()
	418	"Build a congratulation message when puzzle is solved."
	419	(format "Puzzle solved with %d errors. %s"
	420	mpuz-nb-errors
	421	(cond ((= mpuz-nb-errors 0) "That's perfect !")
	422	((= mpuz-nb-errors 1) "That's very good !")
	423	((= mpuz-nb-errors 2) "That's good.")
	424	((= mpuz-nb-errors 3) "That's not bad.")
	425	((= mpuz-nb-errors 4) "That's not too bad...")
	426	((and (>= mpuz-nb-errors 5)
	427	(< mpuz-nb-errors 10)) "That's bad !")
	428	((and (>= mpuz-nb-errors 10)
	429	(< mpuz-nb-errors 15)) "That's awful.")
	430	((>= mpuz-nb-errors 15) "That's not serious."))))
	431
	432	(defun mpuz-show-solution ()
	433	"Display solution for debugging purposes."
	434	(interactive)
	435	(mpuz-switch-to-window)
	436	(let (digit list)
437	(setq digit -1)
438	(while (> 10 (setq digit (1+ digit)))
439	(or (mpuz-digit-solved-p digit)
440	(setq list (cons digit list))))
441	(mapcar 'mpuz-correct-guess list)))
442
6594deb0	443	;;; mpuz.el ends here