;;; 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 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
;; 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 [mouse-2] 'gomoku-click)
- (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.
;; 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
(defun gomoku-terminate-game (result)
"Terminate the current game with RESULT."
- (let (message)
- (cond
- ((eq result 'emacs-won)
- (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins))
- (setq message
- (cond ((< gomoku-number-of-moves 20)
- "This was a REALLY QUICK win.")
- (gomoku-human-refused-draw
- "I won... Too bad you refused my offer of a draw !")
- (gomoku-human-took-back
- "I won... Taking moves back will not help you !")
- ((not gomoku-emacs-played-first)
- "I won... Playing first did not help you much !")
- ((and (zerop gomoku-number-of-human-wins)
- (zerop gomoku-number-of-draws)
- (> gomoku-number-of-emacs-wins 1))
- "I'm becoming tired of winning...")
- (t
- "I won."))))
- ((eq result 'human-won)
- (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins))
- (setq message
- (cond
- (gomoku-human-took-back
- "OK, you won this one. I, for one, never take my moves back...")
- (gomoku-emacs-played-first
- "OK, you won this one... so what ?")
- (t
- "OK, you won this one. Now, let me play first just once."))))
- ((eq result 'human-resigned)
- (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins))
- (setq message "So you resign. That's just one more win for me."))
- ((eq result 'nobody-won)
- (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
- (setq message
- (cond
- (gomoku-human-took-back
- "This is a draw. I, for one, never take my moves back...")
- (gomoku-emacs-played-first
- "This is a draw. Just chance, I guess.")
- (t
- "This is a draw. Now, let me play first just once."))))
- ((eq result 'draw-agreed)
- (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
- (setq message
- (cond
- (gomoku-human-took-back
- "Draw agreed. I, for one, never take my moves back...")
- (gomoku-emacs-played-first
- "Draw agreed. You were lucky.")
- (t
- "Draw agreed. Now, let me play first just once."))))
- ((eq result 'crash-game)
- (setq message
- "Sorry, I have been interrupted and cannot resume that game...")))
-
- (gomoku-display-statistics)
- (if message (message message))
- (ding)
- (setq gomoku-game-in-progress nil)))
+ (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 (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...")
(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")
- (mouse-set-point click)
- (gomoku-human-plays))
+ (if (gomoku-click click)
+ (gomoku-human-plays)))
(defun gomoku-human-plays ()
"Signal to the Gomoku program that you have played.
;; 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)))))))))
"Ask for another game, and start it."
(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."
+ "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)))
+ (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-human-wins
- gomoku-number-of-emacs-wins
- gomoku-number-of-draws))
- (t
- (format ": Won %d, lost %d"
- gomoku-number-of-human-wins
- gomoku-number-of-emacs-wins))))
- ;; 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)))))
(provide 'gomoku)
+;;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb
;;; gomoku.el ends here