]> code.delx.au - gnu-emacs/blobdiff - lisp/play/mpuz.el
Update copyright year to 2014 by running admin/update-copyright.
[gnu-emacs] / lisp / play / mpuz.el
index c5b74a8499fb3333984b675c7043feee9df48eb5..d3d55b30520767b04a0dda4c698113e40a51a5ac 100644 (file)
@@ -1,7 +1,6 @@
 ;;; mpuz.el --- multiplication puzzle for GNU Emacs
 
 ;;; mpuz.el --- multiplication puzzle for GNU Emacs
 
-;; Copyright (C) 1990, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;;   2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1990, 2001-2014 Free Software Foundation, Inc.
 
 ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
 ;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org>
 
 ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
 ;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org>
   :prefix "mpuz-"
   :group 'games)
 
   :prefix "mpuz-"
   :group 'games)
 
-(random t)                             ; randomize
-
 (defcustom mpuz-silent 'error
   "Set this to nil if you want dings on inputs.
 (defcustom mpuz-silent 'error
   "Set this to nil if you want dings on inputs.
-t means never ding, and `error' means only ding on wrong input."
+The value t means never ding, and `error' means only ding on wrong input."
   :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t)
                 (const :tag "If correct" error))
   :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t)
                 (const :tag "If correct" error))
@@ -57,26 +54,26 @@ t means never ding, and `error' means only ding on wrong input."
   :group 'mpuz)
 
 (defface mpuz-unsolved
   :group 'mpuz)
 
 (defface mpuz-unsolved
-  '((((class color)) (:foreground "red1" :bold t))
-    (t (:bold t)))
-  "Face to use for letters to be solved."
+  '((default :weight bold)
+    (((class color)) :foreground "red1"))
+  "Face for letters to be solved."
   :group 'mpuz)
 
 (defface mpuz-solved
   :group 'mpuz)
 
 (defface mpuz-solved
-  '((((class color)) (:foreground "green1" :bold t))
-    (t (:bold t)))
-  "Face to use for solved digits."
+  '((default :weight bold)
+    (((class color)) :foreground "green1"))
+  "Face for solved digits."
   :group 'mpuz)
 
 (defface mpuz-trivial
   :group 'mpuz)
 
 (defface mpuz-trivial
-  '((((class color)) (:foreground "blue" :bold t))
-    (t (:bold t)))
-  "Face to use for trivial digits solved for you."
+  '((default :weight bold)
+    (((class color)) :foreground "blue"))
+  "Face for trivial digits solved for you."
   :group 'mpuz)
 
 (defface mpuz-text
   :group 'mpuz)
 
 (defface mpuz-text
-  '((t (:inherit variable-pitch)))
-  "Face to use for text on right."
+  '((t :inherit variable-pitch))
+  "Face for text on right."
   :group 'mpuz)
 
 \f
   :group 'mpuz)
 
 \f
@@ -89,26 +86,9 @@ t means never ding, and `error' means only ding on wrong input."
 
 (defvar mpuz-mode-map
   (let ((map (make-sparse-keymap)))
 
 (defvar mpuz-mode-map
   (let ((map (make-sparse-keymap)))
-    (define-key map "a" 'mpuz-try-letter)
-    (define-key map "b" 'mpuz-try-letter)
-    (define-key map "c" 'mpuz-try-letter)
-    (define-key map "d" 'mpuz-try-letter)
-    (define-key map "e" 'mpuz-try-letter)
-    (define-key map "f" 'mpuz-try-letter)
-    (define-key map "g" 'mpuz-try-letter)
-    (define-key map "h" 'mpuz-try-letter)
-    (define-key map "i" 'mpuz-try-letter)
-    (define-key map "j" 'mpuz-try-letter)
-    (define-key map "A" 'mpuz-try-letter)
-    (define-key map "B" 'mpuz-try-letter)
-    (define-key map "C" 'mpuz-try-letter)
-    (define-key map "D" 'mpuz-try-letter)
-    (define-key map "E" 'mpuz-try-letter)
-    (define-key map "F" 'mpuz-try-letter)
-    (define-key map "G" 'mpuz-try-letter)
-    (define-key map "H" 'mpuz-try-letter)
-    (define-key map "I" 'mpuz-try-letter)
-    (define-key map "J" 'mpuz-try-letter)
+    (mapc (lambda (ch)
+            (define-key map (char-to-string ch) 'mpuz-try-letter))
+          "abcdefghijABCDEFGHIJ")
     (define-key map "\C-g" 'mpuz-offer-abort)
     (define-key map "?" 'describe-mode)
     map)
     (define-key map "\C-g" 'mpuz-offer-abort)
     (define-key map "?" 'describe-mode)
     map)
@@ -116,7 +96,7 @@ t means never ding, and `error' means only ding on wrong input."
 
 
 
 
 
 
-(defun mpuz-mode ()
+(define-derived-mode mpuz-mode fundamental-mode "Mult Puzzle"
   "Multiplication puzzle mode.
 
 You have to guess which letters stand for which digits in the
   "Multiplication puzzle mode.
 
 You have to guess which letters stand for which digits in the
@@ -128,13 +108,7 @@ 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]."
 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)
-  (kill-all-local-variables)
-  (setq major-mode 'mpuz-mode
-       mode-name  "Mult Puzzle"
-       tab-width 30)
-  (use-local-map mpuz-mode-map)
-  (run-mode-hooks 'mpuz-mode-hook))
+  (setq tab-width 30))
 
 \f
 ;; Some variables for statistics
 
 \f
 ;; Some variables for statistics
@@ -172,7 +146,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
   "A permutation from [0..9] to [0..9].")
 
 (defvar mpuz-letter-to-digit (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.")
+  "The inverse of `mpuz-digit-to-letter'.")
 
 (defmacro mpuz-to-digit (letter)
   (list 'aref 'mpuz-letter-to-digit letter))
 
 (defmacro mpuz-to-digit (letter)
   (list 'aref 'mpuz-letter-to-digit letter))
@@ -199,17 +173,16 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
 (defvar mpuz-board (make-vector 10 nil)
   "The board associates to any digit the list of squares where it appears.")
 
 (defvar mpuz-board (make-vector 10 nil)
   "The board associates to any digit the list of squares where it appears.")
 
-(defun mpuz-put-number-on-board (number row &rest l)
+(defun mpuz-put-number-on-board (number row &rest columns)
   "Put (last digit of) NUMBER on ROW and COLUMNS of the puzzle board."
   (let (digit)
   "Put (last digit of) NUMBER on ROW and COLUMNS of the puzzle board."
   (let (digit)
-    (while l
+    (dolist (column columns)
       (setq digit (% number 10)
       (setq digit (% number 10)
-           number (/ number 10))
-      (aset mpuz-board digit `((,row . ,(car l)) ,@(aref mpuz-board digit)))
-      (setq l (cdr l)))))
+            number (/ number 10))
+      (aset mpuz-board digit `((,row . ,column) ,@(aref mpuz-board digit))))))
 
 (defun mpuz-check-all-solved (&optional row col)
 
 (defun mpuz-check-all-solved (&optional row col)
-  "Check whether all digits have been solved. Return t if yes."
+  "Check whether all digits have been solved.  Return t if yes."
   (catch 'solved
     (let (A B1 B2 C D E squares)
       (and mpuz-solve-when-trivial
   (catch 'solved
     (let (A B1 B2 C D E squares)
       (and mpuz-solve-when-trivial
@@ -295,7 +268,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
   "The general picture of the puzzle screen, as a string.")
 
 (defun mpuz-create-buffer ()
   "The general picture of the puzzle screen, as a string.")
 
 (defun mpuz-create-buffer ()
-  "Create (or recreate) the puzzle buffer. Return it."
+  "Create (or recreate) the puzzle buffer.  Return it."
   (let ((buf (get-buffer-create "*Mult Puzzle*"))
        (face '(face mpuz-text))
        buffer-read-only)
   (let ((buf (get-buffer-create "*Mult Puzzle*"))
        (face '(face mpuz-text))
        buffer-read-only)
@@ -426,7 +399,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
   "Propose a digit for a letter in puzzle."
   (interactive)
   (if mpuz-in-progress
   "Propose a digit for a letter in puzzle."
   (interactive)
   (if mpuz-in-progress
-      (let (letter-char digit digit-char message)
+      (let (letter-char digit digit-char)
        (setq letter-char (upcase last-command-event)
              digit (mpuz-to-digit (- letter-char ?A)))
        (cond ((mpuz-digit-solved-p digit)
        (setq letter-char (upcase last-command-event)
              digit (mpuz-to-digit (- letter-char ?A)))
        (cond ((mpuz-digit-solved-p digit)
@@ -455,8 +428,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
   "Propose LETTER-CHAR as code for DIGIT-CHAR."
   (let* ((letter (- letter-char ?A))
         (digit (- digit-char ?0))
   "Propose LETTER-CHAR as code for DIGIT-CHAR."
   (let* ((letter (- letter-char ?A))
         (digit (- digit-char ?0))
-        (correct-digit (mpuz-to-digit letter))
-        (game mpuz-nb-completed-games))
+        (correct-digit (mpuz-to-digit letter)))
     (cond ((mpuz-digit-solved-p correct-digit)
           (message "%c has already been found." (+ correct-digit ?0)))
          ((mpuz-digit-solved-p digit)
     (cond ((mpuz-digit-solved-p correct-digit)
           (message "%c has already been found." (+ correct-digit ?0)))
          ((mpuz-digit-solved-p digit)
@@ -519,5 +491,4 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
 
 (provide 'mpuz)
 
 
 (provide 'mpuz)
 
-;; arch-tag: 2781d6ba-89e7-43b5-85c7-5d3a2e73feb1
 ;;; mpuz.el ends here
 ;;; mpuz.el ends here