From: Stefan Monnier Date: Wed, 25 Jun 2014 18:11:45 +0000 (-0400) Subject: * lisp/play/landmark.el: Use lexical-binding and avoid `intangible'. X-Git-Tag: emacs-25.0.90~2612^2~709^2~697^2~29 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f51e7ac3695f7c86af9e8d9464cf7da092c6e4ce;p=emacs.git * 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c3951a08c0a..089749ac028 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,22 @@ +2014-06-25 Stefan Monnier + + * 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 * files.el (dir-locals-find-file, file-relative-name): diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index f1bd87ce847..c1175944917 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -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: ) ;; 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 @@ Entry to this mode calls the value of `landmark-mode-hook' if that value 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 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." (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 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." (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 @@ If the game is finished, this command requests for another game." ((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 @@ If the game is finished, this command requests for another game." (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 @@ If the game is finished, this command requests for another game." (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 @@ mouse-1: get robot moving, mouse-2: play on this square"))) "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 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (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 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (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 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (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 @@ mouse-1: get robot moving, mouse-2: play on this square"))) "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 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (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 @@ because it is overwritten by \"One moment please\"." (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 @@ After this limit is reached, landmark-random-move is called to push him out of i ;;;_ - 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 @@ After this limit is reached, landmark-random-move is called to push him out of i ;;;_ + 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 @@ After this limit is reached, landmark-random-move is called to push him out of i (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 @@ After this limit is reached, landmark-random-move is called to push him out of i (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 @@ After this limit is reached, landmark-random-move is called to push him out of i (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 @@ If the game is finished, this command requests for another game." ((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 @@ If the game is finished, this command requests for another game." (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 @@ If the game is finished, this command requests for another game." ;; 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 @@ If the game is finished, this command requests for another game." "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