[Emacs-diffs] trunk r117399: * lisp/play/landmark.el: Use lexical-binding and avoid `intangible'.

[Stefan Monnier]

------------------------------------------------------------
revno: 117399
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2014-06-25 14:11:45 -0400
message:
  * lisp/play/landmark.el: Use lexical-binding and avoid `intangible'.
  (landmark--last-pos): New var.
  (landmark--intangible-chars): New const.
  (landmark--intangible): New function.
  (landmark-mode, landmark-move): Use it.
  (landmark-mode): Remove properties.
  (landmark-plot-square, landmark-point-square, landmark-goto-xy)
  (landmark-cross-qtuple):
  Don't worry about `intangible' any more.
  (landmark-click, landmark-point-y): Same; and don't assume point-min==1.
  (landmark-init-display): Don't set `intangible' and `point-entered'.
  (square): Remove.  Inline it instead.
  (landmark--distance): Rename from `distance'.
  (landmark-calc-distance-of-robot-from): Rename from
  calc-distance-of-robot-from.
  (landmark-calc-smell-internal): Rename from calc-smell-internal.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/play/landmark.el          
landmark.el-20091113204419-o5vbwnq5f7feedwu-1175

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-06-25 10:36:51 +0000
+++ b/lisp/ChangeLog    2014-06-25 18:11:45 +0000
@@ -1,3 +1,22 @@
+2014-06-25  Stefan Monnier  <address@hidden>
+
+       * play/landmark.el: Use lexical-binding and avoid `intangible'.
+       (landmark--last-pos): New var.
+       (landmark--intangible-chars): New const.
+       (landmark--intangible): New function.
+       (landmark-mode, landmark-move): Use it.
+       (landmark-mode): Remove properties.
+       (landmark-plot-square, landmark-point-square, landmark-goto-xy)
+       (landmark-cross-qtuple):
+       Don't worry about `intangible' any more.
+       (landmark-click, landmark-point-y): Same; and don't assume point-min==1.
+       (landmark-init-display): Don't set `intangible' and `point-entered'.
+       (square): Remove.  Inline it instead.
+       (landmark--distance): Rename from `distance'.
+       (landmark-calc-distance-of-robot-from): Rename from
+       calc-distance-of-robot-from.
+       (landmark-calc-smell-internal): Rename from calc-smell-internal.
+
 2014-06-25  Dmitry Antipov  <address@hidden>
 
        * files.el (dir-locals-find-file, file-relative-name):

=== modified file 'lisp/play/landmark.el'
--- a/lisp/play/landmark.el     2014-06-21 21:36:44 +0000
+++ b/lisp/play/landmark.el     2014-06-25 18:11:45 +0000
@@ -1,10 +1,11 @@
-;;; landmark.el --- neural-network robot that learns landmarks
+;;; landmark.el --- Neural-network robot that learns landmarks  -*- 
lexical-binding:t -*-
 
 ;; Copyright (C) 1996-1997, 2000-2014 Free Software Foundation, Inc.
 
 ;; Author: Terrence Brannon (was: <address@hidden>)
 ;; Created: December 16, 1996 - first release to usenet
 ;; Keywords: games, neural network, adaptive search, chemotaxis
+;; Version: 1.0
 
 ;; This file is part of GNU Emacs.
 
@@ -225,9 +226,6 @@
                   'landmark-font-lock-face-X)))
   "Font lock rules for Landmark.")
 
-(put 'landmark-mode 'front-sticky
-     (put 'landmark-mode 'rear-nonsticky '(intangible)))
-(put 'landmark-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.
 (define-derived-mode landmark-mode special-mode "Lm"
@@ -244,7 +242,8 @@
 is non-nil.  One interesting value is `turn-on-font-lock'."
   (landmark-display-statistics)
   (setq-local font-lock-defaults '(landmark-font-lock-keywords t))
-  (setq buffer-read-only t))
+  (setq buffer-read-only t)
+  (add-hook 'post-command-hook #'landmark--intangible nil t))
 
 
 ;;;_ +  THE SCORE TABLE.
@@ -679,8 +678,8 @@
     (landmark-prompt-for-other-game))
    (t
     (message "Let me think...")
-    (let (square score)
-      (setq square (landmark-strongest-square))
+    (let ((square (landmark-strongest-square))
+          score)
       (cond ((null square)
             (landmark-terminate-game 'nobody-won))
            (t
@@ -722,8 +721,7 @@
        (min (max (/ (+ (- (cdr click)
                           landmark-y-offset
                           1)
-                       (let ((inhibit-point-motion-hooks t))
-                         (count-lines 1 (window-start)))
+                        (count-lines (point-min) (window-start))
                        landmark-square-height
                        (% landmark-square-height 2)
                        (/ landmark-square-height 2))
@@ -749,8 +747,8 @@
    ((not landmark-game-in-progress)
     (landmark-prompt-for-other-game))
    (t
-    (let (square score)
-      (setq square (landmark-point-square))
+    (let ((square (landmark-point-square))
+          score)
       (cond ((null square)
             (error "Your point is not on a square. Retry!"))
            ((not (zerop (aref landmark-board square)))
@@ -844,16 +842,15 @@
 
 (defun landmark-point-y ()
   "Return the board row where point is."
-  (let ((inhibit-point-motion-hooks t))
-    (1+ (/ (- (count-lines 1 (point)) landmark-y-offset (if (bolp) 0 1))
-          landmark-square-height))))
+  (1+ (/ (- (count-lines (point-min) (point))
+            landmark-y-offset (if (bolp) 0 1))
+         landmark-square-height)))
 
 (defun landmark-point-square ()
   "Return the index of the square point is on."
-  (let ((inhibit-point-motion-hooks t))
     (landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset)
                               landmark-square-width))
-                       (landmark-point-y))))
+                      (landmark-point-y)))
 
 (defun landmark-goto-square (index)
   "Move point to square number INDEX."
@@ -861,23 +858,21 @@
 
 (defun landmark-goto-xy (x y)
   "Move point to square at X, Y coords."
-  (let ((inhibit-point-motion-hooks t))
     (goto-char (point-min))
-    (forward-line (+ landmark-y-offset (* landmark-square-height (1- y)))))
+  (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))
   (move-to-column (+ landmark-x-offset (* landmark-square-width (1- x)))))
 
 (defun landmark-plot-square (square value)
   "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
   (or (= value 1)
       (landmark-goto-square square))
-  (let ((inhibit-read-only t)
-       (inhibit-point-motion-hooks t))
-    (insert-and-inherit (cond ((= value 1) ?.)
-                             ((= value 2) ?N)
-                             ((= value 3) ?S)
-                             ((= value 4) ?E)
-                             ((= value 5) ?W)
-                             ((= value 6) ?^)))
+  (let ((inhibit-read-only t))
+    (insert (cond ((= value 1) ?.)
+                  ((= value 2) ?N)
+                  ((= value 3) ?S)
+                  ((= value 4) ?E)
+                  ((= value 5) ?W)
+                  ((= value 6) ?^)))
 
     (and (zerop value)
         (add-text-properties (1- (point)) (point)
@@ -892,8 +887,7 @@
   "Display an N by M Landmark board."
   (buffer-disable-undo (current-buffer))
   (let ((inhibit-read-only t)
-       (point 1) opoint
-       (intangible t)
+       (point (point-min)) opoint
        (i m) j x)
     ;; Try to minimize number of chars (because of text properties)
     (setq tab-width
@@ -902,7 +896,7 @@
            (max (/ (+ (% landmark-x-offset landmark-square-width)
                       landmark-square-width 1) 2) 2)))
     (erase-buffer)
-    (newline landmark-y-offset)
+    (insert-char ?\n landmark-y-offset)
     (while (progn
             (setq j n
                   x (- landmark-x-offset landmark-square-width))
@@ -910,9 +904,7 @@
               (insert-char ?\t (/ (- (setq x (+ x landmark-square-width))
                                      (current-column))
                                   tab-width))
-              (insert-char ?  (- x (current-column)))
-              (if (setq intangible (not intangible))
-                  (put-text-property point (point) 'intangible 2))
+               (insert-char ?\s (- x (current-column)))
               (and (zerop j)
                    (= i (- m 2))
                    (progn
@@ -929,14 +921,7 @@
       (if (= i (1- m))
          (setq opoint point))
       (insert-char ?\n landmark-square-height))
-    (or (eq (char-after 1) ?.)
-       (put-text-property 1 2 'point-entered
-                          (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 _y) (if (eobp) (backward-char))))
-    (put-text-property (point-min) (point) 'category 'landmark-mode))
+    (insert-char ?\n))
   (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
   (sit-for 0))                         ; Display NOW
 
@@ -998,8 +983,7 @@
   "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
   (save-excursion                      ; Not moving point from last square
     (let ((depl (landmark-xy-to-index dx dy))
-         (inhibit-read-only t)
-         (inhibit-point-motion-hooks t))
+         (inhibit-read-only t))
       ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
       (while (/= square1 square2)
        (landmark-goto-square square1)
@@ -1018,20 +1002,40 @@
               (setq landmark-n (1+ landmark-n))
               (forward-line 1)
               (indent-to column)
-              (insert-and-inherit ?|))))
+              (insert ?|))))
          ((= dx -1)                    ; 1st Diagonal
           (indent-to (prog1 (- (current-column) (/ landmark-square-width 2))
                        (forward-line (/ landmark-square-height 2))))
-          (insert-and-inherit ?/))
+          (insert ?/))
          (t                            ; 2nd Diagonal
           (indent-to (prog1 (+ (current-column) (/ landmark-square-width 2))
                        (forward-line (/ landmark-square-height 2))))
-          (insert-and-inherit ?\\))))))
+          (insert ?\\))))))
   (sit-for 0))                         ; Display NOW
 
 
 ;;;_ + CURSOR MOTION.
 
+(defvar-local landmark--last-pos 0)
+
+(defconst landmark--intangible-chars "- \t\n|/\\\\")
+
+(defun landmark--intangible ()
+  (when (or (eobp)
+            (save-excursion
+              (not (zerop (skip-chars-forward landmark--intangible-chars)))))
+    (if (<= landmark--last-pos (point))   ;Moving forward.
+        (progn
+          (skip-chars-forward landmark--intangible-chars)
+          (when (eobp)
+            (skip-chars-backward landmark--intangible-chars)
+            (forward-char -1)))
+      (skip-chars-backward landmark--intangible-chars)
+      (if (bobp)
+          (skip-chars-forward landmark--intangible-chars)
+        (forward-char -1))))
+  (setq landmark--last-pos (point)))
+
 ;; previous-line and next-line don't work right with intangible newlines
 (defun landmark-move-down ()
   "Move point down one row on the Landmark board."
@@ -1138,7 +1142,7 @@
 
 
 (defun landmark-print-distance ()
-  (insert (format "tree: %S \n" (calc-distance-of-robot-from 'landmark-tree)))
+  (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 
'landmark-tree)))
   (mapc 'landmark-print-distance-int landmark-directions))
 
 
@@ -1303,9 +1307,9 @@
 ;;;_  - landmark-plot-internal (sym)
 (defun landmark-plot-internal (sym)
   (landmark-plot-square (landmark-xy-to-index
-                  (get sym 'x)
-                  (get sym 'y))
-                  (get sym 'sym)))
+                         (get sym 'x)
+                         (get sym 'y))
+                        (get sym 'sym)))
 ;;;_  - landmark-plot-landmarks ()
 (defun landmark-plot-landmarks ()
   (setq landmark-cx (/ landmark-board-width  2))
@@ -1336,26 +1340,24 @@
 
 
 ;;;_ + Distance-calculation functions
-;;;_  - square (a)
-(defun square (a)
-  (* a a))
 
 ;;;_  - distance (x x0 y y0)
-(defun distance (x x0 y y0)
-  (sqrt (+ (square (- x x0)) (square (- y y0)))))
+(defun landmark--distance (x x0 y y0)
+  (let ((dx (- x x0)) (dy (- y y0)))
+    (sqrt (+ (* dx dx) (* dy dy)))))
 
-;;;_  - calc-distance-of-robot-from (direction)
-(defun calc-distance-of-robot-from (direction)
+;;;_  - landmark-calc-distance-of-robot-from (direction)
+(defun landmark-calc-distance-of-robot-from (direction)
   (put direction 'distance
-       (distance (get direction 'x)
-                (landmark-index-to-x (landmark-point-square))
-                (get direction 'y)
-                (landmark-index-to-y (landmark-point-square)))))
+       (landmark--distance (get direction 'x)
+                           (landmark-index-to-x (landmark-point-square))
+                           (get direction 'y)
+                           (landmark-index-to-y (landmark-point-square)))))
 
-;;;_  - calc-smell-internal (sym)
-(defun calc-smell-internal (sym)
+;;;_  - landmark-calc-smell-internal (sym)
+(defun landmark-calc-smell-internal (sym)
   (let ((r (get sym 'r))
-       (d (calc-distance-of-robot-from sym)))
+       (d (landmark-calc-distance-of-robot-from sym)))
     (if (> (* 0.5 (- 1 (/ d r))) 0)
        (* 0.5 (- 1 (/ d r)))
       0)))
@@ -1402,12 +1404,12 @@
 
 (defun landmark-calc-current-smells ()
   (mapc (lambda (direction)
-            (put direction 'smell (calc-smell-internal direction)))
+            (put direction 'smell (landmark-calc-smell-internal direction)))
          landmark-directions))
 
 (defun landmark-calc-payoff ()
   (put 'z 't-1 (get 'z 't))
-  (put 'z 't (calc-smell-internal 'landmark-tree))
+  (put 'z 't (landmark-calc-smell-internal 'landmark-tree))
   (if (= (- (get 'z 't) (get 'z 't-1)) 0.0)
       (cl-incf landmark-no-payoff)
     (setf landmark-no-payoff 0)))
@@ -1448,8 +1450,9 @@
            (message "e-w normalization"))))
 
   (mapc (lambda (pair)
-            (if (> (get (car pair) 'y_t) 0)
-                (funcall (car (cdr pair)))))
+            (when (> (get (car pair) 'y_t) 0)
+               (funcall (car (cdr pair)))
+               (landmark--intangible)))
          '(
            (landmark-n landmark-move-up)
            (landmark-s landmark-move-down)
@@ -1471,7 +1474,7 @@
 
 (defun landmark-amble-robot ()
   (interactive)
-  (while (> (calc-distance-of-robot-from 'landmark-tree) 0)
+  (while (> (landmark-calc-distance-of-robot-from 'landmark-tree) 0)
 
     (landmark-store-old-y_t)
     (landmark-calc-current-smells)
@@ -1505,8 +1508,7 @@
    ((not landmark-game-in-progress)
     (landmark-prompt-for-other-game))
    (t
-    (let (square)
-      (setq square (landmark-point-square))
+    (let ((square (landmark-point-square)))
       (cond ((null square)
             (error "Your point is not on a square. Retry!"))
            ((not (zerop (aref landmark-board square)))
@@ -1517,7 +1519,7 @@
 
               (landmark-store-old-y_t)
               (landmark-calc-current-smells)
-              (put 'z 't (calc-smell-internal 'landmark-tree))
+              (put 'z 't (landmark-calc-smell-internal 'landmark-tree))
 
               (landmark-random-move)
 
@@ -1590,7 +1592,9 @@
 ;; distance on scent.
 
 (defun landmark-set-landmark-signal-strengths ()
-  (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square 
landmark-cy))) 1.5))
+  (setq landmark-tree-r (* (sqrt (+ (* landmark-cx landmark-cx)
+                                    (* landmark-cy landmark-cy)))
+                           1.5))
   (mapc (lambda (direction)
             (put direction 'r (* landmark-cx 1.1)))
        landmark-ew)
@@ -1609,7 +1613,7 @@
   "Run 100 Landmark games, each time saving the weights from the previous 
game."
   (interactive)
   (landmark 1)
-  (dotimes (scratch-var 100)
+  (dotimes (_ 100)
     (landmark 2)))
 
 ;;;###autoload