annotate lisp/play/landmark.el @ 107754:c065a9e361c6

Explain how to re-throw a signal. control.texi (Handling Errors): How to re-throw a signal caught by condition-case.
author Eli Zaretskii <eliz@gnu.org>
date Wed, 31 Mar 2010 12:43:53 +0300
parents 1d1d5d9bd884
children cc035ccb9275 516f3d80dac6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
22388
2d0bece94ee7 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 21363
diff changeset
1 ;;; landmark.el --- neural-network robot that learns landmarks
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
2
104848
1382a0cd8022 Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents: 104576
diff changeset
3 ;; Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
106815
1d1d5d9bd884 Add 2010 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 105829
diff changeset
4 ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5
38455
802c948ddb3a *** empty log message ***
Pavel Janík <Pavel@Janik.cz>
parents: 38425
diff changeset
6 ;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Created: December 16, 1996 - first release to usenet
104576
4b8f024e6993 Kevin Ryde <user42 at zip.com.au>
Glenn Morris <rgm@gnu.org>
parents: 104390
diff changeset
8 ;; Keywords: games, gomoku, neural network, adaptive search, chemotaxis
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
10 ;;;_* Usage
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
11 ;;; Just type
71625
22433275348d Comment munging; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 69895
diff changeset
12 ;;; M-x eval-buffer
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
13 ;;; M-x lm-test-run
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
14
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
15
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; This file is part of GNU Emacs.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17
94675
949bd6ad1ba4 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
18 ;; GNU Emacs is free software: you can redistribute it and/or modify
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; it under the terms of the GNU General Public License as published by
94675
949bd6ad1ba4 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
20 ;; the Free Software Foundation, either version 3 of the License, or
949bd6ad1ba4 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
21 ;; (at your option) any later version.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; GNU Emacs is distributed in the hope that it will be useful,
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;; GNU General Public License for more details.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; You should have received a copy of the GNU General Public License
94675
949bd6ad1ba4 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
29 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 38076
diff changeset
32 ;;; Commentary:
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;;; Lm is a relatively non-participatory game in which a robot
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;;; attempts to maneuver towards a tree at the center of the window
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;;; based on unique olfactory cues from each of the 4 directions. If
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 ;;; the smell of the tree increases, then the weights in the robot's
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;;; brain are adjusted to encourage this odor-driven behavior in the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 ;;; future. If the smell of the tree decreases, the robots weights are
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;;; adjusted to discourage a correct move.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
41 ;;; In laymen's terms, the search space is initially flat. The point
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;;; of training is to "turn up the edges of the search space" so that
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 ;;; the robot rolls toward the center.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 ;;; Further, do not become alarmed if the robot appears to oscillate
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 ;;; back and forth between two or a few positions. This simply means
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 ;;; it is currently caught in a local minimum and is doing its best to
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 ;;; work its way out.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 ;;; The version of this program as described has a small problem. a
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;;; move in a net direction can produce gross credit assignment. for
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 ;;; example, if moving south will produce positive payoff, then, if in
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;;; a single move, one moves east,west and south, then both east and
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ;;; west will be improved when they shouldn't
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
56 ;;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
57 ;;; concise problem description.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ;;;_* Require
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
60 (eval-when-compile (require 'cl))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 ;;;_* From Gomoku
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 38076
diff changeset
64 ;;; Code:
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 38076
diff changeset
65
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
66 (defgroup lm nil
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
67 "Neural-network robot that learns landmarks."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
68 :prefix "lm-"
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
69 :group 'games)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
70
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ;;;_ + THE BOARD.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 ;; The board is a rectangular grid. We code empty squares with 0, X's with 1
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 ;; and O's with 6. The rectangle is recorded in a one dimensional vector
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 ;; containing padding squares (coded with -1). These squares allow us to
74157
e56f52b00e2d Space/tab mixup.
Juanma Barranquero <lekktu@gmail.com>
parents: 71625
diff changeset
76 ;; detect when we are trying to move out of the board. We denote a square by
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 ;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 ;; leftmost topmost square has coords (1,1) and index lm-board-width + 2.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 ;; Similarly, vectors between squares may be given by two DX, DY coords or by
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 ;; one DEPL (the difference between indexes).
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (defvar lm-board-width nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 "Number of columns on the Lm board.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (defvar lm-board-height nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 "Number of lines on the Lm board.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 (defvar lm-board nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 "Vector recording the actual state of the Lm board.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 (defvar lm-vector-length nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 "Length of lm-board vector.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 (defvar lm-draw-limit nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 ;; This is usually set to 70% of the number of squares.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 "After how many moves will Emacs offer a draw?")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
97 (defvar lm-cx 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
98 "This is the x coordinate of the center of the board.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
99
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
100 (defvar lm-cy 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
101 "This is the y coordinate of the center of the board.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
102
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
103 (defvar lm-m 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
104 "This is the x dimension of the playing board.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
105
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
106 (defvar lm-n 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
107 "This is the y dimension of the playing board.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
108
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
109
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 (defun lm-xy-to-index (x y)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 "Translate X, Y cartesian coords into the corresponding board index."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (+ (* y lm-board-width) x y))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (defun lm-index-to-x (index)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 "Return corresponding x-coord of board INDEX."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (% index (1+ lm-board-width)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (defun lm-index-to-y (index)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 "Return corresponding y-coord of board INDEX."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (/ index (1+ lm-board-width)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (defun lm-init-board ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 "Create the lm-board vector and fill it with initial values."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (setq lm-board (make-vector lm-vector-length 0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 ;; Every square is 0 (i.e. empty) except padding squares:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (let ((i 0) (ii (1- lm-vector-length)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (while (<= i lm-board-width) ; The squares in [0..width] and in
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 (aset lm-board i -1) ; [length - width - 1..length - 1]
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 (aset lm-board ii -1) ; are padding squares.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (setq i (1+ i)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 ii (1- ii))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 (let ((i 0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 (while (< i lm-vector-length)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 (aset lm-board i -1) ; and also all k*(width+1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 (setq i (+ i lm-board-width 1)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
137 ;;;_ + DISPLAYING THE BOARD.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
139 ;; You may change these values if you have a small screen or if the squares
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
140 ;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
142 (defconst lm-square-width 2
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
143 "*Horizontal spacing between squares on the Lm board.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
144
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
145 (defconst lm-square-height 1
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
146 "*Vertical spacing between squares on the Lm board.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
147
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
148 (defconst lm-x-offset 3
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
149 "*Number of columns between the Lm board and the side of the window.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
150
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
151 (defconst lm-y-offset 1
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
152 "*Number of lines between the Lm board and the top of the window.")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 ;;;_ + LM MODE AND KEYMAP.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
157 (defcustom lm-mode-hook nil
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
158 "If non-nil, its value is called on entry to Lm mode."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
159 :type 'hook
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
160 :group 'lm)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (defvar lm-mode-map nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 "Local keymap to use in Lm mode.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (if lm-mode-map nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (setq lm-mode-map (make-sparse-keymap))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 ;; Key bindings for cursor motion.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 (define-key lm-mode-map "y" 'lm-move-nw) ; y
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 (define-key lm-mode-map "u" 'lm-move-ne) ; u
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (define-key lm-mode-map "b" 'lm-move-sw) ; b
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (define-key lm-mode-map "n" 'lm-move-se) ; n
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (define-key lm-mode-map "h" 'backward-char) ; h
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 (define-key lm-mode-map "l" 'forward-char) ; l
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (define-key lm-mode-map "j" 'lm-move-down) ; j
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (define-key lm-mode-map "k" 'lm-move-up) ; k
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 (define-key lm-mode-map [kp-7] 'lm-move-nw)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (define-key lm-mode-map [kp-9] 'lm-move-ne)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 (define-key lm-mode-map [kp-1] 'lm-move-sw)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (define-key lm-mode-map [kp-3] 'lm-move-se)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (define-key lm-mode-map [kp-4] 'backward-char)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (define-key lm-mode-map [kp-6] 'forward-char)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 (define-key lm-mode-map [kp-2] 'lm-move-down)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 (define-key lm-mode-map [kp-8] 'lm-move-up)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 (define-key lm-mode-map "\C-n" 'lm-move-down) ; C-n
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 (define-key lm-mode-map "\C-p" 'lm-move-up) ; C-p
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 ;; Key bindings for entering Human moves.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 (define-key lm-mode-map "X" 'lm-human-plays) ; X
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (define-key lm-mode-map "x" 'lm-human-plays) ; x
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 (define-key lm-mode-map " " 'lm-start-robot) ; SPC
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 (define-key lm-mode-map [down-mouse-1] 'lm-start-robot)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (define-key lm-mode-map [drag-mouse-1] 'lm-click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 (define-key lm-mode-map [mouse-1] 'lm-click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (define-key lm-mode-map [down-mouse-2] 'lm-click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (define-key lm-mode-map [mouse-2] 'lm-mouse-play)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 (define-key lm-mode-map [drag-mouse-2] 'lm-mouse-play)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201
49174
1181f774d922 (lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents: 41320
diff changeset
202 (define-key lm-mode-map [remap previous-line] 'lm-move-up)
1181f774d922 (lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents: 41320
diff changeset
203 (define-key lm-mode-map [remap next-line] 'lm-move-down)
1181f774d922 (lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents: 41320
diff changeset
204 (define-key lm-mode-map [remap beginning-of-line] 'lm-beginning-of-line)
1181f774d922 (lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents: 41320
diff changeset
205 (define-key lm-mode-map [remap end-of-line] 'lm-end-of-line)
1181f774d922 (lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents: 41320
diff changeset
206 (define-key lm-mode-map [remap undo] 'lm-human-takes-back)
1181f774d922 (lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents: 41320
diff changeset
207 (define-key lm-mode-map [remap advertised-undo] 'lm-human-takes-back))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (defvar lm-emacs-won ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 "*For making font-lock use the winner's face for the line.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211
69895
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
212 (defface lm-font-lock-face-O '((((class color)) :foreground "red")
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
213 (t :weight bold))
104848
1382a0cd8022 Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents: 104576
diff changeset
214 "Face to use for Emacs' O."
69895
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
215 :version "22.1"
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
216 :group 'lm)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217
69895
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
218 (defface lm-font-lock-face-X '((((class color)) :foreground "green")
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
219 (t :weight bold))
104848
1382a0cd8022 Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents: 104576
diff changeset
220 "Face to use for your X."
69895
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
221 :version "22.1"
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
222 :group 'lm)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (defvar lm-font-lock-keywords
69895
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
225 '(("O" . 'lm-font-lock-face-O)
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
226 ("X" . 'lm-font-lock-face-X)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 ("[-|/\\]" 0 (if lm-emacs-won
69895
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
228 'lm-font-lock-face-O
215057e97d56 (lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents: 68866
diff changeset
229 'lm-font-lock-face-X)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 "*Font lock rules for Lm.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (put 'lm-mode 'front-sticky
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 (put 'lm-mode 'rear-nonsticky '(intangible)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (put 'lm-mode 'intangible 1)
41317
a33250d752d4 Mark lm-mode as special. Suggested by Klaus Straubinger <ksnetz@arcor.de>
Eli Zaretskii <eliz@gnu.org>
parents: 39866
diff changeset
235 ;; This one is for when they set view-read-only to t: Landmark cannot
a33250d752d4 Mark lm-mode as special. Suggested by Klaus Straubinger <ksnetz@arcor.de>
Eli Zaretskii <eliz@gnu.org>
parents: 39866
diff changeset
236 ;; allow View Mode to be activated in its buffer.
41320
75e9bedb3bab Fix a typo.
Eli Zaretskii <eliz@gnu.org>
parents: 41317
diff changeset
237 (put 'lm-mode 'mode-class 'special)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 (defun lm-mode ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 "Major mode for playing Lm against Emacs.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 You and Emacs play in turn by marking a free square. You mark it with X
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 and Emacs marks it with O. The winner is the first to get five contiguous
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 marks horizontally, vertically or in diagonal.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 You play by moving the cursor over the square you choose and hitting \\[lm-human-plays].
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 Other useful commands:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 \\{lm-mode-map}
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 Entry to this mode calls the value of `lm-mode-hook' if that value
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 is non-nil. One interesting value is `turn-on-font-lock'."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (interactive)
62770
93e71f3dcd14 * play/5x5.el (5x5-mode):
Lute Kamstra <lute@gnu.org>
parents: 62249
diff changeset
252 (kill-all-local-variables)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (setq major-mode 'lm-mode
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 mode-name "Lm")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (lm-display-statistics)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (use-local-map lm-mode-map)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (make-local-variable 'font-lock-defaults)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 (setq font-lock-defaults '(lm-font-lock-keywords t))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 (toggle-read-only t)
62770
93e71f3dcd14 * play/5x5.el (5x5-mode):
Lute Kamstra <lute@gnu.org>
parents: 62249
diff changeset
260 (run-mode-hooks 'lm-mode-hook))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 ;;;_ + THE SCORE TABLE.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 ;; Every (free) square has a score associated to it, recorded in the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 ;; LM-SCORE-TABLE vector. The program always plays in the square having
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 ;; the highest score.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 (defvar lm-score-table nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 "Vector recording the actual score of the free squares.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 ;; The key point point about the algorithm is that, rather than considering
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 ;; the board as just a set of squares, we prefer to see it as a "space" of
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 ;; internested 5-tuples of contiguous squares (called qtuples).
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 ;; The aim of the program is to fill one qtuple with its O's while preventing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 ;; you from filling another one with your X's. To that effect, it computes a
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 ;; score for every qtuple, with better qtuples having better scores. Of
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 ;; course, the score of a qtuple (taken in isolation) is just determined by
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 ;; its contents as a set, i.e. not considering the order of its elements. The
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 ;; highest score is given to the "OOOO" qtuples because playing in such a
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 ;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 ;; not playing in it is just loosing the game, and so on. Note that a
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 ;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 ;; has score zero because there is no more any point in playing in it, from
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 ;; both an attacking and a defending point of view.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 ;; Given the score of every qtuple, the score of a given free square on the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 ;; board is just the sum of the scores of all the qtuples to which it belongs,
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 ;; because playing in that square is playing in all its containing qtuples at
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 ;; once. And it is that function which takes into account the internesting of
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 ;; the qtuples.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 ;; This algorithm is rather simple but anyway it gives a not so dumb level of
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 ;; play. It easily extends to "n-dimensional Lm", where a win should not
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 ;; should be preferred.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 ;; Here are the scores of the nine "non-polluted" configurations. Tuning
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 ;; these values will change (hopefully improve) the strength of the program
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 ;; and may change its style (rather aggressive here).
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 (defconst nil-score 7 "Score of an empty qtuple.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (defconst Xscore 15 "Score of a qtuple containing one X.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (defconst XXscore 400 "Score of a qtuple containing two X's.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (defconst XXXscore 1800 "Score of a qtuple containing three X's.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 (defconst XXXXscore 100000 "Score of a qtuple containing four X's.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (defconst Oscore 35 "Score of a qtuple containing one O.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (defconst OOscore 800 "Score of a qtuple containing two O's.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 (defconst OOOscore 15000 "Score of a qtuple containing three O's.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (defconst OOOOscore 800000 "Score of a qtuple containing four O's.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 ;; These values are not just random: if, given the following situation:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 ;; . . . . . . . O .
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 ;; . X X a . . . X .
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 ;; . . . X . . . X .
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 ;; . . . X . . . X .
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 ;; . . . . . . . b .
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324 ;; you want Emacs to play in "a" and not in "b", then the parameters must
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325 ;; satisfy the inequality:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 ;; 6 * XXscore > XXXscore + XXscore
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 ;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 ;; because "a" mainly belongs to six "XX" qtuples (the others are less
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 ;; conditions are required to obtain sensible moves, but the previous example
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 ;; should illustrate the point. If you manage to improve on these values,
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 ;; please send me a note. Thanks.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336 ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 ;; contents of a qtuple are uniquely determined by the sum of its elements and
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 ;; we just have to set up a translation table.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 (defconst lm-score-trans-table
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
341 (vector nil-score Xscore XXscore XXXscore XXXXscore 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342 Oscore 0 0 0 0 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 OOscore 0 0 0 0 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 OOOscore 0 0 0 0 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 OOOOscore 0 0 0 0 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 "Vector associating qtuple contents to their score.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350 ;; If you do not modify drastically the previous constants, the only way for a
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 ;; square to have a score higher than OOOOscore is to belong to a "OOOO"
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 ;; qtuple, thus to be a winning move. Similarly, the only way for a square to
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 ;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX"
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 ;; qtuple. We may use these considerations to detect when a given move is
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 ;; winning or loosing.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 (defconst lm-winning-threshold OOOOscore
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 "Threshold score beyond which an Emacs move is winning.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 (defconst lm-loosing-threshold XXXXscore
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 "Threshold score beyond which a human move is winning.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (defun lm-strongest-square ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 "Compute index of free square with highest score, or nil if none."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 ;; We just have to loop other all squares. However there are two problems:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 ;; up future searches, we set the score of padding or occupied squares
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 ;; to -1 whenever we meet them.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 ;; 2/ We want to choose randomly between equally good moves.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (let ((score-max 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372 (count 0) ; Number of equally good moves
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 (square (lm-xy-to-index 1 1)) ; First square
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 (end (lm-xy-to-index lm-board-width lm-board-height))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 best-square score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (while (<= square end)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 ;; If score is lower (i.e. most of the time), skip to next:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 ((< (aref lm-score-table square) score-max))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 ;; If score is better, beware of non free squares:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381 ((> (setq score (aref lm-score-table square)) score-max)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (if (zerop (aref lm-board square)) ; is it free ?
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 (setq count 1 ; yes: take it !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 best-square square
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 score-max score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (aset lm-score-table square -1))) ; no: kill it !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 ;; If score is equally good, choose randomly. But first check freeness:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 ((not (zerop (aref lm-board square)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389 (aset lm-score-table square -1))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 ((zerop (random (setq count (1+ count))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 (setq best-square square
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 score-max score)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (setq square (1+ square))) ; try next square
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 best-square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 ;;;_ - INITIALIZING THE SCORE TABLE.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398 ;; At initialization the board is empty so that every qtuple amounts for
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 ;; nil-score. Therefore, the score of any square is nil-score times the number
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 ;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 ;; are sufficiently far from the sides. As computing the number is time
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 ;; consuming, we initialize every square with 20*nil-score and then only
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 ;; consider squares at less than 5 squares from one side. We speed this up by
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 ;; taking symmetry into account.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 ;; Also, as it is likely that successive games will be played on a board with
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406 ;; same size, it is a good idea to save the initial SCORE-TABLE configuration.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 (defvar lm-saved-score-table nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409 "Recorded initial value of previous score table.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 (defvar lm-saved-board-width nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
412 "Recorded value of previous board width.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 (defvar lm-saved-board-height nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415 "Recorded value of previous board height.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
418 (defun lm-init-score-table ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 "Create the score table vector and fill it with initial values."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 (if (and lm-saved-score-table ; Has it been stored last time ?
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421 (= lm-board-width lm-saved-board-width)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (= lm-board-height lm-saved-board-height))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 (setq lm-score-table (copy-sequence lm-saved-score-table))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 ;; No, compute it:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 (setq lm-score-table
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 (make-vector lm-vector-length (* 20 nil-score)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 (let (i j maxi maxj maxi2 maxj2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428 (setq maxi (/ (1+ lm-board-width) 2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 maxj (/ (1+ lm-board-height) 2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430 maxi2 (min 4 maxi)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 maxj2 (min 4 maxj))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
432 ;; We took symmetry into account and could use it more if the board
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
433 ;; would have been square and not rectangular !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
434 ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
435 ;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
436 ;; board may well be less than 8 by 8 !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
437 (setq i 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
438 (while (<= i maxi2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
439 (setq j 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
440 (while (<= j maxj)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
441 (lm-init-square-score i j)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
442 (setq j (1+ j)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
443 (setq i (1+ i)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
444 (while (<= i maxi)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
445 (setq j 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
446 (while (<= j maxj2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
447 (lm-init-square-score i j)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
448 (setq j (1+ j)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
449 (setq i (1+ i))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
450 (setq lm-saved-score-table (copy-sequence lm-score-table)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
451 lm-saved-board-width lm-board-width
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
452 lm-saved-board-height lm-board-height)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
453
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
454 (defun lm-nb-qtuples (i j)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
455 "Return the number of qtuples containing square I,J."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
456 ;; This function is complicated because we have to deal
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
457 ;; with ugly cases like 3 by 6 boards, but it works.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
458 ;; If you have a simpler (and correct) solution, send it to me. Thanks !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
459 (let ((left (min 4 (1- i)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
460 (right (min 4 (- lm-board-width i)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
461 (up (min 4 (1- j)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
462 (down (min 4 (- lm-board-height j))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
463 (+ -12
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
464 (min (max (+ left right) 3) 8)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
465 (min (max (+ up down) 3) 8)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
466 (min (max (+ (min left up) (min right down)) 3) 8)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
467 (min (max (+ (min right up) (min left down)) 3) 8))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
468
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
469 (defun lm-init-square-score (i j)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
470 "Give initial score to square I,J and to its mirror images."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
471 (let ((ii (1+ (- lm-board-width i)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
472 (jj (1+ (- lm-board-height j)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
473 (sc (* (lm-nb-qtuples i j) (aref lm-score-trans-table 0))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
474 (aset lm-score-table (lm-xy-to-index i j) sc)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
475 (aset lm-score-table (lm-xy-to-index ii j) sc)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
476 (aset lm-score-table (lm-xy-to-index i jj) sc)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
477 (aset lm-score-table (lm-xy-to-index ii jj) sc)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
478 ;;;_ - MAINTAINING THE SCORE TABLE.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
479
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
480
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
481 ;; We do not provide functions for computing the SCORE-TABLE given the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
482 ;; contents of the BOARD. This would involve heavy nested loops, with time
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
483 ;; proportional to the size of the board. It is better to update the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
484 ;; SCORE-TABLE after each move. Updating needs not modify more than 36
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
485 ;; squares: it is done in constant time.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
486
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
487 (defun lm-update-score-table (square dval)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
488 "Update score table after SQUARE received a DVAL increment."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
489 ;; The board has already been updated when this function is called.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
490 ;; Updating scores is done by looking for qtuples boundaries in all four
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
491 ;; directions and then calling update-score-in-direction.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
492 ;; Finally all squares received the right increment, and then are up to
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
493 ;; date, except possibly for SQUARE itself if we are taking a move back for
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
494 ;; its score had been set to -1 at the time.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
495 (let* ((x (lm-index-to-x square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
496 (y (lm-index-to-y square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
497 (imin (max -4 (- 1 x)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
498 (jmin (max -4 (- 1 y)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
499 (imax (min 0 (- lm-board-width x 4)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
500 (jmax (min 0 (- lm-board-height y 4))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
501 (lm-update-score-in-direction imin imax
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
502 square 1 0 dval)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
503 (lm-update-score-in-direction jmin jmax
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
504 square 0 1 dval)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
505 (lm-update-score-in-direction (max imin jmin) (min imax jmax)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
506 square 1 1 dval)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
507 (lm-update-score-in-direction (max (- 1 y) -4
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
508 (- x lm-board-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
509 (min 0 (- x 5)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
510 (- lm-board-height y 4))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
511 square -1 1 dval)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
512
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
513 (defun lm-update-score-in-direction (left right square dx dy dval)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
514 "Update scores for all squares in the qtuples in range.
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
515 That is, those between the LEFTth square and the RIGHTth after SQUARE,
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
516 along the DX, DY direction, considering that DVAL has been added on SQUARE."
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
517 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
518 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
519 ;; DX,DY direction.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
520 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
521 ((> left right)) ; Quit
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
522 (t ; Else ..
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
523 (let (depl square0 square1 square2 count delta)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
524 (setq depl (lm-xy-to-index dx dy)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
525 square0 (+ square (* left depl))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
526 square1 (+ square (* right depl))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
527 square2 (+ square0 (* 4 depl)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
528 ;; Compute the contents of the first qtuple:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
529 (setq square square0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
530 count 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
531 (while (<= square square2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
532 (setq count (+ count (aref lm-board square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
533 square (+ square depl)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
534 (while (<= square0 square1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
535 ;; Update the squares of the qtuple beginning in SQUARE0 and ending
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
536 ;; in SQUARE2.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
537 (setq delta (- (aref lm-score-trans-table count)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
538 (aref lm-score-trans-table (- count dval))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
539 (cond ((not (zerop delta)) ; or else nothing to update
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
540 (setq square square0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
541 (while (<= square square2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
542 (if (zerop (aref lm-board square)) ; only for free squares
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
543 (aset lm-score-table square
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
544 (+ (aref lm-score-table square) delta)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
545 (setq square (+ square depl)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
546 ;; Then shift the qtuple one square along DEPL, this only requires
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
547 ;; modifying SQUARE0 and SQUARE2.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
548 (setq square2 (+ square2 depl)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
549 count (+ count (- (aref lm-board square0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
550 (aref lm-board square2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
551 square0 (+ square0 depl)))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
552
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
553 ;;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
554 ;;; GAME CONTROL.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
555 ;;;
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
556
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
557 ;; Several variables are used to monitor a game, including a GAME-HISTORY (the
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
558 ;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
559 ;; (anti-updating the score table) and to compute the table from scratch in
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
560 ;; case of an interruption.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
561
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
562 (defvar lm-game-in-progress nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
563 "Non-nil if a game is in progress.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
564
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
565 (defvar lm-game-history nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
566 "A record of all moves that have been played during current game.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
567
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
568 (defvar lm-number-of-moves nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
569 "Number of moves already played in current game.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
570
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
571 (defvar lm-number-of-human-moves nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
572 "Number of moves already played by human in current game.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
573
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
574 (defvar lm-emacs-played-first nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
575 "Non-nil if Emacs played first.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
576
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
577 (defvar lm-human-took-back nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
578 "Non-nil if Human took back a move during the game.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
579
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
580 (defvar lm-human-refused-draw nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
581 "Non-nil if Human refused Emacs offer of a draw.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
582
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
583 (defvar lm-emacs-is-computing nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
584 ;; This is used to detect interruptions. Hopefully, it should not be needed.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
585 "Non-nil if Emacs is in the middle of a computation.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
586
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
587
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
588 (defun lm-start-game (n m)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
589 "Initialize a new game on an N by M board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
590 (setq lm-emacs-is-computing t) ; Raise flag
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
591 (setq lm-game-in-progress t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
592 (setq lm-board-width n
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
593 lm-board-height m
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
594 lm-vector-length (1+ (* (+ m 2) (1+ n)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
595 lm-draw-limit (/ (* 7 n m) 10))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
596 (setq lm-emacs-won nil
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
597 lm-game-history nil
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
598 lm-number-of-moves 0
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
599 lm-number-of-human-moves 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
600 lm-emacs-played-first nil
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
601 lm-human-took-back nil
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
602 lm-human-refused-draw nil)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
603 (lm-init-display n m) ; Display first: the rest takes time
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
604 (lm-init-score-table) ; INIT-BOARD requires that the score
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
605 (lm-init-board) ; table be already created.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
606 (setq lm-emacs-is-computing nil))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
607
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
608 (defun lm-play-move (square val &optional dont-update-score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
609 "Go to SQUARE, play VAL and update everything."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
610 (setq lm-emacs-is-computing t) ; Raise flag
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
611 (cond ((= 1 val) ; a Human move
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
612 (setq lm-number-of-human-moves (1+ lm-number-of-human-moves)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
613 ((zerop lm-number-of-moves) ; an Emacs move. Is it first ?
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
614 (setq lm-emacs-played-first t)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
615 (setq lm-game-history
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
616 (cons (cons square (aref lm-score-table square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
617 lm-game-history)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
618 lm-number-of-moves (1+ lm-number-of-moves))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
619 (lm-plot-square square val)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
620 (aset lm-board square val) ; *BEFORE* UPDATE-SCORE !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
621 (if dont-update-score nil
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
622 (lm-update-score-table square val) ; previous val was 0: dval = val
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
623 (aset lm-score-table square -1))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
624 (setq lm-emacs-is-computing nil))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
625
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
626 (defun lm-take-back ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
627 "Take back last move and update everything."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
628 (setq lm-emacs-is-computing t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
629 (let* ((last-move (car lm-game-history))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
630 (square (car last-move))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
631 (oldval (aref lm-board square)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
632 (if (= 1 oldval)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
633 (setq lm-number-of-human-moves (1- lm-number-of-human-moves)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
634 (setq lm-game-history (cdr lm-game-history)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
635 lm-number-of-moves (1- lm-number-of-moves))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
636 (lm-plot-square square 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
637 (aset lm-board square 0) ; *BEFORE* UPDATE-SCORE !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
638 (lm-update-score-table square (- oldval))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
639 (aset lm-score-table square (cdr last-move)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
640 (setq lm-emacs-is-computing nil))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
641
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
642
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
643 ;;;_ + SESSION CONTROL.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
644
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
645 (defvar lm-number-of-trials 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
646 "The number of times that landmark has been run.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
647
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
648 (defvar lm-sum-of-moves 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
649 "The total number of moves made in all games.")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
650
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
651 (defvar lm-number-of-emacs-wins 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
652 "Number of games Emacs won in this session.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
653
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
654 (defvar lm-number-of-human-wins 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
655 "Number of games you won in this session.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
656
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
657 (defvar lm-number-of-draws 0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
658 "Number of games already drawn in this session.")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
659
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
660
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
661 (defun lm-terminate-game (result)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
662 "Terminate the current game with RESULT."
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
663 (setq lm-number-of-trials (1+ lm-number-of-trials))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
664 (setq lm-sum-of-moves (+ lm-sum-of-moves lm-number-of-moves))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
665 (if (eq result 'crash-game)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
666 (message
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
667 "Sorry, I have been interrupted and cannot resume that game..."))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
668 (lm-display-statistics)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
669 ;;(ding)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
670 (setq lm-game-in-progress nil))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
671
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
672 (defun lm-crash-game ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
673 "What to do when Emacs detects it has been interrupted."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
674 (setq lm-emacs-is-computing nil)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
675 (lm-terminate-game 'crash-game)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
676 (sit-for 4) ; Let's see the message
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
677 (lm-prompt-for-other-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
678
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
679
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
680 ;;;_ + INTERACTIVE COMMANDS.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
681
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
682 (defun lm-emacs-plays ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
683 "Compute Emacs next move and play it."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
684 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
685 (lm-switch-to-window)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
686 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
687 (lm-emacs-is-computing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
688 (lm-crash-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
689 ((not lm-game-in-progress)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
690 (lm-prompt-for-other-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
691 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
692 (message "Let me think...")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
693 (let (square score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
694 (setq square (lm-strongest-square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
695 (cond ((null square)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
696 (lm-terminate-game 'nobody-won))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
697 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
698 (setq score (aref lm-score-table square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
699 (lm-play-move square 6)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
700 (cond ((>= score lm-winning-threshold)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
701 (setq lm-emacs-won t) ; for font-lock
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
702 (lm-find-filled-qtuple square 6)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
703 (lm-terminate-game 'emacs-won))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
704 ((zerop score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
705 (lm-terminate-game 'nobody-won))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
706 ((and (> lm-number-of-moves lm-draw-limit)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
707 (not lm-human-refused-draw)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
708 (lm-offer-a-draw))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
709 (lm-terminate-game 'draw-agreed))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
710 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
711 (lm-prompt-for-move)))))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
712
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
713 ;; For small square dimensions this is approximate, since though measured in
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
714 ;; pixels, event's (X . Y) is a character's top-left corner.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
715 (defun lm-click (click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
716 "Position at the square where you click."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
717 (interactive "e")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
718 (and (windowp (posn-window (setq click (event-end click))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
719 (numberp (posn-point click))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
720 (select-window (posn-window click))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
721 (setq click (posn-col-row click))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
722 (lm-goto-xy
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
723 (min (max (/ (+ (- (car click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
724 lm-x-offset
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
725 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
726 (window-hscroll)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
727 lm-square-width
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
728 (% lm-square-width 2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
729 (/ lm-square-width 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
730 lm-square-width)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
731 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
732 lm-board-width)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
733 (min (max (/ (+ (- (cdr click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
734 lm-y-offset
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
735 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
736 (let ((inhibit-point-motion-hooks t))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
737 (count-lines 1 (window-start)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
738 lm-square-height
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
739 (% lm-square-height 2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
740 (/ lm-square-height 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
741 lm-square-height)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
742 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
743 lm-board-height))))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
744
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
745 (defun lm-mouse-play (click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
746 "Play at the square where you click."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
747 (interactive "e")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
748 (if (lm-click click)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
749 (lm-human-plays)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
750
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
751 (defun lm-human-plays ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
752 "Signal to the Lm program that you have played.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
753 You must have put the cursor on the square where you want to play.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
754 If the game is finished, this command requests for another game."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
755 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
756 (lm-switch-to-window)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
757 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
758 (lm-emacs-is-computing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
759 (lm-crash-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
760 ((not lm-game-in-progress)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
761 (lm-prompt-for-other-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
762 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
763 (let (square score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
764 (setq square (lm-point-square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
765 (cond ((null square)
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
766 (error "Your point is not on a square. Retry!"))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
767 ((not (zerop (aref lm-board square)))
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
768 (error "Your point is not on a free square. Retry!"))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
769 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
770 (setq score (aref lm-score-table square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
771 (lm-play-move square 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
772 (cond ((and (>= score lm-loosing-threshold)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
773 ;; Just testing SCORE > THRESHOLD is not enough for
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
774 ;; detecting wins, it just gives an indication that
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
775 ;; we confirm with LM-FIND-FILLED-QTUPLE.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
776 (lm-find-filled-qtuple square 1))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
777 (lm-terminate-game 'human-won))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
778 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
779 (lm-emacs-plays)))))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
780
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
781 (defun lm-human-takes-back ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
782 "Signal to the Lm program that you wish to take back your last move."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
783 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
784 (lm-switch-to-window)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
785 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
786 (lm-emacs-is-computing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
787 (lm-crash-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
788 ((not lm-game-in-progress)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
789 (message "Too late for taking back...")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
790 (sit-for 4)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
791 (lm-prompt-for-other-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
792 ((zerop lm-number-of-human-moves)
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
793 (message "You have not played yet... Your move?"))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
794 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
795 (message "One moment, please...")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
796 ;; It is possible for the user to let Emacs play several consecutive
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
797 ;; moves, so that the best way to know when to stop taking back moves is
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
798 ;; to count the number of human moves:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
799 (setq lm-human-took-back t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
800 (let ((number lm-number-of-human-moves))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
801 (while (= number lm-number-of-human-moves)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
802 (lm-take-back)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
803 (lm-prompt-for-move))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
804
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
805 (defun lm-human-resigns ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
806 "Signal to the Lm program that you may want to resign."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
807 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
808 (lm-switch-to-window)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
809 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
810 (lm-emacs-is-computing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
811 (lm-crash-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
812 ((not lm-game-in-progress)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
813 (message "There is no game in progress"))
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
814 ((y-or-n-p "You mean, you resign? ")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
815 (lm-terminate-game 'human-resigned))
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
816 ((y-or-n-p "You mean, we continue? ")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
817 (lm-prompt-for-move))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
818 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
819 (lm-terminate-game 'human-resigned)))) ; OK. Accept it
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
820
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
821 ;;;_ + PROMPTING THE HUMAN PLAYER.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
822
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
823 (defun lm-prompt-for-move ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
824 "Display a message asking for Human's move."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
825 (message (if (zerop lm-number-of-human-moves)
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
826 "Your move? (move to a free square and hit X, RET ...)"
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
827 "Your move?"))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
828 ;; This may seem silly, but if one omits the following line (or a similar
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
829 ;; one), the cursor may very well go to some place where POINT is not.
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
830 ;; FIXME: this can't be right!! --Stef
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
831 (save-excursion (set-buffer (other-buffer))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
832
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
833 (defun lm-prompt-for-other-game ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
834 "Ask for another game, and start it."
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
835 (if (y-or-n-p "Another game? ")
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
836 (if (y-or-n-p "Retain learned weights ")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
837 (lm 2)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
838 (lm 1))
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
839 (message "Chicken!")))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
840
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
841 (defun lm-offer-a-draw ()
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
842 "Offer a draw and return t if Human accepted it."
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
843 (or (y-or-n-p "I offer you a draw. Do you accept it? ")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
844 (not (setq lm-human-refused-draw t))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
845
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
846
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
847 (defun lm-max-width ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
848 "Largest possible board width for the current window."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
849 (1+ (/ (- (window-width (selected-window))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
850 lm-x-offset lm-x-offset 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
851 lm-square-width)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
852
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
853 (defun lm-max-height ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
854 "Largest possible board height for the current window."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
855 (1+ (/ (- (window-height (selected-window))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
856 lm-y-offset lm-y-offset 2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
857 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
858 lm-square-height)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
859
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
860 (defun lm-point-y ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
861 "Return the board row where point is."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
862 (let ((inhibit-point-motion-hooks t))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
863 (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
864 lm-square-height))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
865
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
866 (defun lm-point-square ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
867 "Return the index of the square point is on."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
868 (let ((inhibit-point-motion-hooks t))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
869 (lm-xy-to-index (1+ (/ (- (current-column) lm-x-offset)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
870 lm-square-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
871 (lm-point-y))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
872
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
873 (defun lm-goto-square (index)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
874 "Move point to square number INDEX."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
875 (lm-goto-xy (lm-index-to-x index) (lm-index-to-y index)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
876
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
877 (defun lm-goto-xy (x y)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
878 "Move point to square at X, Y coords."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
879 (let ((inhibit-point-motion-hooks t))
104390
c6ae8d43800c Use forward-line, not goto-line.
Glenn Morris <rgm@gnu.org>
parents: 100908
diff changeset
880 (goto-char (point-min))
c6ae8d43800c Use forward-line, not goto-line.
Glenn Morris <rgm@gnu.org>
parents: 100908
diff changeset
881 (forward-line (+ lm-y-offset (* lm-square-height (1- y)))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
882 (move-to-column (+ lm-x-offset (* lm-square-width (1- x)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
883
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
884 (defun lm-plot-square (square value)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
885 "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
886 (or (= value 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
887 (lm-goto-square square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
888 (let ((inhibit-read-only t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
889 (inhibit-point-motion-hooks t))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
890 (insert-and-inherit (cond ((= value 1) ?.)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
891 ((= value 2) ?N)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
892 ((= value 3) ?S)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
893 ((= value 4) ?E)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
894 ((= value 5) ?W)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
895 ((= value 6) ?^)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
896
30542
f03ab02d1f4e (lm-font-lock-face-O, lm-font-lock-face-X)
Eli Zaretskii <eliz@gnu.org>
parents: 25227
diff changeset
897 (and (zerop value)
38076
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
898 (add-text-properties (1- (point)) (point)
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
899 '(mouse-face highlight
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
900 help-echo "\
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
901 mouse-1: get robot moving, mouse-2: play on this square")))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
902 (delete-char 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
903 (backward-char 1))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
904 (sit-for 0)) ; Display NOW
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
906 (defun lm-init-display (n m)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
907 "Display an N by M Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
908 (buffer-disable-undo (current-buffer))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
909 (let ((inhibit-read-only t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
910 (point 1) opoint
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
911 (intangible t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
912 (i m) j x)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
913 ;; Try to minimize number of chars (because of text properties)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
914 (setq tab-width
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
915 (if (zerop (% lm-x-offset lm-square-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
916 lm-square-width
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
917 (max (/ (+ (% lm-x-offset lm-square-width)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
918 lm-square-width 1) 2) 2)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
919 (erase-buffer)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
920 (newline lm-y-offset)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
921 (while (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
922 (setq j n
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
923 x (- lm-x-offset lm-square-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
924 (while (>= (setq j (1- j)) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
925 (insert-char ?\t (/ (- (setq x (+ x lm-square-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
926 (current-column))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
927 tab-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
928 (insert-char ? (- x (current-column)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
929 (if (setq intangible (not intangible))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
930 (put-text-property point (point) 'intangible 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
931 (and (zerop j)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
932 (= i (- m 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
933 (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
934 (while (>= i 3)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
935 (append-to-buffer (current-buffer) opoint (point))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
936 (setq i (- i 2)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
937 (goto-char (point-max))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
938 (setq point (point))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
939 (insert ?=)
38076
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
940 (add-text-properties point (point)
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
941 '(mouse-face highlight help-echo "\
30c899dc34c4 (lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents: 37840
diff changeset
942 mouse-1: get robot moving, mouse-2: play on this square")))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
943 (> (setq i (1- i)) 0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
944 (if (= i (1- m))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
945 (setq opoint point))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
946 (insert-char ?\n lm-square-height))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
947 (or (eq (char-after 1) ?.)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
948 (put-text-property 1 2 'point-entered
39866
a4570786d40d Do not double variables in the lambda-list.
Pavel Janík <Pavel@Janik.cz>
parents: 38455
diff changeset
949 (lambda (x y) (if (bobp) (forward-char)))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
950 (or intangible
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
951 (put-text-property point (point) 'intangible 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
952 (put-text-property point (point) 'point-entered
39866
a4570786d40d Do not double variables in the lambda-list.
Pavel Janík <Pavel@Janik.cz>
parents: 38455
diff changeset
953 (lambda (x y) (if (eobp) (backward-char))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
954 (put-text-property (point-min) (point) 'category 'lm-mode))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
955 (lm-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
956 (sit-for 0)) ; Display NOW
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
957
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
958 (defun lm-display-statistics ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
959 "Obnoxiously display some statistics about previous games in mode line."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
960 ;; We store this string in the mode-line-process local variable.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
961 ;; This is certainly not the cleanest way out ...
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
962 (setq mode-line-process
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
963 (format ": Trials: %d, Avg#Moves: %d"
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
964 lm-number-of-trials
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
965 (if (zerop lm-number-of-trials)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
966 0
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
967 (/ lm-sum-of-moves lm-number-of-trials))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
968 (force-mode-line-update))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
969
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
970 (defun lm-switch-to-window ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
971 "Find or create the Lm buffer, and display it."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
972 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
973 (let ((buff (get-buffer "*Lm*")))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
974 (if buff ; Buffer exists:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
975 (switch-to-buffer buff) ; no problem.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
976 (if lm-game-in-progress
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
977 (lm-crash-game)) ; buffer has been killed or something
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
978 (switch-to-buffer "*Lm*") ; Anyway, start anew.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
979 (lm-mode))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
980
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
981
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
982 ;;;_ + CROSSING WINNING QTUPLES.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
983
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
984 ;; When someone succeeds in filling a qtuple, we draw a line over the five
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
985 ;; corresponding squares. One problem is that the program does not know which
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
986 ;; squares ! It only knows the square where the last move has been played and
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
987 ;; who won. The solution is to scan the board along all four directions.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
988
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
989 (defun lm-find-filled-qtuple (square value)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
990 "Return t if SQUARE belongs to a qtuple filled with VALUEs."
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
991 (or (lm-check-filled-qtuple square value 1 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
992 (lm-check-filled-qtuple square value 0 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
993 (lm-check-filled-qtuple square value 1 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
994 (lm-check-filled-qtuple square value -1 1)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
995
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
996 (defun lm-check-filled-qtuple (square value dx dy)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
997 "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY."
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
998 (let ((a 0) (b 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
999 (left square) (right square)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1000 (depl (lm-xy-to-index dx dy)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1001 (while (and (> a -4) ; stretch tuple left
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1002 (= value (aref lm-board (setq left (- left depl)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1003 (setq a (1- a)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1004 (while (and (< b (+ a 4)) ; stretch tuple right
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1005 (= value (aref lm-board (setq right (+ right depl)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1006 (setq b (1+ b)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1007 (cond ((= b (+ a 4)) ; tuple length = 5 ?
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1008 (lm-cross-qtuple (+ square (* a depl)) (+ square (* b depl))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1009 dx dy)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1010 t))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1011
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1012 (defun lm-cross-qtuple (square1 square2 dx dy)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1013 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1014 (save-excursion ; Not moving point from last square
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1015 (let ((depl (lm-xy-to-index dx dy))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1016 (inhibit-read-only t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1017 (inhibit-point-motion-hooks t))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1018 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1019 (while (/= square1 square2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1020 (lm-goto-square square1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1021 (setq square1 (+ square1 depl))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1022 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1023 ((= dy 0) ; Horizontal
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1024 (forward-char 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1025 (insert-char ?- (1- lm-square-width) t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1026 (delete-region (point) (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1027 (skip-chars-forward " \t")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1028 (point))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1029 ((= dx 0) ; Vertical
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1030 (let ((lm-n 1)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1031 (column (current-column)))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1032 (while (< lm-n lm-square-height)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1033 (setq lm-n (1+ lm-n))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1034 (forward-line 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1035 (indent-to column)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1036 (insert-and-inherit ?|))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1037 ((= dx -1) ; 1st Diagonal
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1038 (indent-to (prog1 (- (current-column) (/ lm-square-width 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1039 (forward-line (/ lm-square-height 2))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1040 (insert-and-inherit ?/))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1041 (t ; 2nd Diagonal
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1042 (indent-to (prog1 (+ (current-column) (/ lm-square-width 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1043 (forward-line (/ lm-square-height 2))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1044 (insert-and-inherit ?\\))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1045 (sit-for 0)) ; Display NOW
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1046
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1047
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1048 ;;;_ + CURSOR MOTION.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1049
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1050 ;; previous-line and next-line don't work right with intangible newlines
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1051 (defun lm-move-down ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1052 "Move point down one row on the Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1053 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1054 (if (< (lm-point-y) lm-board-height)
85478
786d3a985758 * term/x-win.el (x-gtk-stock-map, icon-map-list)
Dan Nicolaescu <dann@ics.uci.edu>
parents: 78227
diff changeset
1055 (forward-line 1)));;; lm-square-height)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1056
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1057 (defun lm-move-up ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1058 "Move point up one row on the Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1059 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1060 (if (> (lm-point-y) 1)
85478
786d3a985758 * term/x-win.el (x-gtk-stock-map, icon-map-list)
Dan Nicolaescu <dann@ics.uci.edu>
parents: 78227
diff changeset
1061 (forward-line (- lm-square-height))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1062
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1063 (defun lm-move-ne ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1064 "Move point North East on the Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1065 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1066 (lm-move-up)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1067 (forward-char))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1068
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1069 (defun lm-move-se ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1070 "Move point South East on the Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1071 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1072 (lm-move-down)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1073 (forward-char))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1074
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1075 (defun lm-move-nw ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1076 "Move point North West on the Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1077 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1078 (lm-move-up)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1079 (backward-char))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1080
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1081 (defun lm-move-sw ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1082 "Move point South West on the Lm board."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1083 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1084 (lm-move-down)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1085 (backward-char))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1086
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1087 (defun lm-beginning-of-line ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1088 "Move point to first square on the Lm board row."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1089 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1090 (move-to-column lm-x-offset))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1091
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1092 (defun lm-end-of-line ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1093 "Move point to last square on the Lm board row."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1094 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1095 (move-to-column (+ lm-x-offset
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1096 (* lm-square-width (1- lm-board-width)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1097
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1098
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1099 ;;;_ + Simulation variables
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1100
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1101 ;;;_ - lm-nvar
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1102 (defvar lm-nvar 0.0075
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1103 "Not used.
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1104 Affects a noise generator which was used in an earlier incarnation of
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1105 this program to add a random element to the way moves were made.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1106 ;;;_ - lists of cardinal directions
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1107 ;;;_ :
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1108 (defvar lm-ns '(lm-n lm-s)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1109 "Used when doing something relative to the north and south axes.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1110 (defvar lm-ew '(lm-e lm-w)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1111 "Used when doing something relative to the east and west axes.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1112 (defvar lm-directions '(lm-n lm-s lm-e lm-w)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1113 "The cardinal directions.")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1114 (defvar lm-8-directions
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1115 '((lm-n) (lm-n lm-w) (lm-w) (lm-s lm-w)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1116 (lm-s) (lm-s lm-e) (lm-e) (lm-n lm-e))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1117 "The full 8 possible directions.")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1118
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1119 (defvar lm-number-of-moves
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1120 "The number of moves made by the robot so far.")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1121
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1122
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1123 ;;;_* Terry's mods to create lm.el
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1124
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1125 ;;;(setq lm-debug nil)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1126 (defvar lm-debug nil
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1127 "If non-nil, debugging is printed.")
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1128 (defcustom lm-one-moment-please nil
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1129 "If non-nil, print \"One moment please\" when a new board is generated.
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1130 The drawback of this is you don't see how many moves the last run took
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1131 because it is overwritten by \"One moment please\"."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1132 :type 'boolean
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1133 :group 'lm)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1134 (defcustom lm-output-moves t
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1135 "If non-nil, output number of moves so far on a move-by-move basis."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1136 :type 'boolean
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1137 :group 'lm)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1138
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1139
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1140 (defun lm-weights-debug ()
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1141 (if lm-debug
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1142 (progn (lm-print-wts) (lm-blackbox) (lm-print-y,s,noise)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1143 (lm-print-smell))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1144
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1145 ;;;_ - Printing various things
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1146 (defun lm-print-distance-int (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1147 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1148 (insert (format "%S %S " direction (get direction 'distance))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1149
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1150
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1151 (defun lm-print-distance ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1152 (insert (format "tree: %S \n" (calc-distance-of-robot-from 'lm-tree)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1153 (mapc 'lm-print-distance-int lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1154
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1155
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1156 ;;(setq direction 'lm-n)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1157 ;;(get 'lm-n 'lm-s)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1158 (defun lm-nslify-wts-int (direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1159 (mapcar (lambda (target-direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1160 (get direction target-direction))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1161 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1162
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1163
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1164 (defun lm-nslify-wts ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1165 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1166 (let ((l (apply 'append (mapcar 'lm-nslify-wts-int lm-directions))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1167 (insert (format "set data_value WTS \n %s \n" l))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1168 (insert (format "/* max: %S min: %S */"
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1169 (eval (cons 'max l)) (eval (cons 'min l))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1170
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1171 (defun lm-print-wts-int (direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1172 (mapc (lambda (target-direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1173 (insert (format "%S %S %S "
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1174 direction
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1175 target-direction
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1176 (get direction target-direction))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1177 lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1178 (insert "\n"))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1179
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1180 (defun lm-print-wts ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1181 (interactive)
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1182 (with-current-buffer "*lm-wts*"
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1183 (insert "==============================\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1184 (mapc 'lm-print-wts-int lm-directions)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1185
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1186 (defun lm-print-moves (moves)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1187 (interactive)
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1188 (with-current-buffer "*lm-moves*"
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1189 (insert (format "%S\n" moves))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1190
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1191
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1192 (defun lm-print-y,s,noise-int (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1193 (insert (format "%S:lm-y %S, s %S, noise %S \n"
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1194 (symbol-name direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1195 (get direction 'y_t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1196 (get direction 's)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1197 (get direction 'noise)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1198 )))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1199
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1200 (defun lm-print-y,s,noise ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1201 (interactive)
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1202 (with-current-buffer "*lm-y,s,noise*"
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1203 (insert "==============================\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1204 (mapc 'lm-print-y,s,noise-int lm-directions)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1205
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1206 (defun lm-print-smell-int (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1207 (insert (format "%S: smell: %S \n"
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1208 (symbol-name direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1209 (get direction 'smell))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1210
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1211 (defun lm-print-smell ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1212 (interactive)
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1213 (with-current-buffer "*lm-smell*"
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1214 (insert "==============================\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1215 (insert (format "tree: %S \n" (get 'z 't)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1216 (mapc 'lm-print-smell-int lm-directions)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1217
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1218 (defun lm-print-w0-int (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1219 (insert (format "%S: w0: %S \n"
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1220 (symbol-name direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1221 (get direction 'w0))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1222
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1223 (defun lm-print-w0 ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1224 (interactive)
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1225 (with-current-buffer "*lm-w0*"
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1226 (insert "==============================\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1227 (mapc 'lm-print-w0-int lm-directions)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1228
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1229 (defun lm-blackbox ()
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1230 (with-current-buffer "*lm-blackbox*"
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1231 (insert "==============================\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1232 (insert "I smell: ")
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1233 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1234 (if (> (get direction 'smell) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1235 (insert (format "%S " direction))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1236 lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1237 (insert "\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1238
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1239 (insert "I move: ")
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1240 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1241 (if (> (get direction 'y_t) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1242 (insert (format "%S " direction))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1243 lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1244 (insert "\n")
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1245 (lm-print-wts-blackbox)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1246 (insert (format "z_t-z_t-1: %S" (- (get 'z 't) (get 'z 't-1))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1247 (lm-print-distance)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1248 (insert "\n")))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1249
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1250 (defun lm-print-wts-blackbox ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1251 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1252 (mapc 'lm-print-wts-int lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1253
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1254 ;;;_ - learning parameters
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1255 (defcustom lm-bound 0.005
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1256 "The maximum that w0j may be."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1257 :type 'number
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1258 :group 'lm)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1259 (defcustom lm-c 1.0
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1260 "A factor applied to modulate the increase in wij.
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1261 Used in the function lm-update-normal-weights."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1262 :type 'number
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1263 :group 'lm)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1264 (defcustom lm-c-naught 0.5
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1265 "A factor applied to modulate the increase in w0j.
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1266 Used in the function lm-update-naught-weights."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1267 :type 'number
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1268 :group 'lm)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1269 (defvar lm-initial-w0 0.0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1270 (defvar lm-initial-wij 0.0)
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1271 (defcustom lm-no-payoff 0
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1272 "The amount of simulation cycles that have occurred with no movement.
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1273 Used to move the robot when he is stuck in a rut for some reason."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1274 :type 'integer
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1275 :group 'lm)
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1276 (defcustom lm-max-stall-time 2
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1277 "The maximum number of cycles that the robot can remain stuck in a place.
21363
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1278 After this limit is reached, lm-random-move is called to push him out of it."
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1279 :type 'integer
f1fc193b6958 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 18951
diff changeset
1280 :group 'lm)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1281
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1282
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1283 ;;;_ + Randomizing functions
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1284 ;;;_ - lm-flip-a-coin ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1285 (defun lm-flip-a-coin ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1286 (if (> (random 5000) 2500)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1287 -1
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1288 1))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1289 ;;;_ : lm-very-small-random-number ()
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1290 ;(defun lm-very-small-random-number ()
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1291 ; (/
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1292 ; (* (/ (random 900000) 900000.0) .0001)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1293 ;;;_ : lm-randomize-weights-for (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1294 (defun lm-randomize-weights-for (direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1295 (mapc (lambda (target-direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1296 (put direction
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1297 target-direction
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1298 (* (lm-flip-a-coin) (/ (random 10000) 10000.0))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1299 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1300 ;;;_ : lm-noise ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1301 (defun lm-noise ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1302 (* (- (/ (random 30001) 15000.0) 1) lm-nvar))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1303
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1304 ;;;_ : lm-fix-weights-for (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1305 (defun lm-fix-weights-for (direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1306 (mapc (lambda (target-direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1307 (put direction
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1308 target-direction
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1309 lm-initial-wij))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1310 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1311
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1312
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1313 ;;;_ + Plotting functions
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1314 ;;;_ - lm-plot-internal (sym)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1315 (defun lm-plot-internal (sym)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1316 (lm-plot-square (lm-xy-to-index
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1317 (get sym 'x)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1318 (get sym 'y))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1319 (get sym 'sym)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1320 ;;;_ - lm-plot-landmarks ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1321 (defun lm-plot-landmarks ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1322 (setq lm-cx (/ lm-board-width 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1323 (setq lm-cy (/ lm-board-height 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1324
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1325 (put 'lm-n 'x lm-cx)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1326 (put 'lm-n 'y 1)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1327 (put 'lm-n 'sym 2)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1328
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1329 (put 'lm-tree 'x lm-cx)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1330 (put 'lm-tree 'y lm-cy)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1331 (put 'lm-tree 'sym 6)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1332
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1333 (put 'lm-s 'x lm-cx)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1334 (put 'lm-s 'y lm-board-height)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1335 (put 'lm-s 'sym 3)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1336
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1337 (put 'lm-w 'x 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1338 (put 'lm-w 'y (/ lm-board-height 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1339 (put 'lm-w 'sym 5)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1340
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1341 (put 'lm-e 'x lm-board-width)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1342 (put 'lm-e 'y (/ lm-board-height 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1343 (put 'lm-e 'sym 4)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1344
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1345 (mapc 'lm-plot-internal '(lm-n lm-s lm-e lm-w lm-tree)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1346
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1347
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1348
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1349 ;;;_ + Distance-calculation functions
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1350 ;;;_ - square (a)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1351 (defun square (a)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1352 (* a a))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1353
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1354 ;;;_ - distance (x x0 y y0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1355 (defun distance (x x0 y y0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1356 (sqrt (+ (square (- x x0)) (square (- y y0)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1357
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1358 ;;;_ - calc-distance-of-robot-from (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1359 (defun calc-distance-of-robot-from (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1360 (put direction 'distance
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1361 (distance (get direction 'x)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1362 (lm-index-to-x (lm-point-square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1363 (get direction 'y)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1364 (lm-index-to-y (lm-point-square)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1365
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1366 ;;;_ - calc-smell-internal (sym)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1367 (defun calc-smell-internal (sym)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1368 (let ((r (get sym 'r))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1369 (d (calc-distance-of-robot-from sym)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1370 (if (> (* 0.5 (- 1 (/ d r))) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1371 (* 0.5 (- 1 (/ d r)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1372 0)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1373
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1374
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1375 ;;;_ + Learning (neural) functions
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1376 (defun lm-f (x)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1377 (cond
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1378 ((> x lm-bound) lm-bound)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1379 ((< x 0.0) 0.0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1380 (t x)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1381
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1382 (defun lm-y (direction)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1383 (let ((noise (put direction 'noise (lm-noise))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1384 (put direction 'y_t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1385 (if (> (get direction 's) 0.0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1386 1.0
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1387 0.0))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1388
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1389 (defun lm-update-normal-weights (direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1390 (mapc (lambda (target-direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1391 (put direction target-direction
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1392 (+
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1393 (get direction target-direction)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1394 (* lm-c
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1395 (- (get 'z 't) (get 'z 't-1))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1396 (get target-direction 'y_t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1397 (get direction 'smell)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1398 lm-directions))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1399
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1400 (defun lm-update-naught-weights (direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1401 (mapc (lambda (target-direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1402 (put direction 'w0
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1403 (lm-f
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1404 (+
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1405 (get direction 'w0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1406 (* lm-c-naught
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1407 (- (get 'z 't) (get 'z 't-1))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1408 (get direction 'y_t))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1409 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1410
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1411
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1412 ;;;_ + Statistics gathering and creating functions
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1413
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1414 (defun lm-calc-current-smells ()
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1415 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1416 (put direction 'smell (calc-smell-internal direction)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1417 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1418
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1419 (defun lm-calc-payoff ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1420 (put 'z 't-1 (get 'z 't))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1421 (put 'z 't (calc-smell-internal 'lm-tree))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1422 (if (= (- (get 'z 't) (get 'z 't-1)) 0.0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1423 (incf lm-no-payoff)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1424 (setf lm-no-payoff 0)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1425
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1426 (defun lm-store-old-y_t ()
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1427 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1428 (put direction 'y_t-1 (get direction 'y_t)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1429 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1430
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1431
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1432 ;;;_ + Functions to move robot
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1433
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1434 (defun lm-confidence-for (target-direction)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1435 (apply '+
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1436 (get target-direction 'w0)
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1437 (mapcar (lambda (direction)
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1438 (*
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1439 (get direction target-direction)
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1440 (get direction 'smell)))
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1441 lm-directions)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1442
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1443
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1444 (defun lm-calc-confidences ()
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1445 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1446 (put direction 's (lm-confidence-for direction)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1447 lm-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1448
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1449 (defun lm-move ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1450 (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1451 (progn
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1452 (mapc (lambda (dir) (put dir 'y_t 0)) lm-ns)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1453 (if lm-debug
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1454 (message "n-s normalization."))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1455 (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1456 (progn
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1457 (mapc (lambda (dir) (put dir 'y_t 0)) lm-ew)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1458 (if lm-debug
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1459 (message "e-w normalization"))))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1460
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1461 (mapc (lambda (pair)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1462 (if (> (get (car pair) 'y_t) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1463 (funcall (car (cdr pair)))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1464 '(
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1465 (lm-n lm-move-up)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1466 (lm-s lm-move-down)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1467 (lm-e forward-char)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1468 (lm-w backward-char)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1469 (lm-plot-square (lm-point-square) 1)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1470 (incf lm-number-of-moves)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1471 (if lm-output-moves
65585
6d0d4d973f77 Message format spec fixes, commit no. 4
Deepak Goel <deego@gnufans.org>
parents: 64701
diff changeset
1472 (message "Moves made: %d" lm-number-of-moves)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1473
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1474
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1475 (defun lm-random-move ()
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1476 (mapc
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1477 (lambda (direction) (put direction 'y_t 0))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1478 lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1479 (dolist (direction (nth (random 8) lm-8-directions))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1480 (put direction 'y_t 1.0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1481 (lm-move))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1482
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1483 (defun lm-amble-robot ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1484 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1485 (while (> (calc-distance-of-robot-from 'lm-tree) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1486
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1487 (lm-store-old-y_t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1488 (lm-calc-current-smells)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1489
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1490 (if (> lm-no-payoff lm-max-stall-time)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1491 (lm-random-move)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1492 (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1493 (lm-calc-confidences)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1494 (mapc 'lm-y lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1495 (lm-move)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1496
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1497 (lm-calc-payoff)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1498
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1499 (mapc 'lm-update-normal-weights lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1500 (mapc 'lm-update-naught-weights lm-directions)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1501 (if lm-debug
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1502 (lm-weights-debug)))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1503 (lm-terminate-game nil))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1504
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1505
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1506 ;;;_ - lm-start-robot ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1507 (defun lm-start-robot ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1508 "Signal to the Lm program that you have played.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1509 You must have put the cursor on the square where you want to play.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1510 If the game is finished, this command requests for another game."
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1511 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1512 (lm-switch-to-window)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1513 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1514 (lm-emacs-is-computing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1515 (lm-crash-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1516 ((not lm-game-in-progress)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1517 (lm-prompt-for-other-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1518 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1519 (let (square score)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1520 (setq square (lm-point-square))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1521 (cond ((null square)
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
1522 (error "Your point is not on a square. Retry!"))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1523 ((not (zerop (aref lm-board square)))
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
1524 (error "Your point is not on a free square. Retry!"))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1525 (t
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1526 (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1527 (lm-plot-square square 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1528
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1529 (lm-store-old-y_t)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1530 (lm-calc-current-smells)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1531 (put 'z 't (calc-smell-internal 'lm-tree))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1532
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1533 (lm-random-move)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1534
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1535 (lm-calc-payoff)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1536
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1537 (mapc 'lm-update-normal-weights lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1538 (mapc 'lm-update-naught-weights lm-directions)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1539 (lm-amble-robot)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1540 )))))))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1541
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1542
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1543 ;;;_ + Misc functions
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1544 ;;;_ - lm-init (auto-start save-weights)
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1545 (defvar lm-tree-r "")
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1546
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1547 (defun lm-init (auto-start save-weights)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1548
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1549 (setq lm-number-of-moves 0)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1550
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1551 (lm-plot-landmarks)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1552
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1553 (if lm-debug
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1554 (save-current-buffer
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1555 (set-buffer (get-buffer-create "*lm-w0*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1556 (erase-buffer)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1557 (set-buffer (get-buffer-create "*lm-moves*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1558 (set-buffer (get-buffer-create "*lm-wts*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1559 (erase-buffer)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1560 (set-buffer (get-buffer-create "*lm-y,s,noise*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1561 (erase-buffer)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1562 (set-buffer (get-buffer-create "*lm-smell*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1563 (erase-buffer)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1564 (set-buffer (get-buffer-create "*lm-blackbox*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1565 (erase-buffer)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1566 (set-buffer (get-buffer-create "*lm-distance*"))
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1567 (erase-buffer)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1568
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1569
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1570 (lm-set-landmark-signal-strengths)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1571
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1572 (dolist (direction lm-directions)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1573 (put direction 'y_t 0.0))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1574
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1575 (if (not save-weights)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1576 (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1577 (mapc 'lm-fix-weights-for lm-directions)
105829
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1578 (dolist (direction lm-directions)
328150f0cf76 * url-util.el (url-insert-entities-in-string):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104848
diff changeset
1579 (put direction 'w0 lm-initial-w0)))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1580 (message "Weights preserved for this run."))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1581
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1582 (if auto-start
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1583 (progn
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1584 (lm-goto-xy (1+ (random lm-board-width)) (1+ (random lm-board-height)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1585 (lm-start-robot))))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1586
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1587
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1588 ;;;_ - something which doesn't work
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1589 ; no-a-worka!!
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1590 ;(defum lm-sum-list (list)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1591 ; (if (> (length list) 0)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1592 ; (+ (car list) (lm-sum-list (cdr list)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1593 ; 0))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1594 ; this a worka!
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1595 ; (eval (cons '+ list))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1596 ;;;_ - lm-set-landmark-signal-strengths ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1597 ;;; on a screen higher than wide, I noticed that the robot would amble
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1598 ;;; left and right and not move forward. examining *lm-blackbox*
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1599 ;;; revealed that there was no scent from the north and south
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1600 ;;; landmarks, hence, they need less factoring down of the effect of
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1601 ;;; distance on scent.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1602
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1603 (defun lm-set-landmark-signal-strengths ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1604
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1605 (setq lm-tree-r (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1606
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1607 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1608 (put direction 'r (* lm-cx 1.1)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1609 lm-ew)
30888
e559f0aa6b2d Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30542
diff changeset
1610 (mapc (lambda (direction)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1611 (put direction 'r (* lm-cy 1.1)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1612 lm-ns)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1613 (put 'lm-tree 'r lm-tree-r))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1614
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1615
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1616 ;;;_ + lm-test-run ()
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1617
18951
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1618 ;;;###autoload
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1619 (defalias 'landmark-repeat 'lm-test-run)
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1620 ;;;###autoload
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1621 (defun lm-test-run ()
18951
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1622 "Run 100 Lm games, each time saving the weights from the previous game."
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1623 (interactive)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1624
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1625 (lm 1)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1626
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1627 (dotimes (scratch-var 100)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1628
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1629 (lm 2)))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1630
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1631
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1632 ;;;_ + lm: The function you invoke to play
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1633
18951
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1634 ;;;###autoload
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1635 (defalias 'landmark 'lm)
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1636 ;;;###autoload
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1637 (defun lm (parg)
18951
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1638 "Start or resume an Lm game.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1639 If a game is in progress, this command allows you to resume it.
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1640 Here is the relation between prefix args and game options:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1641
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1642 prefix arg | robot is auto-started | weights are saved from last game
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1643 ---------------------------------------------------------------------
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1644 none / 1 | yes | no
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1645 2 | yes | yes
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1646 3 | no | yes
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1647 4 | no | no
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1648
18951
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1649 You start by moving to a square and typing \\[lm-start-robot],
a1041ace6786 (landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents: 18290
diff changeset
1650 if you did not use a prefix arg to ask for automatic start.
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1651 Use \\[describe-mode] for more info."
37840
1e7b34ebbb0a (lm): Use "p" not "P" for interactive spec.
Richard M. Stallman <rms@gnu.org>
parents: 34792
diff changeset
1652 (interactive "p")
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1653
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1654 (setf lm-n nil lm-m nil)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1655 (lm-switch-to-window)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1656 (cond
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1657 (lm-emacs-is-computing
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1658 (lm-crash-game))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1659 ((or (not lm-game-in-progress)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1660 (<= lm-number-of-moves 2))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1661 (let ((max-width (lm-max-width))
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1662 (max-height (lm-max-height)))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1663 (or lm-n (setq lm-n max-width))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1664 (or lm-m (setq lm-m max-height))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1665 (cond ((< lm-n 1)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1666 (error "I need at least 1 column"))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1667 ((< lm-m 1)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1668 (error "I need at least 1 row"))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1669 ((> lm-n max-width)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1670 (error "I cannot display %d columns in that window" lm-n)))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1671 (if (and (> lm-m max-height)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1672 (not (eq lm-m lm-saved-board-height))
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1673 ;; Use EQ because SAVED-BOARD-HEIGHT may be nil
65689
96187e7edd1b 2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents: 65585
diff changeset
1674 (not (y-or-n-p (format "Do you really want %d rows? " lm-m))))
18290
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1675 (setq lm-m max-height)))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1676 (if lm-one-moment-please
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1677 (message "One moment, please..."))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1678 (lm-start-game lm-n lm-m)
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1679 (eval (cons 'lm-init
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1680 (cond
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1681 ((= parg 1) '(t nil))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1682 ((= parg 2) '(t t))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1683 ((= parg 3) '(nil t))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1684 ((= parg 4) '(nil nil))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1685 (t '(nil t))))))))
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1686
d87d578b953d (lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents: 17970
diff changeset
1687
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1688 ;;;_ + Local variables
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1689
68866
5340157fbfc2 * files.el (safe-local-variable-values): New option.
Chong Yidong <cyd@stupidchicken.com>
parents: 68634
diff changeset
1690 ;;; The following `allout-layout' local variable setting:
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1691 ;;; - closes all topics from the first topic to just before the third-to-last,
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1692 ;;; - shows the children of the third to last (config vars)
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1693 ;;; - and the second to last (code section),
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1694 ;;; - and closes the last topic (this local-variables section).
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1695 ;;;Local variables:
68866
5340157fbfc2 * files.el (safe-local-variable-values): New option.
Chong Yidong <cyd@stupidchicken.com>
parents: 68634
diff changeset
1696 ;;;allout-layout: (0 : -1 -1 0)
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1697 ;;;End:
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1698
76953
417f62c55294 Seed RNG on loading.
Glenn Morris <rgm@gnu.org>
parents: 75347
diff changeset
1699 (random t)
417f62c55294 Seed RNG on loading.
Glenn Morris <rgm@gnu.org>
parents: 75347
diff changeset
1700
25227
d270a933be88 Provide `landmark', not `lm', and just once.
Karl Heuer <kwzh@gnu.org>
parents: 23376
diff changeset
1701 (provide 'landmark)
d270a933be88 Provide `landmark', not `lm', and just once.
Karl Heuer <kwzh@gnu.org>
parents: 23376
diff changeset
1702
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 87649
diff changeset
1703 ;; arch-tag: ae5031be-96e6-459e-a3df-1df53117d3f2
17905
07602ad4416d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1704 ;;; landmark.el ends here