;;; gomoku.el --- Gomoku game between you and Emacs
-;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
-;; Author: Phillippe Schnoebelen <phs@lifia.imag.fr>
-;; Adapted-By: ESR
+;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
+;; Maintainer: FSF
+;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: games
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; 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
+;; 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 :-).
+;; know about the forced win, nor do I.
+;; See http://renju.nu/r1rulhis.htm for more information.
;; There are two main places where you may want to customize the program: key
;;; Code:
\f
+(defgroup gomoku nil
+ "Gomoku game between you and Emacs."
+ :prefix "gomoku-"
+ :group 'games)
;;;
;;; GOMOKU MODE AND KEYMAP.
;;;
-(defvar gomoku-mode-hook nil
- "If non-nil, its value is called on entry to Gomoku mode.")
+(defcustom gomoku-mode-hook nil
+ "If non-nil, its value is called on entry to Gomoku mode.
+One useful value to include is `turn-on-font-lock' to highlight the pieces."
+ :type 'hook
+ :group 'gomoku)
+
+;;;
+;;; CONSTANTS FOR BOARD
+;;;
+
+(defconst gomoku-buffer-name "*Gomoku*"
+ "Name of the Gomoku buffer.")
+
+;; 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.")
+
(defvar gomoku-mode-map nil
"Local keymap to use in Gomoku mode.")
(if gomoku-mode-map nil
(setq gomoku-mode-map (make-sparse-keymap))
- ;; 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 cursor motion.
+ (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" 'backward-char) ; h
+ (define-key gomoku-mode-map "l" 'forward-char) ; 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 [kp-7] 'gomoku-move-nw)
+ (define-key gomoku-mode-map [kp-9] 'gomoku-move-ne)
+ (define-key gomoku-mode-map [kp-1] 'gomoku-move-sw)
+ (define-key gomoku-mode-map [kp-3] 'gomoku-move-se)
+ (define-key gomoku-mode-map [kp-4] 'backward-char)
+ (define-key gomoku-mode-map [kp-6] 'forward-char)
+ (define-key gomoku-mode-map [kp-2] 'gomoku-move-down)
+ (define-key gomoku-mode-map [kp-8] 'gomoku-move-up)
+
+ (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-n
+ (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-p
;; 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 " " 'gomoku-human-plays) ; SPC
(define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET
- (define-key gomoku-mode-map "\C-cp" 'gomoku-human-plays) ; C-C P
- (define-key gomoku-mode-map "\C-cb" 'gomoku-human-takes-back) ; C-C B
- (define-key gomoku-mode-map "\C-cr" 'gomoku-human-resigns) ; C-C R
- (define-key gomoku-mode-map "\C-ce" 'gomoku-emacs-plays) ; 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 "\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 [kp-enter] 'gomoku-human-plays)
- (define-key gomoku-mode-map [insert] 'gomoku-human-plays))
+ (define-key gomoku-mode-map [insert] 'gomoku-human-plays)
+ (define-key gomoku-mode-map [down-mouse-1] 'gomoku-click)
+ (define-key gomoku-mode-map [drag-mouse-1] 'gomoku-click)
+ (define-key gomoku-mode-map [mouse-1] 'gomoku-click)
+ (define-key gomoku-mode-map [down-mouse-2] 'gomoku-click)
+ (define-key gomoku-mode-map [mouse-2] 'gomoku-mouse-play)
+ (define-key gomoku-mode-map [drag-mouse-2] 'gomoku-mouse-play)
+
+ (define-key gomoku-mode-map [remap previous-line] 'gomoku-move-up)
+ (define-key gomoku-mode-map [remap next-line] 'gomoku-move-down)
+ (define-key gomoku-mode-map [remap beginning-of-line] 'gomoku-beginning-of-line)
+ (define-key gomoku-mode-map [remap end-of-line] 'gomoku-end-of-line)
+ (define-key gomoku-mode-map [remap undo] 'gomoku-human-takes-back)
+ (define-key gomoku-mode-map [remap advertised-undo] 'gomoku-human-takes-back))
+
+(defvar gomoku-emacs-won ()
+ "For making font-lock use the winner's face for the line.")
+
+(defface gomoku-O
+ '((((class color)) (:foreground "red" :weight bold)))
+ "Face to use for Emacs' O."
+ :group 'gomoku)
+
+(defface gomoku-X
+ '((((class color)) (:foreground "green" :weight bold)))
+ "Face to use for your X."
+ :group 'gomoku)
+
+(defvar gomoku-font-lock-keywords
+ '(("O" . 'gomoku-O)
+ ("X" . 'gomoku-X)
+ ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
+ "*Font lock rules for Gomoku.")
+
+(put 'gomoku-mode 'front-sticky
+ (put 'gomoku-mode 'rear-nonsticky '(intangible)))
+(put 'gomoku-mode 'intangible 1)
+;; This one is for when they set view-read-only to t: Gomoku cannot
+;; allow View Mode to be activated in its buffer.
+(put 'gomoku-mode 'mode-class 'special)
(defun gomoku-mode ()
"Major mode for playing Gomoku against Emacs.
Entry to this mode calls the value of `gomoku-mode-hook' if that value
is non-nil."
(interactive)
+ (kill-all-local-variables)
(setq major-mode 'gomoku-mode
mode-name "Gomoku")
(gomoku-display-statistics)
(use-local-map gomoku-mode-map)
- (run-hooks 'gomoku-mode-hook))
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(gomoku-font-lock-keywords t))
+ (toggle-read-only t)
+ (run-mode-hooks 'gomoku-mode-hook))
\f
;;;
;;; 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
+;; 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
"Vector recording the actual state of the Gomoku board.")
(defvar gomoku-vector-length nil
- "Length of gomoku-board vector.")
+ "Length of `gomoku-board' vector.")
(defvar gomoku-draw-limit nil
;; This is usually set to 70% of the number of squares.
(/ index (1+ gomoku-board-width)))
(defun gomoku-init-board ()
- "Create the gomoku-board vector and fill it with initial values."
+ "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)))
;; 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
+;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the
+;; contents of a qtuple are uniquely determined by the sum of its elements and
;; we just have to set up a translation table.
(defconst gomoku-score-trans-table
gomoku-board-height m
gomoku-vector-length (1+ (* (+ m 2) (1+ n)))
gomoku-draw-limit (/ (* 7 n m) 10))
- (setq gomoku-game-history nil
+ (setq gomoku-emacs-won nil
+ gomoku-game-history nil
gomoku-number-of-moves 0
gomoku-number-of-human-moves 0
gomoku-emacs-played-first nil
;;; SESSION CONTROL.
;;;
-(defvar gomoku-number-of-wins 0
- "Number of games already won in this session.")
+(defvar gomoku-number-of-emacs-wins 0
+ "Number of games Emacs won in this session.")
-(defvar gomoku-number-of-losses 0
- "Number of games already lost 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-wins (1+ gomoku-number-of-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-losses)
- (zerop gomoku-number-of-draws)
- (> gomoku-number-of-wins 1))
- "I'm becoming tired of winning...")
- (t
- "I won."))))
- ((eq result 'human-won)
- (setq gomoku-number-of-losses (1+ gomoku-number-of-losses))
- (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-wins (1+ gomoku-number-of-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)))
+ (message
+ (cond
+ ((eq result 'emacs-won)
+ (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins))
+ (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...")
+ ("I won.")))
+ ((eq result 'human-won)
+ (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins))
+ (concat "OK, you won this one."
+ (cond
+ (gomoku-human-took-back
+ " I, for one, never take my moves back...")
+ (gomoku-emacs-played-first
+ ".. so what?")
+ (" Now, let me play first just once."))))
+ ((eq result 'human-resigned)
+ (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins))
+ "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))
+ (concat "This is a draw. "
+ (cond
+ (gomoku-human-took-back
+ "I, for one, never take my moves back...")
+ (gomoku-emacs-played-first
+ "Just chance, I guess.")
+ ("Now, let me play first just once."))))
+ ((eq result 'draw-agreed)
+ (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
+ (concat "Draw agreed. "
+ (cond
+ (gomoku-human-took-back
+ "I, for one, never take my moves back...")
+ (gomoku-emacs-played-first
+ "You were lucky.")
+ ("Now, let me play first just once."))))
+ ((eq result 'crash-game)
+ "Sorry, I have been interrupted and cannot resume that game...")))
+ (gomoku-display-statistics)
+ ;;(ding)
+ (setq gomoku-game-in-progress nil))
(defun gomoku-crash-game ()
"What to do when Emacs detects it has been interrupted."
;;;###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.
+If prefix arg is given for N, M is prompted for.
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
You play by moving the cursor over the square you choose and hitting
\\<gomoku-mode-map>\\[gomoku-human-plays].
+
+This program actually plays a simplified or archaic version of the
+Gomoku game, and ought to be upgraded to use the full modern rules.
+
Use \\[describe-mode] for more info."
- (interactive)
- (gomoku-switch-to-window)
+ (interactive (if current-prefix-arg
+ (list (prefix-numeric-value current-prefix-arg)
+ (eval (read-minibuffer "Height: ")))))
+ ;; gomoku-switch-to-window, but without the potential call to gomoku
+ ;; from gomoku-prompt-for-other-game.
+ (if (get-buffer gomoku-buffer-name)
+ (switch-to-buffer gomoku-buffer-name)
+ (when gomoku-game-in-progress
+ (setq gomoku-emacs-is-computing nil)
+ (gomoku-terminate-game 'crash-game)
+ (sit-for 4)
+ (or (y-or-n-p "Another game? ") (error "Chicken!")))
+ (switch-to-buffer gomoku-buffer-name)
+ (gomoku-mode))
(cond
(gomoku-emacs-is-computing
(gomoku-crash-game))
- ((not gomoku-game-in-progress)
+ ((or (not gomoku-game-in-progress)
+ (<= gomoku-number-of-moves 2))
(let ((max-width (gomoku-max-width))
(max-height (gomoku-max-height)))
(or n (setq n max-width))
((> 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))))
+ (not (eq m gomoku-saved-board-height))
+ ;; Use EQ 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 ")
+ (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 ")
+ ((y-or-n-p "Shall we continue our game? ")
(gomoku-prompt-for-move))
(t
(gomoku-human-resigns))))
(setq score (aref gomoku-score-table square))
(gomoku-play-move square 6)
(cond ((>= score gomoku-winning-threshold)
+ (setq gomoku-emacs-won t) ; for font-lock
(gomoku-find-filled-qtuple square 6)
- (gomoku-cross-winning-qtuple)
(gomoku-terminate-game 'emacs-won))
((zerop score)
(gomoku-terminate-game 'nobody-won))
(t
(gomoku-prompt-for-move)))))))))
+;; For small square dimensions this is approximate, since though measured in
+;; pixels, event's (X . Y) is a character's top-left corner.
+(defun gomoku-click (click)
+ "Position at the square where you click."
+ (interactive "e")
+ (and (windowp (posn-window (setq click (event-end click))))
+ (numberp (posn-point click))
+ (select-window (posn-window click))
+ (setq click (posn-col-row click))
+ (gomoku-goto-xy
+ (min (max (/ (+ (- (car click)
+ gomoku-x-offset
+ 1)
+ (window-hscroll)
+ gomoku-square-width
+ (% gomoku-square-width 2)
+ (/ gomoku-square-width 2))
+ gomoku-square-width)
+ 1)
+ gomoku-board-width)
+ (min (max (/ (+ (- (cdr click)
+ gomoku-y-offset
+ 1)
+ (let ((inhibit-point-motion-hooks t))
+ (count-lines 1 (window-start)))
+ gomoku-square-height
+ (% gomoku-square-height 2)
+ (/ gomoku-square-height 2))
+ gomoku-square-height)
+ 1)
+ gomoku-board-height))))
+
+(defun gomoku-mouse-play (click)
+ "Play at the square where you click."
+ (interactive "e")
+ (if (gomoku-click 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.
(let (square score)
(setq square (gomoku-point-square))
(cond ((null square)
- (error "Your point is not on a square. Retry !"))
+ (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 !"))
+ (error "Your point is not on a free square. Retry!"))
(t
(setq score (aref gomoku-score-table square))
(gomoku-play-move square 1)
;; 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)))))))))
(sit-for 4)
(gomoku-prompt-for-other-game))
((zerop gomoku-number-of-human-moves)
- (message "You have not played yet... Your move ?"))
+ (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
(gomoku-crash-game))
((not gomoku-game-in-progress)
(message "There is no game in progress"))
- ((y-or-n-p "You mean, you resign ")
+ ((y-or-n-p "You mean, you resign? ")
(gomoku-terminate-game 'human-resigned))
- ((y-or-n-p "You mean, we continue ")
+ ((y-or-n-p "You mean, we continue? ")
(gomoku-prompt-for-move))
(t
(gomoku-terminate-game 'human-resigned)))) ; OK. Accept it
(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 ?"))
+ "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 ")
+ (if (y-or-n-p "Another game? ")
(gomoku gomoku-board-width gomoku-board-height)
- (message "Chicken !")))
+ (error "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)))
+ "Offer a draw and return t if Human accepted it."
+ (or (y-or-n-p "I offer you a draw. Do you accept it? ")
+ (not (setq gomoku-human-refused-draw t))))
\f
;;;
;;; 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))
;; 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)))
+ "Return the board row where point is."
+ (let ((inhibit-point-motion-hooks t))
+ (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1))
+ gomoku-square-height))))
(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))))
+ "Return the index of the square point is on."
+ (let ((inhibit-point-motion-hooks t))
+ (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset)
+ gomoku-square-width))
+ (gomoku-point-y))))
(defun gomoku-goto-square (index)
"Move point to square number 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))))
+ (let ((inhibit-point-motion-hooks t))
+ (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)
+ "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
+ (or (= value 1)
+ (gomoku-goto-square square))
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
+ (insert-and-inherit (cond ((= value 1) ?X)
+ ((= value 6) ?O)
+ (?.)))
+ (and (zerop value)
+ (add-text-properties
+ (1- (point)) (point)
+ '(mouse-face highlight help-echo "mouse-2: play at this square")))
(delete-char 1)
- (backward-char 1)))
+ (backward-char 1))
+ (sit-for 0)) ; Display NOW
(defun gomoku-init-display (n m)
"Display an N by M Gomoku board."
(buffer-disable-undo (current-buffer))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (point 1) opoint
+ (intangible t)
+ (i m) j x)
+ ;; Try to minimize number of chars (because of text properties)
+ (setq tab-width
+ (if (zerop (% gomoku-x-offset gomoku-square-width))
+ gomoku-square-width
+ (max (/ (+ (% gomoku-x-offset gomoku-square-width)
+ gomoku-square-width 1) 2) 2)))
(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
+ (newline gomoku-y-offset)
+ (while (progn
+ (setq j n
+ x (- gomoku-x-offset gomoku-square-width))
+ (while (>= (setq j (1- j)) 0)
+ (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width))
+ (current-column))
+ tab-width))
+ (insert-char ? (- x (current-column)))
+ (if (setq intangible (not intangible))
+ (put-text-property point (point) 'intangible 2))
+ (and (zerop j)
+ (= i (- m 2))
+ (progn
+ (while (>= i 3)
+ (append-to-buffer (current-buffer) opoint (point))
+ (setq i (- i 2)))
+ (goto-char (point-max))))
+ (setq point (point))
+ (insert ?.)
+ (add-text-properties
+ point (point)
+ '(mouse-face highlight
+ help-echo "mouse-2: play at this square")))
+ (> (setq i (1- i)) 0))
+ (if (= i (1- m))
+ (setq opoint point))
+ (insert-char ?\n gomoku-square-height))
+ (or (eq (char-after 1) ?.)
+ (put-text-property 1 2 'point-entered
+ (lambda (x y) (if (bobp) (forward-char)))))
+ (or intangible
+ (put-text-property point (point) 'intangible 2))
+ (put-text-property point (point) 'point-entered
+ (lambda (x y) (if (eobp) (backward-char))))
+ (put-text-property (point-min) (point) 'category 'gomoku-mode))
+ (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-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)))
+ (format ": Won %d, lost %d%s"
+ gomoku-number-of-human-wins
+ gomoku-number-of-emacs-wins
+ (if (zerop gomoku-number-of-draws)
+ ""
+ (format ", drew %d" gomoku-number-of-draws))))
+ (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))))
+ (if (get-buffer gomoku-buffer-name) ; Buffer exists:
+ (switch-to-buffer gomoku-buffer-name) ; no problem.
+ (if gomoku-game-in-progress
+ (gomoku-crash-game)) ; buffer has been killed or something
+ (switch-to-buffer gomoku-buffer-name) ; Anyway, start anew.
+ (gomoku-mode)))
\f
;;;
;;; CROSSING WINNING QTUPLES.
;; 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."
+ "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.
+ "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY."
(let ((a 0) (b 0)
(left square) (right square)
- (depl (gomoku-xy-to-index dx dy))
- a+4)
+ (depl (gomoku-xy-to-index dx dy)))
(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
+ (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)
+ (cond ((= b (+ a 4)) ; tuple length = 5 ?
+ (gomoku-cross-qtuple (+ square (* a depl)) (+ square (* b depl))
+ dx 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)))
+ (let ((depl (gomoku-xy-to-index dx dy))
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
- (while (not (= square1 square2))
+ (while (/= 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))
+ ((= dy 0) ; Horizontal
+ (forward-char 1)
+ (insert-char ?- (1- gomoku-square-width) t)
+ (delete-region (point) (progn
+ (skip-chars-forward " \t")
+ (point))))
+ ((= dx 0) ; Vertical
+ (let ((n 1)
+ (column (current-column)))
(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 ?\\))))))
+ (forward-line 1)
+ (indent-to column)
+ (insert-and-inherit ?|))))
+ ((= dx -1) ; 1st Diagonal
+ (indent-to (prog1 (- (current-column) (/ gomoku-square-width 2))
+ (forward-line (/ gomoku-square-height 2))))
+ (insert-and-inherit ?/))
+ (t ; 2nd Diagonal
+ (indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2))
+ (forward-line (/ gomoku-square-height 2))))
+ (insert-and-inherit ?\\))))))
(sit-for 0)) ; Display NOW
\f
;;;
;;; 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)))))
-
+;; previous-line and next-line don't work right with intangible newlines
(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)))))
+ (if (< (gomoku-point-y) gomoku-board-height)
+ (let ((column (current-column)))
+ (forward-line gomoku-square-height)
+ (move-to-column column))))
(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)))))
+ (if (> (gomoku-point-y) 1)
+ (let ((column (current-column)))
+ (forward-line (- 1 gomoku-square-height))
+ (move-to-column column))))
(defun gomoku-move-ne ()
"Move point North East on the Gomoku board."
(interactive)
(gomoku-move-up)
- (gomoku-move-right))
+ (forward-char))
(defun gomoku-move-se ()
"Move point South East on the Gomoku board."
(interactive)
(gomoku-move-down)
- (gomoku-move-right))
+ (forward-char))
(defun gomoku-move-nw ()
"Move point North West on the Gomoku board."
(interactive)
(gomoku-move-up)
- (gomoku-move-left))
+ (backward-char))
(defun gomoku-move-sw ()
"Move point South West on the Gomoku board."
(interactive)
(gomoku-move-down)
- (gomoku-move-left))
+ (backward-char))
+
+(defun gomoku-beginning-of-line ()
+ "Move point to first square on the Gomoku board row."
+ (interactive)
+ (move-to-column gomoku-x-offset))
+
+(defun gomoku-end-of-line ()
+ "Move point to last square on the Gomoku board row."
+ (interactive)
+ (move-to-column (+ gomoku-x-offset
+ (* gomoku-square-width (1- gomoku-board-width)))))
+
+(random t)
(provide 'gomoku)
+;;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb
;;; gomoku.el ends here