-a0 243
;;; chess.el --- Play chess in Emacs
;; Copyright (C) 2001 John Wiegley <johnw@gnu.org>
;; Version: 2.0
;; Keywords: games
;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: John Wiegley <johnw@gnu.org>
+;; Maintainer: Mario Lang <mlang@delysid.org>
;; Description: Play chess in Emacs
-;; URL: http://www.gci-net.com/~johnw/Emacs/packages/chess.tar.gz
-;; Compatibility: Emacs20, Emacs21, XEmacs21
+;; URL: http://emacs-chess.sourceforge.net/
+;; Compatibility: Emacs21
;; This file is not part of GNU Emacs.
;;
;; To just get a chessboard up, put the following in your .emacs file:
;;
-;; (add-to-list 'load-list "<the path to Emacs Chess>")
+;; (add-to-list 'load-path "<the path to Emacs Chess>")
;;
;; (autoload 'chess "chess" "Play a game of chess" t)
;;
;; interface commands available in each of those buffer types.
;;; Code:
-(require 'chess-session)
-(require 'chess-pgn)
+(require 'chess-game)
+(require 'chess-display)
+(require 'chess-engine)
(defgroup chess nil
"An Emacs chess playing program."
:group 'games)
-(defconst chess-version "2.0"
-(defconst chess-version "2.0a7"
+
+(defconst chess-version "2.0b6"
"The version of the Emacs chess program.")
-(defcustom chess-modules
- (list 'chess-crafty
- (if (display-graphic-p)
- 'chess-images 'chess-ascii))
- 'chess-images 'chess-ics1)
- :type (list 'radio (apropos-internal "\\`chess-[^-]+\\'" 'functionp))
- :type 'sexp
+
+(defcustom chess-default-display
+ '(chess-images chess-ics1 chess-plain)
+ "Default display to be used when starting a chess session.
+A list indicates a series of alternatives if the first display is
+not available."
+ :type '(choice symbol (repeat symbol))
+ :group 'chess)
+
+(defcustom chess-default-modules
+ '((chess-sound chess-announce)
+ chess-autosave
+ chess-clock
+ ;;chess-kibitz jww (2002-04-30): not fully supported yet
+ ;;chess-chat
+ )
+ "Modules to be used when starting a chess session.
+A sublist indicates a series of alternatives, if the first is not
+available.
+These can do just about anything."
+ :type '(repeat (choice symbol (repeat symbol)))
+ :group 'chess)
+
+(defcustom chess-default-engine
+ '(chess-crafty
+ chess-stockfish chess-glaurung chess-fruit
+ chess-gnuchess chess-phalanx
+ chess-ai)
+ "Default engine to be used when starting a chess session.
+A list indicates a series of alternatives if the first engine is not
+available."
+ :type '(choice symbol (repeat symbol))
:group 'chess)
-(defvar chess-current-session nil)
-(defvar chess-illegal nil)
-(put 'chess-illegal 'error-conditions '(error))
+(defcustom chess-full-name (user-full-name)
+ "The full name to use when playing chess."
+ :type 'string
:group 'chess)
-(defun chess ()
- "Start a game of chess."
- (interactive)
- (setq chess-current-session (chess-session-create))
- (chess-session-add-listener chess-current-session 'chess-global-handler)
- (dolist (module chess-modules)
- (require module)
- (chess-session-add-listener chess-current-session module))
- (chess-session-event chess-current-session 'initialize)
- (chess-session-event chess-current-session 'setup (chess-game-create)))
-
-(defun chess-global-handler (session window-config event &rest args)
- "React to changes on the chess board in a global Emacs way."
- (cond
- ((eq event 'initialize)
- (chess-session-set-data session 'my-color t) ; start out white
- (current-window-configuration))
- ((eq event 'shutdown)
- (ignore (set-window-configuration window-config)))
- ((eq event 'setup)
- (ignore (chess-session-set-data session 'current-game (car args))))
- ((eq event 'pass)
- (ignore
- (let ((color (not (chess-session-data session 'my-color))))
- (message "You are now playing %s"
- (if color "White" "Black"))
- (chess-session-set-data session 'my-color
- (not (chess-session-data session
- 'my-color))))))))
- (aset chess-puzzle-locations 3 puzzle-engine)))))))
+(and (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("(\\(chess-error\\)\\>" 1 font-lock-warning-face)
+ ("(\\(chess-with-current-buffer\\)\\>" 1 font-lock-keyword-face))))
+
+(defun chess--create-display (module game my-color disable-popup)
+ (let ((display (chess-display-create game module my-color)))
+ (when display
+ (chess-game-set-data game 'my-color my-color)
+ (if disable-popup
+ (chess-display-disable-popup display))
+ display)))
+
+(defun chess--create-engine (module game response-handler ctor-args)
+ (let ((engine (apply 'chess-engine-create module game
+ response-handler ctor-args)))
+ (when engine
+ ;; for the sake of engines which are ready to play now, and
+ ;; which don't need connect/accept negotiation (most
+ ;; computerized engines fall into this category), we need to
+ ;; let them know we're ready to begin
+ (chess-engine-command engine 'ready)
+ engine)))
+
+(defun chess-create-modules (module-list create-func &rest args)
+ "Create modules from MODULE-LIST with CREATE-FUNC and ARGS.
+If an element of MODULE-LIST is a sublist, treat it as alternatives."
+ (let (objects)
+ (dolist (module module-list)
+ (let (object)
+ (if (symbolp module)
+ (if (setq object (apply create-func module args))
+ (push object objects))
+ ;; this module is actually a list, which means keep trying
+ ;; until we find one that works
+ (while module
+ (if (setq object (condition-case nil
+ (apply create-func (car module) args)
+ (error nil)))
+ (progn
+ (push object objects)
+ (setq module nil))
+ (setq module (cdr module)))))))
+ (nreverse objects)))
+
+(chess-message-catalog 'english
+ '((no-engines-found
+ . "Could not find any chess engines to play against; install gnuchess!")))
+
+;;;###autoload
+(defun chess (&optional engine disable-popup engine-response-handler
+ &rest engine-ctor-args)
+ "Start a game of chess, playing against ENGINE (a module name).
+With prefix argument, prompt for the engine to play against.
+Otherwise use `chess-default-engine' to determine the engine."
+ (interactive
+ (list
+ (if current-prefix-arg
+ (intern
+ (concat "chess-"
+ (let ((str (read-string "Engine to play against: ")))
+ (if (> (length str) 0)
+ str
+ "none"))))
+ chess-default-engine)))
+
+ (let ((game (chess-game-create))
+ (my-color t) ; we start out as white always
+ objects)
+
+ ;; all these odd calls are so that `objects' ends up looking like:
+ ;; (ENGINE FIRST-DISPLAY...)
+
+ (setq objects (chess-create-modules (list chess-default-display)
+ 'chess--create-display
+ game my-color disable-popup))
+ (when (car objects)
+ (mapc 'chess-display-update objects)
+ (chess-module-set-leader (car objects))
+ (unless disable-popup
+ (chess-display-popup (car objects))))
+
+ (nconc objects (chess-create-modules chess-default-modules
+ 'chess-module-create game))
+
+ (push (unless (eq engine 'none)
+ (car ;(condition-case nil
+ (chess-create-modules (list (or engine chess-default-engine))
+ 'chess--create-engine game
+ engine-response-handler
+ engine-ctor-args)
+ ; (error nil))
+ ))
+ objects)
+
+ (unless (car objects)
+ (chess-message 'no-engines-found))
+
+ objects))
+
+;;;###autoload
+(defalias 'chess-session 'chess)
+
+;;;###autoload
+(defun chess-create-display (perspective &optional modules-too)
+ "Create a display, letting the user's customization decide the style.
+If MODULES-TOO is non-nil, also create and associate the modules
+listed in `chess-default-modules'."
+ (if modules-too
+ (let ((display (cadr (chess-session 'none))))
+ (chess-display-set-perspective* display perspective))
+ (car (chess-create-modules (list chess-default-display)
+ 'chess--create-display
+ (chess-game-create) perspective nil))))
(provide 'chess)