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