Mercurial > hg > xemacs-beta
diff lisp/games/gomoku.el @ 48:56c54cf7c5b6 r19-16b90
Import from CVS: tag r19-16b90
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:56:04 +0200 |
| parents | b82b59fe008d |
| children | 131b0175ea99 |
line wrap: on
line diff
--- a/lisp/games/gomoku.el Mon Aug 13 08:55:32 2007 +0200 +++ b/lisp/games/gomoku.el Mon Aug 13 08:56:04 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen <phs@lifia.imag.fr> -;; Adapted-By: ESR, Daniel.Pfeiffer@Informatik.START.dbp.de +;; Adapted-By: ESR ;; Keywords: games ;; This file is part of XEmacs. @@ -19,14 +19,20 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.34. +;;; Synched up with: FSF 19.30. ;;; 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 @@ -71,117 +77,66 @@ ;;; ;;; GOMOKU MODE AND KEYMAP. ;;; -(require 'facemenu) - (defvar gomoku-mode-hook nil "If non-nil, its value is called on entry to Gomoku mode.") (defvar gomoku-mode-map nil "Local keymap to use in Gomoku mode.") -(if gomoku-mode-map nil +(if gomoku-mode-map + nil (setq gomoku-mode-map (make-sparse-keymap)) (set-keymap-name gomoku-mode-map 'gomoku-mode-map) - ;; 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 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 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-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 [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 "\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 - (substitute-key-definition 'previous-line 'gomoku-move-up - gomoku-mode-map (current-global-map)) - (substitute-key-definition 'next-line 'gomoku-move-down - gomoku-mode-map (current-global-map)) - (substitute-key-definition 'beginning-of-line 'gomoku-beginning-of-line - gomoku-mode-map (current-global-map)) - (substitute-key-definition 'end-of-line 'gomoku-end-of-line - gomoku-mode-map (current-global-map)) - (substitute-key-definition 'undo 'gomoku-human-takes-back - gomoku-mode-map (current-global-map)) - (substitute-key-definition 'advertised-undo 'gomoku-human-takes-back - gomoku-mode-map (current-global-map))) - -(defvar gomoku-emacs-won () - "*For making font-lock use the winner's face for the line.") + (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 [kp-enter] 'gomoku-human-plays) + (define-key gomoku-mode-map [button2] 'gomoku-click) + (define-key gomoku-mode-map [insert] 'gomoku-human-plays)) -(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))) -(put 'gomoku-mode 'intangible 1) (defun gomoku-mode () "Major mode for playing Gomoku against Emacs. -You and Emacs play in turn by marking a free square. You mark it with X -and Emacs marks it with O. The winner is the first to get five contiguous +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 marks horizontally, vertically or in diagonal. - You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. - Other useful commands: \\{gomoku-mode-map} Entry to this mode calls the value of `gomoku-mode-hook' if that value -is non-nil. One interesting value is `turn-on-font-lock'." +is non-nil." (interactive) (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)) ;;; @@ -315,8 +270,8 @@ ;; please send me a note. Thanks. -;; 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 +;; 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 ;; we just have to set up a translation table. (defconst gomoku-score-trans-table @@ -579,8 +534,7 @@ gomoku-board-height m gomoku-vector-length (1+ (* (+ m 2) (1+ n))) gomoku-draw-limit (/ (* 7 n m) 10)) - (setq gomuku emacs-won nil - gomoku-game-history nil + (setq gomoku-game-history nil gomoku-number-of-moves 0 gomoku-number-of-human-moves 0 gomoku-emacs-played-first nil @@ -641,58 +595,66 @@ (defun gomoku-terminate-game (result) "Terminate the current game with RESULT." - (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)) + (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))) (defun gomoku-crash-game () "What to do when Emacs detects it has been interrupted." @@ -710,24 +672,19 @@ "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 +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 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]. Use \\[describe-mode] for more info." - (interactive (if current-prefix-arg - (list (prefix-numeric-value current-prefix-arg) - (eval (read-minibuffer "Height: "))))) + (interactive) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing (gomoku-crash-game)) - ((or (not gomoku-game-in-progress) - (<= gomoku-number-of-moves 2)) + ((not gomoku-game-in-progress) (let ((max-width (gomoku-max-width)) (max-height (gomoku-max-height))) (or n (setq n max-width)) @@ -739,8 +696,8 @@ ((> n max-width) (error "I cannot display %d columns in that window" n))) (if (and (> m max-height) - (not (eq m gomoku-saved-board-height)) - ;; Use EQ because SAVED-BOARD-HEIGHT may be nil + (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)))) (setq m max-height))) (message "One moment, please...") @@ -772,8 +729,8 @@ (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)) @@ -784,43 +741,11 @@ (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))) + (mouse-set-point click) + (gomoku-human-plays)) (defun gomoku-human-plays () "Signal to the Gomoku program that you have played. @@ -848,6 +773,7 @@ ;; 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))))))))) @@ -909,12 +835,13 @@ "Ask for another game, and start it." (if (y-or-n-p "Another game ") (gomoku gomoku-board-width gomoku-board-height) - (message "Chicken !"))) + (message "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 ") - (not (setq gomoku-human-refused-draw t)))) + (prog1 (setq gomoku-human-refused-draw t) + nil))) ;;; ;;; DISPLAYING THE BOARD. @@ -949,18 +876,30 @@ ;; 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." - (let ((inhibit-point-motion-hooks t)) - (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1)) - gomoku-square-height)))) + "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))) (defun gomoku-point-square () - "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)))) + "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)))) (defun gomoku-goto-square (index) "Move point to square number INDEX." @@ -968,89 +907,70 @@ (defun gomoku-goto-xy (x y) "Move point to square at X, Y coords." - (let ((inhibit-point-motion-hooks t)) - (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y))))) + (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." - (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 window-system - (zerop value) - (put-text-property (1- (point)) (point) 'mouse-face 'highlight)) + "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) (delete-char 1) - (backward-char 1)) - (sit-for 0)) ; Display NOW + (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) - (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))) + (let ((inhibit-read-only t)) (erase-buffer) - (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 ?.) - (if window-system - (put-text-property point (point) - 'mouse-face 'highlight))) - (> (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 x) (if (bobp) (forward-char))))) - (or intangible - (put-text-property point (point) 'intangible 2)) - (put-text-property point (point) 'point-entered - (lambda (x x) (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 + (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 (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 - (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)))) + (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)))) (force-mode-line-update)) (defun gomoku-switch-to-window () @@ -1058,11 +978,11 @@ (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)))) + (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)))) ;;; ;;; CROSSING WINNING QTUPLES. @@ -1073,6 +993,19 @@ ;; 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." (or (gomoku-check-filled-qtuple square value 1 0) @@ -1082,105 +1015,121 @@ (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. (let ((a 0) (b 0) (left square) (right square) - (depl (gomoku-xy-to-index dx dy))) + (depl (gomoku-xy-to-index dx dy)) + a+4) (while (and (> a -4) ; stretch tuple left (= value (aref gomoku-board (setq left (- left depl))))) (setq a (1- a))) - (while (and (< b (+ a 4)) ; stretch tuple right + (setq a+4 (+ a 4)) + (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 ? - (gomoku-cross-qtuple (+ square (* a depl)) (+ square (* b depl)) - dx dy) + (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) 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)) - (inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (let ((depl (gomoku-xy-to-index dx dy))) ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 - (while (/= square1 square2) + (while (not (= square1 square2)) (gomoku-goto-square square1) (setq square1 (+ square1 depl)) (cond - ((= 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))) + ((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)) (while (< n gomoku-square-height) (setq n (1+ n)) - (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 ?\\)))))) + (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 ?\\)))))) (sit-for 0)) ; Display NOW ;;; ;;; CURSOR MOTION. ;;; -;; previous-line and next-line don't work right with intangible newlines +(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))))) + (defun gomoku-move-down () "Move point down one row on the Gomoku board." (interactive) - (if (< (gomoku-point-y) gomoku-board-height) - (next-line gomoku-square-height))) + (let ((y (gomoku-point-y))) + (next-line (cond ((null y) 1) + ((< y gomoku-board-height) gomoku-square-height) + (t 0))))) (defun gomoku-move-up () "Move point up one row on the Gomoku board." (interactive) - (if (> (gomoku-point-y) 1) - (previous-line gomoku-square-height))) + (let ((y (gomoku-point-y))) + (previous-line (cond ((null y) 1) + ((> y 1) gomoku-square-height) + (t 0))))) (defun gomoku-move-ne () "Move point North East on the Gomoku board." (interactive) (gomoku-move-up) - (forward-char)) + (gomoku-move-right)) (defun gomoku-move-se () "Move point South East on the Gomoku board." (interactive) (gomoku-move-down) - (forward-char)) + (gomoku-move-right)) (defun gomoku-move-nw () "Move point North West on the Gomoku board." (interactive) (gomoku-move-up) - (backward-char)) + (gomoku-move-left)) (defun gomoku-move-sw () "Move point South West on the Gomoku board." (interactive) (gomoku-move-down) - (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))))) + (gomoku-move-left)) (provide 'gomoku)