;;; gomoku.el --- Gomoku game between you and Emacs
-;; Copyright (C) 1988, 1994, 1996, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
;; Maintainer: FSF
;; GNU Emacs 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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).
: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.")
(define-key gomoku-mode-map [mouse-2] 'gomoku-mouse-play)
(define-key gomoku-mode-map [drag-mouse-2] 'gomoku-mouse-play)
- (substitute-key-definition 'previous-line 'gomoku-move-up
- gomoku-mode-map (current-global-map))
- (substitute-key-definition 'next-line 'gomoku-move-down
- gomoku-mode-map (current-global-map))
- (substitute-key-definition 'beginning-of-line 'gomoku-beginning-of-line
- gomoku-mode-map (current-global-map))
- (substitute-key-definition 'end-of-line 'gomoku-end-of-line
- gomoku-mode-map (current-global-map))
- (substitute-key-definition 'undo 'gomoku-human-takes-back
- gomoku-mode-map (current-global-map))
- (substitute-key-definition 'advertised-undo 'gomoku-human-takes-back
- gomoku-mode-map (current-global-map)))
+ (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.")
-(defcustom gomoku-font-lock-O-face
- (if (display-color-p)
- (list (facemenu-get-face 'fg:red) 'bold))
- "*Face to use for Emacs' O."
- :type '(repeat face)
+(defface gomoku-O
+ '((((class color)) (:foreground "red" :weight bold)))
+ "Face to use for Emacs' O."
:group 'gomoku)
-(defcustom gomoku-font-lock-X-face
- (if (display-color-p)
- (list (facemenu-get-face 'fg:green) 'bold))
- "*Face to use for your X."
- :type '(repeat face)
+(defface gomoku-X
+ '((((class color)) (:foreground "green" :weight bold)))
+ "Face to use for your X."
:group 'gomoku)
(defvar gomoku-font-lock-keywords
- '(("O" . gomoku-font-lock-O-face)
- ("X" . gomoku-font-lock-X-face)
- ("[-|/\\]" 0 (if gomoku-emacs-won
- gomoku-font-lock-O-face
- gomoku-font-lock-X-face)))
+ '(("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)
-(define-derived-mode gomoku-mode nil "Gomoku"
+(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
Other useful commands:
\\{gomoku-mode-map}
Entry to this mode calls the value of `gomoku-mode-hook' if that value
-is non-nil. One interesting value is `turn-on-font-lock'."
+is non-nil."
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'gomoku-mode
+ mode-name "Gomoku")
(gomoku-display-statistics)
- (set (make-local-variable 'font-lock-defaults)
- '(gomoku-font-lock-keywords t))
- (toggle-read-only t))
+ (use-local-map gomoku-mode-map)
+ (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)))
(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 !")
+ "I won... Too bad you refused my offer of a draw!")
(gomoku-human-took-back
- "I won... Taking moves back will not help you !")
+ "I won... Taking moves back will not help you!")
((not gomoku-emacs-played-first)
- "I won... Playing first did not help you much !")
+ "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))
(gomoku-human-took-back
" I, for one, never take my moves back...")
(gomoku-emacs-played-first
- ".. so what ?")
+ ".. 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))
(interactive (if current-prefix-arg
(list (prefix-numeric-value current-prefix-arg)
(eval (read-minibuffer "Height: ")))))
- (gomoku-switch-to-window)
+ ;; 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))
(if (and (> m max-height)
(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))))
+ (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))))
gomoku-square-height)
1)
gomoku-board-height))))
-
+
(defun gomoku-mouse-play (click)
"Play at the square where you click."
(interactive "e")
(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)
(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 ")
+ "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))
(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.
;; who won. The solution is to scan the board along all four directions.
(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."
+ "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)))
"Move point down one row on the Gomoku board."
(interactive)
(if (< (gomoku-point-y) gomoku-board-height)
- (next-line gomoku-square-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)
(if (> (gomoku-point-y) 1)
- (previous-line gomoku-square-height)))
+ (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."
(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