Ancient leading comment removed.

(gomoku-mode-map): Added numeric keypad for 8 directions, changed
comments to lowercase (C-c rather than C-C), added SPC to play and
undo's binding to go back.
(gomoku-emacs-won, gomoku-font-lock-O-face, gomoku-font-lock-X-face)
(gomoku-font-lock-keywords):  New variables.
(gomoku-mode): Use it and make buffer read-only for user.
(gomoku-terminate-game): Remove (ding) -- maybe should be optonal.
(gomoku-init-display): Rewritten, makes fields intangible so you
can't go in between.  Make free fields have mouse-face.
(gomoku-cross-qtuple): Take account of intangible text, and that
empty lines are now really empty.
(gomoku-move-left, gomoku-move-right): Removed thanks to intangibility.
(gomoku-move-ne, -se, -nw, -sw): Use normal left / right motion.

1 files changed, 128 insertions, 100 deletions

diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index b7d6bea0ac3..48429a3110f 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,6 +1,6 @@
 ;;; gomoku.el --- Gomoku game between you and Emacs
 
-;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996 Free Software Foundation, Inc.
 
 ;; Author: Philippe Schnoebelen <phs@lifia.imag.fr>
 ;; Adapted-By: ESR
@@ -25,12 +25,6 @@
 
 ;;; 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
@@ -84,38 +78,75 @@
 (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)		; RET
   (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays)	; RET
-  (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 [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)
+
+  (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 '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)))
+
+(defvar gomoku-emacs-won ()
+  "*For making font-lock use the winner's face for the line.")
+
+(defvar gomoku-font-lock-O-face
+  (if window-system
+      (list (facemenu-get-face 'fg:red) 'bold))
+  "*Face to use for Emacs' O.")
+
+(defvar gomoku-font-lock-X-face
+  (if window-system
+      (list (facemenu-get-face 'fg:green) 'bold))
+  "*Face to use for your X.")
+
+(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)))
+  "*Font lock rules for Gomoku.")
+
+(put 'gomoku-mode 'front-sticky
+     (put 'gomoku-mode 'rear-nonsticky '(intangible)))
 
 (defun gomoku-mode ()
   "Major mode for playing Gomoku against Emacs.
@@ -128,12 +159,15 @@ You play by moving the cursor over the square you choose and hitting \\[gomoku-h
 Other useful commands:
 \\{gomoku-mode-map}
 Entry to this mode calls the value of `gomoku-mode-hook' if that value
-is non-nil."
+is non-nil.  One interesting value is `turn-on-font-lock'."
   (interactive)
   (setq major-mode 'gomoku-mode
 	mode-name "Gomoku")
   (gomoku-display-statistics)
   (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-hooks 'gomoku-mode-hook))
 
 ;;;
@@ -531,7 +565,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
@@ -650,7 +685,7 @@ that DVAL has been added on SQUARE."
 
     (gomoku-display-statistics)
     (if message (message message))
-    (ding)
+    ;;(ding)
     (setq gomoku-game-in-progress nil)))
 
 (defun gomoku-crash-game ()
@@ -728,6 +763,7 @@ Use \\[describe-mode] for more info."
 	     (gomoku-play-move square 6)
 	     (cond ((>= score gomoku-winning-threshold)
 		    (gomoku-find-filled-qtuple square 6)
+		    (setq gomoku-emacs-won t) ; for font-lock
 		    (gomoku-cross-winning-qtuple)
 		    (gomoku-terminate-game 'emacs-won))
 		   ((zerop score)
@@ -918,41 +954,44 @@ If the game is finished, this command requests for another game."
 
 (defun gomoku-put-char (char)
   "Draw CHAR on the Gomoku screen."
-  (let ((inhibit-read-only t))
-    (insert char)
+  (let ((inhibit-read-only t)
+	(inhibit-point-motion-hooks t))
+    (insert-and-inherit char)
+    (and window-system
+	 (eq char ?.)
+	 (put-text-property (1- (point)) (point) 'mouse-face 'highlight))
     (delete-char 1)
     (backward-char 1)))
 
 (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)
+	(string1 (make-string gomoku-x-offset ? ))
+	(string2 (make-string (1- gomoku-square-width) ? ))
+	(point 1)
+	(i m) j)
     (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
+    ;; We do not use gomoku-plot-square which would be too slow for
+    ;; initializing the display.
+    (newline gomoku-y-offset)
+    (while (progn
+	     (indent-to gomoku-x-offset)
+	     (setq j n)
+	     (while (progn
+		      (put-text-property point (point) 'category 'gomoku-mode)
+		      (put-text-property point (point) 'intangible (point))
+		      (setq point (point))
+		      (insert ?.)
+		      (if window-system
+			  (put-text-property point (point)
+					     'mouse-face 'highlight))
+		      (> (setq j (1- j)) 0))
+	       (insert string2))
+	     (> (setq i (1- i)) 0))
+      (insert-char ?\n gomoku-square-height))
+    (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."
@@ -1042,53 +1081,42 @@ If the game is finished, this command requests for another game."
 (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-char (1- gomoku-square-width)))
+	  ((= 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
+	       (forward-line 1)
+	       (indent-to column)
+	       (insert-and-inherit ?|))))
+	  ((= dx -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
+	   (indent-to (prog1 (current-column)
+			(forward-line (/ gomoku-square-height 2))))
+	   (insert-and-inherit ?/))
+	  (t				; 2nd Diagonal
 	   (forward-char (/ gomoku-square-width 2))
-	   (next-line (/ gomoku-square-height 2))
-	   (gomoku-put-char ?\\))))))
+	   (indent-to (prog1 (current-column)
+			(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)
@@ -1109,25 +1137,25 @@ If the game is finished, this command requests for another game."
   "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))
 
 (provide 'gomoku)