comparison lisp/play/gomoku.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; gomoku.el --- Gomoku game between you and Emacs

;; Copyright (C) 1988, 1994, 1996, 2001, 2003 Free Software Foundation, Inc.

;; Author: Philippe Schnoebelen <[e-mail]>
;; Maintainer: FSF
;; Adapted-By: ESR, Daniel Pfeiffer <[e-mail]>
;; Keywords: games

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; RULES:
;;

;;;
;;; CONSTANTS FOR BOARD
;;;

;; You may change these values if you have a small screen or if the squares
;; 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.")

  (define-key gomoku-mode-map [remap advertised-undo] 'gomoku-human-takes-back))

(defvar gomoku-emacs-won ()
  "For making font-lock use the winner's face for the line.")

(defface gomoku-font-lock-O-face
    '((((class color)) (:foreground "red" :weight bold)))
  "Face to use for Emacs' O."
  :group 'gomoku)

(defface gomoku-font-lock-X-face
    '((((class color)) (:foreground "green" :weight bold)))
  "Face to use for your X."
  :group 'gomoku)

(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)

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'."
  (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))

;;;
;;; THE BOARD.
;;;

    ((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.")))

     (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)

Use \\[describe-mode] for more info."
  (interactive (if current-prefix-arg
		   (list (prefix-numeric-value current-prefix-arg)
			 (eval (read-minibuffer "Height: ")))))
  (gomoku-switch-to-window)
  (cond
   (gomoku-emacs-is-computing
    (gomoku-crash-game))
   ((or (not gomoku-game-in-progress)
	(<= gomoku-number-of-moves 2))

	    ((> 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 (y-or-n-p (format "Do you really want %d rows " m))))
	  (setq m max-height)))
    (message "One moment, please...")
    (gomoku-start-game n m)
    (if (y-or-n-p "Do you allow me to play first ")
	(gomoku-emacs-plays)
	(gomoku-prompt-for-move)))
   ((y-or-n-p "Shall we continue our game ")
    (gomoku-prompt-for-move))
   (t
    (gomoku-human-resigns))))

(defun gomoku-emacs-plays ()

    (gomoku-prompt-for-other-game))
   (t
    (let (square score)
      (setq square (gomoku-point-square))
      (cond ((null square)
	     (error "Your point is not on a square. Retry !"))
	    ((not (zerop (aref gomoku-board square)))
	     (error "Your point is not on a free square. Retry !"))
	    (t
	     (setq score (aref gomoku-score-table square))
	     (gomoku-play-move square 1)
	     (cond ((and (>= score gomoku-loosing-threshold)
			 ;; Just testing SCORE > THRESHOLD is not enough for

   ((not gomoku-game-in-progress)
    (message "Too late for taking back...")
    (sit-for 4)
    (gomoku-prompt-for-other-game))
   ((zerop gomoku-number-of-human-moves)
    (message "You have not played yet... Your move ?"))
   (t
    (message "One moment, please...")
    ;; It is possible for the user to let Emacs play several consecutive
    ;; moves, so that the best way to know when to stop taking back moves is
    ;; to count the number of human moves:

  (cond
   (gomoku-emacs-is-computing
    (gomoku-crash-game))
   ((not gomoku-game-in-progress)
    (message "There is no game in progress"))
   ((y-or-n-p "You mean, you resign ")
    (gomoku-terminate-game 'human-resigned))
   ((y-or-n-p "You mean, we continue ")
    (gomoku-prompt-for-move))
   (t
    (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it

;;;

;;;

(defun gomoku-prompt-for-move ()
  "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.
  (save-excursion (set-buffer (other-buffer))))

(defun gomoku-prompt-for-other-game ()
  "Ask for another game, and start it."
  (if (y-or-n-p "Another game ")
      (gomoku gomoku-board-width gomoku-board-height)
    (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))))

;;;
;;; DISPLAYING THE BOARD.
;;;

  (force-mode-line-update))

(defun gomoku-switch-to-window ()
  "Find or create the Gomoku buffer, and display it."
  (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))))

;;;
;;; CROSSING WINNING QTUPLES.
;;;

  (move-to-column (+ gomoku-x-offset
		     (* gomoku-square-width (1- gomoku-board-width)))))

(provide 'gomoku)

;;; gomoku.el ends here

88155:d7ddb3e565de

;;; gomoku.el --- Gomoku game between you and Emacs

;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: Philippe Schnoebelen <[e-mail]>
;; Maintainer: FSF
;; Adapted-By: ESR, Daniel Pfeiffer <[e-mail]>
;; Keywords: games

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; RULES:
;;

;;;
;;; CONSTANTS FOR BOARD
;;;

(defconst gomoku-buffer-name "*Gomoku*"
  "Name of the Gomoku buffer.")

;; You may change these values if you have a small screen or if the squares
;; 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.")

  (define-key gomoku-mode-map [remap advertised-undo] 'gomoku-human-takes-back))

(defvar gomoku-emacs-won ()
  "For making font-lock use the winner's face for the line.")

(defface gomoku-O
    '((((class color)) (:foreground "red" :weight bold)))
  "Face to use for Emacs' O."
  :group 'gomoku)

(defface gomoku-X
    '((((class color)) (:foreground "green" :weight bold)))
  "Face to use for your X."
  :group 'gomoku)

(defvar gomoku-font-lock-keywords
  '(("O" . 'gomoku-O)
    ("X" . 'gomoku-X)
    ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
  "*Font lock rules for Gomoku.")

(put 'gomoku-mode 'front-sticky
     (put 'gomoku-mode 'rear-nonsticky '(intangible)))
(put 'gomoku-mode 'intangible 1)

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."
  (interactive)
  (kill-all-local-variables)
  (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-mode-hooks 'gomoku-mode-hook))

;;;
;;; THE BOARD.
;;;

    ((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.")))

     (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)

Use \\[describe-mode] for more info."
  (interactive (if current-prefix-arg
		   (list (prefix-numeric-value current-prefix-arg)
			 (eval (read-minibuffer "Height: ")))))
  ;; gomoku-switch-to-window, but without the potential call to gomoku
  ;; from gomoku-prompt-for-other-game.
  (if (get-buffer gomoku-buffer-name)
      (switch-to-buffer gomoku-buffer-name)
    (when gomoku-game-in-progress
      (setq gomoku-emacs-is-computing nil)
      (gomoku-terminate-game 'crash-game)
      (sit-for 4)
      (or (y-or-n-p "Another game? ") (error "Chicken!")))
    (switch-to-buffer gomoku-buffer-name)
    (gomoku-mode))
  (cond
   (gomoku-emacs-is-computing
    (gomoku-crash-game))
   ((or (not gomoku-game-in-progress)
	(<= gomoku-number-of-moves 2))

	    ((> 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 (y-or-n-p (format "Do you really want %d rows? " m))))
	  (setq m max-height)))
    (message "One moment, please...")
    (gomoku-start-game n m)
    (if (y-or-n-p "Do you allow me to play first? ")
	(gomoku-emacs-plays)
	(gomoku-prompt-for-move)))
   ((y-or-n-p "Shall we continue our game? ")
    (gomoku-prompt-for-move))
   (t
    (gomoku-human-resigns))))

(defun gomoku-emacs-plays ()

    (gomoku-prompt-for-other-game))
   (t
    (let (square score)
      (setq square (gomoku-point-square))
      (cond ((null square)
	     (error "Your point is not on a square. Retry!"))
	    ((not (zerop (aref gomoku-board square)))
	     (error "Your point is not on a free square. Retry!"))
	    (t
	     (setq score (aref gomoku-score-table square))
	     (gomoku-play-move square 1)
	     (cond ((and (>= score gomoku-loosing-threshold)
			 ;; Just testing SCORE > THRESHOLD is not enough for

   ((not gomoku-game-in-progress)
    (message "Too late for taking back...")
    (sit-for 4)
    (gomoku-prompt-for-other-game))
   ((zerop gomoku-number-of-human-moves)
    (message "You have not played yet... Your move?"))
   (t
    (message "One moment, please...")
    ;; It is possible for the user to let Emacs play several consecutive
    ;; moves, so that the best way to know when to stop taking back moves is
    ;; to count the number of human moves:

  (cond
   (gomoku-emacs-is-computing
    (gomoku-crash-game))
   ((not gomoku-game-in-progress)
    (message "There is no game in progress"))
   ((y-or-n-p "You mean, you resign? ")
    (gomoku-terminate-game 'human-resigned))
   ((y-or-n-p "You mean, we continue? ")
    (gomoku-prompt-for-move))
   (t
    (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it

;;;

;;;

(defun gomoku-prompt-for-move ()
  "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.
  (save-excursion (set-buffer (other-buffer))))

(defun gomoku-prompt-for-other-game ()
  "Ask for another game, and start it."
  (if (y-or-n-p "Another game? ")
      (gomoku gomoku-board-width gomoku-board-height)
    (error "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))))

;;;
;;; DISPLAYING THE BOARD.
;;;

  (force-mode-line-update))

(defun gomoku-switch-to-window ()
  "Find or create the Gomoku buffer, and display it."
  (interactive)
  (if (get-buffer gomoku-buffer-name)       ; Buffer exists:
      (switch-to-buffer gomoku-buffer-name) ;   no problem.
    (if gomoku-game-in-progress
        (gomoku-crash-game))            ;   buffer has been killed or something
    (switch-to-buffer gomoku-buffer-name)   ; Anyway, start anew.
    (gomoku-mode)))

;;;
;;; CROSSING WINNING QTUPLES.
;;;

  (move-to-column (+ gomoku-x-offset
		     (* gomoku-square-width (1- gomoku-board-width)))))

(provide 'gomoku)

;;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb
;;; gomoku.el ends here