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