-;;; gomoku.el --- Gomoku game between you and Emacs
+;;; gomoku.el --- Gomoku game between you and Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996, 2001-2016 Free Software Foundation,
+;; Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: games
;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
(defconst gomoku-square-width 4
- "*Horizontal spacing between squares on the Gomoku board.")
+ "Horizontal spacing between squares on the Gomoku board.")
(defconst gomoku-square-height 2
- "*Vertical spacing between squares on the Gomoku board.")
+ "Vertical spacing between squares on the Gomoku board.")
(defconst gomoku-x-offset 3
- "*Number of columns between the Gomoku board and the side of the window.")
+ "Number of columns between the Gomoku board and the side of the window.")
(defconst gomoku-y-offset 1
- "*Number of lines between the Gomoku board and the top of the window.")
+ "Number of lines between the Gomoku board and the top of the window.")
(defvar gomoku-mode-map
(defface gomoku-O
'((((class color)) (:foreground "red" :weight bold)))
- "Face to use for Emacs' O."
+ "Face to use for Emacs's O."
:group 'gomoku)
(defface gomoku-X
'(("O" . 'gomoku-O)
("X" . 'gomoku-X)
("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
- "*Font lock rules for Gomoku.")
+ "Font lock rules for Gomoku.")
-(put 'gomoku-mode 'front-sticky
- (put 'gomoku-mode 'rear-nonsticky '(intangible)))
-(put 'gomoku-mode 'intangible 1)
;; This one is for when they set view-read-only to t: Gomoku cannot
;; allow View Mode to be activated in its buffer.
-(put 'gomoku-mode 'mode-class 'special)
-
-(define-derived-mode gomoku-mode nil "Gomoku"
+(define-derived-mode gomoku-mode special-mode "Gomoku"
"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
\\{gomoku-mode-map}"
(gomoku-display-statistics)
(make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(gomoku-font-lock-keywords t))
- (toggle-read-only t))
+ (setq font-lock-defaults '(gomoku-font-lock-keywords t)
+ buffer-read-only t)
+ (add-hook 'post-command-hook #'gomoku--intangible nil t))
\f
;;;
;;; THE BOARD.
;; its contents as a set, i.e. not considering the order of its elements. The
;; highest score is given to the "OOOO" qtuples because playing in such a
;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
-;; not playing in it is just loosing the game, and so on. Note that a
+;; not playing in it is just losing the game, and so on. Note that a
;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
;; has score zero because there is no more any point in playing in it, from
;; both an attacking and a defending point of view.
;; these values will change (hopefully improve) the strength of the program
;; and may change its style (rather aggressive here).
-(defconst nil-score 7 "Score of an empty qtuple.")
-(defconst Xscore 15 "Score of a qtuple containing one X.")
-(defconst XXscore 400 "Score of a qtuple containing two X's.")
-(defconst XXXscore 1800 "Score of a qtuple containing three X's.")
-(defconst XXXXscore 100000 "Score of a qtuple containing four X's.")
-(defconst Oscore 35 "Score of a qtuple containing one O.")
-(defconst OOscore 800 "Score of a qtuple containing two O's.")
-(defconst OOOscore 15000 "Score of a qtuple containing three O's.")
-(defconst OOOOscore 800000 "Score of a qtuple containing four O's.")
+(defconst gomoku-nil-score 7 "Score of an empty qtuple.")
+(defconst gomoku-Xscore 15 "Score of a qtuple containing one X.")
+(defconst gomoku-XXscore 400 "Score of a qtuple containing two X's.")
+(defconst gomoku-XXXscore 1800 "Score of a qtuple containing three X's.")
+(defconst gomoku-XXXXscore 100000 "Score of a qtuple containing four X's.")
+(defconst gomoku-Oscore 35 "Score of a qtuple containing one O.")
+(defconst gomoku-OOscore 800 "Score of a qtuple containing two O's.")
+(defconst gomoku-OOOscore 15000 "Score of a qtuple containing three O's.")
+(defconst gomoku-OOOOscore 800000 "Score of a qtuple containing four O's.")
;; These values are not just random: if, given the following situation:
;;
;; you want Emacs to play in "a" and not in "b", then the parameters must
;; satisfy the inequality:
;;
-;; 6 * XXscore > XXXscore + XXscore
+;; 6 * gomoku-XXscore > gomoku-XXXscore + gomoku-XXscore
;;
;; because "a" mainly belongs to six "XX" qtuples (the others are less
;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other
;; we just have to set up a translation table.
(defconst gomoku-score-trans-table
- (vector nil-score Xscore XXscore XXXscore XXXXscore 0
- Oscore 0 0 0 0 0
- OOscore 0 0 0 0 0
- OOOscore 0 0 0 0 0
- OOOOscore 0 0 0 0 0
+ (vector gomoku-nil-score gomoku-Xscore gomoku-XXscore gomoku-XXXscore gomoku-XXXXscore 0
+ gomoku-Oscore 0 0 0 0 0
+ gomoku-OOscore 0 0 0 0 0
+ gomoku-OOOscore 0 0 0 0 0
+ gomoku-OOOOscore 0 0 0 0 0
0)
"Vector associating qtuple contents to their score.")
;; If you do not modify drastically the previous constants, the only way for a
-;; square to have a score higher than OOOOscore is to belong to a "OOOO"
+;; square to have a score higher than gomoku-OOOOscore is to belong to a "OOOO"
;; qtuple, thus to be a winning move. Similarly, the only way for a square to
-;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX"
+;; have a score between gomoku-XXXXscore and gomoku-OOOOscore is to belong to a "XXXX"
;; qtuple. We may use these considerations to detect when a given move is
-;; winning or loosing.
+;; winning or losing.
-(defconst gomoku-winning-threshold OOOOscore
+(defconst gomoku-winning-threshold gomoku-OOOOscore
"Threshold score beyond which an Emacs move is winning.")
-(defconst gomoku-loosing-threshold XXXXscore
+(defconst gomoku-losing-threshold gomoku-XXXXscore
"Threshold score beyond which a human move is winning.")
best-square square
score-max score)
(aset gomoku-score-table square -1))) ; no: kill it !
- ;; If score is equally good, choose randomly. But first check freeness:
+ ;; If score is equally good, choose randomly. But first check freedom:
((not (zerop (aref gomoku-board square)))
(aset gomoku-score-table square -1))
((zerop (random (setq count (1+ count))))
;;;
;; At initialization the board is empty so that every qtuple amounts for
-;; nil-score. Therefore, the score of any square is nil-score times the number
+;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score times the number
;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
;; are sufficiently far from the sides. As computing the number is time
-;; consuming, we initialize every square with 20*nil-score and then only
+;; consuming, we initialize every square with 20*gomoku-nil-score and then only
;; consider squares at less than 5 squares from one side. We speed this up by
;; taking symmetry into account.
;; Also, as it is likely that successive games will be played on a board with
(setq gomoku-score-table (copy-sequence gomoku-saved-score-table))
;; No, compute it:
(setq gomoku-score-table
- (make-vector gomoku-vector-length (* 20 nil-score)))
+ (make-vector gomoku-vector-length (* 20 gomoku-nil-score)))
(let (i j maxi maxj maxi2 maxj2)
(setq maxi (/ (1+ gomoku-board-width) 2)
maxj (/ (1+ gomoku-board-height) 2)
;;;
;; Several variables are used to monitor a game, including a GAME-HISTORY (the
-;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back
+;; list of all (SQUARE . PREVSCORE) played) that allows you to take moves back
;; (anti-updating the score table) and to compute the table from scratch in
;; case of an interruption.
(min (max (/ (+ (- (cdr click)
gomoku-y-offset
1)
- (let ((inhibit-point-motion-hooks t))
- (count-lines 1 (window-start)))
+ (count-lines (point-min) (window-start))
gomoku-square-height
(% gomoku-square-height 2)
(/ gomoku-square-height 2))
(t
(setq score (aref gomoku-score-table square))
(gomoku-play-move square 1)
- (cond ((and (>= score gomoku-loosing-threshold)
+ (cond ((and (>= score gomoku-losing-threshold)
;; Just testing SCORE > THRESHOLD is not enough for
;; detecting wins, it just gives an indication that
;; we confirm with GOMOKU-FIND-FILLED-QTUPLE.
"Display a message asking for Human's move."
(message (if (zerop gomoku-number-of-human-moves)
"Your move? (Move to a free square and hit X, RET ...)"
- "Your move?"))
- ;; This may seem silly, but if one omits the following line (or a similar
- ;; one), the cursor may very well go to some place where POINT is not.
- ;; FIXME: this can't be right!! --Stef
- (save-excursion (set-buffer (other-buffer))))
+ "Your move?")))
(defun gomoku-prompt-for-other-game ()
"Ask for another game, and start it."
(defun gomoku-max-width ()
"Largest possible board width for the current window."
- (1+ (/ (- (window-width (selected-window))
+ (1+ (/ (- (window-width)
gomoku-x-offset gomoku-x-offset 1)
gomoku-square-width)))
(defun gomoku-max-height ()
"Largest possible board height for the current window."
- (1+ (/ (- (window-height (selected-window))
+ (1+ (/ (- (window-height)
gomoku-y-offset gomoku-y-offset 2)
;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
gomoku-square-height)))
(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))))
+ (1+ (/ (- (count-lines (point-min) (point))
+ gomoku-y-offset (if (bolp) 0 1))
+ gomoku-square-height)))
(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))))
+ (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset)
+ gomoku-square-width))
+ (gomoku-point-y)))
(defun gomoku-goto-square (index)
"Move point to square number INDEX."
(defun gomoku-goto-xy (x y)
"Move point to square at X, Y coords."
- (let ((inhibit-point-motion-hooks t))
- (goto-char (point-min))
- (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y)))))
+ (goto-char (point-min))
+ (forward-line (+ 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."
+ "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)
- (?.)))
+ (let ((inhibit-read-only t))
+ (insert (cond ((= value 1) ?X)
+ ((= value 6) ?O)
+ (?.)))
(and (zerop value)
(add-text-properties
(1- (point)) (point)
"Display an N by M Gomoku board."
(buffer-disable-undo (current-buffer))
(let ((inhibit-read-only t)
- (point 1) opoint
- (intangible t)
+ (point (point-min)) opoint
(i m) j x)
;; Try to minimize number of chars (because of text properties)
(setq tab-width
(max (/ (+ (% gomoku-x-offset gomoku-square-width)
gomoku-square-width 1) 2) 2)))
(erase-buffer)
- (newline gomoku-y-offset)
+ (insert-char ?\n 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))
+ (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width))
+ (current-column))
+ tab-width))
+ (insert-char ?\s (- x (current-column)))
(and (zerop j)
(= i (- m 2))
(progn
(if (= i (1- m))
(setq opoint point))
(insert-char ?\n gomoku-square-height))
- (or (eq (char-after 1) ?.)
- (put-text-property 1 2 'point-entered
- (lambda (x y) (if (bobp) (forward-char)))))
- (or intangible
- (put-text-property point (point) 'intangible 2))
- (put-text-property point (point) 'point-entered
- (lambda (x y) (if (eobp) (backward-char))))
- (put-text-property (point-min) (point) 'category 'gomoku-mode))
+ (insert-char ?\n))
(gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
- (sit-for 0)) ; Display NOW
+ (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))))
- (force-mode-line-update))
+ ;; Update mode line only if Gomoku buffer is current (Bug#12771).
+ (when (string-equal (buffer-name) gomoku-buffer-name)
+ ;; 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))))
+ (force-mode-line-update)))
(defun gomoku-switch-to-window ()
"Find or create the Gomoku buffer, and display it."
"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))
+ (inhibit-read-only t))
;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
(while (/= square1 square2)
(gomoku-goto-square square1)
(setq n (1+ n))
(forward-line 1)
(indent-to column)
- (insert-and-inherit ?|))))
+ (insert ?|))))
((= dx -1) ; 1st Diagonal
(indent-to (prog1 (- (current-column) (/ gomoku-square-width 2))
(forward-line (/ gomoku-square-height 2))))
- (insert-and-inherit ?/))
+ (insert ?/))
(t ; 2nd Diagonal
(indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2))
(forward-line (/ gomoku-square-height 2))))
- (insert-and-inherit ?\\))))))
+ (insert ?\\))))))
(sit-for 0)) ; Display NOW
\f
;;;
;;; CURSOR MOTION.
;;;
+
+(defvar-local gomoku--last-pos 0)
+
+(defconst gomoku--intangible-chars "- \t\n|/\\\\")
+
+(defun gomoku--intangible ()
+ (when (or (eobp)
+ (save-excursion
+ (not (zerop (skip-chars-forward gomoku--intangible-chars)))))
+ (if (<= gomoku--last-pos (point)) ;Moving forward.
+ (progn
+ (skip-chars-forward gomoku--intangible-chars)
+ (when (eobp)
+ (skip-chars-backward gomoku--intangible-chars)
+ (forward-char -1)))
+ (skip-chars-backward gomoku--intangible-chars)
+ (if (bobp)
+ (skip-chars-forward gomoku--intangible-chars)
+ (forward-char -1))))
+ (setq gomoku--last-pos (point)))
+
;; 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)
- (if (< (gomoku-point-y) gomoku-board-height)
- (let ((column (current-column)))
- (forward-line gomoku-square-height)
- (move-to-column column))))
+ (when (< (gomoku-point-y) gomoku-board-height)
+ (let ((column (current-column)))
+ (forward-line gomoku-square-height)
+ (move-to-column column))))
(defun gomoku-move-up ()
"Move point up one row on the Gomoku board."
(interactive)
- (if (> (gomoku-point-y) 1)
- (let ((column (current-column)))
- (forward-line (- 1 gomoku-square-height))
- (move-to-column column))))
+ (when (> (gomoku-point-y) 1)
+ (let ((column (current-column)))
+ (forward-line (- gomoku-square-height))
+ (move-to-column column))))
(defun gomoku-move-ne ()
"Move point North East on the Gomoku board."
(move-to-column (+ gomoku-x-offset
(* gomoku-square-width (1- gomoku-board-width)))))
-(random t)
-
(provide 'gomoku)
-;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb
;;; gomoku.el ends here