OS/2 Shareware BBS: 5 Edit/05-Edit.zip/me34src.zip/me3/mutt/package/gomoku.mut

Lisp/Scheme | 1995-01-14 | 42KB | 1,345 lines

;;   Once installed and compiled, the program is invoked with 'M-x gomoku'
;; and 'C-h m' (the well-known describe-mode) will list all key bindings
;; provided to the player.  Have fun.

;;; Gomoku game between you and GNU Emacs.  Last modified on 13 Sep 1988
;;; Converted to Mutt 9/88 C Durland
;;;
;;; Written by Ph. Schnoebelen ([e-mail]), 1987, 1988
;;; with precious advices from J.-F. Rit.
;;; This has been tested with GNU Emacs 18.50.
;;;
;;; This software is distributed 'as is', without warranties of any
;;; kind, but all comments, suggestions and bug reports are welcome.


;; 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 :-).


;; HOW TO INSTALL:
;;
;; There is nothing specific w.r.t. installation: just put this file in the
;; lisp directory and add an autoload for command gomoku in site-init.el. If
;; you don't want to rebuild Emacs, then every single user interested in
;; Gomoku will have to put the autoload command in its .emacs file.  Another
;; possibility is to define in your .emacs some command using (require
;; 'gomoku).
;;
;; The most important thing is to BYTE-COMPILE gomoku.el because it is
;; important that the code be as fast as possible.
;;
;; 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:
;;
;; Once this file has been installed, the command "M-x gomoku" will display 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.


(include me.mh)
(include mod.mut)
(include random.mut)
(include max.mut)
(include min.mut)

;;;
;;; GOMOKU MODE AND KEYMAP.
;;;

(defun create-gomoku-mode-map
{
  (toggle-read-only TRUE)

  ;; Key bindings for cursor motion. Arrow keys are just "function"
  ;; keys, see below.
  (bind-local-key "gomoku-move-nw"    "y")        ; Y
  (bind-local-key "gomoku-move-ne"    "u")        ; U
  (bind-local-key "gomoku-move-sw"    "b")        ; B
  (bind-local-key "gomoku-move-se"    "n")        ; N
  (bind-local-key "gomoku-move-left"    "h")        ; H
  (bind-local-key "gomoku-move-right"    "l")        ; L
  (bind-local-key "gomoku-move-down"    "j")        ; J
  (bind-local-key "gomoku-move-up"    "k")        ; K
  (bind-local-key "gomoku-move-down"    "C-n")        ; C-N
  (bind-local-key "gomoku-move-down"    "F-D")        ; down arrow
  (bind-local-key "gomoku-move-up"    "C-p")        ; C-P
  (bind-local-key "gomoku-move-up"    "F-C")        ; up arrow
  (bind-local-key "gomoku-move-right"    "C-f")        ; C-F
  (bind-local-key "gomoku-move-right"    "F-E")        ; right arrow
  (bind-local-key "gomoku-move-left"    "C-b")        ; C-B
  (bind-local-key "gomoku-move-left"    "F-F")        ; left arrow

  ;; Key bindings for entering Human moves.
  (bind-local-key  "gomoku-human-plays"        "X")    ; X
  (bind-local-key  "gomoku-human-plays"        "x")    ; x
  (bind-local-key  "gomoku-human-plays"        "C-m")    ; RET
; (bind-local-key  "gomoku-human-plays"        "C-Xp")    ; C-C P
  (bind-local-key  "gomoku-human-resigns"    "C-Xr")    ; C-C R
  (bind-local-key  "gomoku-emacs-plays"        "C-Xe")    ; C-C E
; (bind-local-key  "gomoku-human-takes-back"    "C-cb")    ; C-C B
})


;;    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 RET, x, ..  or whatever has been
;; set locally.

;; Other useful commands:
;;   C-c r Indicate that you resign.
;;   C-c t Take back your last move.
;;   C-c e Ask for Emacs to play (thus passing).

(defun gomoku-mode
{
;  (setq major-mode 'gomoku-mode    mode-name "Gomoku")

  (clear-modes)
  (major-mode "Gomoku")
  (gomoku-display-statistics)
  (create-gomoku-mode-map)
})

;;;
;;; 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).

(const gomoku-max-vector-length 4000)

  ;; Number of columns on the Gomoku board.
(int gomoku-board-width)

  ;; Number of lines on the Gomoku board.
(int gomoku-board-height)

  ;; Vector recording the actual state of the Gomoku board.
(array int gomoku-board gomoku-max-vector-length)

  ;; Length of gomoku-board vector.
(int gomoku-vector-length)

  ;; After how many moves will Emacs offer a draw ?
  ;; This is usually set to 70% of the number of squares.
(int gomoku-draw-limit)

  ;; Translate X, Y cartesian coords into the corresponding board index.
(defun gomoku-xy-to-index (int x y) { (+ (* y gomoku-board-width) x y) })

  ;; Return corresponding x-coord of board INDEX.
(defun gomoku-index-to-x (int index) { (mod index (+ 1 gomoku-board-width)) })

  ;; Return corresponding y-coord of board INDEX.
(defun gomoku-index-to-y (int index) { (/ index (+ 1 gomoku-board-width)) })

  ;; Create the gomoku-board vector and fill it with initial values.
(defun gomoku-init-board
{
  (int i ii)

;(setq gomoku-board (make-vector gomoku-vector-length 0))
    ;; Every square is 0 (i.e. empty) except padding squares:

  (i gomoku-vector-length) (while (!= 0 (-= i 1)) (gomoku-board i 0))

  (i 0) (ii (- gomoku-vector-length 1))
  (while (<= i gomoku-board-width)    ; The squares in [0..width] and in
  {
    (gomoku-board i  -1)        ;    [length - width - 1..length - 1]
    (gomoku-board ii -1)        ;    are padding squares.
    (+= i 1)(-= ii 1)
  })

  (i 0)
  (while (< i gomoku-vector-length)
  {
    (gomoku-board i -1)        ; and also all k*(width+1)
    (+= 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.

  ;; Vector recording the actual score of the free squares.
(array int gomoku-score-table gomoku-max-vector-length)


;; The key 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).

(const nil-score      7)    ; Score of an empty qtuple.
(const Xscore         15)    ; Score of a qtuple containing one X.
(const XXscore        400)    ; Score of a qtuple containing two X's.
(const XXXscore           1800)    ; Score of a qtuple containing three X's.
(const XXXXscore     100000)    ; Score of a qtuple containing four X's.
(const Oscore         35)    ; Score of a qtuple containing one O.
(const OOscore        800)    ; Score of a qtuple containing two O's.
(const OOOscore          15000)    ; Score of a qtuple containing three O's.
(const 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.
(array int gomoku-score-trans-table 31)
(defun gomoku-init-score-trans-table
{
  (gomoku-score-trans-table 0  nil-score)
  (gomoku-score-trans-table 1  Xscore)
  (gomoku-score-trans-table 2  XXscore)
  (gomoku-score-trans-table 3  XXXscore)
  (gomoku-score-trans-table 4  XXXXscore)
  (gomoku-score-trans-table 6  Oscore)
  (gomoku-score-trans-table 12 OOscore)
  (gomoku-score-trans-table 18 OOOscore)
  (gomoku-score-trans-table 24 OOOOscore)
})

;; 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.

  ;; Threshold score beyond which an emacs move is winning.
(const gomoku-winning-threshold OOOOscore)

  ;; Threshold score beyond which a human move is winning.
(const gomoku-loosing-threshold XXXXscore)

  ;; Compute index of free square with highest score, or nil if none.
(defun gomoku-strongest-square
{
  ;; 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.

  (int score score-max)
  (int count square end best-square)

  (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))
  (while (<= square end)
  {
    (cond
    ;; If score is lower (i.e. most of the time), skip to next:
      (< (gomoku-score-table square) score-max) ()
    ;; If score is better, beware of non free squares:
      (> (score (gomoku-score-table square)) score-max)
        (if (== 0 (gomoku-board square))    ; is it free ?
      {
        (count 1)                ; yes: take it !
        (best-square square)
        (score-max   score)
      }
      (gomoku-score-table square -1)    ; no: kill it !
    )
    ;; If score is equally good, choose randomly. But first check freeness:
      (!= 0 (gomoku-board square)) (gomoku-score-table square -1)
      (== count (random-number (+= count 1)))
    { (best-square square)(score-max score) }
    )
    (+= square 1)    ; try next square
  })
  best-square
})

  ;; Return a random integer between 0 and N-1 inclusive.
(defun random-number (n) { (mod (rand) n) })

;;;
;;; 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.

  ;; Recorded initial value of previous score table.
;(??? gomoku-saved-score-table)

  ;; Recorded value of previous board width.
(int gomoku-saved-board-width)

  ;; Recorded value of previous board height.
(int gomoku-saved-board-height)


  ;; Create the score table vector and fill it with initial values.
(defun gomoku-init-score-table
{
  (int i j maxi maxj maxi2 maxj2)

;  (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)))
  (i 0)
  (while (< i gomoku-vector-length)
    { (gomoku-score-table i (* 20 nil-score)) (+= i 1) })

  (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 !
  (i 1)
  (while (<= i maxi2)
  {
    (j 1)
    (while (<= j maxj) { (gomoku-init-square-score i j) (+= j 1) })
    (+= i 1)
  })
  (while (<= i maxi)
  {
    (j 1)
    (while (<= j maxj2) { (gomoku-init-square-score i j) (+= j 1) })
    (+= i 1)
  })
;(setq gomoku-saved-score-table  (copy-sequence gomoku-score-table)
;        gomoku-saved-board-width  gomoku-board-width
;        gomoku-saved-board-height gomoku-board-height)
})

  ;; Return the number of qtuples containing square I,J.
(defun gomoku-nb-qtuples (int 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 !

  (int left right up down)

  (left  (min 4 (- i 1)))
  (right (min 4 (- gomoku-board-width i)))
  (up    (min 4 (- j 1)))
  (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))
})

  ;; Give initial score to square I,J and to its mirror images.
(defun gomoku-init-square-score (int i j)
{
  (int ii jj)(int sc)

  (ii (+ 1 (- gomoku-board-width i)))
  (jj (+ 1 (- gomoku-board-height j)))
  (sc (* (gomoku-nb-qtuples i j) (gomoku-score-trans-table 0)))
  (gomoku-score-table (gomoku-xy-to-index i  j)  sc)
  (gomoku-score-table (gomoku-xy-to-index ii j)     sc)
  (gomoku-score-table (gomoku-xy-to-index i  jj) sc)
  (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.

  ;; Update score table after SQUARE received a DVAL increment.
(defun gomoku-update-score-table (int square dval)
{
  ;; 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.

  (int x y imin jmin imax jmax)

  (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)
})

  ;; 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.
(defun gomoku-update-score-in-direction (int left right sq dx dy dval)
{
  ;; 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.

  (int depl square square0 square1 square2 count)
  (int delta)

  (square sq)
  (if (> left right) (done))        ; Quit
  (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:
  (square square0)
  (count  0)
  (while (<= square square2)
    { (+= count (gomoku-board square)) (+= square depl) })
  (while (<= square0 square1)
  {
    ;; Update the squares of the qtuple beginning in SQUARE0 and ending
    ;; in SQUARE2.
    (delta (- (gomoku-score-trans-table count)
          (gomoku-score-trans-table (- count dval))))
    (if (!= 0 delta)        ; or else nothing to update
    {
      (square square0)
      (while (<= square square2)
      {
    (if (== 0 (gomoku-board square))     ; only for free squares
      (gomoku-score-table square (+ (gomoku-score-table square) delta)))
    (+= square depl)
      })
    })
    ;; Then shift the qtuple one square along DEPL, this only requires
    ;; modifying SQUARE0 and SQUARE2.
    (+= square2 depl)
    (+= count (- (gomoku-board square2) (gomoku-board 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.

  ;; Non-nil if a game is in progress.
(bool gomoku-game-in-progress)

  ;; Number of moves already played in current game.
(int gomoku-number-of-moves)

  ;; Number of moves already played by human in current game.
(int gomoku-number-of-human-moves)

  ;; Non-nil if Emacs played first.
(bool gomoku-emacs-played-first)

  ;; Non-nil if Human took back a move during the game.
(bool gomoku-human-took-back)

  ;; Non-nil if Human refused Emacs offer of a draw.
(bool gomoku-human-refused-draw)

  ;; This is used to detect interruptions. Hopefully, it should not be needed.
  ;; Non-nil if Emacs is in the middle of a computation.
(bool gomoku-emacs-is-computing)


  ;; Initialize a new game on an N by M board.
(defun gomoku-start-game (int n m)
{
  (gomoku-emacs-is-computing TRUE)    ; Raise flag
  (gomoku-game-in-progress TRUE)
  (gomoku-board-width  n) (gomoku-board-height m)
  (gomoku-vector-length (+ 1 (* (+ m 2) (+ 1 n))))
(if (<= gomoku-max-vector-length gomoku-vector-length)
(error "Board too big"))
  (gomoku-draw-limit (/ (* 7 n m) 10))
  (gomoku-number-of-moves 0)
  (gomoku-number-of-human-moves 0)
  (gomoku-emacs-played-first TRUE)
  (gomoku-human-took-back    FALSE)
  (gomoku-human-refused-draw FALSE)
  (gomoku-init-display n m)        ; Display first: the rest takes time
  (gomoku-init-score-trans-table)
  (gomoku-init-score-table)        ; INIT-BOARD requires that the score
  (gomoku-init-board)            ;   table be already created.
  (gomoku-emacs-is-computing FALSE)
})

  ;; Go to SQUARE, play VAL and update everything.
(defun gomoku-play-move (int square val) ; &optional dont-update-score
{
  (gomoku-emacs-is-computing TRUE)    ; Raise flag
  (cond
    (== 1 val)            ; a Human move
    (gomoku-number-of-human-moves (+ 1 gomoku-number-of-human-moves))
    (== 0 gomoku-number-of-moves)    ; an Emacs move. Is it first ?
    (gomoku-emacs-played-first TRUE)
  )
;  (setq gomoku-game-history
;    (cons (cons square (aref gomoku-score-table square))
;          gomoku-game-history)

  (+= gomoku-number-of-moves 1)

  (gomoku-plot-square square val)
  (gomoku-board square val)    ; *BEFORE* UPDATE-SCORE !
  (gomoku-update-score-table square val) ; previous val was 0: dval = val
  (gomoku-score-table square -1)
  (gomoku-emacs-is-computing FALSE)
})

  ;; Take back last move and update everything.
(defun gomoku-take-back
{
;  (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.
;;;

  ;; Number of games already won in this session.
(int gomoku-number-of-wins)

  ;; Number of games already lost in this session.
(int gomoku-number-of-losses)

  ;; Number of games already drawn in this session.
(int gomoku-number-of-draws)


(const
  emacs-won     1
  human-won     2
  nobody-won     3
  draw-agreed     4
  human-resigned 5
  crash-game     6
)

  ;; Terminate the current game with RESULT.
(defun gomoku-terminate-game (int result)
{
  (string message)

  (switch result
    emacs-won
    {
      (gomoku-number-of-wins (+ 1 gomoku-number-of-wins))
      (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 (== 0 gomoku-number-of-losses)
           (== 0 gomoku-number-of-draws)
           (> gomoku-number-of-wins 1))
           "I'm becoming tired of winning..."
      TRUE "I won."
    )
      )
    }
    human-won
    {
      (gomoku-number-of-losses (+ 1 gomoku-number-of-losses))
      (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 ?"
      TRUE
        "OK, you won this one. Now, let me play first just once."
    )
      )
    }
    human-resigned
    {
      (gomoku-number-of-wins (+ 1 gomoku-number-of-wins))
      (message "So you resign... That's just one more win for me.")
    }
    nobody-won
    {
      (gomoku-number-of-draws (+ 1 gomoku-number-of-draws))
      (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."
      TRUE "This is a draw. Now, let me play first just once."
    )
      )
    }
    draw-agreed
    {
      (gomoku-number-of-draws (+ 1 gomoku-number-of-draws))
      (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."
      TRUE "Draw agreed. Now, let me play first just once."
    )
      )
    }
    crash-game
      (message "Sorry, I have been interrupted and cannot resume that game...")
  )
  (gomoku-display-statistics)
  (msg message)
  (gomoku-game-in-progress FALSE)
})

  ;; What to do when Emacs detects it has been interrupted.
(defun gomoku-crash-game
{
  (gomoku-emacs-is-computing FALSE)
  (gomoku-terminate-game crash-game)
;  (sit-for 4)                ; Let's see the message
  (gomoku-prompt-for-other-game)
})

;;;
;;; INTERACTIVE COMMANDS.
;;;

(defun error (string error-message)
{
  (msg error-message)(halt)
})

;; Start a Gomoku game between you and Emacs.
;; If a game is in progress, this command allows 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 RET,
;;   x, ..  or whatever has been set locally.
(defun gomoku
{
  (int n m max-width max-height)

  (n 0)(m 0)
  (if (arg-flag)
    {
      (n (convert-to NUMBER (ask "Gomoku board width: ")))
      (m (convert-to NUMBER (ask "Gomoku board height: ")))
    }
    (if (!= 0 (nargs)) { (n (arg 0)) (m (arg 1)) })
  )

  (gomoku-switch-to-window)

  (cond
    gomoku-emacs-is-computing (gomoku-crash-game) ; ???
    (not gomoku-game-in-progress)
    {
      (max-width (gomoku-max-width)) (max-height (gomoku-max-height))
      (if (== 0 n) (n max-width))
      (if (== 0 m) (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 (concat "I cannot display " n " columns in that window"))
      )
      (if (and (> m max-height)
           (!= m gomoku-saved-board-height)
           (not (yesno "Do you really want " m " rows")))
      (m max-height))
      (msg "One moment, please...")
      (gomoku-start-game n m)
      (if (yesno "Do you allow me to play first")
    (gomoku-emacs-plays)
    (gomoku-prompt-for-move))
    }
    (yesno "Shall we continue our game") (gomoku-prompt-for-move)
    TRUE (gomoku-human-resigns)
  )
})

  ;; Compute Emacs next move and play it.
(defun gomoku-emacs-plays
{
  (int square) (int score)

;  (gomoku-switch-to-window)
  (cond
    gomoku-emacs-is-computing (gomoku-crash-game)
    (not gomoku-game-in-progress) (gomoku-prompt-for-other-game)
    TRUE
    {
      (msg "Let me think...")
      (square (gomoku-strongest-square))
      (cond
        (== 0 square) (gomoku-terminate-game nobody-won)
    TRUE
    {
      (score (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)
        }
        (== 0 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)
        TRUE (gomoku-prompt-for-move)
      )
    }
      )
    }
  )
})

  ;; 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.
(defun gomoku-human-plays
{
  (int square) (int score)

  (gomoku-switch-to-window)
  (cond
    gomoku-emacs-is-computing (gomoku-crash-game)
    (not gomoku-game-in-progress) (gomoku-prompt-for-other-game)
    TRUE
    {
      (square (gomoku-point-square))
      (cond
        (== 0 square) (error "Your point is not on a square. Retry !")
    (!= 0 (gomoku-board square))
      (error "Your point is not on a free square. Retry !")
    TRUE
    {
      (score (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)
          }
        TRUE (gomoku-emacs-plays)
      )
    }
      )
    }
  )
})

  ;; Signal to the Gomoku program that you wish to take back your last move.
(defun gomoku-human-takes-back
{
(msg "Take back not implemented yet")
;  (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))))
})

  ;; Signal to the Gomoku program that you may want to resign.
(defun gomoku-human-resigns
{
  (gomoku-switch-to-window)
  (cond
    gomoku-emacs-is-computing (gomoku-crash-game)
    (not gomoku-game-in-progress) (msg "There is no game in progress")
    (yesno "You mean, you resign") (gomoku-terminate-game human-resigned)
    (yesno "You mean, we continue") (gomoku-prompt-for-move)
    TRUE (gomoku-terminate-game human-resigned)    ; OK. Accept it
  )
})

;;;
;;; PROMPTING THE HUMAN PLAYER.
;;;

  ;; Display a message asking for Human's move.
(defun gomoku-prompt-for-move
{
  (msg
    (if (== 0 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))))
})

  ;; Ask for another game, and start it.
(defun gomoku-prompt-for-other-game
{
  (if (yesno "Another game")
    (gomoku gomoku-board-width gomoku-board-height)
    (msg "Chicken !"))
})

  ;; Offer a draw and return T if Human accepted it.
(defun gomoku-offer-a-draw
{
  (if (yesno "I offer you a draw. Do you accept it")
    (gomoku-human-refused-draw TRUE)
    FALSE)
})

;;;
;;; 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).

  ;; Horizontal spacing between squares on the Gomoku board.
(const gomoku-square-width 4)

  ;; Vertical spacing between squares on the Gomoku board.
(const gomoku-square-height 2)

  ;; Number of columns between the Gomoku board and the side of the window.
(const gomoku-x-offset 3)

  ;; Number of lines between the Gomoku board and the top of the window.
(const gomoku-y-offset 1)


  ;; Largest possible board width for the current window.
(defun gomoku-max-width
{
  (+ 1 (/ (- (screen-width) gomoku-x-offset gomoku-x-offset 1)
     gomoku-square-width))
})

  ;; Largest possible board height for the current window.
(defun gomoku-max-height
{
  (+ 1 (/ (- (window-height -1) gomoku-y-offset gomoku-y-offset 1)
     ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
     gomoku-square-height))
})

 ;; Return the board column where point is, or nil if it is not a board column.
(defun gomoku-point-x
{
  (int col)

  (col (- (current-column) gomoku-x-offset 1))
  (if (and (>= col 0)
       (== 0 (mod col gomoku-square-width))
       (<= (col (+ 1 (/ col gomoku-square-width))) gomoku-board-width))
    col
    0)
})

  ;; Return the board row where point is, or nil if it is not a board row.
(defun gomoku-point-y
{
  (int row)
  (int buffer-size dot lines buffer-row wasted char-at-dot)    ;; BufferInfo

  (buffer-stats -1 (loc buffer-size))

  (row (- (buffer-row) gomoku-y-offset 1))
  (if (and (>= row 0)
      (== 0 (mod row gomoku-square-height))
      (<= (row (+ 1 (/ row gomoku-square-height))) gomoku-board-height))
    row
    0)
})

  ;; Return the index of the square point is on, or nil if not on the board.
(defun gomoku-point-square
{
  (int x y)

  (if (and (!= 0 (x (gomoku-point-x)))(!= 0 (y (gomoku-point-y))))
    (gomoku-xy-to-index x y)
    0)
})

  ;; Move point to square number INDEX.
(defun gomoku-goto-square (int index)
  { (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index)) })

  ;; Move point to square at X, Y coords.
(defun gomoku-goto-xy (int x y)
{
  (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (- y 1))))
  (current-column (+ 1 gomoku-x-offset (* gomoku-square-width (- x 1))))
})

  ;; Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there.
(defun gomoku-plot-square (int square value)
{
  (gomoku-goto-square square)
  (gomoku-put-char (cond (== value 1) "X"
             (== value 6) "O"
             TRUE          "."))
  (update)    ; Display NOW
})

  ;; Draw CHAR on the Gomoku screen.
(defun gomoku-put-char (string char)
{
  (insert-text char)
  (delete-character)
  (previous-character)
})

(const BLANKS "          ")

  ;; Display an N by M Gomoku board.
(defun gomoku-init-display (int n m)
{
  (int i j)
  (string row)

  (clear-buffer)
    ;; 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.
  (row (concat (extract-elements BLANKS 0 gomoku-x-offset) "."))
  (j 0)(while (< (+= j 1) n)
    (row (concat row
    (extract-elements BLANKS 0 (- gomoku-square-width 1)) ".")))
  (j 0)
  (arg-prefix gomoku-y-offset)(newline)
  (while (<= (+= j 1) m)
  {
    (insert-text row)
    (arg-prefix gomoku-square-height)(newline)
  })
  (beginning-of-buffer)

  (gomoku-goto-xy (/ (+ 1 n) 2) (/ (+ 1 m) 2)) ; center of the board
  (update)                ; Display NOW
})

  ;; Obnoxiously display some statistics about previous games in mode line.
(defun gomoku-display-statistics
{
  ;; 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-wins
;          gomoku-number-of-losses
;          gomoku-number-of-draws))
;     ((not (zerop gomoku-number-of-losses))
;      (format ": Won %d, lost %d"
;          gomoku-number-of-wins
;          gomoku-number-of-losses))
;     ((zerop gomoku-number-of-wins)
;      "")
;     ((= 1 gomoku-number-of-wins)
;      ": Already won one")
;     (t
;      (format ": Won %d in a row"
;          gomoku-number-of-wins))))
  ;; Then a (standard) kludgy line will force update of mode line.
;  (set-buffer-modified-p (buffer-modified-p)))
})

  ;; Find or create the Gomoku buffer, and display it.
(defun gomoku-switch-to-window
{
  (int b)

  (if (== (current-buffer) (b (attached-buffer "*Gomoku*"))) (done))
  (if (!= -2 b)
    {        ; Buffer exists: no problem.
      (switch-to-buffer "*Gomoku*")
    }
    {
      (if gomoku-game-in-progress
     (gomoku-crash-game))        ; Buffer has been killed or something
      (switch-to-buffer "*Gomoku*")    ; Anyway, start anew.
      (buffer-flags (attached-buffer "*Gomoku*") BFFoo)
      (gomoku-mode)
    }
  )
;  (arg-prefix 1000)(scroll-up)(update)
})

;;;
;;; 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.

  ;; First square of the winning qtuple.
(int gomoku-winning-qtuple-beg)

  ;; Last square of the winning qtuple.
(int gomoku-winning-qtuple-end)

  ;; Direction of the winning qtuple (along the X axis).
(int gomoku-winning-qtuple-dx)

  ;; Direction of the winning qtuple (along the Y axis).
(int gomoku-winning-qtuple-dy)


  ;; Return T if SQUARE belongs to a qtuple filled with VALUEs.
(defun gomoku-find-filled-qtuple (int square value)
{
  (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))
})

  ;; Return T if SQUARE belongs to a qtuple filled  with VALUEs along DX, DY.
  ;; And record it in the WINNING-QTUPLE-... variables.
(defun gomoku-check-filled-qtuple (int square value dx dy)
{
  (int a b left right depl a+4)

  (a 0) (b 0)
  (left square) (right square)
  (depl (gomoku-xy-to-index dx dy))
  (while
    (and (> a -4)        ; stretch tuple left
     (== value (gomoku-board (-= left depl))))
    (-= a 1))
  (a+4 (+ a 4))
  (while
    (and (< b a+4)        ; stretch tuple right
     (== value (gomoku-board (+= right depl))))
    (+= b 1))
  (if (== b a+4)            ; tuple length = 5 ?
    {
      (gomoku-winning-qtuple-beg (+ square (* a depl)))
      (gomoku-winning-qtuple-end (+ square (* b depl)))
      (gomoku-winning-qtuple-dx dx)
      (gomoku-winning-qtuple-dy dy)
      TRUE
    }
    FALSE)
})

  ;; Cross winning qtuple, as found by gomoku-find-filled-qtuple.
(defun gomoku-cross-winning-qtuple
{
  (gomoku-cross-qtuple gomoku-winning-qtuple-beg
               gomoku-winning-qtuple-end
               gomoku-winning-qtuple-dx
               gomoku-winning-qtuple-dy)
})

  ;; Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction.
(defun gomoku-cross-qtuple (int sq1 square2 dx dy)
{
  (int depl n col square1)

  (square1 sq1)
  (set-mark)            ; Not moving point from last square
  (depl (gomoku-xy-to-index dx dy))
      ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
  (while (not (== square1 square2))
  {
    (gomoku-goto-square square1)
    (+= square1 depl)
    (cond
      (and (== dx 1) (== dy 0))        ; Horizontal
      {
    (n 1)
    (while (< n gomoku-square-width)
    {
      (+= n 1)
      (next-character)
      (gomoku-put-char "-")
    })
      }
      (and (== dx 0) (== dy 1))        ; Vertical
      {
    (n 1)(col (current-column))
    (while (< n gomoku-square-height)
    {
      (+= n 1)
      (forward-line 1)
      (to-col col)
      (insert-text "|")
    })
      }
      (and (== dx -1) (== dy 1))    ; 1st Diagonal
      {
    (arg-prefix (/ gomoku-square-width 2))(previous-character)
    (col (current-column))
    (forward-line (/ gomoku-square-height 2))
    (to-col col)
    (insert-text "/")
      }
      (and (== dx 1) (== dy 1))        ; 2nd Diagonal
      {
    (next-character (/ gomoku-square-width 2))
    (col (current-column))
    (forward-line (/ gomoku-square-height 2))
    (to-col col)
    (insert-text "\\")
      }
    )
  })
  (swap-marks)
  (update)                ; Display NOW
})

;;;
;;; CURSOR MOTION.
;;;
  ;; Move point backward one column on the Gomoku board.
(defun gomoku-move-left
{
  (int x)

  (x (gomoku-point-x))
  (arg-prefix
    (cond
      (== 0 x) 1
      (> x 1) gomoku-square-width
      TRUE 0
    ))
  (previous-character)
})

  ;; Move point forward one column on the Gomoku board.
(defun gomoku-move-right
{
  (int x)

  (x (gomoku-point-x))
  (arg-prefix
    (cond
      (== x 0) 1
      (< x gomoku-board-width) gomoku-square-width
      TRUE 0
    ))
  (next-character)
})

  ;; Move point down one row on the Gomoku board.
(defun gomoku-move-down
{
  (int x y)

  (y (gomoku-point-y))(x (current-column))

  (forward-line
    (cond
      (== 0 y) 1
      (< y gomoku-board-height) gomoku-square-height
      TRUE 0
    ))
  (current-column x)
})

  ;; Move point up one row on the Gomoku board.
(defun gomoku-move-up
{
  (int x y)

  (y (gomoku-point-y))(x (current-column))

  (forward-line
    (- 0
      (cond
        (== 0 y) 1
    (> y 1) gomoku-square-height
    TRUE 0
      )))
  (current-column x)
})

  ;; Move point North East on the Gomoku board.
(defun gomoku-move-ne { (gomoku-move-up) (gomoku-move-right) })

  ;; Move point South East on the Gomoku board.
(defun gomoku-move-se { (gomoku-move-down) (gomoku-move-right) })

  ;; Move point North West on the Gomoku board.
(defun gomoku-move-nw { (gomoku-move-up) (gomoku-move-left) })

  ;; Move point South West on the Gomoku board.
(defun gomoku-move-sw { (gomoku-move-down) (gomoku-move-left) })