(s-region-bind): Doc fix.

[gnu-emacs] / lisp / play / landmark.el

diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el
index 93300df4143be350ad6170ee6e954697f0f42c87..feab5de1bc3c46c2d3c74cb7bd775c87ca37af94 100644 (file)
--- a/lisp/play/landmark.el
+++ b/lisp/play/landmark.el
@@ -1,10 +1,10 @@
 ;;; landmark.el --- neural-network robot that learns landmarks
 
-;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (c) 1996, 1997, 2000, 2003, 2005 Free Software Foundation, Inc.
 
-;; Author: Terrence Brannon <brannon@rana.usc.edu>
+;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>)
 ;; Created: December 16, 1996 - first release to usenet
-;; Keywords: gomoku neural network adaptive search chemotaxis
+;; Keywords: gomoku, neural network, adaptive search, chemotaxis
 
 ;;;_* Usage
 ;;; Just type
@@ -26,11 +26,11 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 
-;;;_* Commentary
+;;; Commentary:
 ;;; Lm is a relatively non-participatory game in which a robot
 ;;; attempts to maneuver towards a tree at the center of the window
 ;;; based on unique olfactory cues from each of the 4 directions. If
@@ -54,20 +54,16 @@
 ;;; a single move, one moves east,west and south, then both east and
 ;;; west will be improved when they shouldn't
 
-;;; For further references see
-;;; http://rana.usc.edu:8376/~brannon/warez/yours-truly/lm/
 ;;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this
 ;;; concise problem description.
 
-;;;_* Provide
-
-(provide 'lm)
-
 ;;;_* Require
-(require 'cl)
+(eval-when-compile (require 'cl))
 
 ;;;_* From Gomoku
 
+;;; Code:
+
 (defgroup lm nil
   "Neural-network robot that learns landmarks."
   :prefix "lm-"
@@ -204,29 +200,23 @@
   (define-key lm-mode-map [mouse-2] 'lm-mouse-play)
   (define-key lm-mode-map [drag-mouse-2] 'lm-mouse-play)
 
-  (substitute-key-definition 'previous-line 'lm-move-up
-                            lm-mode-map (current-global-map))
-  (substitute-key-definition 'next-line 'lm-move-down
-                            lm-mode-map (current-global-map))
-  (substitute-key-definition 'beginning-of-line 'lm-beginning-of-line
-                            lm-mode-map (current-global-map))
-  (substitute-key-definition 'end-of-line 'lm-end-of-line
-                            lm-mode-map (current-global-map))
-  (substitute-key-definition 'undo 'lm-human-takes-back
-                            lm-mode-map (current-global-map))
-  (substitute-key-definition 'advertised-undo 'lm-human-takes-back
-                            lm-mode-map (current-global-map)))
+  (define-key lm-mode-map [remap previous-line] 'lm-move-up)
+  (define-key lm-mode-map [remap next-line] 'lm-move-down)
+  (define-key lm-mode-map [remap beginning-of-line] 'lm-beginning-of-line)
+  (define-key lm-mode-map [remap end-of-line] 'lm-end-of-line)
+  (define-key lm-mode-map [remap undo] 'lm-human-takes-back)
+  (define-key lm-mode-map [remap advertised-undo] 'lm-human-takes-back))
 
 (defvar lm-emacs-won ()
   "*For making font-lock use the winner's face for the line.")
 
 (defvar lm-font-lock-face-O
-  (if window-system
+  (if (display-color-p)
       (list (facemenu-get-face 'fg:red) 'bold))
   "*Face to use for Emacs' O.")
 
 (defvar lm-font-lock-face-X
-  (if window-system
+  (if (display-color-p)
       (list (facemenu-get-face 'fg:green) 'bold))
   "*Face to use for your X.")
 
@@ -241,6 +231,9 @@
 (put 'lm-mode 'front-sticky
      (put 'lm-mode 'rear-nonsticky '(intangible)))
 (put 'lm-mode 'intangible 1)
+;; This one is for when they set view-read-only to t: Landmark cannot
+;; allow View Mode to be activated in its buffer.
+(put 'lm-mode 'mode-class 'special)
 
 (defun lm-mode ()
   "Major mode for playing Lm against Emacs.
@@ -255,6 +248,7 @@ Other useful commands:
 Entry to this mode calls the value of `lm-mode-hook' if that value
 is non-nil.  One interesting value is `turn-on-font-lock'."
   (interactive)
+  (kill-all-local-variables)
   (setq major-mode 'lm-mode
        mode-name "Lm")
   (lm-display-statistics)
@@ -262,7 +256,7 @@ is non-nil.  One interesting value is `turn-on-font-lock'."
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(lm-font-lock-keywords t))
   (toggle-read-only t)
-  (run-hooks 'lm-mode-hook))
+  (run-mode-hooks 'lm-mode-hook))
 
 
 ;;;_ +  THE SCORE TABLE.
@@ -897,9 +891,11 @@ If the game is finished, this command requests for another game."
                              ((= value 5) ?W)
                              ((= value 6) ?^)))
 
-    (and window-system
-        (zerop value)
-        (put-text-property (1- (point)) (point) 'mouse-face 'highlight))
+    (and (zerop value)
+        (add-text-properties (1- (point)) (point)
+                             '(mouse-face highlight
+                               help-echo "\
+mouse-1: get robot moving, mouse-2: play on this square")))
     (delete-char 1)
     (backward-char 1))
   (sit-for 0)) ; Display NOW
@@ -938,20 +934,20 @@ If the game is finished, this command requests for another game."
                      (goto-char (point-max))))
               (setq point (point))
               (insert ?=)
-              (if window-system
-                  (put-text-property point (point)
-                                     'mouse-face 'highlight)))
+              (add-text-properties point (point)
+                                   '(mouse-face highlight help-echo "\
+mouse-1: get robot moving, mouse-2: play on this square")))
             (> (setq i (1- i)) 0))
       (if (= i (1- m))
          (setq opoint point))
       (insert-char ?\n lm-square-height))
     (or (eq (char-after 1) ?.)
        (put-text-property 1 2 'point-entered
-                          (lambda (x x) (if (bobp) (forward-char)))))
+                          (lambda (x y) (if (bobp) (forward-char)))))
     (or intangible
        (put-text-property point (point) 'intangible 2))
     (put-text-property point (point) 'point-entered
-                      (lambda (x x) (if (eobp) (backward-char))))
+                      (lambda (x y) (if (eobp) (backward-char))))
     (put-text-property (point-min) (point) 'category 'lm-mode))
   (lm-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
   (sit-for 0))                         ; Display NOW
@@ -1096,8 +1092,6 @@ If the game is finished, this command requests for another game."
   (move-to-column (+ lm-x-offset
                     (* lm-square-width (1- lm-board-width)))))
 
-(provide 'lm)
-
 
 ;;;_ + Simulation variables
 
@@ -1125,8 +1119,6 @@ this program to add a random element to the way moves were made.")
 
 ;;;_* Terry's mods to create lm.el
 
-;;;_ + Debugging things
-(setq debug-on-error t)
 ;;;(setq lm-debug nil)
 (defvar lm-debug nil
   "If non-nil, debugging is printed.")
@@ -1161,7 +1153,7 @@ because it is overwritten by \"One moment please\"."
 ;;(setq direction 'lm-n)
 ;;(get 'lm-n 'lm-s)
 (defun lm-nslify-wts-int (direction)
-  (mapcar '(lambda (target-direction)
+  (mapcar (lambda (target-direction)
             (get direction target-direction))
          lm-directions))
 
@@ -1174,7 +1166,7 @@ because it is overwritten by \"One moment please\"."
                  (eval (cons 'max l)) (eval (cons 'min l))))))
 
 (defun lm-print-wts-int (direction)
-  (mapc '(lambda (target-direction)
+  (mapc (lambda (target-direction)
             (insert (format "%S %S %S "
                              direction
                              target-direction
@@ -1241,14 +1233,14 @@ because it is overwritten by \"One moment please\"."
     (set-buffer "*lm-blackbox*")
     (insert "==============================\n")
     (insert "I smell: ")
-    (mapc '(lambda (direction)
+    (mapc (lambda (direction)
               (if (> (get direction 'smell) 0)
                   (insert (format "%S " direction))))
            lm-directions)
     (insert "\n")
 
     (insert "I move: ")
-    (mapc '(lambda (direction)
+    (mapc (lambda (direction)
               (if (> (get direction 'y_t) 0)
                   (insert (format "%S " direction))))
            lm-directions)
@@ -1303,7 +1295,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
 ;   (* (/ (random 900000) 900000.0) .0001)))
 ;;;_   : lm-randomize-weights-for (direction)
 (defun lm-randomize-weights-for (direction)
-  (mapc '(lambda (target-direction)
+  (mapc (lambda (target-direction)
             (put direction
                  target-direction
                  (* (lm-flip-a-coin) (/  (random 10000) 10000.0))))
@@ -1314,7 +1306,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
 
 ;;;_   : lm-fix-weights-for (direction)
 (defun lm-fix-weights-for (direction)
-  (mapc '(lambda (target-direction)
+  (mapc (lambda (target-direction)
             (put direction
                  target-direction
                  lm-initial-wij))
@@ -1398,7 +1390,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
           0.0))))
 
 (defun lm-update-normal-weights (direction)
-  (mapc '(lambda (target-direction)
+  (mapc (lambda (target-direction)
             (put direction target-direction
                  (+
                   (get direction target-direction)
@@ -1409,7 +1401,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
          lm-directions))
 
 (defun lm-update-naught-weights (direction)
-  (mapc '(lambda (target-direction)
+  (mapc (lambda (target-direction)
             (put direction 'w0
                  (lm-f
                   (+
@@ -1423,7 +1415,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
 ;;;_ + Statistics gathering and creating functions
 
 (defun lm-calc-current-smells ()
-  (mapc '(lambda (direction)
+  (mapc (lambda (direction)
             (put direction 'smell (calc-smell-internal direction)))
          lm-directions))
 
@@ -1435,7 +1427,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
     (setf lm-no-payoff 0)))
 
 (defun lm-store-old-y_t ()
-  (mapc '(lambda (direction)
+  (mapc (lambda (direction)
             (put direction 'y_t-1 (get direction 'y_t)))
          lm-directions))
 
@@ -1443,35 +1435,33 @@ After this limit is reached, lm-random-move is called to push him out of it."
 ;;;_ + Functions to move robot
 
 (defun lm-confidence-for (target-direction)
-  (+
-   (get target-direction 'w0)
-   (reduce '+
-    (mapcar '(lambda (direction)
-              (*
-               (get direction target-direction)
-               (get direction 'smell))
-                       )
-           lm-directions))))
+  (apply '+
+        (get target-direction 'w0)
+        (mapcar (lambda (direction)
+                  (*
+                   (get direction target-direction)
+                   (get direction 'smell)))
+                lm-directions)))
 
 
 (defun lm-calc-confidences ()
-  (mapc '(lambda (direction)
+  (mapc (lambda (direction)
             (put direction 's (lm-confidence-for direction)))
             lm-directions))
 
 (defun lm-move ()
   (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0))
       (progn
-       (mapc '(lambda (dir) (put dir 'y_t 0)) lm-ns)
+       (mapc (lambda (dir) (put dir 'y_t 0)) lm-ns)
        (if lm-debug
            (message "n-s normalization."))))
   (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0))
       (progn
-       (mapc '(lambda (dir) (put dir 'y_t 0)) lm-ew)
+       (mapc (lambda (dir) (put dir 'y_t 0)) lm-ew)
        (if lm-debug
            (message "e-w normalization"))))
 
-  (mapc '(lambda (pair)
+  (mapc (lambda (pair)
             (if (> (get (car pair) 'y_t) 0)
                 (funcall (car (cdr pair)))))
          '(
@@ -1487,7 +1477,7 @@ After this limit is reached, lm-random-move is called to push him out of it."
 
 (defun lm-random-move ()
   (mapc
-   '(lambda (direction) (put direction 'y_t 0))
+   (lambda (direction) (put direction 'y_t 0))
    lm-directions)
   (dolist (direction (nth (random 8) lm-8-directions))
     (put direction 'y_t 1.0))
@@ -1583,14 +1573,14 @@ If the game is finished, this command requests for another game."
 
   (lm-set-landmark-signal-strengths)
 
-  (mapc '(lambda (direction)
+  (mapc (lambda (direction)
             (put direction 'y_t 0.0))
          lm-directions)
 
   (if (not save-weights)
       (progn
        (mapc 'lm-fix-weights-for lm-directions)
-       (mapc '(lambda (direction)
+       (mapc (lambda (direction)
                   (put direction 'w0 lm-initial-w0))
        lm-directions))
     (message "Weights preserved for this run."))
@@ -1620,10 +1610,10 @@ If the game is finished, this command requests for another game."
 
   (setq lm-tree-r       (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5))
 
-  (mapc '(lambda (direction)
+  (mapc (lambda (direction)
             (put direction 'r (* lm-cx 1.1)))
        lm-ew)
-  (mapc '(lambda (direction)
+  (mapc (lambda (direction)
             (put direction 'r (* lm-cy 1.1)))
        lm-ns)
   (put 'lm-tree 'r lm-tree-r))
@@ -1712,4 +1702,7 @@ Use \\[describe-mode] for more info."
 ;;;outline-layout: (0 : -1 -1 0)
 ;;;End:
 
+(provide 'landmark)
+
+;;; arch-tag: ae5031be-96e6-459e-a3df-1df53117d3f2
 ;;; landmark.el ends here