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