1;;; mpuz.el --- multiplication puzzle for GNU Emacs 2 3;; Copyright (C) 1990, 2001, 2002, 2003, 2004, 2005, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> 7;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org> 8;; Keywords: games 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; `M-x mpuz' generates a random multiplication puzzle. This is a 30;; multiplication example in which each digit has been consistently replaced 31;; with some letter. Your job is to reconstruct the original digits. Type 32;; `?' while the mode is active for detailed help. 33 34;;; Code: 35 36(defgroup mpuz nil 37 "Multiplication puzzle." 38 :prefix "mpuz-" 39 :group 'games) 40 41(random t) ; randomize 42 43(defcustom mpuz-silent 'error 44 "*Set this to nil if you want dings on inputs. 45t means never ding, and `error' means only ding on wrong input." 46 :type '(choice (const :tag "No" nil) 47 (const :tag "Yes" t) 48 (const :tag "If correct" error)) 49 :group 'mpuz) 50 51(defcustom mpuz-solve-when-trivial t 52 "*Solve any row that can be trivially calculated from what you've found." 53 :type 'boolean 54 :group 'mpuz) 55 56(defcustom mpuz-allow-double-multiplicator nil 57 "*Allow 2nd factors like 33 or 77." 58 :type 'boolean 59 :group 'mpuz) 60 61(defface mpuz-unsolved 62 '((((class color)) (:foreground "red1" :bold t)) 63 (t (:bold t))) 64 "*Face to use for letters to be solved." 65 :group 'mpuz) 66 67(defface mpuz-solved 68 '((((class color)) (:foreground "green1" :bold t)) 69 (t (:bold t))) 70 "*Face to use for solved digits." 71 :group 'mpuz) 72 73(defface mpuz-trivial 74 '((((class color)) (:foreground "blue" :bold t)) 75 (t (:bold t))) 76 "*Face to use for trivial digits solved for you." 77 :group 'mpuz) 78 79(defface mpuz-text 80 '((t (:inherit variable-pitch))) 81 "*Face to use for text on right." 82 :group 'mpuz) 83 84 85;; Mpuz mode and keymaps 86;;---------------------- 87(defcustom mpuz-mode-hook nil 88 "Hook to run upon entry to mpuz." 89 :type 'hook 90 :group 'mpuz) 91 92(defvar mpuz-mode-map nil 93 "Local keymap to use in Mult Puzzle.") 94 95(if mpuz-mode-map nil 96 (setq mpuz-mode-map (make-sparse-keymap)) 97 (define-key mpuz-mode-map "a" 'mpuz-try-letter) 98 (define-key mpuz-mode-map "b" 'mpuz-try-letter) 99 (define-key mpuz-mode-map "c" 'mpuz-try-letter) 100 (define-key mpuz-mode-map "d" 'mpuz-try-letter) 101 (define-key mpuz-mode-map "e" 'mpuz-try-letter) 102 (define-key mpuz-mode-map "f" 'mpuz-try-letter) 103 (define-key mpuz-mode-map "g" 'mpuz-try-letter) 104 (define-key mpuz-mode-map "h" 'mpuz-try-letter) 105 (define-key mpuz-mode-map "i" 'mpuz-try-letter) 106 (define-key mpuz-mode-map "j" 'mpuz-try-letter) 107 (define-key mpuz-mode-map "A" 'mpuz-try-letter) 108 (define-key mpuz-mode-map "B" 'mpuz-try-letter) 109 (define-key mpuz-mode-map "C" 'mpuz-try-letter) 110 (define-key mpuz-mode-map "D" 'mpuz-try-letter) 111 (define-key mpuz-mode-map "E" 'mpuz-try-letter) 112 (define-key mpuz-mode-map "F" 'mpuz-try-letter) 113 (define-key mpuz-mode-map "G" 'mpuz-try-letter) 114 (define-key mpuz-mode-map "H" 'mpuz-try-letter) 115 (define-key mpuz-mode-map "I" 'mpuz-try-letter) 116 (define-key mpuz-mode-map "J" 'mpuz-try-letter) 117 (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort) 118 (define-key mpuz-mode-map "?" 'describe-mode)) 119 120(defun mpuz-mode () 121 "Multiplication puzzle mode. 122 123You have to guess which letters stand for which digits in the 124multiplication displayed inside the `*Mult Puzzle*' buffer. 125 126You may enter a guess for a letter's value by typing first the letter, 127then the digit. Thus, to guess that A=3, type `A 3'. 128 129To leave the game to do other editing work, just switch buffers. 130Then you may resume the game with M-x mpuz. 131You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." 132 (interactive) 133 (kill-all-local-variables) 134 (setq major-mode 'mpuz-mode 135 mode-name "Mult Puzzle" 136 tab-width 30) 137 (use-local-map mpuz-mode-map) 138 (run-mode-hooks 'mpuz-mode-hook)) 139 140 141;; Some variables for statistics 142;;------------------------------ 143(defvar mpuz-nb-errors 0 144 "Number of errors made in current game.") 145 146(defvar mpuz-nb-completed-games 0 147 "Number of games completed.") 148 149(defvar mpuz-nb-cumulated-errors 0 150 "Number of errors made in previous games.") 151 152 153;; Some variables for game tracking 154;;--------------------------------- 155(defvar mpuz-in-progress nil 156 "True if a game is currently in progress.") 157 158(defvar mpuz-found-digits (make-bool-vector 10 nil) 159 "A vector recording which digits have been decrypted.") 160 161(defvar mpuz-trivial-digits (make-bool-vector 10 nil) 162 "A vector recording which digits have been solved for you.") 163 164(defmacro mpuz-digit-solved-p (digit) 165 `(or (aref mpuz-found-digits ,digit) 166 (aref mpuz-trivial-digits ,digit))) 167 168 169;; A puzzle uses a permutation of [0..9] into itself. 170;; We use both the permutation and its inverse. 171;;--------------------------------------------------- 172(defvar mpuz-digit-to-letter (make-vector 10 0) 173 "A permutation from [0..9] to [0..9].") 174 175(defvar mpuz-letter-to-digit (make-vector 10 0) 176 "The inverse of mpuz-digit-to-letter.") 177 178(defmacro mpuz-to-digit (letter) 179 (list 'aref 'mpuz-letter-to-digit letter)) 180 181(defmacro mpuz-to-letter (digit) 182 (list 'aref 'mpuz-digit-to-letter digit)) 183 184(defun mpuz-build-random-perm () 185 "Initialize puzzle coding with a random permutation." 186 (let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq 187 (index 10) 188 elem) 189 (while letters 190 (setq elem (nth (random index) letters) 191 letters (delq elem letters) 192 index (1- index)) 193 (aset mpuz-digit-to-letter index elem) 194 (aset mpuz-letter-to-digit elem index)))) 195 196 197;; A puzzle also uses a board displaying a multiplication. 198;; Every digit appears in the board, crypted or not. 199;;------------------------------------------------------ 200(defvar mpuz-board (make-vector 10 nil) 201 "The board associates to any digit the list of squares where it appears.") 202 203(defun mpuz-put-number-on-board (number row &rest l) 204 "Put (last digit of) NUMBER on ROW and COLUMNS of the puzzle board." 205 (let (digit) 206 (while l 207 (setq digit (% number 10) 208 number (/ number 10)) 209 (aset mpuz-board digit `((,row . ,(car l)) ,@(aref mpuz-board digit))) 210 (setq l (cdr l))))) 211 212(defun mpuz-check-all-solved (&optional row col) 213 "Check whether all digits have been solved. Return t if yes." 214 (catch 'solved 215 (let (A B1 B2 C D E squares) 216 (and mpuz-solve-when-trivial 217 (not row) 218 (while 219 (cond ((or (and (setq B1 (or B1 (mpuz-check-all-solved 4 7)) 220 B2 (or B2 (mpuz-check-all-solved 4 9)) 221 E (or E (mpuz-check-all-solved 10)) 222 A (or A (mpuz-check-all-solved 2))) 223 B1 B2) 224 (and E (or A (and B1 B2)))) 225 (mpuz-solve) 226 (mpuz-paint-board) 227 (throw 'solved t)) 228 ((and (setq D (or D (mpuz-check-all-solved 8)) 229 C (or C (mpuz-check-all-solved 6))) 230 D (not E)) 231 (mpuz-solve 10)) 232 ((and E (not (eq C D))) 233 (mpuz-solve (if D 6 8))) 234 ((and A (not (eq B2 C))) 235 (mpuz-solve (if C 4 6) (if C 9))) 236 ((and A (not (eq B1 D))) 237 (mpuz-solve (if D 4 8) (if D 7))) 238 ((and (not A) (or (and B2 C) (and B1 D))) 239 (mpuz-solve 2))))) 240 (mpuz-paint-board) 241 (mapc (lambda (digit) 242 (and (not (mpuz-digit-solved-p digit)) ; unsolved 243 (setq squares (aref mpuz-board digit)) 244 (if row 245 (if col 246 (member (cons row col) squares) 247 (assq row squares)) 248 squares) ; and appearing in the puzzle! 249 (throw 'solved nil))) 250 [0 1 2 3 4 5 6 7 8 9])) 251 t)) 252 253 254;; To build a puzzle, we take two random numbers and multiply them. 255;; We also take a random permutation for encryption. 256;; The random numbers are only use to see which digit appears in which square 257;; of the board. Everything is stored in individual squares. 258;;--------------------------------------------------------------------------- 259(defun mpuz-random-puzzle () 260 "Draw random values to be multiplied in a puzzle." 261 (mpuz-build-random-perm) 262 (fillarray mpuz-board nil) ; erase the board 263 ;; A,B,C,D & E, are the five rows of our multiplication. 264 ;; Choose random values, discarding cases with leading zeros in C or D. 265 (let* ((A (if mpuz-allow-double-multiplicator (+ 112 (random 888)) 266 (+ 125 (random 875)))) 267 (min (1+ (/ 999 A))) 268 (B1 (+ min (random (- 10 min)))) 269 B2 C D E) 270 (while (if (= B1 (setq B2 (+ min (random (- 10 min))))) 271 (not mpuz-allow-double-multiplicator))) 272 (setq C (* A B2) 273 D (* A B1) 274 E (+ C (* D 10))) 275 ;; Individual digits are now put on their respective squares. 276 ;; [NB: A square is a pair (row . column) of the screen.] 277 (mpuz-put-number-on-board A 2 9 7 5) 278 (mpuz-put-number-on-board (+ (* B1 10) B2) 4 9 7) 279 (mpuz-put-number-on-board C 6 9 7 5 3) 280 (mpuz-put-number-on-board D 8 7 5 3 1) 281 (mpuz-put-number-on-board E 10 9 7 5 3 1))) 282 283;; Display 284;;-------- 285(defconst mpuz-framework 286 " 287 . . . 288 Number of errors (this game): 0 289 x . . 290 ------- 291 . . . . 292 Number of completed games: 0 293 . . . . 294 --------- Average number of errors: 0.00 295 . . . . ." 296 "The general picture of the puzzle screen, as a string.") 297 298(defun mpuz-create-buffer () 299 "Create (or recreate) the puzzle buffer. Return it." 300 (let ((buf (get-buffer-create "*Mult Puzzle*")) 301 (face '(face mpuz-text)) 302 buffer-read-only) 303 (save-excursion 304 (set-buffer buf) 305 (erase-buffer) 306 (insert mpuz-framework) 307 (set-text-properties 13 42 face) 308 (set-text-properties 79 105 face) 309 (set-text-properties 128 153 face) 310 (mpuz-paint-board) 311 (mpuz-paint-errors) 312 (mpuz-paint-statistics)) 313 buf)) 314 315(defun mpuz-paint-number (n &optional eol words) 316 (end-of-line eol) 317 (let (buffer-read-only) 318 (delete-region (point) 319 (progn (backward-word (or words 1)) (point))) 320 (insert n))) 321 322(defun mpuz-paint-errors () 323 "Paint error count on the puzzle screen." 324 (mpuz-switch-to-window) 325 (goto-line 3) 326 (mpuz-paint-number (prin1-to-string mpuz-nb-errors))) 327 328(defun mpuz-paint-statistics () 329 "Paint statistics about previous games on the puzzle screen." 330 (goto-line 7) 331 (mpuz-paint-number (prin1-to-string mpuz-nb-completed-games)) 332 (mpuz-paint-number 333 (format "%.2f" 334 (if (zerop mpuz-nb-completed-games) 335 0 336 (/ (+ 0.0 mpuz-nb-cumulated-errors) 337 mpuz-nb-completed-games))) 338 3 2)) 339 340(defun mpuz-paint-board () 341 "Paint board situation on the puzzle screen." 342 (mpuz-switch-to-window) 343 (mapc 'mpuz-paint-digit [0 1 2 3 4 5 6 7 8 9]) 344 (goto-char (point-min))) 345 346(defun mpuz-paint-digit (digit) 347 "Paint all occurrences of DIGIT on the puzzle board." 348 (let ((char (if (mpuz-digit-solved-p digit) 349 (+ digit ?0) 350 (+ (mpuz-to-letter digit) ?A))) 351 (face `(face 352 ,(cond ((aref mpuz-trivial-digits digit) 'mpuz-trivial) 353 ((aref mpuz-found-digits digit) 'mpuz-solved) 354 ('mpuz-unsolved)))) 355 buffer-read-only) 356 (mapc (lambda (square) 357 (goto-line (car square)) ; line before column! 358 (move-to-column (cdr square)) 359 (insert char) 360 (set-text-properties (1- (point)) (point) face) 361 (delete-char 1)) 362 (aref mpuz-board digit)))) 363 364(defun mpuz-get-buffer () 365 "Get the puzzle buffer if it exists." 366 (get-buffer "*Mult Puzzle*")) 367 368(defun mpuz-switch-to-window () 369 "Find or create the Mult-Puzzle buffer, and display it." 370 (let ((buf (mpuz-get-buffer))) 371 (or buf (setq buf (mpuz-create-buffer))) 372 (switch-to-buffer buf) 373 (setq buffer-read-only t) 374 (mpuz-mode))) 375 376 377;; Game control 378;;------------- 379(defun mpuz-start-new-game () 380 "Start a new puzzle." 381 (message "Here we go...") 382 (setq mpuz-nb-errors 0 383 mpuz-in-progress t) 384 (fillarray mpuz-found-digits nil) ; initialize mpuz-found-digits 385 (fillarray mpuz-trivial-digits nil) 386 (mpuz-random-puzzle) 387 (mpuz-switch-to-window) 388 (mpuz-paint-board) 389 (mpuz-paint-errors) 390 (mpuz-ask-for-try)) 391 392;;;###autoload 393(defun mpuz () 394 "Multiplication puzzle with GNU Emacs." 395 ;; Main entry point 396 (interactive) 397 (mpuz-switch-to-window) 398 (if mpuz-in-progress 399 (mpuz-offer-abort) 400 (mpuz-start-new-game))) 401 402(defun mpuz-offer-abort () 403 "Ask if user wants to abort current puzzle." 404 (interactive) 405 (if (y-or-n-p "Abort game? ") 406 (let ((buf (mpuz-get-buffer))) 407 (message "Mult Puzzle aborted.") 408 (setq mpuz-in-progress nil 409 mpuz-nb-errors 0) 410 (fillarray mpuz-board nil) 411 (if buf (kill-buffer buf))) 412 (mpuz-ask-for-try))) 413 414(defun mpuz-ask-for-try () 415 "Ask for user proposal in puzzle." 416 (message "Your try?")) 417 418(defun mpuz-ding (error) 419 "Dings, unless global variable `mpuz-silent' forbids it." 420 (cond ((eq mpuz-silent t)) 421 ((not mpuz-silent) (ding t)) 422 (error (ding t)))) 423 424(defun mpuz-try-letter () 425 "Propose a digit for a letter in puzzle." 426 (interactive) 427 (if mpuz-in-progress 428 (let (letter-char digit digit-char message) 429 (setq letter-char (upcase last-command-char) 430 digit (mpuz-to-digit (- letter-char ?A))) 431 (cond ((mpuz-digit-solved-p digit) 432 (message "%c already solved." letter-char) 433 (mpuz-ding t)) 434 ((null (aref mpuz-board digit)) 435 (message "%c does not appear." letter-char) 436 (mpuz-ding t)) 437 ((progn (message "%c = " letter-char) 438 ;; <char> has been entered. 439 ;; Print "<char> =" and 440 ;; read <num> or = <num> 441 (setq digit-char (read-char)) 442 (if (eq digit-char ?=) 443 (setq digit-char (read-char))) 444 (or (> digit-char ?9) (< digit-char ?0))) ; bad input 445 (message "%c = %c" letter-char digit-char) 446 (mpuz-ding t)) 447 (t 448 (mpuz-try-proposal letter-char digit-char)))) 449 (if (y-or-n-p "Start a new game? ") 450 (mpuz-start-new-game) 451 (message "OK. I won't.")))) 452 453(defun mpuz-try-proposal (letter-char digit-char) 454 "Propose LETTER-CHAR as code for DIGIT-CHAR." 455 (let* ((letter (- letter-char ?A)) 456 (digit (- digit-char ?0)) 457 (correct-digit (mpuz-to-digit letter)) 458 (game mpuz-nb-completed-games)) 459 (cond ((mpuz-digit-solved-p correct-digit) 460 (message "%c has already been found." (+ correct-digit ?0))) 461 ((mpuz-digit-solved-p digit) 462 (message "%c has already been placed." digit-char)) 463 ((= digit correct-digit) 464 (message "%c = %c correct!" letter-char digit-char) 465 (mpuz-ding nil) 466 (aset mpuz-found-digits digit t) ; Mark digit as solved 467 (and (mpuz-check-all-solved) 468 (mpuz-close-game))) 469 (t ;;; incorrect guess 470 (message "%c = %c incorrect!" letter-char digit-char) 471 (mpuz-ding t) 472 (setq mpuz-nb-errors (1+ mpuz-nb-errors)) 473 (mpuz-paint-errors))))) 474 475(defun mpuz-close-game () 476 "Housecleaning when puzzle has been solved." 477 (setq mpuz-in-progress nil 478 mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors) 479 mpuz-nb-completed-games (1+ mpuz-nb-completed-games)) 480 (mpuz-paint-statistics) 481 (let ((message (format "Puzzle solved with %d error%s. That's %s" 482 mpuz-nb-errors 483 (if (= mpuz-nb-errors 1) "" "s") 484 (cond ((= mpuz-nb-errors 0) "perfect!") 485 ((= mpuz-nb-errors 1) "very good!") 486 ((= mpuz-nb-errors 2) "good.") 487 ((= mpuz-nb-errors 3) "not bad.") 488 ((= mpuz-nb-errors 4) "not too bad...") 489 ((< mpuz-nb-errors 10) "bad!") 490 ((< mpuz-nb-errors 15) "awful.") 491 (t "not serious."))))) 492 (message message) 493 (sit-for 4) 494 (if (y-or-n-p (concat message " Start a new game? ")) 495 (mpuz-start-new-game) 496 (message "Good Bye!")))) 497 498(defun mpuz-solve (&optional row col) 499 "Find solution for autosolving." 500 (mapc (lambda (digit) 501 (or (mpuz-digit-solved-p digit) 502 (if row 503 (not (if col 504 (member (cons row col) (aref mpuz-board digit)) 505 (assq row (aref mpuz-board digit))))) 506 (aset mpuz-trivial-digits digit t))) 507 [0 1 2 3 4 5 6 7 8 9]) 508 t) 509 510(defun mpuz-show-solution (row) 511 "Display solution for debugging purposes." 512 (interactive "P") 513 (mpuz-switch-to-window) 514 (mpuz-solve (if row (* 2 (prefix-numeric-value row)))) 515 (mpuz-paint-board) 516 (if (mpuz-check-all-solved) 517 (mpuz-close-game))) 518 519(provide 'mpuz) 520 521;;; arch-tag: 2781d6ba-89e7-43b5-85c7-5d3a2e73feb1 522;;; mpuz.el ends here 523