Mercurial > emacs
annotate lisp/play/gomoku.el @ 11209:4d404c6112e3
Add missing close backquote.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 05 Apr 1995 20:46:40 +0000 |
parents | 09392b4de856 |
children | d90395d3b0ad |
rev | line source |
---|---|
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; gomoku.el --- Gomoku game between you and Emacs |
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
7300 | 3 ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. |
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
4 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
5 ;; Author: Phillippe Schnoebelen <phs@lifia.imag.fr> |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
6 ;; Adapted-By: ESR |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
7 ;; Keywords: games |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
8 |
36 | 9 ;; This file is part of GNU Emacs. |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
13 ;; the Free Software Foundation; either version 2, or (at your option) |
36 | 14 ;; any later version. |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
25 ;;; Commentary: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
26 |
36 | 27 ;;; Gomoku game between you and GNU Emacs. Last modified on 13 Sep 1988 |
28 ;;; | |
29 ;;; Written by Ph. Schnoebelen (phs@lifia.imag.fr), 1987, 1988 | |
30 ;;; with precious advices from J.-F. Rit. | |
31 ;;; This has been tested with GNU Emacs 18.50. | |
32 | |
33 ;; RULES: | |
34 ;; | |
35 ;; Gomoku is a game played between two players on a rectangular board. Each | |
36 ;; player, in turn, marks a free square of its choice. The winner is the first | |
37 ;; one to mark five contiguous squares in any direction (horizontally, | |
38 ;; vertically or diagonally). | |
39 ;; | |
40 ;; I have been told that, in "The TRUE Gomoku", some restrictions are made | |
41 ;; about the squares where one may play, or else there is a known forced win | |
42 ;; for the first player. This program has no such restriction, but it does not | |
43 ;; know about the forced win, nor do I. Furthermore, you probably do not know | |
44 ;; it yourself :-). | |
45 | |
46 | |
47 ;; There are two main places where you may want to customize the program: key | |
48 ;; bindings and board display. These features are commented in the code. Go | |
49 ;; and see. | |
50 | |
51 | |
52 ;; HOW TO USE: | |
53 ;; | |
1221
d5f91623a2cb
(gomoku): Make it autoload.
Richard M. Stallman <rms@gnu.org>
parents:
923
diff
changeset
|
54 ;; The command "M-x gomoku" displays a |
36 | 55 ;; board, the size of which depends on the size of the current window. The |
56 ;; size of the board is easily modified by giving numeric arguments to the | |
57 ;; gomoku command and/or by customizing the displaying parameters. | |
58 ;; | |
59 ;; Emacs plays when it is its turn. When it is your turn, just put the cursor | |
60 ;; on the square where you want to play and hit RET, or X, or whatever key you | |
61 ;; bind to the command gomoku-human-plays. When it is your turn, Emacs is | |
62 ;; idle: you may switch buffers, read your mail, ... Just come back to the | |
63 ;; *Gomoku* buffer and resume play. | |
64 | |
65 | |
66 ;; ALGORITHM: | |
67 ;; | |
68 ;; The algorithm is briefly described in section "THE SCORE TABLE". Some | |
69 ;; parameters may be modified if you want to change the style exhibited by the | |
70 ;; program. | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
71 |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
660
diff
changeset
|
72 ;;; Code: |
36 | 73 |
74 ;;; | |
75 ;;; GOMOKU MODE AND KEYMAP. | |
76 ;;; | |
77 (defvar gomoku-mode-hook nil | |
78 "If non-nil, its value is called on entry to Gomoku mode.") | |
79 | |
80 (defvar gomoku-mode-map nil | |
81 "Local keymap to use in Gomoku mode.") | |
82 | |
83 (if gomoku-mode-map nil | |
84 (setq gomoku-mode-map (make-sparse-keymap)) | |
85 | |
86 ;; Key bindings for cursor motion. Arrow keys are just "function" | |
87 ;; keys, see below. | |
88 (define-key gomoku-mode-map "y" 'gomoku-move-nw) ; Y | |
89 (define-key gomoku-mode-map "u" 'gomoku-move-ne) ; U | |
90 (define-key gomoku-mode-map "b" 'gomoku-move-sw) ; B | |
91 (define-key gomoku-mode-map "n" 'gomoku-move-se) ; N | |
92 (define-key gomoku-mode-map "h" 'gomoku-move-left) ; H | |
93 (define-key gomoku-mode-map "l" 'gomoku-move-right) ; L | |
94 (define-key gomoku-mode-map "j" 'gomoku-move-down) ; J | |
95 (define-key gomoku-mode-map "k" 'gomoku-move-up) ; K | |
96 (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-N | |
97 (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-P | |
98 (define-key gomoku-mode-map "\C-f" 'gomoku-move-right) ; C-F | |
99 (define-key gomoku-mode-map "\C-b" 'gomoku-move-left) ; C-B | |
100 | |
101 ;; Key bindings for entering Human moves. | |
102 ;; If you have a mouse, you may also bind some mouse click ... | |
103 (define-key gomoku-mode-map "X" 'gomoku-human-plays) ; X | |
104 (define-key gomoku-mode-map "x" 'gomoku-human-plays) ; x | |
105 (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET | |
106 (define-key gomoku-mode-map "\C-cp" 'gomoku-human-plays) ; C-C P | |
107 (define-key gomoku-mode-map "\C-cb" 'gomoku-human-takes-back) ; C-C B | |
108 (define-key gomoku-mode-map "\C-cr" 'gomoku-human-resigns) ; C-C R | |
109 (define-key gomoku-mode-map "\C-ce" 'gomoku-emacs-plays) ; C-C E | |
110 | |
923 | 111 (define-key gomoku-mode-map [up] 'gomoku-move-up) |
112 (define-key gomoku-mode-map [down] 'gomoku-move-down) | |
113 (define-key gomoku-mode-map [left] 'gomoku-move-left) | |
114 (define-key gomoku-mode-map [right] 'gomoku-move-right) | |
115 (define-key gomoku-mode-map [kp-enter] 'gomoku-human-plays) | |
10026
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
116 (define-key gomoku-mode-map [mouse-2] 'gomoku-click) |
923 | 117 (define-key gomoku-mode-map [insert] 'gomoku-human-plays)) |
36 | 118 |
119 (defun gomoku-mode () | |
120 "Major mode for playing Gomoku against Emacs. | |
207 | 121 You and Emacs play in turn by marking a free square. You mark it with X |
122 and Emacs marks it with O. The winner is the first to get five contiguous | |
36 | 123 marks horizontally, vertically or in diagonal. |
207 | 124 |
125 You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. | |
36 | 126 |
127 Other useful commands: | |
128 \\{gomoku-mode-map} | |
207 | 129 Entry to this mode calls the value of `gomoku-mode-hook' if that value |
130 is non-nil." | |
36 | 131 (interactive) |
132 (setq major-mode 'gomoku-mode | |
133 mode-name "Gomoku") | |
134 (gomoku-display-statistics) | |
135 (use-local-map gomoku-mode-map) | |
136 (run-hooks 'gomoku-mode-hook)) | |
137 | |
138 ;;; | |
139 ;;; THE BOARD. | |
140 ;;; | |
141 | |
142 ;; The board is a rectangular grid. We code empty squares with 0, X's with 1 | |
143 ;; and O's with 6. The rectangle is recorded in a one dimensional vector | |
144 ;; containing padding squares (coded with -1). These squares allow us to | |
145 ;; detect when we are trying to move out of the board. We denote a square by | |
146 ;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The | |
147 ;; leftmost topmost square has coords (1,1) and index gomoku-board-width + 2. | |
148 ;; Similarly, vectors between squares may be given by two DX, DY coords or by | |
149 ;; one DEPL (the difference between indexes). | |
150 | |
151 (defvar gomoku-board-width nil | |
152 "Number of columns on the Gomoku board.") | |
153 | |
154 (defvar gomoku-board-height nil | |
155 "Number of lines on the Gomoku board.") | |
156 | |
157 (defvar gomoku-board nil | |
158 "Vector recording the actual state of the Gomoku board.") | |
159 | |
160 (defvar gomoku-vector-length nil | |
161 "Length of gomoku-board vector.") | |
162 | |
163 (defvar gomoku-draw-limit nil | |
164 ;; This is usually set to 70% of the number of squares. | |
207 | 165 "After how many moves will Emacs offer a draw?") |
36 | 166 |
167 | |
168 (defun gomoku-xy-to-index (x y) | |
169 "Translate X, Y cartesian coords into the corresponding board index." | |
170 (+ (* y gomoku-board-width) x y)) | |
171 | |
172 (defun gomoku-index-to-x (index) | |
173 "Return corresponding x-coord of board INDEX." | |
174 (% index (1+ gomoku-board-width))) | |
175 | |
176 (defun gomoku-index-to-y (index) | |
177 "Return corresponding y-coord of board INDEX." | |
178 (/ index (1+ gomoku-board-width))) | |
179 | |
180 (defun gomoku-init-board () | |
181 "Create the gomoku-board vector and fill it with initial values." | |
182 (setq gomoku-board (make-vector gomoku-vector-length 0)) | |
183 ;; Every square is 0 (i.e. empty) except padding squares: | |
184 (let ((i 0) (ii (1- gomoku-vector-length))) | |
185 (while (<= i gomoku-board-width) ; The squares in [0..width] and in | |
186 (aset gomoku-board i -1) ; [length - width - 1..length - 1] | |
187 (aset gomoku-board ii -1) ; are padding squares. | |
188 (setq i (1+ i) | |
189 ii (1- ii)))) | |
190 (let ((i 0)) | |
191 (while (< i gomoku-vector-length) | |
192 (aset gomoku-board i -1) ; and also all k*(width+1) | |
193 (setq i (+ i gomoku-board-width 1))))) | |
194 | |
195 ;;; | |
196 ;;; THE SCORE TABLE. | |
197 ;;; | |
198 | |
199 ;; Every (free) square has a score associated to it, recorded in the | |
200 ;; GOMOKU-SCORE-TABLE vector. The program always plays in the square having | |
201 ;; the highest score. | |
202 | |
203 (defvar gomoku-score-table nil | |
204 "Vector recording the actual score of the free squares.") | |
205 | |
206 | |
207 ;; The key point point about the algorithm is that, rather than considering | |
208 ;; the board as just a set of squares, we prefer to see it as a "space" of | |
209 ;; internested 5-tuples of contiguous squares (called qtuples). | |
210 ;; | |
211 ;; The aim of the program is to fill one qtuple with its O's while preventing | |
212 ;; you from filling another one with your X's. To that effect, it computes a | |
213 ;; score for every qtuple, with better qtuples having better scores. Of | |
214 ;; course, the score of a qtuple (taken in isolation) is just determined by | |
215 ;; its contents as a set, i.e. not considering the order of its elements. The | |
216 ;; highest score is given to the "OOOO" qtuples because playing in such a | |
217 ;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because | |
218 ;; not playing in it is just loosing the game, and so on. Note that a | |
219 ;; "polluted" qtuple, i.e. one containing at least one X and at least one O, | |
220 ;; has score zero because there is no more any point in playing in it, from | |
221 ;; both an attacking and a defending point of view. | |
222 ;; | |
223 ;; Given the score of every qtuple, the score of a given free square on the | |
224 ;; board is just the sum of the scores of all the qtuples to which it belongs, | |
225 ;; because playing in that square is playing in all its containing qtuples at | |
226 ;; once. And it is that function which takes into account the internesting of | |
227 ;; the qtuples. | |
228 ;; | |
229 ;; This algorithm is rather simple but anyway it gives a not so dumb level of | |
230 ;; play. It easily extends to "n-dimensional Gomoku", where a win should not | |
231 ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) | |
232 ;; should be preferred. | |
233 | |
234 | |
235 ;; Here are the scores of the nine "non-polluted" configurations. Tuning | |
236 ;; these values will change (hopefully improve) the strength of the program | |
237 ;; and may change its style (rather aggressive here). | |
238 | |
239 (defconst nil-score 7 "Score of an empty qtuple.") | |
240 (defconst Xscore 15 "Score of a qtuple containing one X.") | |
241 (defconst XXscore 400 "Score of a qtuple containing two X's.") | |
242 (defconst XXXscore 1800 "Score of a qtuple containing three X's.") | |
243 (defconst XXXXscore 100000 "Score of a qtuple containing four X's.") | |
244 (defconst Oscore 35 "Score of a qtuple containing one O.") | |
245 (defconst OOscore 800 "Score of a qtuple containing two O's.") | |
246 (defconst OOOscore 15000 "Score of a qtuple containing three O's.") | |
247 (defconst OOOOscore 800000 "Score of a qtuple containing four O's.") | |
248 | |
249 ;; These values are not just random: if, given the following situation: | |
250 ;; | |
251 ;; . . . . . . . O . | |
252 ;; . X X a . . . X . | |
253 ;; . . . X . . . X . | |
254 ;; . . . X . . . X . | |
255 ;; . . . . . . . b . | |
256 ;; | |
257 ;; you want Emacs to play in "a" and not in "b", then the parameters must | |
258 ;; satisfy the inequality: | |
259 ;; | |
260 ;; 6 * XXscore > XXXscore + XXscore | |
261 ;; | |
262 ;; because "a" mainly belongs to six "XX" qtuples (the others are less | |
263 ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other | |
264 ;; conditions are required to obtain sensible moves, but the previous example | |
265 ;; should illustrate the point. If you manage to improve on these values, | |
266 ;; please send me a note. Thanks. | |
267 | |
268 | |
269 ;; As we choosed values 0, 1 and 6 to denote empty, X and O squares, the | |
270 ;; contents of a qtuple is uniquely determined by the sum of its elements and | |
271 ;; we just have to set up a translation table. | |
272 | |
273 (defconst gomoku-score-trans-table | |
274 (vector nil-score Xscore XXscore XXXscore XXXXscore 0 | |
275 Oscore 0 0 0 0 0 | |
276 OOscore 0 0 0 0 0 | |
277 OOOscore 0 0 0 0 0 | |
278 OOOOscore 0 0 0 0 0 | |
279 0) | |
280 "Vector associating qtuple contents to their score.") | |
281 | |
282 | |
283 ;; If you do not modify drastically the previous constants, the only way for a | |
284 ;; square to have a score higher than OOOOscore is to belong to a "OOOO" | |
285 ;; qtuple, thus to be a winning move. Similarly, the only way for a square to | |
286 ;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX" | |
287 ;; qtuple. We may use these considerations to detect when a given move is | |
288 ;; winning or loosing. | |
289 | |
290 (defconst gomoku-winning-threshold OOOOscore | |
207 | 291 "Threshold score beyond which an Emacs move is winning.") |
36 | 292 |
293 (defconst gomoku-loosing-threshold XXXXscore | |
294 "Threshold score beyond which a human move is winning.") | |
295 | |
296 | |
297 (defun gomoku-strongest-square () | |
298 "Compute index of free square with highest score, or nil if none." | |
299 ;; We just have to loop other all squares. However there are two problems: | |
300 ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed | |
301 ;; up future searches, we set the score of padding or occupied squares | |
302 ;; to -1 whenever we meet them. | |
303 ;; 2/ We want to choose randomly between equally good moves. | |
304 (let ((score-max 0) | |
305 (count 0) ; Number of equally good moves | |
306 (square (gomoku-xy-to-index 1 1)) ; First square | |
307 (end (gomoku-xy-to-index gomoku-board-width gomoku-board-height)) | |
308 best-square score) | |
309 (while (<= square end) | |
310 (cond | |
311 ;; If score is lower (i.e. most of the time), skip to next: | |
312 ((< (aref gomoku-score-table square) score-max)) | |
313 ;; If score is better, beware of non free squares: | |
314 ((> (setq score (aref gomoku-score-table square)) score-max) | |
315 (if (zerop (aref gomoku-board square)) ; is it free ? | |
316 (setq count 1 ; yes: take it ! | |
317 best-square square | |
318 score-max score) | |
319 (aset gomoku-score-table square -1))) ; no: kill it ! | |
320 ;; If score is equally good, choose randomly. But first check freeness: | |
321 ((not (zerop (aref gomoku-board square))) | |
322 (aset gomoku-score-table square -1)) | |
4402 | 323 ((zerop (random (setq count (1+ count)))) |
36 | 324 (setq best-square square |
325 score-max score))) | |
326 (setq square (1+ square))) ; try next square | |
327 best-square)) | |
328 | |
329 ;;; | |
330 ;;; INITIALIZING THE SCORE TABLE. | |
331 ;;; | |
332 | |
333 ;; At initialization the board is empty so that every qtuple amounts for | |
334 ;; nil-score. Therefore, the score of any square is nil-score times the number | |
335 ;; of qtuples that pass through it. This number is 3 in a corner and 20 if you | |
336 ;; are sufficiently far from the sides. As computing the number is time | |
337 ;; consuming, we initialize every square with 20*nil-score and then only | |
338 ;; consider squares at less than 5 squares from one side. We speed this up by | |
339 ;; taking symmetry into account. | |
340 ;; Also, as it is likely that successive games will be played on a board with | |
341 ;; same size, it is a good idea to save the initial SCORE-TABLE configuration. | |
342 | |
343 (defvar gomoku-saved-score-table nil | |
344 "Recorded initial value of previous score table.") | |
345 | |
346 (defvar gomoku-saved-board-width nil | |
347 "Recorded value of previous board width.") | |
348 | |
349 (defvar gomoku-saved-board-height nil | |
350 "Recorded value of previous board height.") | |
351 | |
352 | |
353 (defun gomoku-init-score-table () | |
354 "Create the score table vector and fill it with initial values." | |
355 (if (and gomoku-saved-score-table ; Has it been stored last time ? | |
356 (= gomoku-board-width gomoku-saved-board-width) | |
357 (= gomoku-board-height gomoku-saved-board-height)) | |
358 (setq gomoku-score-table (copy-sequence gomoku-saved-score-table)) | |
359 ;; No, compute it: | |
360 (setq gomoku-score-table | |
361 (make-vector gomoku-vector-length (* 20 nil-score))) | |
362 (let (i j maxi maxj maxi2 maxj2) | |
363 (setq maxi (/ (1+ gomoku-board-width) 2) | |
364 maxj (/ (1+ gomoku-board-height) 2) | |
365 maxi2 (min 4 maxi) | |
366 maxj2 (min 4 maxj)) | |
367 ;; We took symmetry into account and could use it more if the board | |
368 ;; would have been square and not rectangular ! | |
369 ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U | |
370 ;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the | |
371 ;; board may well be less than 8 by 8 ! | |
372 (setq i 1) | |
373 (while (<= i maxi2) | |
374 (setq j 1) | |
375 (while (<= j maxj) | |
376 (gomoku-init-square-score i j) | |
377 (setq j (1+ j))) | |
378 (setq i (1+ i))) | |
379 (while (<= i maxi) | |
380 (setq j 1) | |
381 (while (<= j maxj2) | |
382 (gomoku-init-square-score i j) | |
383 (setq j (1+ j))) | |
384 (setq i (1+ i)))) | |
385 (setq gomoku-saved-score-table (copy-sequence gomoku-score-table) | |
386 gomoku-saved-board-width gomoku-board-width | |
387 gomoku-saved-board-height gomoku-board-height))) | |
388 | |
389 (defun gomoku-nb-qtuples (i j) | |
390 "Return the number of qtuples containing square I,J." | |
207 | 391 ;; This function is complicated because we have to deal |
36 | 392 ;; with ugly cases like 3 by 6 boards, but it works. |
393 ;; If you have a simpler (and correct) solution, send it to me. Thanks ! | |
394 (let ((left (min 4 (1- i))) | |
395 (right (min 4 (- gomoku-board-width i))) | |
396 (up (min 4 (1- j))) | |
397 (down (min 4 (- gomoku-board-height j)))) | |
398 (+ -12 | |
399 (min (max (+ left right) 3) 8) | |
400 (min (max (+ up down) 3) 8) | |
401 (min (max (+ (min left up) (min right down)) 3) 8) | |
402 (min (max (+ (min right up) (min left down)) 3) 8)))) | |
403 | |
404 (defun gomoku-init-square-score (i j) | |
405 "Give initial score to square I,J and to its mirror images." | |
406 (let ((ii (1+ (- gomoku-board-width i))) | |
407 (jj (1+ (- gomoku-board-height j))) | |
408 (sc (* (gomoku-nb-qtuples i j) (aref gomoku-score-trans-table 0)))) | |
409 (aset gomoku-score-table (gomoku-xy-to-index i j) sc) | |
410 (aset gomoku-score-table (gomoku-xy-to-index ii j) sc) | |
411 (aset gomoku-score-table (gomoku-xy-to-index i jj) sc) | |
412 (aset gomoku-score-table (gomoku-xy-to-index ii jj) sc))) | |
413 | |
414 ;;; | |
415 ;;; MAINTAINING THE SCORE TABLE. | |
416 ;;; | |
417 | |
418 ;; We do not provide functions for computing the SCORE-TABLE given the | |
419 ;; contents of the BOARD. This would involve heavy nested loops, with time | |
420 ;; proportional to the size of the board. It is better to update the | |
421 ;; SCORE-TABLE after each move. Updating needs not modify more than 36 | |
422 ;; squares: it is done in constant time. | |
423 | |
424 (defun gomoku-update-score-table (square dval) | |
425 "Update score table after SQUARE received a DVAL increment." | |
426 ;; The board has already been updated when this function is called. | |
427 ;; Updating scores is done by looking for qtuples boundaries in all four | |
428 ;; directions and then calling update-score-in-direction. | |
429 ;; Finally all squares received the right increment, and then are up to | |
430 ;; date, except possibly for SQUARE itself if we are taking a move back for | |
431 ;; its score had been set to -1 at the time. | |
432 (let* ((x (gomoku-index-to-x square)) | |
433 (y (gomoku-index-to-y square)) | |
434 (imin (max -4 (- 1 x))) | |
435 (jmin (max -4 (- 1 y))) | |
436 (imax (min 0 (- gomoku-board-width x 4))) | |
437 (jmax (min 0 (- gomoku-board-height y 4)))) | |
438 (gomoku-update-score-in-direction imin imax | |
439 square 1 0 dval) | |
440 (gomoku-update-score-in-direction jmin jmax | |
441 square 0 1 dval) | |
442 (gomoku-update-score-in-direction (max imin jmin) (min imax jmax) | |
443 square 1 1 dval) | |
444 (gomoku-update-score-in-direction (max (- 1 y) -4 | |
445 (- x gomoku-board-width)) | |
446 (min 0 (- x 5) | |
447 (- gomoku-board-height y 4)) | |
448 square -1 1 dval))) | |
449 | |
450 (defun gomoku-update-score-in-direction (left right square dx dy dval) | |
451 "Update scores for all squares in the qtuples starting between the LEFTth | |
452 square and the RIGHTth after SQUARE, along the DX, DY direction, considering | |
453 that DVAL has been added on SQUARE." | |
454 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well | |
455 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that | |
456 ;; DX,DY direction. | |
457 (cond | |
458 ((> left right)) ; Quit | |
459 (t ; Else .. | |
460 (let (depl square0 square1 square2 count delta) | |
461 (setq depl (gomoku-xy-to-index dx dy) | |
462 square0 (+ square (* left depl)) | |
463 square1 (+ square (* right depl)) | |
464 square2 (+ square0 (* 4 depl))) | |
465 ;; Compute the contents of the first qtuple: | |
466 (setq square square0 | |
467 count 0) | |
468 (while (<= square square2) | |
469 (setq count (+ count (aref gomoku-board square)) | |
470 square (+ square depl))) | |
471 (while (<= square0 square1) | |
472 ;; Update the squares of the qtuple beginning in SQUARE0 and ending | |
473 ;; in SQUARE2. | |
474 (setq delta (- (aref gomoku-score-trans-table count) | |
475 (aref gomoku-score-trans-table (- count dval)))) | |
476 (cond ((not (zerop delta)) ; or else nothing to update | |
477 (setq square square0) | |
478 (while (<= square square2) | |
479 (if (zerop (aref gomoku-board square)) ; only for free squares | |
480 (aset gomoku-score-table square | |
481 (+ (aref gomoku-score-table square) delta))) | |
482 (setq square (+ square depl))))) | |
483 ;; Then shift the qtuple one square along DEPL, this only requires | |
484 ;; modifying SQUARE0 and SQUARE2. | |
485 (setq square2 (+ square2 depl) | |
486 count (+ count (- (aref gomoku-board square0)) | |
487 (aref gomoku-board square2)) | |
488 square0 (+ square0 depl))))))) | |
489 | |
490 ;;; | |
491 ;;; GAME CONTROL. | |
492 ;;; | |
493 | |
494 ;; Several variables are used to monitor a game, including a GAME-HISTORY (the | |
495 ;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back | |
496 ;; (anti-updating the score table) and to compute the table from scratch in | |
497 ;; case of an interruption. | |
498 | |
499 (defvar gomoku-game-in-progress nil | |
500 "Non-nil if a game is in progress.") | |
501 | |
502 (defvar gomoku-game-history nil | |
503 "A record of all moves that have been played during current game.") | |
504 | |
505 (defvar gomoku-number-of-moves nil | |
506 "Number of moves already played in current game.") | |
507 | |
508 (defvar gomoku-number-of-human-moves nil | |
509 "Number of moves already played by human in current game.") | |
510 | |
511 (defvar gomoku-emacs-played-first nil | |
512 "Non-nil if Emacs played first.") | |
513 | |
514 (defvar gomoku-human-took-back nil | |
515 "Non-nil if Human took back a move during the game.") | |
516 | |
517 (defvar gomoku-human-refused-draw nil | |
518 "Non-nil if Human refused Emacs offer of a draw.") | |
519 | |
520 (defvar gomoku-emacs-is-computing nil | |
521 ;; This is used to detect interruptions. Hopefully, it should not be needed. | |
522 "Non-nil if Emacs is in the middle of a computation.") | |
523 | |
524 | |
525 (defun gomoku-start-game (n m) | |
526 "Initialize a new game on an N by M board." | |
527 (setq gomoku-emacs-is-computing t) ; Raise flag | |
528 (setq gomoku-game-in-progress t) | |
529 (setq gomoku-board-width n | |
530 gomoku-board-height m | |
531 gomoku-vector-length (1+ (* (+ m 2) (1+ n))) | |
532 gomoku-draw-limit (/ (* 7 n m) 10)) | |
533 (setq gomoku-game-history nil | |
534 gomoku-number-of-moves 0 | |
535 gomoku-number-of-human-moves 0 | |
536 gomoku-emacs-played-first nil | |
537 gomoku-human-took-back nil | |
538 gomoku-human-refused-draw nil) | |
539 (gomoku-init-display n m) ; Display first: the rest takes time | |
540 (gomoku-init-score-table) ; INIT-BOARD requires that the score | |
541 (gomoku-init-board) ; table be already created. | |
542 (setq gomoku-emacs-is-computing nil)) | |
543 | |
544 (defun gomoku-play-move (square val &optional dont-update-score) | |
545 "Go to SQUARE, play VAL and update everything." | |
546 (setq gomoku-emacs-is-computing t) ; Raise flag | |
547 (cond ((= 1 val) ; a Human move | |
548 (setq gomoku-number-of-human-moves (1+ gomoku-number-of-human-moves))) | |
549 ((zerop gomoku-number-of-moves) ; an Emacs move. Is it first ? | |
550 (setq gomoku-emacs-played-first t))) | |
551 (setq gomoku-game-history | |
552 (cons (cons square (aref gomoku-score-table square)) | |
553 gomoku-game-history) | |
554 gomoku-number-of-moves (1+ gomoku-number-of-moves)) | |
555 (gomoku-plot-square square val) | |
556 (aset gomoku-board square val) ; *BEFORE* UPDATE-SCORE ! | |
557 (if dont-update-score nil | |
558 (gomoku-update-score-table square val) ; previous val was 0: dval = val | |
559 (aset gomoku-score-table square -1)) | |
560 (setq gomoku-emacs-is-computing nil)) | |
561 | |
562 (defun gomoku-take-back () | |
563 "Take back last move and update everything." | |
564 (setq gomoku-emacs-is-computing t) | |
565 (let* ((last-move (car gomoku-game-history)) | |
566 (square (car last-move)) | |
567 (oldval (aref gomoku-board square))) | |
568 (if (= 1 oldval) | |
569 (setq gomoku-number-of-human-moves (1- gomoku-number-of-human-moves))) | |
570 (setq gomoku-game-history (cdr gomoku-game-history) | |
571 gomoku-number-of-moves (1- gomoku-number-of-moves)) | |
572 (gomoku-plot-square square 0) | |
573 (aset gomoku-board square 0) ; *BEFORE* UPDATE-SCORE ! | |
574 (gomoku-update-score-table square (- oldval)) | |
575 (aset gomoku-score-table square (cdr last-move))) | |
576 (setq gomoku-emacs-is-computing nil)) | |
577 | |
578 ;;; | |
579 ;;; SESSION CONTROL. | |
580 ;;; | |
581 | |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
582 (defvar gomoku-number-of-emacs-wins 0 |
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
583 "Number of games Emacs won in this session.") |
36 | 584 |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
585 (defvar gomoku-number-of-human-wins 0 |
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
586 "Number of games you won in this session.") |
36 | 587 |
588 (defvar gomoku-number-of-draws 0 | |
589 "Number of games already drawn in this session.") | |
590 | |
591 | |
592 (defun gomoku-terminate-game (result) | |
593 "Terminate the current game with RESULT." | |
594 (let (message) | |
595 (cond | |
596 ((eq result 'emacs-won) | |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
597 (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) |
36 | 598 (setq message |
599 (cond ((< gomoku-number-of-moves 20) | |
600 "This was a REALLY QUICK win.") | |
601 (gomoku-human-refused-draw | |
602 "I won... Too bad you refused my offer of a draw !") | |
603 (gomoku-human-took-back | |
604 "I won... Taking moves back will not help you !") | |
605 ((not gomoku-emacs-played-first) | |
606 "I won... Playing first did not help you much !") | |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
607 ((and (zerop gomoku-number-of-human-wins) |
36 | 608 (zerop gomoku-number-of-draws) |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
609 (> gomoku-number-of-emacs-wins 1)) |
36 | 610 "I'm becoming tired of winning...") |
611 (t | |
612 "I won.")))) | |
613 ((eq result 'human-won) | |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
614 (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins)) |
36 | 615 (setq message |
616 (cond | |
617 (gomoku-human-took-back | |
207 | 618 "OK, you won this one. I, for one, never take my moves back...") |
36 | 619 (gomoku-emacs-played-first |
620 "OK, you won this one... so what ?") | |
621 (t | |
207 | 622 "OK, you won this one. Now, let me play first just once.")))) |
36 | 623 ((eq result 'human-resigned) |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
624 (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) |
207 | 625 (setq message "So you resign. That's just one more win for me.")) |
36 | 626 ((eq result 'nobody-won) |
627 (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) | |
628 (setq message | |
629 (cond | |
630 (gomoku-human-took-back | |
207 | 631 "This is a draw. I, for one, never take my moves back...") |
36 | 632 (gomoku-emacs-played-first |
207 | 633 "This is a draw. Just chance, I guess.") |
36 | 634 (t |
207 | 635 "This is a draw. Now, let me play first just once.")))) |
36 | 636 ((eq result 'draw-agreed) |
637 (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) | |
638 (setq message | |
639 (cond | |
640 (gomoku-human-took-back | |
207 | 641 "Draw agreed. I, for one, never take my moves back...") |
36 | 642 (gomoku-emacs-played-first |
207 | 643 "Draw agreed. You were lucky.") |
36 | 644 (t |
207 | 645 "Draw agreed. Now, let me play first just once.")))) |
36 | 646 ((eq result 'crash-game) |
647 (setq message | |
648 "Sorry, I have been interrupted and cannot resume that game..."))) | |
649 | |
650 (gomoku-display-statistics) | |
651 (if message (message message)) | |
652 (ding) | |
653 (setq gomoku-game-in-progress nil))) | |
654 | |
655 (defun gomoku-crash-game () | |
656 "What to do when Emacs detects it has been interrupted." | |
657 (setq gomoku-emacs-is-computing nil) | |
658 (gomoku-terminate-game 'crash-game) | |
659 (sit-for 4) ; Let's see the message | |
660 (gomoku-prompt-for-other-game)) | |
661 | |
662 ;;; | |
663 ;;; INTERACTIVE COMMANDS. | |
664 ;;; | |
665 | |
1221
d5f91623a2cb
(gomoku): Make it autoload.
Richard M. Stallman <rms@gnu.org>
parents:
923
diff
changeset
|
666 ;;;###autoload |
36 | 667 (defun gomoku (&optional n m) |
668 "Start a Gomoku game between you and Emacs. | |
669 If a game is in progress, this command allow you to resume it. | |
670 If optional arguments N and M are given, an N by M board is used. | |
671 | |
207 | 672 You and Emacs play in turn by marking a free square. You mark it with X |
36 | 673 and Emacs marks it with O. The winner is the first to get five contiguous |
674 marks horizontally, vertically or in diagonal. | |
207 | 675 |
676 You play by moving the cursor over the square you choose and hitting | |
677 \\<gomoku-mode-map>\\[gomoku-human-plays]. | |
678 Use \\[describe-mode] for more info." | |
36 | 679 (interactive) |
680 (gomoku-switch-to-window) | |
681 (cond | |
682 (gomoku-emacs-is-computing | |
683 (gomoku-crash-game)) | |
684 ((not gomoku-game-in-progress) | |
685 (let ((max-width (gomoku-max-width)) | |
686 (max-height (gomoku-max-height))) | |
687 (or n (setq n max-width)) | |
688 (or m (setq m max-height)) | |
689 (cond ((< n 1) | |
690 (error "I need at least 1 column")) | |
691 ((< m 1) | |
692 (error "I need at least 1 row")) | |
693 ((> n max-width) | |
694 (error "I cannot display %d columns in that window" n))) | |
695 (if (and (> m max-height) | |
696 (not (equal m gomoku-saved-board-height)) | |
697 ;; Use EQUAL because SAVED-BOARD-HEIGHT may be nil | |
698 (not (y-or-n-p (format "Do you really want %d rows " m)))) | |
699 (setq m max-height))) | |
700 (message "One moment, please...") | |
701 (gomoku-start-game n m) | |
702 (if (y-or-n-p "Do you allow me to play first ") | |
703 (gomoku-emacs-plays) | |
704 (gomoku-prompt-for-move))) | |
705 ((y-or-n-p "Shall we continue our game ") | |
706 (gomoku-prompt-for-move)) | |
707 (t | |
708 (gomoku-human-resigns)))) | |
709 | |
710 (defun gomoku-emacs-plays () | |
711 "Compute Emacs next move and play it." | |
712 (interactive) | |
713 (gomoku-switch-to-window) | |
714 (cond | |
715 (gomoku-emacs-is-computing | |
716 (gomoku-crash-game)) | |
717 ((not gomoku-game-in-progress) | |
718 (gomoku-prompt-for-other-game)) | |
719 (t | |
720 (message "Let me think...") | |
721 (let (square score) | |
722 (setq square (gomoku-strongest-square)) | |
723 (cond ((null square) | |
724 (gomoku-terminate-game 'nobody-won)) | |
725 (t | |
726 (setq score (aref gomoku-score-table square)) | |
727 (gomoku-play-move square 6) | |
728 (cond ((>= score gomoku-winning-threshold) | |
729 (gomoku-find-filled-qtuple square 6) | |
730 (gomoku-cross-winning-qtuple) | |
731 (gomoku-terminate-game 'emacs-won)) | |
732 ((zerop score) | |
733 (gomoku-terminate-game 'nobody-won)) | |
734 ((and (> gomoku-number-of-moves gomoku-draw-limit) | |
735 (not gomoku-human-refused-draw) | |
736 (gomoku-offer-a-draw)) | |
737 (gomoku-terminate-game 'draw-agreed)) | |
738 (t | |
739 (gomoku-prompt-for-move))))))))) | |
740 | |
10026
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
741 (defun gomoku-click (click) |
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
742 "Play at the square where you click." |
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
743 (interactive "e") |
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
744 (mouse-set-point click) |
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
745 (gomoku-human-plays)) |
09392b4de856
(gomoku-click): New function.
Richard M. Stallman <rms@gnu.org>
parents:
7800
diff
changeset
|
746 |
36 | 747 (defun gomoku-human-plays () |
748 "Signal to the Gomoku program that you have played. | |
749 You must have put the cursor on the square where you want to play. | |
750 If the game is finished, this command requests for another game." | |
751 (interactive) | |
752 (gomoku-switch-to-window) | |
753 (cond | |
754 (gomoku-emacs-is-computing | |
755 (gomoku-crash-game)) | |
756 ((not gomoku-game-in-progress) | |
757 (gomoku-prompt-for-other-game)) | |
758 (t | |
759 (let (square score) | |
760 (setq square (gomoku-point-square)) | |
761 (cond ((null square) | |
762 (error "Your point is not on a square. Retry !")) | |
763 ((not (zerop (aref gomoku-board square))) | |
764 (error "Your point is not on a free square. Retry !")) | |
765 (t | |
766 (setq score (aref gomoku-score-table square)) | |
767 (gomoku-play-move square 1) | |
768 (cond ((and (>= score gomoku-loosing-threshold) | |
769 ;; Just testing SCORE > THRESHOLD is not enough for | |
770 ;; detecting wins, it just gives an indication that | |
771 ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE. | |
772 (gomoku-find-filled-qtuple square 1)) | |
773 (gomoku-cross-winning-qtuple) | |
774 (gomoku-terminate-game 'human-won)) | |
775 (t | |
776 (gomoku-emacs-plays))))))))) | |
777 | |
778 (defun gomoku-human-takes-back () | |
779 "Signal to the Gomoku program that you wish to take back your last move." | |
780 (interactive) | |
781 (gomoku-switch-to-window) | |
782 (cond | |
783 (gomoku-emacs-is-computing | |
784 (gomoku-crash-game)) | |
785 ((not gomoku-game-in-progress) | |
786 (message "Too late for taking back...") | |
787 (sit-for 4) | |
788 (gomoku-prompt-for-other-game)) | |
789 ((zerop gomoku-number-of-human-moves) | |
790 (message "You have not played yet... Your move ?")) | |
791 (t | |
792 (message "One moment, please...") | |
793 ;; It is possible for the user to let Emacs play several consecutive | |
794 ;; moves, so that the best way to know when to stop taking back moves is | |
795 ;; to count the number of human moves: | |
796 (setq gomoku-human-took-back t) | |
797 (let ((number gomoku-number-of-human-moves)) | |
798 (while (= number gomoku-number-of-human-moves) | |
799 (gomoku-take-back))) | |
800 (gomoku-prompt-for-move)))) | |
801 | |
802 (defun gomoku-human-resigns () | |
803 "Signal to the Gomoku program that you may want to resign." | |
804 (interactive) | |
805 (gomoku-switch-to-window) | |
806 (cond | |
807 (gomoku-emacs-is-computing | |
808 (gomoku-crash-game)) | |
809 ((not gomoku-game-in-progress) | |
810 (message "There is no game in progress")) | |
811 ((y-or-n-p "You mean, you resign ") | |
812 (gomoku-terminate-game 'human-resigned)) | |
813 ((y-or-n-p "You mean, we continue ") | |
814 (gomoku-prompt-for-move)) | |
815 (t | |
816 (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it | |
817 | |
818 ;;; | |
819 ;;; PROMPTING THE HUMAN PLAYER. | |
820 ;;; | |
821 | |
822 (defun gomoku-prompt-for-move () | |
823 "Display a message asking for Human's move." | |
824 (message (if (zerop gomoku-number-of-human-moves) | |
825 "Your move ? (move to a free square and hit X, RET ...)" | |
826 "Your move ?")) | |
827 ;; This may seem silly, but if one omits the following line (or a similar | |
828 ;; one), the cursor may very well go to some place where POINT is not. | |
829 (save-excursion (set-buffer (other-buffer)))) | |
830 | |
831 (defun gomoku-prompt-for-other-game () | |
832 "Ask for another game, and start it." | |
833 (if (y-or-n-p "Another game ") | |
834 (gomoku gomoku-board-width gomoku-board-height) | |
835 (message "Chicken !"))) | |
836 | |
837 (defun gomoku-offer-a-draw () | |
838 "Offer a draw and return T if Human accepted it." | |
839 (or (y-or-n-p "I offer you a draw. Do you accept it ") | |
840 (prog1 (setq gomoku-human-refused-draw t) | |
841 nil))) | |
842 | |
843 ;;; | |
844 ;;; DISPLAYING THE BOARD. | |
845 ;;; | |
846 | |
847 ;; You may change these values if you have a small screen or if the squares | |
848 ;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). | |
849 | |
850 (defconst gomoku-square-width 4 | |
851 "*Horizontal spacing between squares on the Gomoku board.") | |
852 | |
853 (defconst gomoku-square-height 2 | |
854 "*Vertical spacing between squares on the Gomoku board.") | |
855 | |
856 (defconst gomoku-x-offset 3 | |
857 "*Number of columns between the Gomoku board and the side of the window.") | |
858 | |
859 (defconst gomoku-y-offset 1 | |
860 "*Number of lines between the Gomoku board and the top of the window.") | |
861 | |
862 | |
863 (defun gomoku-max-width () | |
864 "Largest possible board width for the current window." | |
865 (1+ (/ (- (window-width (selected-window)) | |
866 gomoku-x-offset gomoku-x-offset 1) | |
867 gomoku-square-width))) | |
868 | |
869 (defun gomoku-max-height () | |
870 "Largest possible board height for the current window." | |
871 (1+ (/ (- (window-height (selected-window)) | |
872 gomoku-y-offset gomoku-y-offset 2) | |
873 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! | |
874 gomoku-square-height))) | |
875 | |
876 (defun gomoku-point-x () | |
877 "Return the board column where point is, or nil if it is not a board column." | |
878 (let ((col (- (current-column) gomoku-x-offset))) | |
879 (if (and (>= col 0) | |
880 (zerop (% col gomoku-square-width)) | |
881 (<= (setq col (1+ (/ col gomoku-square-width))) | |
882 gomoku-board-width)) | |
883 col))) | |
884 | |
885 (defun gomoku-point-y () | |
886 "Return the board row where point is, or nil if it is not a board row." | |
887 (let ((row (- (count-lines 1 (point)) gomoku-y-offset 1))) | |
888 (if (and (>= row 0) | |
889 (zerop (% row gomoku-square-height)) | |
890 (<= (setq row (1+ (/ row gomoku-square-height))) | |
891 gomoku-board-height)) | |
892 row))) | |
893 | |
894 (defun gomoku-point-square () | |
895 "Return the index of the square point is on, or nil if not on the board." | |
896 (let (x y) | |
897 (and (setq x (gomoku-point-x)) | |
898 (setq y (gomoku-point-y)) | |
899 (gomoku-xy-to-index x y)))) | |
900 | |
901 (defun gomoku-goto-square (index) | |
902 "Move point to square number INDEX." | |
903 (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index))) | |
904 | |
905 (defun gomoku-goto-xy (x y) | |
906 "Move point to square at X, Y coords." | |
907 (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y)))) | |
908 (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) | |
909 | |
910 (defun gomoku-plot-square (square value) | |
911 "Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there." | |
912 (gomoku-goto-square square) | |
913 (gomoku-put-char (cond ((= value 1) ?X) | |
914 ((= value 6) ?O) | |
915 (t ?.))) | |
916 (sit-for 0)) ; Display NOW | |
917 | |
918 (defun gomoku-put-char (char) | |
919 "Draw CHAR on the Gomoku screen." | |
5822
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
920 (let ((inhibit-read-only t)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
921 (insert char) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
922 (delete-char 1) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
923 (backward-char 1))) |
36 | 924 |
925 (defun gomoku-init-display (n m) | |
926 "Display an N by M Gomoku board." | |
52 | 927 (buffer-disable-undo (current-buffer)) |
5822
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
928 (let ((inhibit-read-only t)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
929 (erase-buffer) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
930 (let (string1 string2 string3 string4) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
931 ;; We do not use gomoku-plot-square which would be too slow for |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
932 ;; initializing the display. Rather we build STRING1 for lines where |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
933 ;; board squares are to be found, and STRING2 for empty lines. STRING1 is |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
934 ;; like STRING2 except for dots every DX squares. Empty lines are filled |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
935 ;; with spaces so that cursor moving up and down remains on the same |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
936 ;; column. |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
937 (setq string1 (concat (make-string (1- gomoku-square-width) ? ) ".") |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
938 string1 (apply 'concat |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
939 (make-list (1- n) string1)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
940 string1 (concat (make-string gomoku-x-offset ? ) "." string1 "\n") |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
941 string2 (make-string (+ 1 gomoku-x-offset |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
942 (* (1- n) gomoku-square-width)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
943 ? ) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
944 string2 (concat string2 "\n") |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
945 string3 (apply 'concat |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
946 (make-list (1- gomoku-square-height) string2)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
947 string3 (concat string3 string1) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
948 string3 (apply 'concat |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
949 (make-list (1- m) string3)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
950 string4 (apply 'concat |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
951 (make-list gomoku-y-offset string2))) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
952 (insert string4 string1 string3)) |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
953 (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board |
db219f81f5de
(gomoku-init-display, gomoku-put-char):
Richard M. Stallman <rms@gnu.org>
parents:
4402
diff
changeset
|
954 (sit-for 0))) ; Display NOW |
36 | 955 |
956 (defun gomoku-display-statistics () | |
957 "Obnoxiously display some statistics about previous games in mode line." | |
958 ;; We store this string in the mode-line-process local variable. | |
959 ;; This is certainly not the cleanest way out ... | |
960 (setq mode-line-process | |
961 (cond | |
962 ((not (zerop gomoku-number-of-draws)) | |
963 (format ": Won %d, lost %d, drew %d" | |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
964 gomoku-number-of-human-wins |
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
965 gomoku-number-of-emacs-wins |
36 | 966 gomoku-number-of-draws)) |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
967 (t |
36 | 968 (format ": Won %d, lost %d" |
7800
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
969 gomoku-number-of-human-wins |
329e59e31d8d
(gomoku-display-statistics): Use human's point of view
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
970 gomoku-number-of-emacs-wins)))) |
36 | 971 ;; Then a (standard) kludgy line will force update of mode line. |
972 (set-buffer-modified-p (buffer-modified-p))) | |
973 | |
974 (defun gomoku-switch-to-window () | |
975 "Find or create the Gomoku buffer, and display it." | |
976 (interactive) | |
977 (let ((buff (get-buffer "*Gomoku*"))) | |
978 (if buff ; Buffer exists: | |
979 (switch-to-buffer buff) ; no problem. | |
980 (if gomoku-game-in-progress | |
981 (gomoku-crash-game)) ; buffer has been killed or something | |
982 (switch-to-buffer "*Gomoku*") ; Anyway, start anew. | |
983 (gomoku-mode)))) | |
984 | |
985 ;;; | |
986 ;;; CROSSING WINNING QTUPLES. | |
987 ;;; | |
988 | |
989 ;; When someone succeeds in filling a qtuple, we draw a line over the five | |
990 ;; corresponding squares. One problem is that the program does not know which | |
991 ;; squares ! It only knows the square where the last move has been played and | |
992 ;; who won. The solution is to scan the board along all four directions. | |
993 | |
994 (defvar gomoku-winning-qtuple-beg nil | |
995 "First square of the winning qtuple.") | |
996 | |
997 (defvar gomoku-winning-qtuple-end nil | |
998 "Last square of the winning qtuple.") | |
999 | |
1000 (defvar gomoku-winning-qtuple-dx nil | |
1001 "Direction of the winning qtuple (along the X axis).") | |
1002 | |
1003 (defvar gomoku-winning-qtuple-dy nil | |
1004 "Direction of the winning qtuple (along the Y axis).") | |
1005 | |
1006 | |
1007 (defun gomoku-find-filled-qtuple (square value) | |
1008 "Return T if SQUARE belongs to a qtuple filled with VALUEs." | |
1009 (or (gomoku-check-filled-qtuple square value 1 0) | |
1010 (gomoku-check-filled-qtuple square value 0 1) | |
1011 (gomoku-check-filled-qtuple square value 1 1) | |
1012 (gomoku-check-filled-qtuple square value -1 1))) | |
1013 | |
1014 (defun gomoku-check-filled-qtuple (square value dx dy) | |
1015 "Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." | |
1016 ;; And record it in the WINNING-QTUPLE-... variables. | |
1017 (let ((a 0) (b 0) | |
1018 (left square) (right square) | |
1019 (depl (gomoku-xy-to-index dx dy)) | |
1020 a+4) | |
1021 (while (and (> a -4) ; stretch tuple left | |
1022 (= value (aref gomoku-board (setq left (- left depl))))) | |
1023 (setq a (1- a))) | |
1024 (setq a+4 (+ a 4)) | |
1025 (while (and (< b a+4) ; stretch tuple right | |
1026 (= value (aref gomoku-board (setq right (+ right depl))))) | |
1027 (setq b (1+ b))) | |
1028 (cond ((= b a+4) ; tuple length = 5 ? | |
1029 (setq gomoku-winning-qtuple-beg (+ square (* a depl)) | |
1030 gomoku-winning-qtuple-end (+ square (* b depl)) | |
1031 gomoku-winning-qtuple-dx dx | |
1032 gomoku-winning-qtuple-dy dy) | |
1033 t)))) | |
1034 | |
1035 (defun gomoku-cross-winning-qtuple () | |
207 | 1036 "Cross winning qtuple, as found by `gomoku-find-filled-qtuple'." |
36 | 1037 (gomoku-cross-qtuple gomoku-winning-qtuple-beg |
1038 gomoku-winning-qtuple-end | |
1039 gomoku-winning-qtuple-dx | |
1040 gomoku-winning-qtuple-dy)) | |
1041 | |
1042 (defun gomoku-cross-qtuple (square1 square2 dx dy) | |
1043 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." | |
1044 (save-excursion ; Not moving point from last square | |
1045 (let ((depl (gomoku-xy-to-index dx dy))) | |
1046 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 | |
1047 (while (not (= square1 square2)) | |
1048 (gomoku-goto-square square1) | |
1049 (setq square1 (+ square1 depl)) | |
1050 (cond | |
1051 ((and (= dx 1) (= dy 0)) ; Horizontal | |
1052 (let ((n 1)) | |
1053 (while (< n gomoku-square-width) | |
1054 (setq n (1+ n)) | |
1055 (forward-char 1) | |
1056 (gomoku-put-char ?-)))) | |
1057 ((and (= dx 0) (= dy 1)) ; Vertical | |
1058 (let ((n 1)) | |
1059 (while (< n gomoku-square-height) | |
1060 (setq n (1+ n)) | |
1061 (next-line 1) | |
1062 (gomoku-put-char ?|)))) | |
1063 ((and (= dx -1) (= dy 1)) ; 1st Diagonal | |
1064 (backward-char (/ gomoku-square-width 2)) | |
1065 (next-line (/ gomoku-square-height 2)) | |
1066 (gomoku-put-char ?/)) | |
1067 ((and (= dx 1) (= dy 1)) ; 2nd Diagonal | |
1068 (forward-char (/ gomoku-square-width 2)) | |
1069 (next-line (/ gomoku-square-height 2)) | |
1070 (gomoku-put-char ?\\)))))) | |
1071 (sit-for 0)) ; Display NOW | |
1072 | |
1073 ;;; | |
1074 ;;; CURSOR MOTION. | |
1075 ;;; | |
1076 (defun gomoku-move-left () | |
1077 "Move point backward one column on the Gomoku board." | |
1078 (interactive) | |
1079 (let ((x (gomoku-point-x))) | |
1080 (backward-char (cond ((null x) 1) | |
1081 ((> x 1) gomoku-square-width) | |
1082 (t 0))))) | |
1083 | |
1084 (defun gomoku-move-right () | |
1085 "Move point forward one column on the Gomoku board." | |
1086 (interactive) | |
1087 (let ((x (gomoku-point-x))) | |
1088 (forward-char (cond ((null x) 1) | |
1089 ((< x gomoku-board-width) gomoku-square-width) | |
1090 (t 0))))) | |
1091 | |
1092 (defun gomoku-move-down () | |
1093 "Move point down one row on the Gomoku board." | |
1094 (interactive) | |
1095 (let ((y (gomoku-point-y))) | |
1096 (next-line (cond ((null y) 1) | |
1097 ((< y gomoku-board-height) gomoku-square-height) | |
1098 (t 0))))) | |
1099 | |
1100 (defun gomoku-move-up () | |
1101 "Move point up one row on the Gomoku board." | |
1102 (interactive) | |
1103 (let ((y (gomoku-point-y))) | |
1104 (previous-line (cond ((null y) 1) | |
1105 ((> y 1) gomoku-square-height) | |
1106 (t 0))))) | |
1107 | |
1108 (defun gomoku-move-ne () | |
1109 "Move point North East on the Gomoku board." | |
1110 (interactive) | |
1111 (gomoku-move-up) | |
1112 (gomoku-move-right)) | |
1113 | |
1114 (defun gomoku-move-se () | |
1115 "Move point South East on the Gomoku board." | |
1116 (interactive) | |
1117 (gomoku-move-down) | |
1118 (gomoku-move-right)) | |
1119 | |
1120 (defun gomoku-move-nw () | |
1121 "Move point North West on the Gomoku board." | |
1122 (interactive) | |
1123 (gomoku-move-up) | |
1124 (gomoku-move-left)) | |
1125 | |
1126 (defun gomoku-move-sw () | |
1127 "Move point South West on the Gomoku board." | |
1128 (interactive) | |
1129 (gomoku-move-down) | |
1130 (gomoku-move-left)) | |
1131 | |
584 | 1132 (provide 'gomoku) |
36 | 1133 |
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1134 ;;; gomoku.el ends here |