Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
47:11c6df210d7f | 48:56c54cf7c5b6 |
---|---|
1 ;;; gomoku.el --- Gomoku game between you and Emacs | 1 ;;; gomoku.el --- Gomoku game between you and Emacs |
2 | 2 |
3 ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Philippe Schnoebelen <phs@lifia.imag.fr> | 5 ;; Author: Philippe Schnoebelen <phs@lifia.imag.fr> |
6 ;; Adapted-By: ESR, Daniel.Pfeiffer@Informatik.START.dbp.de | 6 ;; Adapted-By: ESR |
7 ;; Keywords: games | 7 ;; Keywords: games |
8 | 8 |
9 ;; This file is part of XEmacs. | 9 ;; This file is part of XEmacs. |
10 | 10 |
11 ;; XEmacs is free software; you can redistribute it and/or modify it | 11 ;; XEmacs is free software; you can redistribute it and/or modify it |
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 ;; General Public License for more details. | 19 ;; General Public License for more details. |
20 | 20 |
21 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free | 22 ;; along with XEmacs; see the file COPYING. If not, write to the |
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
24 ;; 02111-1307, USA. | 24 ;; Boston, MA 02111-1307, USA. |
25 | 25 |
26 ;;; Synched up with: FSF 19.34. | 26 ;;; Synched up with: FSF 19.30. |
27 | 27 |
28 ;;; Commentary: | 28 ;;; Commentary: |
29 | |
30 ;;; Gomoku game between you and GNU Emacs. Last modified on 13 Sep 1988 | |
31 ;;; | |
32 ;;; Written by Ph. Schnoebelen (phs@lifia.imag.fr), 1987, 1988 | |
33 ;;; with precious advices from J.-F. Rit. | |
34 ;;; This has been tested with GNU Emacs 18.50. | |
29 | 35 |
30 ;; RULES: | 36 ;; RULES: |
31 ;; | 37 ;; |
32 ;; Gomoku is a game played between two players on a rectangular board. Each | 38 ;; Gomoku is a game played between two players on a rectangular board. Each |
33 ;; player, in turn, marks a free square of its choice. The winner is the first | 39 ;; player, in turn, marks a free square of its choice. The winner is the first |
69 ;;; Code: | 75 ;;; Code: |
70 | 76 |
71 ;;; | 77 ;;; |
72 ;;; GOMOKU MODE AND KEYMAP. | 78 ;;; GOMOKU MODE AND KEYMAP. |
73 ;;; | 79 ;;; |
74 (require 'facemenu) | |
75 | |
76 (defvar gomoku-mode-hook nil | 80 (defvar gomoku-mode-hook nil |
77 "If non-nil, its value is called on entry to Gomoku mode.") | 81 "If non-nil, its value is called on entry to Gomoku mode.") |
78 | 82 |
79 (defvar gomoku-mode-map nil | 83 (defvar gomoku-mode-map nil |
80 "Local keymap to use in Gomoku mode.") | 84 "Local keymap to use in Gomoku mode.") |
81 | 85 |
82 (if gomoku-mode-map nil | 86 (if gomoku-mode-map |
87 nil | |
83 (setq gomoku-mode-map (make-sparse-keymap)) | 88 (setq gomoku-mode-map (make-sparse-keymap)) |
84 (set-keymap-name gomoku-mode-map 'gomoku-mode-map) | 89 (set-keymap-name gomoku-mode-map 'gomoku-mode-map) |
85 | 90 |
86 ;; Key bindings for cursor motion. | 91 ;; Key bindings for cursor motion. Arrow keys are just "function" |
87 (define-key gomoku-mode-map "y" 'gomoku-move-nw) ; y | 92 ;; keys, see below. |
88 (define-key gomoku-mode-map "u" 'gomoku-move-ne) ; u | 93 (define-key gomoku-mode-map "y" 'gomoku-move-nw) ; Y |
89 (define-key gomoku-mode-map "b" 'gomoku-move-sw) ; b | 94 (define-key gomoku-mode-map "u" 'gomoku-move-ne) ; U |
90 (define-key gomoku-mode-map "n" 'gomoku-move-se) ; n | 95 (define-key gomoku-mode-map "b" 'gomoku-move-sw) ; B |
91 (define-key gomoku-mode-map "h" 'backward-char) ; h | 96 (define-key gomoku-mode-map "n" 'gomoku-move-se) ; N |
92 (define-key gomoku-mode-map "l" 'forward-char) ; l | 97 (define-key gomoku-mode-map "h" 'gomoku-move-left) ; H |
93 (define-key gomoku-mode-map "j" 'gomoku-move-down) ; j | 98 (define-key gomoku-mode-map "l" 'gomoku-move-right) ; L |
94 (define-key gomoku-mode-map "k" 'gomoku-move-up) ; k | 99 (define-key gomoku-mode-map "j" 'gomoku-move-down) ; J |
95 | 100 (define-key gomoku-mode-map "k" 'gomoku-move-up) ; K |
96 (define-key gomoku-mode-map [kp-7] 'gomoku-move-nw) | 101 (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-N |
97 (define-key gomoku-mode-map [kp-9] 'gomoku-move-ne) | 102 (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-P |
98 (define-key gomoku-mode-map [kp-1] 'gomoku-move-sw) | 103 (define-key gomoku-mode-map "\C-f" 'gomoku-move-right) ; C-F |
99 (define-key gomoku-mode-map [kp-3] 'gomoku-move-se) | 104 (define-key gomoku-mode-map "\C-b" 'gomoku-move-left) ; C-B |
100 (define-key gomoku-mode-map [kp-4] 'backward-char) | |
101 (define-key gomoku-mode-map [kp-6] 'forward-char) | |
102 (define-key gomoku-mode-map [kp-2] 'gomoku-move-down) | |
103 (define-key gomoku-mode-map [kp-8] 'gomoku-move-up) | |
104 | |
105 (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-n | |
106 (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-p | |
107 | 105 |
108 ;; Key bindings for entering Human moves. | 106 ;; Key bindings for entering Human moves. |
107 ;; If you have a mouse, you may also bind some mouse click ... | |
109 (define-key gomoku-mode-map "X" 'gomoku-human-plays) ; X | 108 (define-key gomoku-mode-map "X" 'gomoku-human-plays) ; X |
110 (define-key gomoku-mode-map "x" 'gomoku-human-plays) ; x | 109 (define-key gomoku-mode-map "x" 'gomoku-human-plays) ; x |
111 (define-key gomoku-mode-map " " 'gomoku-human-plays) ; SPC | |
112 (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET | 110 (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET |
113 (define-key gomoku-mode-map "\C-c\C-p" 'gomoku-human-plays) ; C-c C-p | 111 (define-key gomoku-mode-map "\C-c\C-p" 'gomoku-human-plays) ; C-C C-P |
114 (define-key gomoku-mode-map "\C-c\C-b" 'gomoku-human-takes-back) ; C-c C-b | 112 (define-key gomoku-mode-map "\C-c\C-b" 'gomoku-human-takes-back) ; C-C C-B |
115 (define-key gomoku-mode-map "\C-c\C-r" 'gomoku-human-resigns) ; C-c C-r | 113 (define-key gomoku-mode-map "\C-c\C-r" 'gomoku-human-resigns) ; C-C C-R |
116 (define-key gomoku-mode-map "\C-c\C-e" 'gomoku-emacs-plays) ; C-c C-e | 114 (define-key gomoku-mode-map "\C-c\C-e" 'gomoku-emacs-plays) ; C-C C-E |
117 | 115 |
116 (define-key gomoku-mode-map [up] 'gomoku-move-up) | |
117 (define-key gomoku-mode-map [down] 'gomoku-move-down) | |
118 (define-key gomoku-mode-map [left] 'gomoku-move-left) | |
119 (define-key gomoku-mode-map [right] 'gomoku-move-right) | |
118 (define-key gomoku-mode-map [kp-enter] 'gomoku-human-plays) | 120 (define-key gomoku-mode-map [kp-enter] 'gomoku-human-plays) |
119 (define-key gomoku-mode-map [insert] 'gomoku-human-plays) | 121 (define-key gomoku-mode-map [button2] 'gomoku-click) |
120 (define-key gomoku-mode-map [down-mouse-1] 'gomoku-click) | 122 (define-key gomoku-mode-map [insert] 'gomoku-human-plays)) |
121 (define-key gomoku-mode-map [drag-mouse-1] 'gomoku-click) | 123 |
122 (define-key gomoku-mode-map [mouse-1] 'gomoku-click) | |
123 (define-key gomoku-mode-map [down-mouse-2] 'gomoku-click) | |
124 (define-key gomoku-mode-map [mouse-2] 'gomoku-mouse-play) | |
125 (define-key gomoku-mode-map [drag-mouse-2] 'gomoku-mouse-play) | |
126 | |
127 (substitute-key-definition 'previous-line 'gomoku-move-up | |
128 gomoku-mode-map (current-global-map)) | |
129 (substitute-key-definition 'next-line 'gomoku-move-down | |
130 gomoku-mode-map (current-global-map)) | |
131 (substitute-key-definition 'beginning-of-line 'gomoku-beginning-of-line | |
132 gomoku-mode-map (current-global-map)) | |
133 (substitute-key-definition 'end-of-line 'gomoku-end-of-line | |
134 gomoku-mode-map (current-global-map)) | |
135 (substitute-key-definition 'undo 'gomoku-human-takes-back | |
136 gomoku-mode-map (current-global-map)) | |
137 (substitute-key-definition 'advertised-undo 'gomoku-human-takes-back | |
138 gomoku-mode-map (current-global-map))) | |
139 | |
140 (defvar gomoku-emacs-won () | |
141 "*For making font-lock use the winner's face for the line.") | |
142 | |
143 (defvar gomoku-font-lock-O-face | |
144 (if window-system | |
145 (list (facemenu-get-face 'fg:red) 'bold)) | |
146 "*Face to use for Emacs' O.") | |
147 | |
148 (defvar gomoku-font-lock-X-face | |
149 (if window-system | |
150 (list (facemenu-get-face 'fg:green) 'bold)) | |
151 "*Face to use for your X.") | |
152 | |
153 (defvar gomoku-font-lock-keywords | |
154 '(("O" . gomoku-font-lock-O-face) | |
155 ("X" . gomoku-font-lock-X-face) | |
156 ("[-|/\\]" 0 (if gomoku-emacs-won | |
157 gomoku-font-lock-O-face | |
158 gomoku-font-lock-X-face))) | |
159 "*Font lock rules for Gomoku.") | |
160 | |
161 (put 'gomoku-mode 'front-sticky | |
162 (put 'gomoku-mode 'rear-nonsticky '(intangible))) | |
163 (put 'gomoku-mode 'intangible 1) | |
164 | 124 |
165 (defun gomoku-mode () | 125 (defun gomoku-mode () |
166 "Major mode for playing Gomoku against Emacs. | 126 "Major mode for playing Gomoku against Emacs. |
167 You and Emacs play in turn by marking a free square. You mark it with X | 127 You and Emacs play in turn by marking a free square. You mark it with X |
168 and Emacs marks it with O. The winner is the first to get five contiguous | 128 and Emacs marks it with O. The winner is the first to get five contiguous |
169 marks horizontally, vertically or in diagonal. | 129 marks horizontally, vertically or in diagonal. |
170 | |
171 You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. | 130 You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. |
172 | |
173 Other useful commands: | 131 Other useful commands: |
174 \\{gomoku-mode-map} | 132 \\{gomoku-mode-map} |
175 Entry to this mode calls the value of `gomoku-mode-hook' if that value | 133 Entry to this mode calls the value of `gomoku-mode-hook' if that value |
176 is non-nil. One interesting value is `turn-on-font-lock'." | 134 is non-nil." |
177 (interactive) | 135 (interactive) |
178 (setq major-mode 'gomoku-mode | 136 (setq major-mode 'gomoku-mode |
179 mode-name "Gomoku") | 137 mode-name "Gomoku") |
180 (gomoku-display-statistics) | 138 (gomoku-display-statistics) |
181 (use-local-map gomoku-mode-map) | 139 (use-local-map gomoku-mode-map) |
182 (make-local-variable 'font-lock-defaults) | |
183 (setq font-lock-defaults '(gomoku-font-lock-keywords t)) | |
184 (toggle-read-only t) | |
185 (run-hooks 'gomoku-mode-hook)) | 140 (run-hooks 'gomoku-mode-hook)) |
186 | 141 |
187 ;;; | 142 ;;; |
188 ;;; THE BOARD. | 143 ;;; THE BOARD. |
189 ;;; | 144 ;;; |
313 ;; conditions are required to obtain sensible moves, but the previous example | 268 ;; conditions are required to obtain sensible moves, but the previous example |
314 ;; should illustrate the point. If you manage to improve on these values, | 269 ;; should illustrate the point. If you manage to improve on these values, |
315 ;; please send me a note. Thanks. | 270 ;; please send me a note. Thanks. |
316 | 271 |
317 | 272 |
318 ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the | 273 ;; As we choosed values 0, 1 and 6 to denote empty, X and O squares, the |
319 ;; contents of a qtuple are uniquely determined by the sum of its elements and | 274 ;; contents of a qtuple is uniquely determined by the sum of its elements and |
320 ;; we just have to set up a translation table. | 275 ;; we just have to set up a translation table. |
321 | 276 |
322 (defconst gomoku-score-trans-table | 277 (defconst gomoku-score-trans-table |
323 (vector nil-score Xscore XXscore XXXscore XXXXscore 0 | 278 (vector nil-score Xscore XXscore XXXscore XXXXscore 0 |
324 Oscore 0 0 0 0 0 | 279 Oscore 0 0 0 0 0 |
577 (setq gomoku-game-in-progress t) | 532 (setq gomoku-game-in-progress t) |
578 (setq gomoku-board-width n | 533 (setq gomoku-board-width n |
579 gomoku-board-height m | 534 gomoku-board-height m |
580 gomoku-vector-length (1+ (* (+ m 2) (1+ n))) | 535 gomoku-vector-length (1+ (* (+ m 2) (1+ n))) |
581 gomoku-draw-limit (/ (* 7 n m) 10)) | 536 gomoku-draw-limit (/ (* 7 n m) 10)) |
582 (setq gomuku emacs-won nil | 537 (setq gomoku-game-history nil |
583 gomoku-game-history nil | |
584 gomoku-number-of-moves 0 | 538 gomoku-number-of-moves 0 |
585 gomoku-number-of-human-moves 0 | 539 gomoku-number-of-human-moves 0 |
586 gomoku-emacs-played-first nil | 540 gomoku-emacs-played-first nil |
587 gomoku-human-took-back nil | 541 gomoku-human-took-back nil |
588 gomoku-human-refused-draw nil) | 542 gomoku-human-refused-draw nil) |
639 "Number of games already drawn in this session.") | 593 "Number of games already drawn in this session.") |
640 | 594 |
641 | 595 |
642 (defun gomoku-terminate-game (result) | 596 (defun gomoku-terminate-game (result) |
643 "Terminate the current game with RESULT." | 597 "Terminate the current game with RESULT." |
644 (message | 598 (let (message) |
645 (cond | 599 (cond |
646 ((eq result 'emacs-won) | 600 ((eq result 'emacs-won) |
647 (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) | 601 (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) |
648 (cond ((< gomoku-number-of-moves 20) | 602 (setq message |
649 "This was a REALLY QUICK win.") | 603 (cond ((< gomoku-number-of-moves 20) |
650 (gomoku-human-refused-draw | 604 "This was a REALLY QUICK win.") |
651 "I won... Too bad you refused my offer of a draw !") | 605 (gomoku-human-refused-draw |
652 (gomoku-human-took-back | 606 "I won... Too bad you refused my offer of a draw !") |
653 "I won... Taking moves back will not help you !") | 607 (gomoku-human-took-back |
654 ((not gomoku-emacs-played-first) | 608 "I won... Taking moves back will not help you !") |
655 "I won... Playing first did not help you much !") | 609 ((not gomoku-emacs-played-first) |
656 ((and (zerop gomoku-number-of-human-wins) | 610 "I won... Playing first did not help you much !") |
657 (zerop gomoku-number-of-draws) | 611 ((and (zerop gomoku-number-of-human-wins) |
658 (> gomoku-number-of-emacs-wins 1)) | 612 (zerop gomoku-number-of-draws) |
659 "I'm becoming tired of winning...") | 613 (> gomoku-number-of-emacs-wins 1)) |
660 ("I won."))) | 614 "I'm becoming tired of winning...") |
661 ((eq result 'human-won) | 615 (t |
662 (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins)) | 616 "I won.")))) |
663 (concat "OK, you won this one." | 617 ((eq result 'human-won) |
664 (cond | 618 (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins)) |
665 (gomoku-human-took-back | 619 (setq message |
666 " I, for one, never take my moves back...") | 620 (cond |
667 (gomoku-emacs-played-first | 621 (gomoku-human-took-back |
668 ".. so what ?") | 622 "OK, you won this one. I, for one, never take my moves back...") |
669 (" Now, let me play first just once.")))) | 623 (gomoku-emacs-played-first |
670 ((eq result 'human-resigned) | 624 "OK, you won this one... so what ?") |
671 (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) | 625 (t |
672 "So you resign. That's just one more win for me.") | 626 "OK, you won this one. Now, let me play first just once.")))) |
673 ((eq result 'nobody-won) | 627 ((eq result 'human-resigned) |
674 (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) | 628 (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) |
675 (concat "This is a draw. " | 629 (setq message "So you resign. That's just one more win for me.")) |
676 (cond | 630 ((eq result 'nobody-won) |
677 (gomoku-human-took-back | 631 (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) |
678 "I, for one, never take my moves back...") | 632 (setq message |
679 (gomoku-emacs-played-first | 633 (cond |
680 "Just chance, I guess.") | 634 (gomoku-human-took-back |
681 ("Now, let me play first just once.")))) | 635 "This is a draw. I, for one, never take my moves back...") |
682 ((eq result 'draw-agreed) | 636 (gomoku-emacs-played-first |
683 (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) | 637 "This is a draw. Just chance, I guess.") |
684 (concat "Draw agreed. " | 638 (t |
685 (cond | 639 "This is a draw. Now, let me play first just once.")))) |
686 (gomoku-human-took-back | 640 ((eq result 'draw-agreed) |
687 "I, for one, never take my moves back...") | 641 (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) |
688 (gomoku-emacs-played-first | 642 (setq message |
689 "You were lucky.") | 643 (cond |
690 ("Now, let me play first just once.")))) | 644 (gomoku-human-took-back |
691 ((eq result 'crash-game) | 645 "Draw agreed. I, for one, never take my moves back...") |
692 "Sorry, I have been interrupted and cannot resume that game..."))) | 646 (gomoku-emacs-played-first |
693 (gomoku-display-statistics) | 647 "Draw agreed. You were lucky.") |
694 ;;(ding) | 648 (t |
695 (setq gomoku-game-in-progress nil)) | 649 "Draw agreed. Now, let me play first just once.")))) |
650 ((eq result 'crash-game) | |
651 (setq message | |
652 "Sorry, I have been interrupted and cannot resume that game..."))) | |
653 | |
654 (gomoku-display-statistics) | |
655 (if message (message message)) | |
656 (ding) | |
657 (setq gomoku-game-in-progress nil))) | |
696 | 658 |
697 (defun gomoku-crash-game () | 659 (defun gomoku-crash-game () |
698 "What to do when Emacs detects it has been interrupted." | 660 "What to do when Emacs detects it has been interrupted." |
699 (setq gomoku-emacs-is-computing nil) | 661 (setq gomoku-emacs-is-computing nil) |
700 (gomoku-terminate-game 'crash-game) | 662 (gomoku-terminate-game 'crash-game) |
708 ;;;###autoload | 670 ;;;###autoload |
709 (defun gomoku (&optional n m) | 671 (defun gomoku (&optional n m) |
710 "Start a Gomoku game between you and Emacs. | 672 "Start a Gomoku game between you and Emacs. |
711 If a game is in progress, this command allow you to resume it. | 673 If a game is in progress, this command allow you to resume it. |
712 If optional arguments N and M are given, an N by M board is used. | 674 If optional arguments N and M are given, an N by M board is used. |
713 If prefix arg is given for N, M is prompted for. | 675 |
714 | 676 You and Emacs play in turn by marking a free square. You mark it with X |
715 You and Emacs play in turn by marking a free square. You mark it with X | |
716 and Emacs marks it with O. The winner is the first to get five contiguous | 677 and Emacs marks it with O. The winner is the first to get five contiguous |
717 marks horizontally, vertically or in diagonal. | 678 marks horizontally, vertically or in diagonal. |
718 | |
719 You play by moving the cursor over the square you choose and hitting | 679 You play by moving the cursor over the square you choose and hitting |
720 \\<gomoku-mode-map>\\[gomoku-human-plays]. | 680 \\<gomoku-mode-map>\\[gomoku-human-plays]. |
721 Use \\[describe-mode] for more info." | 681 Use \\[describe-mode] for more info." |
722 (interactive (if current-prefix-arg | 682 (interactive) |
723 (list (prefix-numeric-value current-prefix-arg) | |
724 (eval (read-minibuffer "Height: "))))) | |
725 (gomoku-switch-to-window) | 683 (gomoku-switch-to-window) |
726 (cond | 684 (cond |
727 (gomoku-emacs-is-computing | 685 (gomoku-emacs-is-computing |
728 (gomoku-crash-game)) | 686 (gomoku-crash-game)) |
729 ((or (not gomoku-game-in-progress) | 687 ((not gomoku-game-in-progress) |
730 (<= gomoku-number-of-moves 2)) | |
731 (let ((max-width (gomoku-max-width)) | 688 (let ((max-width (gomoku-max-width)) |
732 (max-height (gomoku-max-height))) | 689 (max-height (gomoku-max-height))) |
733 (or n (setq n max-width)) | 690 (or n (setq n max-width)) |
734 (or m (setq m max-height)) | 691 (or m (setq m max-height)) |
735 (cond ((< n 1) | 692 (cond ((< n 1) |
737 ((< m 1) | 694 ((< m 1) |
738 (error "I need at least 1 row")) | 695 (error "I need at least 1 row")) |
739 ((> n max-width) | 696 ((> n max-width) |
740 (error "I cannot display %d columns in that window" n))) | 697 (error "I cannot display %d columns in that window" n))) |
741 (if (and (> m max-height) | 698 (if (and (> m max-height) |
742 (not (eq m gomoku-saved-board-height)) | 699 (not (equal m gomoku-saved-board-height)) |
743 ;; Use EQ because SAVED-BOARD-HEIGHT may be nil | 700 ;; Use EQUAL because SAVED-BOARD-HEIGHT may be nil |
744 (not (y-or-n-p (format "Do you really want %d rows " m)))) | 701 (not (y-or-n-p (format "Do you really want %d rows " m)))) |
745 (setq m max-height))) | 702 (setq m max-height))) |
746 (message "One moment, please...") | 703 (message "One moment, please...") |
747 (gomoku-start-game n m) | 704 (gomoku-start-game n m) |
748 (if (y-or-n-p "Do you allow me to play first ") | 705 (if (y-or-n-p "Do you allow me to play first ") |
770 (gomoku-terminate-game 'nobody-won)) | 727 (gomoku-terminate-game 'nobody-won)) |
771 (t | 728 (t |
772 (setq score (aref gomoku-score-table square)) | 729 (setq score (aref gomoku-score-table square)) |
773 (gomoku-play-move square 6) | 730 (gomoku-play-move square 6) |
774 (cond ((>= score gomoku-winning-threshold) | 731 (cond ((>= score gomoku-winning-threshold) |
775 (setq gomoku-emacs-won t) ; for font-lock | |
776 (gomoku-find-filled-qtuple square 6) | 732 (gomoku-find-filled-qtuple square 6) |
733 (gomoku-cross-winning-qtuple) | |
777 (gomoku-terminate-game 'emacs-won)) | 734 (gomoku-terminate-game 'emacs-won)) |
778 ((zerop score) | 735 ((zerop score) |
779 (gomoku-terminate-game 'nobody-won)) | 736 (gomoku-terminate-game 'nobody-won)) |
780 ((and (> gomoku-number-of-moves gomoku-draw-limit) | 737 ((and (> gomoku-number-of-moves gomoku-draw-limit) |
781 (not gomoku-human-refused-draw) | 738 (not gomoku-human-refused-draw) |
782 (gomoku-offer-a-draw)) | 739 (gomoku-offer-a-draw)) |
783 (gomoku-terminate-game 'draw-agreed)) | 740 (gomoku-terminate-game 'draw-agreed)) |
784 (t | 741 (t |
785 (gomoku-prompt-for-move))))))))) | 742 (gomoku-prompt-for-move))))))))) |
786 | 743 |
787 ;; For small square dimensions this is approximate, since though measured in | |
788 ;; pixels, event's (X . Y) is a character's top-left corner. | |
789 (defun gomoku-click (click) | 744 (defun gomoku-click (click) |
790 "Position at the square where you click." | |
791 (interactive "e") | |
792 (and (windowp (posn-window (setq click (event-end click)))) | |
793 (numberp (posn-point click)) | |
794 (select-window (posn-window click)) | |
795 (setq click (posn-col-row click)) | |
796 (gomoku-goto-xy | |
797 (min (max (/ (+ (- (car click) | |
798 gomoku-x-offset | |
799 1) | |
800 (window-hscroll) | |
801 gomoku-square-width | |
802 (% gomoku-square-width 2) | |
803 (/ gomoku-square-width 2)) | |
804 gomoku-square-width) | |
805 1) | |
806 gomoku-board-width) | |
807 (min (max (/ (+ (- (cdr click) | |
808 gomoku-y-offset | |
809 1) | |
810 (let ((inhibit-point-motion-hooks t)) | |
811 (count-lines 1 (window-start))) | |
812 gomoku-square-height | |
813 (% gomoku-square-height 2) | |
814 (/ gomoku-square-height 2)) | |
815 gomoku-square-height) | |
816 1) | |
817 gomoku-board-height)))) | |
818 | |
819 (defun gomoku-mouse-play (click) | |
820 "Play at the square where you click." | 745 "Play at the square where you click." |
821 (interactive "e") | 746 (interactive "e") |
822 (if (gomoku-click click) | 747 (mouse-set-point click) |
823 (gomoku-human-plays))) | 748 (gomoku-human-plays)) |
824 | 749 |
825 (defun gomoku-human-plays () | 750 (defun gomoku-human-plays () |
826 "Signal to the Gomoku program that you have played. | 751 "Signal to the Gomoku program that you have played. |
827 You must have put the cursor on the square where you want to play. | 752 You must have put the cursor on the square where you want to play. |
828 If the game is finished, this command requests for another game." | 753 If the game is finished, this command requests for another game." |
846 (cond ((and (>= score gomoku-loosing-threshold) | 771 (cond ((and (>= score gomoku-loosing-threshold) |
847 ;; Just testing SCORE > THRESHOLD is not enough for | 772 ;; Just testing SCORE > THRESHOLD is not enough for |
848 ;; detecting wins, it just gives an indication that | 773 ;; detecting wins, it just gives an indication that |
849 ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE. | 774 ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE. |
850 (gomoku-find-filled-qtuple square 1)) | 775 (gomoku-find-filled-qtuple square 1)) |
776 (gomoku-cross-winning-qtuple) | |
851 (gomoku-terminate-game 'human-won)) | 777 (gomoku-terminate-game 'human-won)) |
852 (t | 778 (t |
853 (gomoku-emacs-plays))))))))) | 779 (gomoku-emacs-plays))))))))) |
854 | 780 |
855 (defun gomoku-human-takes-back () | 781 (defun gomoku-human-takes-back () |
907 | 833 |
908 (defun gomoku-prompt-for-other-game () | 834 (defun gomoku-prompt-for-other-game () |
909 "Ask for another game, and start it." | 835 "Ask for another game, and start it." |
910 (if (y-or-n-p "Another game ") | 836 (if (y-or-n-p "Another game ") |
911 (gomoku gomoku-board-width gomoku-board-height) | 837 (gomoku gomoku-board-width gomoku-board-height) |
912 (message "Chicken !"))) | 838 (message "Chicken !"))) |
913 | 839 |
914 (defun gomoku-offer-a-draw () | 840 (defun gomoku-offer-a-draw () |
915 "Offer a draw and return T if Human accepted it." | 841 "Offer a draw and return T if Human accepted it." |
916 (or (y-or-n-p "I offer you a draw. Do you accept it ") | 842 (or (y-or-n-p "I offer you a draw. Do you accept it ") |
917 (not (setq gomoku-human-refused-draw t)))) | 843 (prog1 (setq gomoku-human-refused-draw t) |
844 nil))) | |
918 | 845 |
919 ;;; | 846 ;;; |
920 ;;; DISPLAYING THE BOARD. | 847 ;;; DISPLAYING THE BOARD. |
921 ;;; | 848 ;;; |
922 | 849 |
947 (1+ (/ (- (window-height (selected-window)) | 874 (1+ (/ (- (window-height (selected-window)) |
948 gomoku-y-offset gomoku-y-offset 2) | 875 gomoku-y-offset gomoku-y-offset 2) |
949 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! | 876 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! |
950 gomoku-square-height))) | 877 gomoku-square-height))) |
951 | 878 |
879 (defun gomoku-point-x () | |
880 "Return the board column where point is, or nil if it is not a board column." | |
881 (let ((col (- (current-column) gomoku-x-offset))) | |
882 (if (and (>= col 0) | |
883 (zerop (% col gomoku-square-width)) | |
884 (<= (setq col (1+ (/ col gomoku-square-width))) | |
885 gomoku-board-width)) | |
886 col))) | |
887 | |
952 (defun gomoku-point-y () | 888 (defun gomoku-point-y () |
953 "Return the board row where point is." | 889 "Return the board row where point is, or nil if it is not a board row." |
954 (let ((inhibit-point-motion-hooks t)) | 890 (let ((row (- (count-lines 1 (point)) gomoku-y-offset 1))) |
955 (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1)) | 891 (if (and (>= row 0) |
956 gomoku-square-height)))) | 892 (zerop (% row gomoku-square-height)) |
893 (<= (setq row (1+ (/ row gomoku-square-height))) | |
894 gomoku-board-height)) | |
895 row))) | |
957 | 896 |
958 (defun gomoku-point-square () | 897 (defun gomoku-point-square () |
959 "Return the index of the square point is on." | 898 "Return the index of the square point is on, or nil if not on the board." |
960 (let ((inhibit-point-motion-hooks t)) | 899 (let (x y) |
961 (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset) | 900 (and (setq x (gomoku-point-x)) |
962 gomoku-square-width)) | 901 (setq y (gomoku-point-y)) |
963 (gomoku-point-y)))) | 902 (gomoku-xy-to-index x y)))) |
964 | 903 |
965 (defun gomoku-goto-square (index) | 904 (defun gomoku-goto-square (index) |
966 "Move point to square number INDEX." | 905 "Move point to square number INDEX." |
967 (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index))) | 906 (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index))) |
968 | 907 |
969 (defun gomoku-goto-xy (x y) | 908 (defun gomoku-goto-xy (x y) |
970 "Move point to square at X, Y coords." | 909 "Move point to square at X, Y coords." |
971 (let ((inhibit-point-motion-hooks t)) | 910 (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y)))) |
972 (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y))))) | |
973 (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) | 911 (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) |
974 | 912 |
975 (defun gomoku-plot-square (square value) | 913 (defun gomoku-plot-square (square value) |
976 "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." | 914 "Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there." |
977 (or (= value 1) | 915 (gomoku-goto-square square) |
978 (gomoku-goto-square square)) | 916 (gomoku-put-char (cond ((= value 1) ?X) |
979 (let ((inhibit-read-only t) | 917 ((= value 6) ?O) |
980 (inhibit-point-motion-hooks t)) | 918 (t ?.))) |
981 (insert-and-inherit (cond ((= value 1) ?X) | 919 (sit-for 0)) ; Display NOW |
982 ((= value 6) ?O) | 920 |
983 (?.))) | 921 (defun gomoku-put-char (char) |
984 (and window-system | 922 "Draw CHAR on the Gomoku screen." |
985 (zerop value) | 923 (let ((inhibit-read-only t)) |
986 (put-text-property (1- (point)) (point) 'mouse-face 'highlight)) | 924 (insert char) |
987 (delete-char 1) | 925 (delete-char 1) |
988 (backward-char 1)) | 926 (backward-char 1))) |
989 (sit-for 0)) ; Display NOW | |
990 | 927 |
991 (defun gomoku-init-display (n m) | 928 (defun gomoku-init-display (n m) |
992 "Display an N by M Gomoku board." | 929 "Display an N by M Gomoku board." |
993 (buffer-disable-undo (current-buffer)) | 930 (buffer-disable-undo (current-buffer)) |
994 (let ((inhibit-read-only t) | 931 (let ((inhibit-read-only t)) |
995 (point 1) opoint | |
996 (intangible t) | |
997 (i m) j x) | |
998 ;; Try to minimize number of chars (because of text properties) | |
999 (setq tab-width | |
1000 (if (zerop (% gomoku-x-offset gomoku-square-width)) | |
1001 gomoku-square-width | |
1002 (max (/ (+ (% gomoku-x-offset gomoku-square-width) | |
1003 gomoku-square-width 1) 2) 2))) | |
1004 (erase-buffer) | 932 (erase-buffer) |
1005 (newline gomoku-y-offset) | 933 (let (string1 string2 string3 string4) |
1006 (while (progn | 934 ;; We do not use gomoku-plot-square which would be too slow for |
1007 (setq j n | 935 ;; initializing the display. Rather we build STRING1 for lines where |
1008 x (- gomoku-x-offset gomoku-square-width)) | 936 ;; board squares are to be found, and STRING2 for empty lines. STRING1 is |
1009 (while (>= (setq j (1- j)) 0) | 937 ;; like STRING2 except for dots every DX squares. Empty lines are filled |
1010 (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width)) | 938 ;; with spaces so that cursor moving up and down remains on the same |
1011 (current-column)) | 939 ;; column. |
1012 tab-width)) | 940 (setq string1 (concat (make-string (1- gomoku-square-width) ? ) ".") |
1013 (insert-char ? (- x (current-column))) | 941 string1 (apply 'concat |
1014 (if (setq intangible (not intangible)) | 942 (make-list (1- n) string1)) |
1015 (put-text-property point (point) 'intangible 2)) | 943 string1 (concat (make-string gomoku-x-offset ? ) "." string1 "\n") |
1016 (and (zerop j) | 944 string2 (make-string (+ 1 gomoku-x-offset |
1017 (= i (- m 2)) | 945 (* (1- n) gomoku-square-width)) |
1018 (progn | 946 ? ) |
1019 (while (>= i 3) | 947 string2 (concat string2 "\n") |
1020 (append-to-buffer (current-buffer) opoint (point)) | 948 string3 (apply 'concat |
1021 (setq i (- i 2))) | 949 (make-list (1- gomoku-square-height) string2)) |
1022 (goto-char (point-max)))) | 950 string3 (concat string3 string1) |
1023 (setq point (point)) | 951 string3 (apply 'concat |
1024 (insert ?.) | 952 (make-list (1- m) string3)) |
1025 (if window-system | 953 string4 (apply 'concat |
1026 (put-text-property point (point) | 954 (make-list gomoku-y-offset string2))) |
1027 'mouse-face 'highlight))) | 955 (insert string4 string1 string3)) |
1028 (> (setq i (1- i)) 0)) | 956 (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board |
1029 (if (= i (1- m)) | 957 (sit-for 0))) ; Display NOW |
1030 (setq opoint point)) | |
1031 (insert-char ?\n gomoku-square-height)) | |
1032 (or (eq (char-after 1) ?.) | |
1033 (put-text-property 1 2 'point-entered | |
1034 (lambda (x x) (if (bobp) (forward-char))))) | |
1035 (or intangible | |
1036 (put-text-property point (point) 'intangible 2)) | |
1037 (put-text-property point (point) 'point-entered | |
1038 (lambda (x x) (if (eobp) (backward-char)))) | |
1039 (put-text-property (point-min) (point) 'category 'gomoku-mode)) | |
1040 (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board | |
1041 (sit-for 0)) ; Display NOW | |
1042 | 958 |
1043 (defun gomoku-display-statistics () | 959 (defun gomoku-display-statistics () |
1044 "Obnoxiously display some statistics about previous games in mode line." | 960 "Obnoxiously display some statistics about previous games in mode line." |
1045 ;; We store this string in the mode-line-process local variable. | 961 ;; We store this string in the mode-line-process local variable. |
1046 ;; This is certainly not the cleanest way out ... | 962 ;; This is certainly not the cleanest way out ... |
1047 (setq mode-line-process | 963 (setq mode-line-process |
1048 (format ": Won %d, lost %d%s" | 964 (cond |
1049 gomoku-number-of-human-wins | 965 ((not (zerop gomoku-number-of-draws)) |
1050 gomoku-number-of-emacs-wins | 966 (format ": Won %d, lost %d, drew %d" |
1051 (if (zerop gomoku-number-of-draws) | 967 gomoku-number-of-human-wins |
1052 "" | 968 gomoku-number-of-emacs-wins |
1053 (format ", drew %d" gomoku-number-of-draws)))) | 969 gomoku-number-of-draws)) |
970 (t | |
971 (format ": Won %d, lost %d" | |
972 gomoku-number-of-human-wins | |
973 gomoku-number-of-emacs-wins)))) | |
1054 (force-mode-line-update)) | 974 (force-mode-line-update)) |
1055 | 975 |
1056 (defun gomoku-switch-to-window () | 976 (defun gomoku-switch-to-window () |
1057 "Find or create the Gomoku buffer, and display it." | 977 "Find or create the Gomoku buffer, and display it." |
1058 (interactive) | 978 (interactive) |
1059 (let ((buff (get-buffer "*Gomoku*"))) | 979 (let ((buff (get-buffer "*Gomoku*"))) |
1060 (if buff ; Buffer exists: | 980 (if buff ; Buffer exists: |
1061 (switch-to-buffer buff) ; no problem. | 981 (switch-to-buffer buff) ; no problem. |
1062 (if gomoku-game-in-progress | 982 (if gomoku-game-in-progress |
1063 (gomoku-crash-game)) ; buffer has been killed or something | 983 (gomoku-crash-game)) ; buffer has been killed or something |
1064 (switch-to-buffer "*Gomoku*") ; Anyway, start anew. | 984 (switch-to-buffer "*Gomoku*") ; Anyway, start anew. |
1065 (gomoku-mode)))) | 985 (gomoku-mode)))) |
1066 | 986 |
1067 ;;; | 987 ;;; |
1068 ;;; CROSSING WINNING QTUPLES. | 988 ;;; CROSSING WINNING QTUPLES. |
1069 ;;; | 989 ;;; |
1070 | 990 |
1071 ;; When someone succeeds in filling a qtuple, we draw a line over the five | 991 ;; When someone succeeds in filling a qtuple, we draw a line over the five |
1072 ;; corresponding squares. One problem is that the program does not know which | 992 ;; corresponding squares. One problem is that the program does not know which |
1073 ;; squares ! It only knows the square where the last move has been played and | 993 ;; squares ! It only knows the square where the last move has been played and |
1074 ;; who won. The solution is to scan the board along all four directions. | 994 ;; who won. The solution is to scan the board along all four directions. |
995 | |
996 (defvar gomoku-winning-qtuple-beg nil | |
997 "First square of the winning qtuple.") | |
998 | |
999 (defvar gomoku-winning-qtuple-end nil | |
1000 "Last square of the winning qtuple.") | |
1001 | |
1002 (defvar gomoku-winning-qtuple-dx nil | |
1003 "Direction of the winning qtuple (along the X axis).") | |
1004 | |
1005 (defvar gomoku-winning-qtuple-dy nil | |
1006 "Direction of the winning qtuple (along the Y axis).") | |
1007 | |
1075 | 1008 |
1076 (defun gomoku-find-filled-qtuple (square value) | 1009 (defun gomoku-find-filled-qtuple (square value) |
1077 "Return T if SQUARE belongs to a qtuple filled with VALUEs." | 1010 "Return T if SQUARE belongs to a qtuple filled with VALUEs." |
1078 (or (gomoku-check-filled-qtuple square value 1 0) | 1011 (or (gomoku-check-filled-qtuple square value 1 0) |
1079 (gomoku-check-filled-qtuple square value 0 1) | 1012 (gomoku-check-filled-qtuple square value 0 1) |
1080 (gomoku-check-filled-qtuple square value 1 1) | 1013 (gomoku-check-filled-qtuple square value 1 1) |
1081 (gomoku-check-filled-qtuple square value -1 1))) | 1014 (gomoku-check-filled-qtuple square value -1 1))) |
1082 | 1015 |
1083 (defun gomoku-check-filled-qtuple (square value dx dy) | 1016 (defun gomoku-check-filled-qtuple (square value dx dy) |
1084 "Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." | 1017 "Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." |
1018 ;; And record it in the WINNING-QTUPLE-... variables. | |
1085 (let ((a 0) (b 0) | 1019 (let ((a 0) (b 0) |
1086 (left square) (right square) | 1020 (left square) (right square) |
1087 (depl (gomoku-xy-to-index dx dy))) | 1021 (depl (gomoku-xy-to-index dx dy)) |
1022 a+4) | |
1088 (while (and (> a -4) ; stretch tuple left | 1023 (while (and (> a -4) ; stretch tuple left |
1089 (= value (aref gomoku-board (setq left (- left depl))))) | 1024 (= value (aref gomoku-board (setq left (- left depl))))) |
1090 (setq a (1- a))) | 1025 (setq a (1- a))) |
1091 (while (and (< b (+ a 4)) ; stretch tuple right | 1026 (setq a+4 (+ a 4)) |
1027 (while (and (< b a+4) ; stretch tuple right | |
1092 (= value (aref gomoku-board (setq right (+ right depl))))) | 1028 (= value (aref gomoku-board (setq right (+ right depl))))) |
1093 (setq b (1+ b))) | 1029 (setq b (1+ b))) |
1094 (cond ((= b (+ a 4)) ; tuple length = 5 ? | 1030 (cond ((= b a+4) ; tuple length = 5 ? |
1095 (gomoku-cross-qtuple (+ square (* a depl)) (+ square (* b depl)) | 1031 (setq gomoku-winning-qtuple-beg (+ square (* a depl)) |
1096 dx dy) | 1032 gomoku-winning-qtuple-end (+ square (* b depl)) |
1033 gomoku-winning-qtuple-dx dx | |
1034 gomoku-winning-qtuple-dy dy) | |
1097 t)))) | 1035 t)))) |
1036 | |
1037 (defun gomoku-cross-winning-qtuple () | |
1038 "Cross winning qtuple, as found by `gomoku-find-filled-qtuple'." | |
1039 (gomoku-cross-qtuple gomoku-winning-qtuple-beg | |
1040 gomoku-winning-qtuple-end | |
1041 gomoku-winning-qtuple-dx | |
1042 gomoku-winning-qtuple-dy)) | |
1098 | 1043 |
1099 (defun gomoku-cross-qtuple (square1 square2 dx dy) | 1044 (defun gomoku-cross-qtuple (square1 square2 dx dy) |
1100 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." | 1045 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." |
1101 (save-excursion ; Not moving point from last square | 1046 (save-excursion ; Not moving point from last square |
1102 (let ((depl (gomoku-xy-to-index dx dy)) | 1047 (let ((depl (gomoku-xy-to-index dx dy))) |
1103 (inhibit-read-only t) | |
1104 (inhibit-point-motion-hooks t)) | |
1105 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 | 1048 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 |
1106 (while (/= square1 square2) | 1049 (while (not (= square1 square2)) |
1107 (gomoku-goto-square square1) | 1050 (gomoku-goto-square square1) |
1108 (setq square1 (+ square1 depl)) | 1051 (setq square1 (+ square1 depl)) |
1109 (cond | 1052 (cond |
1110 ((= dy 0) ; Horizontal | 1053 ((and (= dx 1) (= dy 0)) ; Horizontal |
1111 (forward-char 1) | 1054 (let ((n 1)) |
1112 (insert-char ?- (1- gomoku-square-width) t) | 1055 (while (< n gomoku-square-width) |
1113 (delete-region (point) (progn | 1056 (setq n (1+ n)) |
1114 (skip-chars-forward " \t") | 1057 (forward-char 1) |
1115 (point)))) | 1058 (gomoku-put-char ?-)))) |
1116 ((= dx 0) ; Vertical | 1059 ((and (= dx 0) (= dy 1)) ; Vertical |
1117 (let ((n 1) | 1060 (let ((n 1)) |
1118 (column (current-column))) | |
1119 (while (< n gomoku-square-height) | 1061 (while (< n gomoku-square-height) |
1120 (setq n (1+ n)) | 1062 (setq n (1+ n)) |
1121 (forward-line 1) | 1063 (next-line 1) |
1122 (indent-to column) | 1064 (gomoku-put-char ?|)))) |
1123 (insert-and-inherit ?|)))) | 1065 ((and (= dx -1) (= dy 1)) ; 1st Diagonal |
1124 ((= dx -1) ; 1st Diagonal | 1066 (backward-char (/ gomoku-square-width 2)) |
1125 (indent-to (prog1 (- (current-column) (/ gomoku-square-width 2)) | 1067 (next-line (/ gomoku-square-height 2)) |
1126 (forward-line (/ gomoku-square-height 2)))) | 1068 (gomoku-put-char ?/)) |
1127 (insert-and-inherit ?/)) | 1069 ((and (= dx 1) (= dy 1)) ; 2nd Diagonal |
1128 (t ; 2nd Diagonal | 1070 (forward-char (/ gomoku-square-width 2)) |
1129 (indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2)) | 1071 (next-line (/ gomoku-square-height 2)) |
1130 (forward-line (/ gomoku-square-height 2)))) | 1072 (gomoku-put-char ?\\)))))) |
1131 (insert-and-inherit ?\\)))))) | |
1132 (sit-for 0)) ; Display NOW | 1073 (sit-for 0)) ; Display NOW |
1133 | 1074 |
1134 ;;; | 1075 ;;; |
1135 ;;; CURSOR MOTION. | 1076 ;;; CURSOR MOTION. |
1136 ;;; | 1077 ;;; |
1137 ;; previous-line and next-line don't work right with intangible newlines | 1078 (defun gomoku-move-left () |
1079 "Move point backward one column on the Gomoku board." | |
1080 (interactive) | |
1081 (let ((x (gomoku-point-x))) | |
1082 (backward-char (cond ((null x) 1) | |
1083 ((> x 1) gomoku-square-width) | |
1084 (t 0))))) | |
1085 | |
1086 (defun gomoku-move-right () | |
1087 "Move point forward one column on the Gomoku board." | |
1088 (interactive) | |
1089 (let ((x (gomoku-point-x))) | |
1090 (forward-char (cond ((null x) 1) | |
1091 ((< x gomoku-board-width) gomoku-square-width) | |
1092 (t 0))))) | |
1093 | |
1138 (defun gomoku-move-down () | 1094 (defun gomoku-move-down () |
1139 "Move point down one row on the Gomoku board." | 1095 "Move point down one row on the Gomoku board." |
1140 (interactive) | 1096 (interactive) |
1141 (if (< (gomoku-point-y) gomoku-board-height) | 1097 (let ((y (gomoku-point-y))) |
1142 (next-line gomoku-square-height))) | 1098 (next-line (cond ((null y) 1) |
1099 ((< y gomoku-board-height) gomoku-square-height) | |
1100 (t 0))))) | |
1143 | 1101 |
1144 (defun gomoku-move-up () | 1102 (defun gomoku-move-up () |
1145 "Move point up one row on the Gomoku board." | 1103 "Move point up one row on the Gomoku board." |
1146 (interactive) | 1104 (interactive) |
1147 (if (> (gomoku-point-y) 1) | 1105 (let ((y (gomoku-point-y))) |
1148 (previous-line gomoku-square-height))) | 1106 (previous-line (cond ((null y) 1) |
1107 ((> y 1) gomoku-square-height) | |
1108 (t 0))))) | |
1149 | 1109 |
1150 (defun gomoku-move-ne () | 1110 (defun gomoku-move-ne () |
1151 "Move point North East on the Gomoku board." | 1111 "Move point North East on the Gomoku board." |
1152 (interactive) | 1112 (interactive) |
1153 (gomoku-move-up) | 1113 (gomoku-move-up) |
1154 (forward-char)) | 1114 (gomoku-move-right)) |
1155 | 1115 |
1156 (defun gomoku-move-se () | 1116 (defun gomoku-move-se () |
1157 "Move point South East on the Gomoku board." | 1117 "Move point South East on the Gomoku board." |
1158 (interactive) | 1118 (interactive) |
1159 (gomoku-move-down) | 1119 (gomoku-move-down) |
1160 (forward-char)) | 1120 (gomoku-move-right)) |
1161 | 1121 |
1162 (defun gomoku-move-nw () | 1122 (defun gomoku-move-nw () |
1163 "Move point North West on the Gomoku board." | 1123 "Move point North West on the Gomoku board." |
1164 (interactive) | 1124 (interactive) |
1165 (gomoku-move-up) | 1125 (gomoku-move-up) |
1166 (backward-char)) | 1126 (gomoku-move-left)) |
1167 | 1127 |
1168 (defun gomoku-move-sw () | 1128 (defun gomoku-move-sw () |
1169 "Move point South West on the Gomoku board." | 1129 "Move point South West on the Gomoku board." |
1170 (interactive) | 1130 (interactive) |
1171 (gomoku-move-down) | 1131 (gomoku-move-down) |
1172 (backward-char)) | 1132 (gomoku-move-left)) |
1173 | |
1174 (defun gomoku-beginning-of-line () | |
1175 "Move point to first square on the Gomoku board row." | |
1176 (interactive) | |
1177 (move-to-column gomoku-x-offset)) | |
1178 | |
1179 (defun gomoku-end-of-line () | |
1180 "Move point to last square on the Gomoku board row." | |
1181 (interactive) | |
1182 (move-to-column (+ gomoku-x-offset | |
1183 (* gomoku-square-width (1- gomoku-board-width))))) | |
1184 | 1133 |
1185 (provide 'gomoku) | 1134 (provide 'gomoku) |
1186 | 1135 |
1187 ;;; gomoku.el ends here | 1136 ;;; gomoku.el ends here |