X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8f1204db34c0e8380f1eb81c9202520511744be3..c4f592c47f236d2493b86760d11fb38ffd3275d6:/lisp/play/gomoku.el

diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 18c0b1173d..8c04f254a0 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,9 +1,11 @@
 ;;; 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.
@@ -19,20 +21,15 @@
 ;; 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).
@@ -40,8 +37,8 @@
 ;; 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
@@ -71,11 +68,41 @@
 
 ;;; Code:
 
+(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.")
@@ -83,37 +110,79 @@
 (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.
@@ -128,20 +197,24 @@ Other useful commands:
 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))
 
 ;;;
 ;;; 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
@@ -157,7 +230,7 @@ is non-nil."
   "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.
@@ -177,7 +250,7 @@ is non-nil."
   (/ 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)))
@@ -265,8 +338,8 @@ is non-nil."
 ;; 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
@@ -529,7 +602,8 @@ that DVAL has been added on SQUARE."
 	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
@@ -578,11 +652,11 @@ that DVAL has been added on SQUARE."
 ;;; 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.")
@@ -590,66 +664,58 @@ that DVAL has been added on SQUARE."
 
 (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."
@@ -665,8 +731,10 @@ that DVAL has been added on SQUARE."
 ;;;###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
@@ -674,13 +742,30 @@ marks horizontally, vertically or in diagonal.
 
 You play by moving the cursor over the square you choose and hitting
 \\<gomoku-mode-map>\\[gomoku-human-plays].
+
+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))
@@ -692,16 +777,16 @@ Use \\[describe-mode] for more info."
 	    ((> 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))))
@@ -725,8 +810,8 @@ Use \\[describe-mode] for more info."
 	     (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))
@@ -737,6 +822,44 @@ Use \\[describe-mode] for more info."
 		   (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.
@@ -752,9 +875,9 @@ If the game is finished, this command requests for another game."
     (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)
@@ -763,7 +886,6 @@ If the game is finished, this command requests for another game."
 			 ;; 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)))))))))
@@ -780,7 +902,7 @@ If the game is finished, this command requests for another game."
     (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
@@ -801,9 +923,9 @@ If the game is finished, this command requests for another game."
     (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
@@ -815,44 +937,27 @@ If the game is finished, this command requests for another game."
 (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))))
 
 ;;;
 ;;; 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))
@@ -866,30 +971,18 @@ If the game is finished, this command requests for another game."
 	 ;; 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."
@@ -897,90 +990,102 @@ If the game is finished, this command requests for another game."
 
 (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)))
 
 ;;;
 ;;; CROSSING WINNING QTUPLES.
@@ -991,144 +1096,122 @@ If the game is finished, this command requests for another game."
 ;; 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
 
 ;;;
 ;;; 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