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