From: Richard M. Stallman Date: Fri, 22 Mar 1996 20:43:05 +0000 (+0000) Subject: Ancient leading comment removed. X-Git-Tag: emacs-19.34~1000 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f5ecf0c90362f451a86d6127366cf950c724b95b;p=emacs.git 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. --- 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 ;; 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)