Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/games/gomoku.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,1135 @@ +;;; gomoku.el --- Gomoku game between you and Emacs + +;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. + +;; Author: Philippe Schnoebelen <phs@lifia.imag.fr> +;; Adapted-By: ESR +;; Keywords: games + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Synched up with: FSF 19.30. + +;;; Commentary: + +;;; Gomoku game between you and GNU Emacs. Last modified on 13 Sep 1988 +;;; +;;; Written by Ph. Schnoebelen (phs@lifia.imag.fr), 1987, 1988 +;;; with precious advices from J.-F. Rit. +;;; This has been tested with GNU Emacs 18.50. + +;; RULES: +;; +;; Gomoku is a game played between two players on a rectangular board. Each +;; player, in turn, marks a free square of its choice. The winner is the first +;; one to mark five contiguous squares in any direction (horizontally, +;; vertically or diagonally). +;; +;; I have been told that, in "The TRUE Gomoku", some restrictions are made +;; about the squares where one may play, or else there is a known forced win +;; for the first player. This program has no such restriction, but it does not +;; know about the forced win, nor do I. Furthermore, you probably do not know +;; it yourself :-). + + +;; There are two main places where you may want to customize the program: key +;; bindings and board display. These features are commented in the code. Go +;; and see. + + +;; HOW TO USE: +;; +;; The command "M-x gomoku" displays a +;; board, the size of which depends on the size of the current window. The +;; size of the board is easily modified by giving numeric arguments to the +;; gomoku command and/or by customizing the displaying parameters. +;; +;; Emacs plays when it is its turn. When it is your turn, just put the cursor +;; on the square where you want to play and hit RET, or X, or whatever key you +;; bind to the command gomoku-human-plays. When it is your turn, Emacs is +;; idle: you may switch buffers, read your mail, ... Just come back to the +;; *Gomoku* buffer and resume play. + + +;; ALGORITHM: +;; +;; The algorithm is briefly described in section "THE SCORE TABLE". Some +;; parameters may be modified if you want to change the style exhibited by the +;; program. + +;;; Code: + +;;; +;;; GOMOKU MODE AND KEYMAP. +;;; +(defvar gomoku-mode-hook nil + "If non-nil, its value is called on entry to Gomoku mode.") + +(defvar gomoku-mode-map nil + "Local keymap to use in Gomoku mode.") + +(if gomoku-mode-map + nil + (setq gomoku-mode-map (make-sparse-keymap)) + (set-keymap-name gomoku-mode-map 'gomoku-mode-map) + + ;; Key bindings for cursor motion. Arrow keys are just "function" + ;; keys, see below. + (define-key gomoku-mode-map "y" 'gomoku-move-nw) ; Y + (define-key gomoku-mode-map "u" 'gomoku-move-ne) ; U + (define-key gomoku-mode-map "b" 'gomoku-move-sw) ; B + (define-key gomoku-mode-map "n" 'gomoku-move-se) ; N + (define-key gomoku-mode-map "h" 'gomoku-move-left) ; H + (define-key gomoku-mode-map "l" 'gomoku-move-right) ; L + (define-key gomoku-mode-map "j" 'gomoku-move-down) ; J + (define-key gomoku-mode-map "k" 'gomoku-move-up) ; K + (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-N + (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-P + (define-key gomoku-mode-map "\C-f" 'gomoku-move-right) ; C-F + (define-key gomoku-mode-map "\C-b" 'gomoku-move-left) ; C-B + + ;; Key bindings for entering Human moves. + ;; If you have a mouse, you may also bind some mouse click ... + (define-key gomoku-mode-map "X" 'gomoku-human-plays) ; X + (define-key gomoku-mode-map "x" 'gomoku-human-plays) ; x + (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET + (define-key gomoku-mode-map "\C-c\C-p" 'gomoku-human-plays) ; C-C C-P + (define-key gomoku-mode-map "\C-c\C-b" 'gomoku-human-takes-back) ; C-C C-B + (define-key gomoku-mode-map "\C-c\C-r" 'gomoku-human-resigns) ; C-C C-R + (define-key gomoku-mode-map "\C-c\C-e" 'gomoku-emacs-plays) ; C-C C-E + + (define-key gomoku-mode-map [up] 'gomoku-move-up) + (define-key gomoku-mode-map [down] 'gomoku-move-down) + (define-key gomoku-mode-map [left] 'gomoku-move-left) + (define-key gomoku-mode-map [right] 'gomoku-move-right) + (define-key gomoku-mode-map [kp_enter] 'gomoku-human-plays) + (define-key gomoku-mode-map [button2] 'gomoku-click) + (define-key gomoku-mode-map [insert] 'gomoku-human-plays)) + + +(defun gomoku-mode () + "Major mode for playing Gomoku against Emacs. +You and Emacs play in turn by marking a free square. You mark it with X +and Emacs marks it with O. The winner is the first to get five contiguous +marks horizontally, vertically or in diagonal. +You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. +Other useful commands: +\\{gomoku-mode-map} +Entry to this mode calls the value of `gomoku-mode-hook' if that value +is non-nil." + (interactive) + (setq major-mode 'gomoku-mode + mode-name "Gomoku") + (gomoku-display-statistics) + (use-local-map gomoku-mode-map) + (run-hooks 'gomoku-mode-hook)) + +;;; +;;; THE BOARD. +;;; + +;; The board is a rectangular grid. We code empty squares with 0, X's with 1 +;; and O's with 6. The rectangle is recorded in a one dimensional vector +;; containing padding squares (coded with -1). These squares allow us to +;; detect when we are trying to move out of the board. We denote a square by +;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The +;; leftmost topmost square has coords (1,1) and index gomoku-board-width + 2. +;; Similarly, vectors between squares may be given by two DX, DY coords or by +;; one DEPL (the difference between indexes). + +(defvar gomoku-board-width nil + "Number of columns on the Gomoku board.") + +(defvar gomoku-board-height nil + "Number of lines on the Gomoku board.") + +(defvar gomoku-board nil + "Vector recording the actual state of the Gomoku board.") + +(defvar gomoku-vector-length nil + "Length of gomoku-board vector.") + +(defvar gomoku-draw-limit nil + ;; This is usually set to 70% of the number of squares. + "After how many moves will Emacs offer a draw?") + + +(defun gomoku-xy-to-index (x y) + "Translate X, Y cartesian coords into the corresponding board index." + (+ (* y gomoku-board-width) x y)) + +(defun gomoku-index-to-x (index) + "Return corresponding x-coord of board INDEX." + (% index (1+ gomoku-board-width))) + +(defun gomoku-index-to-y (index) + "Return corresponding y-coord of board INDEX." + (/ index (1+ gomoku-board-width))) + +(defun gomoku-init-board () + "Create the gomoku-board vector and fill it with initial values." + (setq gomoku-board (make-vector gomoku-vector-length 0)) + ;; Every square is 0 (i.e. empty) except padding squares: + (let ((i 0) (ii (1- gomoku-vector-length))) + (while (<= i gomoku-board-width) ; The squares in [0..width] and in + (aset gomoku-board i -1) ; [length - width - 1..length - 1] + (aset gomoku-board ii -1) ; are padding squares. + (setq i (1+ i) + ii (1- ii)))) + (let ((i 0)) + (while (< i gomoku-vector-length) + (aset gomoku-board i -1) ; and also all k*(width+1) + (setq i (+ i gomoku-board-width 1))))) + +;;; +;;; THE SCORE TABLE. +;;; + +;; Every (free) square has a score associated to it, recorded in the +;; GOMOKU-SCORE-TABLE vector. The program always plays in the square having +;; the highest score. + +(defvar gomoku-score-table nil + "Vector recording the actual score of the free squares.") + + +;; The key point point about the algorithm is that, rather than considering +;; the board as just a set of squares, we prefer to see it as a "space" of +;; internested 5-tuples of contiguous squares (called qtuples). +;; +;; The aim of the program is to fill one qtuple with its O's while preventing +;; you from filling another one with your X's. To that effect, it computes a +;; score for every qtuple, with better qtuples having better scores. Of +;; course, the score of a qtuple (taken in isolation) is just determined by +;; its contents as a set, i.e. not considering the order of its elements. The +;; highest score is given to the "OOOO" qtuples because playing in such a +;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because +;; not playing in it is just loosing the game, and so on. Note that a +;; "polluted" qtuple, i.e. one containing at least one X and at least one O, +;; has score zero because there is no more any point in playing in it, from +;; both an attacking and a defending point of view. +;; +;; Given the score of every qtuple, the score of a given free square on the +;; board is just the sum of the scores of all the qtuples to which it belongs, +;; because playing in that square is playing in all its containing qtuples at +;; once. And it is that function which takes into account the internesting of +;; the qtuples. +;; +;; This algorithm is rather simple but anyway it gives a not so dumb level of +;; play. It easily extends to "n-dimensional Gomoku", where a win should not +;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) +;; should be preferred. + + +;; Here are the scores of the nine "non-polluted" configurations. Tuning +;; these values will change (hopefully improve) the strength of the program +;; and may change its style (rather aggressive here). + +(defconst nil-score 7 "Score of an empty qtuple.") +(defconst Xscore 15 "Score of a qtuple containing one X.") +(defconst XXscore 400 "Score of a qtuple containing two X's.") +(defconst XXXscore 1800 "Score of a qtuple containing three X's.") +(defconst XXXXscore 100000 "Score of a qtuple containing four X's.") +(defconst Oscore 35 "Score of a qtuple containing one O.") +(defconst OOscore 800 "Score of a qtuple containing two O's.") +(defconst OOOscore 15000 "Score of a qtuple containing three O's.") +(defconst OOOOscore 800000 "Score of a qtuple containing four O's.") + +;; These values are not just random: if, given the following situation: +;; +;; . . . . . . . O . +;; . X X a . . . X . +;; . . . X . . . X . +;; . . . X . . . X . +;; . . . . . . . b . +;; +;; you want Emacs to play in "a" and not in "b", then the parameters must +;; satisfy the inequality: +;; +;; 6 * XXscore > XXXscore + XXscore +;; +;; because "a" mainly belongs to six "XX" qtuples (the others are less +;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other +;; conditions are required to obtain sensible moves, but the previous example +;; should illustrate the point. If you manage to improve on these values, +;; please send me a note. Thanks. + + +;; As we choosed values 0, 1 and 6 to denote empty, X and O squares, the +;; contents of a qtuple is uniquely determined by the sum of its elements and +;; we just have to set up a translation table. + +(defconst gomoku-score-trans-table + (vector nil-score Xscore XXscore XXXscore XXXXscore 0 + Oscore 0 0 0 0 0 + OOscore 0 0 0 0 0 + OOOscore 0 0 0 0 0 + OOOOscore 0 0 0 0 0 + 0) + "Vector associating qtuple contents to their score.") + + +;; If you do not modify drastically the previous constants, the only way for a +;; square to have a score higher than OOOOscore is to belong to a "OOOO" +;; qtuple, thus to be a winning move. Similarly, the only way for a square to +;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX" +;; qtuple. We may use these considerations to detect when a given move is +;; winning or loosing. + +(defconst gomoku-winning-threshold OOOOscore + "Threshold score beyond which an Emacs move is winning.") + +(defconst gomoku-loosing-threshold XXXXscore + "Threshold score beyond which a human move is winning.") + + +(defun gomoku-strongest-square () + "Compute index of free square with highest score, or nil if none." + ;; We just have to loop other all squares. However there are two problems: + ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed + ;; up future searches, we set the score of padding or occupied squares + ;; to -1 whenever we meet them. + ;; 2/ We want to choose randomly between equally good moves. + (let ((score-max 0) + (count 0) ; Number of equally good moves + (square (gomoku-xy-to-index 1 1)) ; First square + (end (gomoku-xy-to-index gomoku-board-width gomoku-board-height)) + best-square score) + (while (<= square end) + (cond + ;; If score is lower (i.e. most of the time), skip to next: + ((< (aref gomoku-score-table square) score-max)) + ;; If score is better, beware of non free squares: + ((> (setq score (aref gomoku-score-table square)) score-max) + (if (zerop (aref gomoku-board square)) ; is it free ? + (setq count 1 ; yes: take it ! + best-square square + score-max score) + (aset gomoku-score-table square -1))) ; no: kill it ! + ;; If score is equally good, choose randomly. But first check freeness: + ((not (zerop (aref gomoku-board square))) + (aset gomoku-score-table square -1)) + ((zerop (random (setq count (1+ count)))) + (setq best-square square + score-max score))) + (setq square (1+ square))) ; try next square + best-square)) + +;;; +;;; INITIALIZING THE SCORE TABLE. +;;; + +;; At initialization the board is empty so that every qtuple amounts for +;; nil-score. Therefore, the score of any square is nil-score times the number +;; of qtuples that pass through it. This number is 3 in a corner and 20 if you +;; are sufficiently far from the sides. As computing the number is time +;; consuming, we initialize every square with 20*nil-score and then only +;; consider squares at less than 5 squares from one side. We speed this up by +;; taking symmetry into account. +;; Also, as it is likely that successive games will be played on a board with +;; same size, it is a good idea to save the initial SCORE-TABLE configuration. + +(defvar gomoku-saved-score-table nil + "Recorded initial value of previous score table.") + +(defvar gomoku-saved-board-width nil + "Recorded value of previous board width.") + +(defvar gomoku-saved-board-height nil + "Recorded value of previous board height.") + + +(defun gomoku-init-score-table () + "Create the score table vector and fill it with initial values." + (if (and gomoku-saved-score-table ; Has it been stored last time ? + (= gomoku-board-width gomoku-saved-board-width) + (= gomoku-board-height gomoku-saved-board-height)) + (setq gomoku-score-table (copy-sequence gomoku-saved-score-table)) + ;; No, compute it: + (setq gomoku-score-table + (make-vector gomoku-vector-length (* 20 nil-score))) + (let (i j maxi maxj maxi2 maxj2) + (setq maxi (/ (1+ gomoku-board-width) 2) + maxj (/ (1+ gomoku-board-height) 2) + maxi2 (min 4 maxi) + maxj2 (min 4 maxj)) + ;; We took symmetry into account and could use it more if the board + ;; would have been square and not rectangular ! + ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U + ;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the + ;; board may well be less than 8 by 8 ! + (setq i 1) + (while (<= i maxi2) + (setq j 1) + (while (<= j maxj) + (gomoku-init-square-score i j) + (setq j (1+ j))) + (setq i (1+ i))) + (while (<= i maxi) + (setq j 1) + (while (<= j maxj2) + (gomoku-init-square-score i j) + (setq j (1+ j))) + (setq i (1+ i)))) + (setq gomoku-saved-score-table (copy-sequence gomoku-score-table) + gomoku-saved-board-width gomoku-board-width + gomoku-saved-board-height gomoku-board-height))) + +(defun gomoku-nb-qtuples (i j) + "Return the number of qtuples containing square I,J." + ;; This function is complicated because we have to deal + ;; with ugly cases like 3 by 6 boards, but it works. + ;; If you have a simpler (and correct) solution, send it to me. Thanks ! + (let ((left (min 4 (1- i))) + (right (min 4 (- gomoku-board-width i))) + (up (min 4 (1- j))) + (down (min 4 (- gomoku-board-height j)))) + (+ -12 + (min (max (+ left right) 3) 8) + (min (max (+ up down) 3) 8) + (min (max (+ (min left up) (min right down)) 3) 8) + (min (max (+ (min right up) (min left down)) 3) 8)))) + +(defun gomoku-init-square-score (i j) + "Give initial score to square I,J and to its mirror images." + (let ((ii (1+ (- gomoku-board-width i))) + (jj (1+ (- gomoku-board-height j))) + (sc (* (gomoku-nb-qtuples i j) (aref gomoku-score-trans-table 0)))) + (aset gomoku-score-table (gomoku-xy-to-index i j) sc) + (aset gomoku-score-table (gomoku-xy-to-index ii j) sc) + (aset gomoku-score-table (gomoku-xy-to-index i jj) sc) + (aset gomoku-score-table (gomoku-xy-to-index ii jj) sc))) + +;;; +;;; MAINTAINING THE SCORE TABLE. +;;; + +;; We do not provide functions for computing the SCORE-TABLE given the +;; contents of the BOARD. This would involve heavy nested loops, with time +;; proportional to the size of the board. It is better to update the +;; SCORE-TABLE after each move. Updating needs not modify more than 36 +;; squares: it is done in constant time. + +(defun gomoku-update-score-table (square dval) + "Update score table after SQUARE received a DVAL increment." + ;; The board has already been updated when this function is called. + ;; Updating scores is done by looking for qtuples boundaries in all four + ;; directions and then calling update-score-in-direction. + ;; Finally all squares received the right increment, and then are up to + ;; date, except possibly for SQUARE itself if we are taking a move back for + ;; its score had been set to -1 at the time. + (let* ((x (gomoku-index-to-x square)) + (y (gomoku-index-to-y square)) + (imin (max -4 (- 1 x))) + (jmin (max -4 (- 1 y))) + (imax (min 0 (- gomoku-board-width x 4))) + (jmax (min 0 (- gomoku-board-height y 4)))) + (gomoku-update-score-in-direction imin imax + square 1 0 dval) + (gomoku-update-score-in-direction jmin jmax + square 0 1 dval) + (gomoku-update-score-in-direction (max imin jmin) (min imax jmax) + square 1 1 dval) + (gomoku-update-score-in-direction (max (- 1 y) -4 + (- x gomoku-board-width)) + (min 0 (- x 5) + (- gomoku-board-height y 4)) + square -1 1 dval))) + +(defun gomoku-update-score-in-direction (left right square dx dy dval) + "Update scores for all squares in the qtuples starting between the LEFTth +square and the RIGHTth after SQUARE, along the DX, DY direction, considering +that DVAL has been added on SQUARE." + ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well + ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that + ;; DX,DY direction. + (cond + ((> left right)) ; Quit + (t ; Else .. + (let (depl square0 square1 square2 count delta) + (setq depl (gomoku-xy-to-index dx dy) + square0 (+ square (* left depl)) + square1 (+ square (* right depl)) + square2 (+ square0 (* 4 depl))) + ;; Compute the contents of the first qtuple: + (setq square square0 + count 0) + (while (<= square square2) + (setq count (+ count (aref gomoku-board square)) + square (+ square depl))) + (while (<= square0 square1) + ;; Update the squares of the qtuple beginning in SQUARE0 and ending + ;; in SQUARE2. + (setq delta (- (aref gomoku-score-trans-table count) + (aref gomoku-score-trans-table (- count dval)))) + (cond ((not (zerop delta)) ; or else nothing to update + (setq square square0) + (while (<= square square2) + (if (zerop (aref gomoku-board square)) ; only for free squares + (aset gomoku-score-table square + (+ (aref gomoku-score-table square) delta))) + (setq square (+ square depl))))) + ;; Then shift the qtuple one square along DEPL, this only requires + ;; modifying SQUARE0 and SQUARE2. + (setq square2 (+ square2 depl) + count (+ count (- (aref gomoku-board square0)) + (aref gomoku-board square2)) + square0 (+ square0 depl))))))) + +;;; +;;; GAME CONTROL. +;;; + +;; Several variables are used to monitor a game, including a GAME-HISTORY (the +;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back +;; (anti-updating the score table) and to compute the table from scratch in +;; case of an interruption. + +(defvar gomoku-game-in-progress nil + "Non-nil if a game is in progress.") + +(defvar gomoku-game-history nil + "A record of all moves that have been played during current game.") + +(defvar gomoku-number-of-moves nil + "Number of moves already played in current game.") + +(defvar gomoku-number-of-human-moves nil + "Number of moves already played by human in current game.") + +(defvar gomoku-emacs-played-first nil + "Non-nil if Emacs played first.") + +(defvar gomoku-human-took-back nil + "Non-nil if Human took back a move during the game.") + +(defvar gomoku-human-refused-draw nil + "Non-nil if Human refused Emacs offer of a draw.") + +(defvar gomoku-emacs-is-computing nil + ;; This is used to detect interruptions. Hopefully, it should not be needed. + "Non-nil if Emacs is in the middle of a computation.") + + +(defun gomoku-start-game (n m) + "Initialize a new game on an N by M board." + (setq gomoku-emacs-is-computing t) ; Raise flag + (setq gomoku-game-in-progress t) + (setq gomoku-board-width n + gomoku-board-height m + gomoku-vector-length (1+ (* (+ m 2) (1+ n))) + gomoku-draw-limit (/ (* 7 n m) 10)) + (setq gomoku-game-history nil + gomoku-number-of-moves 0 + gomoku-number-of-human-moves 0 + gomoku-emacs-played-first nil + gomoku-human-took-back nil + gomoku-human-refused-draw nil) + (gomoku-init-display n m) ; Display first: the rest takes time + (gomoku-init-score-table) ; INIT-BOARD requires that the score + (gomoku-init-board) ; table be already created. + (setq gomoku-emacs-is-computing nil)) + +(defun gomoku-play-move (square val &optional dont-update-score) + "Go to SQUARE, play VAL and update everything." + (setq gomoku-emacs-is-computing t) ; Raise flag + (cond ((= 1 val) ; a Human move + (setq gomoku-number-of-human-moves (1+ gomoku-number-of-human-moves))) + ((zerop gomoku-number-of-moves) ; an Emacs move. Is it first ? + (setq gomoku-emacs-played-first t))) + (setq gomoku-game-history + (cons (cons square (aref gomoku-score-table square)) + gomoku-game-history) + gomoku-number-of-moves (1+ gomoku-number-of-moves)) + (gomoku-plot-square square val) + (aset gomoku-board square val) ; *BEFORE* UPDATE-SCORE ! + (if dont-update-score nil + (gomoku-update-score-table square val) ; previous val was 0: dval = val + (aset gomoku-score-table square -1)) + (setq gomoku-emacs-is-computing nil)) + +(defun gomoku-take-back () + "Take back last move and update everything." + (setq gomoku-emacs-is-computing t) + (let* ((last-move (car gomoku-game-history)) + (square (car last-move)) + (oldval (aref gomoku-board square))) + (if (= 1 oldval) + (setq gomoku-number-of-human-moves (1- gomoku-number-of-human-moves))) + (setq gomoku-game-history (cdr gomoku-game-history) + gomoku-number-of-moves (1- gomoku-number-of-moves)) + (gomoku-plot-square square 0) + (aset gomoku-board square 0) ; *BEFORE* UPDATE-SCORE ! + (gomoku-update-score-table square (- oldval)) + (aset gomoku-score-table square (cdr last-move))) + (setq gomoku-emacs-is-computing nil)) + +;;; +;;; SESSION CONTROL. +;;; + +(defvar gomoku-number-of-emacs-wins 0 + "Number of games Emacs won in this session.") + +(defvar gomoku-number-of-human-wins 0 + "Number of games you won in this session.") + +(defvar gomoku-number-of-draws 0 + "Number of games already drawn in this session.") + + +(defun gomoku-terminate-game (result) + "Terminate the current game with RESULT." + (let (message) + (cond + ((eq result 'emacs-won) + (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) + (setq message + (cond ((< gomoku-number-of-moves 20) + "This was a REALLY QUICK win.") + (gomoku-human-refused-draw + "I won... Too bad you refused my offer of a draw !") + (gomoku-human-took-back + "I won... Taking moves back will not help you !") + ((not gomoku-emacs-played-first) + "I won... Playing first did not help you much !") + ((and (zerop gomoku-number-of-human-wins) + (zerop gomoku-number-of-draws) + (> gomoku-number-of-emacs-wins 1)) + "I'm becoming tired of winning...") + (t + "I won.")))) + ((eq result 'human-won) + (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins)) + (setq message + (cond + (gomoku-human-took-back + "OK, you won this one. I, for one, never take my moves back...") + (gomoku-emacs-played-first + "OK, you won this one... so what ?") + (t + "OK, you won this one. Now, let me play first just once.")))) + ((eq result 'human-resigned) + (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) + (setq message "So you resign. That's just one more win for me.")) + ((eq result 'nobody-won) + (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) + (setq message + (cond + (gomoku-human-took-back + "This is a draw. I, for one, never take my moves back...") + (gomoku-emacs-played-first + "This is a draw. Just chance, I guess.") + (t + "This is a draw. Now, let me play first just once.")))) + ((eq result 'draw-agreed) + (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) + (setq message + (cond + (gomoku-human-took-back + "Draw agreed. I, for one, never take my moves back...") + (gomoku-emacs-played-first + "Draw agreed. You were lucky.") + (t + "Draw agreed. Now, let me play first just once.")))) + ((eq result 'crash-game) + (setq message + "Sorry, I have been interrupted and cannot resume that game..."))) + + (gomoku-display-statistics) + (if message (message message)) + (ding) + (setq gomoku-game-in-progress nil))) + +(defun gomoku-crash-game () + "What to do when Emacs detects it has been interrupted." + (setq gomoku-emacs-is-computing nil) + (gomoku-terminate-game 'crash-game) + (sit-for 4) ; Let's see the message + (gomoku-prompt-for-other-game)) + +;;; +;;; INTERACTIVE COMMANDS. +;;; + +;;;###autoload +(defun gomoku (&optional n m) + "Start a Gomoku game between you and Emacs. +If a game is in progress, this command allow you to resume it. +If optional arguments N and M are given, an N by M board is used. + +You and Emacs play in turn by marking a free square. You mark it with X +and Emacs marks it with O. The winner is the first to get five contiguous +marks horizontally, vertically or in diagonal. +You play by moving the cursor over the square you choose and hitting +\\<gomoku-mode-map>\\[gomoku-human-plays]. +Use \\[describe-mode] for more info." + (interactive) + (gomoku-switch-to-window) + (cond + (gomoku-emacs-is-computing + (gomoku-crash-game)) + ((not gomoku-game-in-progress) + (let ((max-width (gomoku-max-width)) + (max-height (gomoku-max-height))) + (or n (setq n max-width)) + (or m (setq m max-height)) + (cond ((< n 1) + (error "I need at least 1 column")) + ((< m 1) + (error "I need at least 1 row")) + ((> n max-width) + (error "I cannot display %d columns in that window" n))) + (if (and (> m max-height) + (not (equal m gomoku-saved-board-height)) + ;; Use EQUAL because SAVED-BOARD-HEIGHT may be nil + (not (y-or-n-p (format "Do you really want %d rows " m)))) + (setq m max-height))) + (message "One moment, please...") + (gomoku-start-game n m) + (if (y-or-n-p "Do you allow me to play first ") + (gomoku-emacs-plays) + (gomoku-prompt-for-move))) + ((y-or-n-p "Shall we continue our game ") + (gomoku-prompt-for-move)) + (t + (gomoku-human-resigns)))) + +(defun gomoku-emacs-plays () + "Compute Emacs next move and play it." + (interactive) + (gomoku-switch-to-window) + (cond + (gomoku-emacs-is-computing + (gomoku-crash-game)) + ((not gomoku-game-in-progress) + (gomoku-prompt-for-other-game)) + (t + (message "Let me think...") + (let (square score) + (setq square (gomoku-strongest-square)) + (cond ((null square) + (gomoku-terminate-game 'nobody-won)) + (t + (setq score (aref gomoku-score-table square)) + (gomoku-play-move square 6) + (cond ((>= score gomoku-winning-threshold) + (gomoku-find-filled-qtuple square 6) + (gomoku-cross-winning-qtuple) + (gomoku-terminate-game 'emacs-won)) + ((zerop score) + (gomoku-terminate-game 'nobody-won)) + ((and (> gomoku-number-of-moves gomoku-draw-limit) + (not gomoku-human-refused-draw) + (gomoku-offer-a-draw)) + (gomoku-terminate-game 'draw-agreed)) + (t + (gomoku-prompt-for-move))))))))) + +(defun gomoku-click (click) + "Play at the square where you click." + (interactive "e") + (mouse-set-point click) + (gomoku-human-plays)) + +(defun gomoku-human-plays () + "Signal to the Gomoku program that you have played. +You must have put the cursor on the square where you want to play. +If the game is finished, this command requests for another game." + (interactive) + (gomoku-switch-to-window) + (cond + (gomoku-emacs-is-computing + (gomoku-crash-game)) + ((not gomoku-game-in-progress) + (gomoku-prompt-for-other-game)) + (t + (let (square score) + (setq square (gomoku-point-square)) + (cond ((null square) + (error "Your point is not on a square. Retry !")) + ((not (zerop (aref gomoku-board square))) + (error "Your point is not on a free square. Retry !")) + (t + (setq score (aref gomoku-score-table square)) + (gomoku-play-move square 1) + (cond ((and (>= score gomoku-loosing-threshold) + ;; Just testing SCORE > THRESHOLD is not enough for + ;; detecting wins, it just gives an indication that + ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE. + (gomoku-find-filled-qtuple square 1)) + (gomoku-cross-winning-qtuple) + (gomoku-terminate-game 'human-won)) + (t + (gomoku-emacs-plays))))))))) + +(defun gomoku-human-takes-back () + "Signal to the Gomoku program that you wish to take back your last move." + (interactive) + (gomoku-switch-to-window) + (cond + (gomoku-emacs-is-computing + (gomoku-crash-game)) + ((not gomoku-game-in-progress) + (message "Too late for taking back...") + (sit-for 4) + (gomoku-prompt-for-other-game)) + ((zerop gomoku-number-of-human-moves) + (message "You have not played yet... Your move ?")) + (t + (message "One moment, please...") + ;; It is possible for the user to let Emacs play several consecutive + ;; moves, so that the best way to know when to stop taking back moves is + ;; to count the number of human moves: + (setq gomoku-human-took-back t) + (let ((number gomoku-number-of-human-moves)) + (while (= number gomoku-number-of-human-moves) + (gomoku-take-back))) + (gomoku-prompt-for-move)))) + +(defun gomoku-human-resigns () + "Signal to the Gomoku program that you may want to resign." + (interactive) + (gomoku-switch-to-window) + (cond + (gomoku-emacs-is-computing + (gomoku-crash-game)) + ((not gomoku-game-in-progress) + (message "There is no game in progress")) + ((y-or-n-p "You mean, you resign ") + (gomoku-terminate-game 'human-resigned)) + ((y-or-n-p "You mean, we continue ") + (gomoku-prompt-for-move)) + (t + (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it + +;;; +;;; PROMPTING THE HUMAN PLAYER. +;;; + +(defun gomoku-prompt-for-move () + "Display a message asking for Human's move." + (message (if (zerop gomoku-number-of-human-moves) + "Your move ? (move to a free square and hit X, RET ...)" + "Your move ?")) + ;; This may seem silly, but if one omits the following line (or a similar + ;; one), the cursor may very well go to some place where POINT is not. + (save-excursion (set-buffer (other-buffer)))) + +(defun gomoku-prompt-for-other-game () + "Ask for another game, and start it." + (if (y-or-n-p "Another game ") + (gomoku gomoku-board-width gomoku-board-height) + (message "Chicken !"))) + +(defun gomoku-offer-a-draw () + "Offer a draw and return T if Human accepted it." + (or (y-or-n-p "I offer you a draw. Do you accept it ") + (prog1 (setq gomoku-human-refused-draw t) + nil))) + +;;; +;;; DISPLAYING THE BOARD. +;;; + +;; You may change these values if you have a small screen or if the squares +;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). + +(defconst gomoku-square-width 4 + "*Horizontal spacing between squares on the Gomoku board.") + +(defconst gomoku-square-height 2 + "*Vertical spacing between squares on the Gomoku board.") + +(defconst gomoku-x-offset 3 + "*Number of columns between the Gomoku board and the side of the window.") + +(defconst gomoku-y-offset 1 + "*Number of lines between the Gomoku board and the top of the window.") + + +(defun gomoku-max-width () + "Largest possible board width for the current window." + (1+ (/ (- (window-width (selected-window)) + gomoku-x-offset gomoku-x-offset 1) + gomoku-square-width))) + +(defun gomoku-max-height () + "Largest possible board height for the current window." + (1+ (/ (- (window-height (selected-window)) + gomoku-y-offset gomoku-y-offset 2) + ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! + gomoku-square-height))) + +(defun gomoku-point-x () + "Return the board column where point is, or nil if it is not a board column." + (let ((col (- (current-column) gomoku-x-offset))) + (if (and (>= col 0) + (zerop (% col gomoku-square-width)) + (<= (setq col (1+ (/ col gomoku-square-width))) + gomoku-board-width)) + col))) + +(defun gomoku-point-y () + "Return the board row where point is, or nil if it is not a board row." + (let ((row (- (count-lines 1 (point)) gomoku-y-offset 1))) + (if (and (>= row 0) + (zerop (% row gomoku-square-height)) + (<= (setq row (1+ (/ row gomoku-square-height))) + gomoku-board-height)) + row))) + +(defun gomoku-point-square () + "Return the index of the square point is on, or nil if not on the board." + (let (x y) + (and (setq x (gomoku-point-x)) + (setq y (gomoku-point-y)) + (gomoku-xy-to-index x y)))) + +(defun gomoku-goto-square (index) + "Move point to square number INDEX." + (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index))) + +(defun gomoku-goto-xy (x y) + "Move point to square at X, Y coords." + (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y)))) + (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) + +(defun gomoku-plot-square (square value) + "Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there." + (gomoku-goto-square square) + (gomoku-put-char (cond ((= value 1) ?X) + ((= value 6) ?O) + (t ?.))) + (sit-for 0)) ; Display NOW + +(defun gomoku-put-char (char) + "Draw CHAR on the Gomoku screen." + (let ((inhibit-read-only t)) + (insert char) + (delete-char 1) + (backward-char 1))) + +(defun gomoku-init-display (n m) + "Display an N by M Gomoku board." + (buffer-disable-undo (current-buffer)) + (let ((inhibit-read-only t)) + (erase-buffer) + (let (string1 string2 string3 string4) + ;; We do not use gomoku-plot-square which would be too slow for + ;; initializing the display. Rather we build STRING1 for lines where + ;; board squares are to be found, and STRING2 for empty lines. STRING1 is + ;; like STRING2 except for dots every DX squares. Empty lines are filled + ;; with spaces so that cursor moving up and down remains on the same + ;; column. + (setq string1 (concat (make-string (1- gomoku-square-width) ? ) ".") + string1 (apply 'concat + (make-list (1- n) string1)) + string1 (concat (make-string gomoku-x-offset ? ) "." string1 "\n") + string2 (make-string (+ 1 gomoku-x-offset + (* (1- n) gomoku-square-width)) + ? ) + string2 (concat string2 "\n") + string3 (apply 'concat + (make-list (1- gomoku-square-height) string2)) + string3 (concat string3 string1) + string3 (apply 'concat + (make-list (1- m) string3)) + string4 (apply 'concat + (make-list gomoku-y-offset string2))) + (insert string4 string1 string3)) + (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board + (sit-for 0))) ; Display NOW + +(defun gomoku-display-statistics () + "Obnoxiously display some statistics about previous games in mode line." + ;; We store this string in the mode-line-process local variable. + ;; This is certainly not the cleanest way out ... + (setq mode-line-process + (cond + ((not (zerop gomoku-number-of-draws)) + (format ": Won %d, lost %d, drew %d" + gomoku-number-of-human-wins + gomoku-number-of-emacs-wins + gomoku-number-of-draws)) + (t + (format ": Won %d, lost %d" + gomoku-number-of-human-wins + gomoku-number-of-emacs-wins)))) + (force-mode-line-update)) + +(defun gomoku-switch-to-window () + "Find or create the Gomoku buffer, and display it." + (interactive) + (let ((buff (get-buffer "*Gomoku*"))) + (if buff ; Buffer exists: + (switch-to-buffer buff) ; no problem. + (if gomoku-game-in-progress + (gomoku-crash-game)) ; buffer has been killed or something + (switch-to-buffer "*Gomoku*") ; Anyway, start anew. + (gomoku-mode)))) + +;;; +;;; CROSSING WINNING QTUPLES. +;;; + +;; When someone succeeds in filling a qtuple, we draw a line over the five +;; corresponding squares. One problem is that the program does not know which +;; squares ! It only knows the square where the last move has been played and +;; who won. The solution is to scan the board along all four directions. + +(defvar gomoku-winning-qtuple-beg nil + "First square of the winning qtuple.") + +(defvar gomoku-winning-qtuple-end nil + "Last square of the winning qtuple.") + +(defvar gomoku-winning-qtuple-dx nil + "Direction of the winning qtuple (along the X axis).") + +(defvar gomoku-winning-qtuple-dy nil + "Direction of the winning qtuple (along the Y axis).") + + +(defun gomoku-find-filled-qtuple (square value) + "Return T if SQUARE belongs to a qtuple filled with VALUEs." + (or (gomoku-check-filled-qtuple square value 1 0) + (gomoku-check-filled-qtuple square value 0 1) + (gomoku-check-filled-qtuple square value 1 1) + (gomoku-check-filled-qtuple square value -1 1))) + +(defun gomoku-check-filled-qtuple (square value dx dy) + "Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." + ;; And record it in the WINNING-QTUPLE-... variables. + (let ((a 0) (b 0) + (left square) (right square) + (depl (gomoku-xy-to-index dx dy)) + a+4) + (while (and (> a -4) ; stretch tuple left + (= value (aref gomoku-board (setq left (- left depl))))) + (setq a (1- a))) + (setq a+4 (+ a 4)) + (while (and (< b a+4) ; stretch tuple right + (= value (aref gomoku-board (setq right (+ right depl))))) + (setq b (1+ b))) + (cond ((= b a+4) ; tuple length = 5 ? + (setq gomoku-winning-qtuple-beg (+ square (* a depl)) + gomoku-winning-qtuple-end (+ square (* b depl)) + gomoku-winning-qtuple-dx dx + gomoku-winning-qtuple-dy dy) + t)))) + +(defun gomoku-cross-winning-qtuple () + "Cross winning qtuple, as found by `gomoku-find-filled-qtuple'." + (gomoku-cross-qtuple gomoku-winning-qtuple-beg + gomoku-winning-qtuple-end + gomoku-winning-qtuple-dx + gomoku-winning-qtuple-dy)) + +(defun gomoku-cross-qtuple (square1 square2 dx dy) + "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." + (save-excursion ; Not moving point from last square + (let ((depl (gomoku-xy-to-index dx dy))) + ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 + (while (not (= square1 square2)) + (gomoku-goto-square square1) + (setq square1 (+ square1 depl)) + (cond + ((and (= dx 1) (= dy 0)) ; Horizontal + (let ((n 1)) + (while (< n gomoku-square-width) + (setq n (1+ n)) + (forward-char 1) + (gomoku-put-char ?-)))) + ((and (= dx 0) (= dy 1)) ; Vertical + (let ((n 1)) + (while (< n gomoku-square-height) + (setq n (1+ n)) + (next-line 1) + (gomoku-put-char ?|)))) + ((and (= dx -1) (= dy 1)) ; 1st Diagonal + (backward-char (/ gomoku-square-width 2)) + (next-line (/ gomoku-square-height 2)) + (gomoku-put-char ?/)) + ((and (= dx 1) (= dy 1)) ; 2nd Diagonal + (forward-char (/ gomoku-square-width 2)) + (next-line (/ gomoku-square-height 2)) + (gomoku-put-char ?\\)))))) + (sit-for 0)) ; Display NOW + +;;; +;;; CURSOR MOTION. +;;; +(defun gomoku-move-left () + "Move point backward one column on the Gomoku board." + (interactive) + (let ((x (gomoku-point-x))) + (backward-char (cond ((null x) 1) + ((> x 1) gomoku-square-width) + (t 0))))) + +(defun gomoku-move-right () + "Move point forward one column on the Gomoku board." + (interactive) + (let ((x (gomoku-point-x))) + (forward-char (cond ((null x) 1) + ((< x gomoku-board-width) gomoku-square-width) + (t 0))))) + +(defun gomoku-move-down () + "Move point down one row on the Gomoku board." + (interactive) + (let ((y (gomoku-point-y))) + (next-line (cond ((null y) 1) + ((< y gomoku-board-height) gomoku-square-height) + (t 0))))) + +(defun gomoku-move-up () + "Move point up one row on the Gomoku board." + (interactive) + (let ((y (gomoku-point-y))) + (previous-line (cond ((null y) 1) + ((> y 1) gomoku-square-height) + (t 0))))) + +(defun gomoku-move-ne () + "Move point North East on the Gomoku board." + (interactive) + (gomoku-move-up) + (gomoku-move-right)) + +(defun gomoku-move-se () + "Move point South East on the Gomoku board." + (interactive) + (gomoku-move-down) + (gomoku-move-right)) + +(defun gomoku-move-nw () + "Move point North West on the Gomoku board." + (interactive) + (gomoku-move-up) + (gomoku-move-left)) + +(defun gomoku-move-sw () + "Move point South West on the Gomoku board." + (interactive) + (gomoku-move-down) + (gomoku-move-left)) + +(provide 'gomoku) + +;;; gomoku.el ends here