diff options
| -rw-r--r-- | Makefile | 7 | ||||
| -rw-r--r-- | TODO | 7 | ||||
| -rw-r--r-- | chess-algebraic.el | 17 | ||||
| -rw-r--r-- | chess-auto.el | 78 | ||||
| -rw-r--r-- | chess-crafty.el | 38 | ||||
| -rw-r--r-- | chess-display.el | 108 | ||||
| -rw-r--r-- | chess-gnuchess.el | 4 | ||||
| -rw-r--r-- | chess-images.el | 29 | ||||
| -rw-r--r-- | chess-maint.el | 4 | ||||
| -rw-r--r-- | chess-pgn.el | 19 | ||||
| -rw-r--r-- | chess-ply.el | 10 | ||||
| -rw-r--r-- | chess-pos.el | 2 | ||||
| -rw-r--r-- | chess-process.el | 133 | ||||
| -rw-r--r-- | chess-standard.el | 11 | ||||
| -rw-r--r-- | chess.el | 12 |
15 files changed, 247 insertions, 232 deletions
@@ -1,11 +1,9 @@ -DIRS = $(shell find . ! -name CVS -type d) SPECIAL = chess-auto.el -SOURCE = $(filter-out $(SPECIAL),$(shell find -name '*.el')) +SOURCE = $(filter-out $(SPECIAL),$(wildcard *.el)) TARGET = $(patsubst %.el,%.elc,$(SPECIAL) $(SOURCE)) EMACS = emacs all: $(TARGET) - -rm subdirs.elc chess-auto.el: chess-auto.in $(SOURCE) cp chess-auto.in chess-auto.el @@ -13,10 +11,11 @@ chess-auto.el: chess-auto.in $(SOURCE) $(EMACS) --no-init-file --no-site-file -batch \ -l $(shell pwd)/chess-auto \ -f generate-autoloads \ - $(shell pwd)/chess-auto.el $(DIRS) + $(shell pwd)/chess-auto.el . %.elc: %.el $(EMACS) --no-init-file --no-site-file -batch \ + -l $(shell pwd)/chess-maint \ -f batch-byte-compile $< clean: @@ -1,8 +1,11 @@ * 2.0 -Write chess-game-to-pgn and chess-pgn-to-game. +Keyboard shortcuts: + Right now "nf, nf", causes an error. + Castling is not supported. + Capital letters not supported. -Get keyboard shortcuts working, right now "nf, nf", causes an error. +Long castling is signaled as an illegal move from chess-standard. * Other diff --git a/chess-algebraic.el b/chess-algebraic.el index 6e6ba83..0b041cb 100644 --- a/chess-algebraic.el +++ b/chess-algebraic.el @@ -34,16 +34,17 @@ ;; $Revision$ (require 'chess-pos) +(require 'chess-ply) (defconst chess-algebraic-pieces-regexp "[RNBKQ]") (defconst chess-algebraic-regexp (format (concat "\\(" - "O-O\\(-O\\)?\\|" - "\\(%s\\(\\([a-h]\\|[1-8]\\)?\\|[a-h][1-8]\\)\\)?" - "\\([x-]\\)?" - "\\([a-h][1-8]\\)" - "\\(=\\(%s\\)\\)?" + "O-O\\(-O\\)?\\|" + "\\(%s?\\(\\([a-h]\\|[1-8]\\)?\\|[a-h][1-8]\\)\\)?" + "\\([x-]\\)?" + "\\([a-h][1-8]\\)" + "\\(=\\(%s\\)\\)?" "\\)" "\\([#+]\\)?") chess-algebraic-pieces-regexp @@ -54,8 +55,9 @@ This regexp handles both long and short form.") (defun chess-algebraic-to-ply (position move) "Convert the algebraic notation MOVE for POSITION to a ply." (when (string-match chess-algebraic-regexp move) - (let* ((piece (aref move 0)) + (let* ((color (chess-pos-side-to-move position)) (mate (match-string 10 move)) + (piece (aref move 0)) (changes (if (eq piece ?O) (let ((rank (if color 7 0)) @@ -68,8 +70,7 @@ This regexp handles both long and short form.") (target (chess-coord-to-index (match-string 7 move)))) (if (and source (= (length source) 2)) (list (chess-coord-to-index source) target) - (let ((color (chess-pos-side-to-move position)) - candidates which) + (let (candidates which) (unless (< piece ?a) (setq piece ?P)) ;; we must use our knowledge of how pieces can diff --git a/chess-auto.el b/chess-auto.el index 81ec22c..2ce3a6f 100644 --- a/chess-auto.el +++ b/chess-auto.el @@ -9,25 +9,25 @@ ;;; Generated autoloads follow (made by autoload.el). -;;;### (autoloads (chess-crafty) "chess-crafty" "engines/chess-crafty.el" -;;;;;; (15163 40201)) -;;; Generated autoloads from engines/chess-crafty.el +;;;### (autoloads (chess) "chess" "chess.el" (15487 9165)) +;;; Generated autoloads from chess.el -(autoload (quote chess-crafty) "chess-crafty" nil nil nil) +(autoload (quote chess) "chess" "\ +Start a game of chess." t nil) ;;;*** -;;;### (autoloads (chess-gnuchess) "chess-gnuchess" "engines/chess-gnuchess.el" -;;;;;; (15163 40201)) -;;; Generated autoloads from engines/chess-gnuchess.el +;;;### (autoloads (chess-gnuchess) "chess-gnuchess" "chess-gnuchess.el" +;;;;;; (15487 8747)) +;;; Generated autoloads from chess-gnuchess.el (autoload (quote chess-gnuchess) "chess-gnuchess" nil nil nil) ;;;*** -;;;### (autoloads (chess-highlight) "chess-highlight" "tools/chess-highlight.el" -;;;;;; (15160 56560)) -;;; Generated autoloads from tools/chess-highlight.el +;;;### (autoloads (chess-highlight) "chess-highlight" "chess-highlight.el" +;;;;;; (15487 8169)) +;;; Generated autoloads from chess-highlight.el (autoload (quote chess-highlight) "chess-highlight" "\ This is the module constructor, call with a chess BOARD object. @@ -39,27 +39,27 @@ behavior of this module. One symbol which must be accepted is ;;;*** -;;;### (autoloads (chess-ics1) "chess-ics1" "displays/chess-ics1.el" -;;;;;; (15482 53911)) -;;; Generated autoloads from displays/chess-ics1.el +;;;### (autoloads (chess-ics1) "chess-ics1" "chess-ics1.el" (15487 +;;;;;; 7434)) +;;; Generated autoloads from chess-ics1.el (autoload (quote chess-ics1) "chess-ics1" "\ Handle any commands being sent to this instance of this module." nil nil) ;;;*** -;;;### (autoloads (chess-images) "chess-images" "displays/chess-images.el" -;;;;;; (15482 53911)) -;;; Generated autoloads from displays/chess-images.el +;;;### (autoloads (chess-images) "chess-images" "chess-images.el" +;;;;;; (15487 8784)) +;;; Generated autoloads from chess-images.el (autoload (quote chess-images) "chess-images" "\ This display module presents a standard chessboard using images." nil nil) ;;;*** -;;;### (autoloads (chess-module) "chess-module" "misc/chess-module.el" -;;;;;; (15484 30636)) -;;; Generated autoloads from misc/chess-module.el +;;;### (autoloads (chess-module) "chess-module" "chess-module.el" +;;;;;; (15487 7434)) +;;; Generated autoloads from chess-module.el (autoload (quote chess-module) "chess-module" "\ This is the module constructor, call with a chess GAME object. @@ -71,49 +71,35 @@ behavior of this module. One symbol which must be accepted is ;;;*** -;;;### (autoloads (chess-phalanx) "chess-phalanx" "engines/chess-phalanx.el" -;;;;;; (15163 40201)) -;;; Generated autoloads from engines/chess-phalanx.el +;;;### (autoloads (chess-phalanx) "chess-phalanx" "chess-phalanx.el" +;;;;;; (15487 7434)) +;;; Generated autoloads from chess-phalanx.el (autoload (quote chess-phalanx) "chess-phalanx" nil nil nil) ;;;*** -;;;### (autoloads (chess-plain) "chess-plain" "displays/chess-plain.el" -;;;;;; (15482 53911)) -;;; Generated autoloads from displays/chess-plain.el +;;;### (autoloads (chess-plain) "chess-plain" "chess-plain.el" (15487 +;;;;;; 7434)) +;;; Generated autoloads from chess-plain.el (autoload (quote chess-plain) "chess-plain" "\ Handle any commands being sent to this instance of this module." nil nil) ;;;*** -;;;### (autoloads (chess-module) "chess-speak" "displays/chess-speak.el" -;;;;;; (15478 2520)) -;;; Generated autoloads from displays/chess-speak.el - -(autoload (quote chess-module) "chess-speak" "\ -This is the module constructor, call with a chess BOARD object. -This function returns an initialized module closure, which is a -function object that maintains the state associated with this call. -It may be called with command symbols in order to influence the -behavior of this module. One symbol which must be accepted is -`shutdown'." nil nil) - -;;;*** - -;;;### (autoloads (chess-standard) "chess-standard" "core/chess-standard.el" -;;;;;; (15484 32658)) -;;; Generated autoloads from core/chess-standard.el +;;;### (autoloads (chess-standard) "chess-standard" "chess-standard.el" +;;;;;; (15487 9133)) +;;; Generated autoloads from chess-standard.el (autoload (quote chess-standard) "chess-standard" nil nil nil) ;;;*** -;;;### (autoloads (chess) "chess" "chess.el" (15486 56060)) -;;; Generated autoloads from chess.el +;;;### (autoloads (chess-crafty) "chess-crafty" "chess-crafty.el" +;;;;;; (15487 7434)) +;;; Generated autoloads from chess-crafty.el -(autoload (quote chess) "chess" "\ -Start a game of chess." t nil) +(autoload (quote chess-crafty) "chess-crafty" nil nil nil) ;;;*** diff --git a/chess-crafty.el b/chess-crafty.el index 51ca30a..06b5451 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -15,21 +15,33 @@ :type 'string :group 'chess-crafty) -;;;###autoload -(defun chess-crafty (game) - (chess-process game 'chess-crafty-handler nil - (if (file-name-absolute-p chess-crafty-command) - chess-crafty-command - (executable-find chess-crafty-command)))) - ;;; Code: -(defun chess-crafty-handler (game buffer command &rest args) - (unless (apply 'chess-process-handler game buffer command args) - (ignore - (if (eq command 'initialize) - (process-send-string (get-buffer-process buffer) - "alarm off\nansi off\n"))))) +;;;###autoload +(defun chess-crafty (session buffer event &rest args) + (if (not (eq event 'initialize)) + (apply 'chess-process session buffer event args) + (with-current-buffer + (chess-process session buffer event + chess-process-triggers + (if (file-name-absolute-p chess-crafty-command) + chess-crafty-command + (executable-find chess-crafty-command))) + (process-send-string + (get-buffer-process (current-buffer)) + (concat "display nogeneral\n" + "display nochanges\n" + "display noextstats\n" + "display nohashstats\n" + "display nomoves\n" + "display nonodes\n" + "display noply1\n" + "display nostats\n" + "display notime\n" + "display novariation\n" + "alarm off\n" + "ansi off\n")) + (current-buffer)))) (provide 'chess-crafty) diff --git a/chess-display.el b/chess-display.el index bbb2035..dab6ddf 100644 --- a/chess-display.el +++ b/chess-display.el @@ -6,7 +6,10 @@ ;;; Code: +(require 'chess-session) (require 'chess-game) +(require 'chess-algebraic) +(require 'chess-fen) (defgroup chess-display nil "Common code used by chess displays." @@ -43,53 +46,6 @@ (make-variable-buffer-local 'chess-display-draw-function) (make-variable-buffer-local 'chess-display-highlight-function) -;;; Code: - -(defun chess-display (session buffer event &rest args) - "This display module presents a standard chessboard. -See `chess-display-type' for the different kinds of displays." - (cond - ((eq event 'initialize) - (let ((buf (generate-new-buffer "*Chessboard*"))) - (with-current-buffer buf - (setq chess-display-draw-function (car args) - chess-display-highlight-function (cadr args) - chess-display-perspective - (chess-session-data session 'my-color)) - (chess-display-mode) - buf))) - ((eq event 'shutdown) - (ignore - (if (buffer-live-p buffer) - (kill-buffer buffer)))) - (t - (ignore - (with-current-buffer buffer - (cond - ((eq event 'setup) - (setq chess-display-game (car args) - chess-display-game-index (chess-game-index (car args)) - chess-display-position (chess-game-pos (car args))) - (funcall chess-display-draw-function)) - - ((eq event 'highlight) - ;; if they are unselecting the piece, just redraw - (if (eq (nth 2 args) 'unselected) - (funcall chess-display-draw-function) - (apply chess-display-highlight-function args))) - - ((eq event 'move) - (assert (eq chess-display-game - (chess-session-data session 'current-game))) - (setq chess-display-game-index (chess-game-index chess-display-game) - chess-display-position (chess-game-pos chess-display-game)) - (funcall chess-display-draw-function)) - - (t - (funcall chess-display-draw-function))) - - (chess-display-set-modeline)))))) - (defvar chess-display-mode-map (let ((map (make-keymap))) (suppress-keymap map) @@ -155,6 +111,56 @@ See `chess-display-type' for the different kinds of displays." (make-variable-buffer-local 'chess-display-perspective) (make-variable-buffer-local 'chess-display-mode-line) +;;; Code: + +;;;###autoload +(defun chess-display (session buffer event &rest args) + "This display module presents a standard chessboard. +See `chess-display-type' for the different kinds of displays." + (cond + ((eq event 'initialize) + (let ((buf (generate-new-buffer "*Chessboard*"))) + (with-current-buffer buf + (setq cursor-type nil + chess-display-draw-function (car args) + chess-display-highlight-function (cadr args) + chess-display-perspective + (chess-session-data session 'my-color)) + (chess-display-mode) + buf))) + ((eq event 'shutdown) + (ignore + (if (buffer-live-p buffer) + (kill-buffer buffer)))) + (t + (ignore + (with-current-buffer buffer + (cond + ((eq event 'setup) + (setq cursor-type nil + chess-display-game (car args) + chess-display-game-index (chess-game-index (car args)) + chess-display-position (chess-game-pos (car args))) + (funcall chess-display-draw-function)) + + ((eq event 'highlight) + ;; if they are unselecting the piece, just redraw + (if (eq (nth 2 args) 'unselected) + (funcall chess-display-draw-function) + (apply chess-display-highlight-function args))) + + ((eq event 'move) + (assert (eq chess-display-game + (chess-session-data session 'current-game))) + (setq chess-display-game-index (chess-game-index chess-display-game) + chess-display-position (chess-game-pos chess-display-game)) + (funcall chess-display-draw-function)) + + (t + (funcall chess-display-draw-function))) + + (chess-display-set-modeline)))))) + (defun chess-display-mode () "A mode for displaying and interacting with a chessboard. The key bindings available in this mode are: @@ -180,7 +186,7 @@ The key bindings available in this mode are: (/ index 2) (1+ (/ index 2)))) ". " (if color "... ") (chess-ply-to-algebraic - (chess-game-ply chess-display-game index))))))) + (chess-game-ply chess-display-game (1- index)))))))) (defsubst chess-display-current-p () "Return non-nil if the displayed chessboard reflects the current game. @@ -198,14 +204,16 @@ This means that no editing is being done." "Setup the current board for editing." (interactive) (when (chess-display-current-p) - (setq chess-display-position + (setq cursor-type t + chess-display-position (chess-pos-copy (chess-game-pos chess-display-game))) (message "Now editing board, use S to send..."))) (defun chess-display-restore-board () "Setup the current board for editing." (interactive) - (setq chess-display-position (chess-game-pos chess-display-game) + (setq cursor-type nil + chess-display-position (chess-game-pos chess-display-game) chess-display-game-index (chess-game-index chess-display-game)) (funcall chess-display-draw-function)) diff --git a/chess-gnuchess.el b/chess-gnuchess.el index 1031f4f..ef2e4be 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -16,9 +16,9 @@ :group 'chess-gnuchess) ;;;###autoload -(defun chess-gnuchess (game) +(defun chess-gnuchess (session process event &rest args) (chess-process - game nil + session process event (list (list (concat "My move is : \\(" chess-algebraic-regexp "\\)") (function (lambda (move) diff --git a/chess-images.el b/chess-images.el index 10d1821..2a0a602 100644 --- a/chess-images.el +++ b/chess-images.el @@ -127,11 +127,6 @@ jww (2001-06-23): This is still not fully implemented." :set 'chess-images-clear-image-cache :group 'chess-images) -(defun chess-images (game) - "A chessboard display that uses graphical images." - (chess-display game 'chess-images-handler - )) - ;;; Code: (defconst chess-images-piece-names @@ -202,8 +197,7 @@ jww (2001-06-23): This is still not fully implemented." (goto-char (point-min))) (while (if inverted (>= rank 0) (< rank 8)) (while (if inverted (>= file 0) (< file 8)) - (let* ((piece (chess-pos-piece board - (chess-rf-to-index rank file))) + (let* ((piece (chess-pos-piece board (chess-rf-to-index rank file))) (image (if (= piece ? ) (aref chess-images-cache @@ -418,8 +412,6 @@ This is necessary for bizzare Emacs reasons." chess-images-light-color)) (piece-colors (list chess-images-black-color chess-images-white-color)) - (c 0) (b 0) - (pieces chess-images-piece-names) blank name image-data) (dotimes (c 2) (dotimes (b 2) @@ -427,24 +419,21 @@ This is necessary for bizzare Emacs reasons." (let ((file (expand-file-name (format "%s-%s.%s" (nth c colors) (nth 1 piece) chess-images-extension) - chess-images-directory)) - image) - (cond - ((file-readable-p file) - (aset (aref (aref chess-images-cache c) b) - (nth 2 piece) - (chess-images-create-image file b c))) - ;; try loading an xboard format file - (t + chess-images-directory))) + (if (file-readable-p file) + (aset (aref (aref chess-images-cache c) b) + (nth 2 piece) + (chess-images-create-image file b c)) + ;; try loading an xboard format file (setq file (expand-file-name - (format "%c%c%c%d.%s" (caar pieces) + (format "%c%c%c%d.%s" (car piece) (if (= c 0) ?d ?l) (if (= b 0) ?d ?l) chess-images-size chess-images-extension) chess-images-directory)) (aset (aref (aref chess-images-cache c) b) (nth 2 piece) - (chess-images-create-image file b c)))))))) + (chess-images-create-image file b c))))))) (cond ((file-readable-p (setq blank (expand-file-name diff --git a/chess-maint.el b/chess-maint.el new file mode 100644 index 0000000..e229c50 --- /dev/null +++ b/chess-maint.el @@ -0,0 +1,4 @@ +(require 'cl) +(defvar chess-modules) +(defvar chess-current-session) +(add-to-list 'load-path ".") diff --git a/chess-pgn.el b/chess-pgn.el index 56fab5a..7c4fe93 100644 --- a/chess-pgn.el +++ b/chess-pgn.el @@ -6,8 +6,9 @@ (require 'chess-game) (require 'chess-algebraic) +(require 'chess-fen) -(defun chess-pgn-read-plies (position &optional top-level) +(defun chess-pgn-read-plies (game position &optional top-level) (let ((plies (list t)) prevpos done) (while (not (or done (eobp))) (cond @@ -34,8 +35,8 @@ ((looking-at "(") (forward-char) (skip-chars-forward " \t\n") - (chess-pos-add-annotation prevpos (chess-pgn-read-plies - (chess-pos-copy prevpos)))) + (chess-pos-add-annotation + prevpos (chess-pgn-read-plies game (chess-pos-copy prevpos)))) ((and (not top-level) (looking-at ")")) (forward-char) @@ -57,12 +58,12 @@ (let ((fen (chess-game-tag game "FEN"))) (chess-game-set-plies game (chess-pgn-read-plies - (if fen - (chess-fen-to-position fen) - (chess-pos-copy chess-starting-position)) t))) + game (if fen + (chess-fen-to-pos fen) + (chess-pos-copy chess-starting-position)) t))) game))) -(defun chess-pgn-insert-annotations (ply) +(defun chess-pgn-insert-annotations (index ply) (dolist (ann (chess-pos-annotations (chess-ply-pos ply))) (if (stringp ann) (insert (format " {%s}" ann)) @@ -75,14 +76,14 @@ (unless for-black (insert (format "%d. %s" index (chess-ply-to-algebraic (car plies)))) - (chess-pgn-insert-annotations (car plies)) + (chess-pgn-insert-annotations index (car plies)) (setq plies (cdr plies) index (1+ index))) (when plies (when for-black (insert (format "%d. ..." index)) (setq for-black nil)) (insert (format " %s" (chess-ply-to-algebraic (car plies)))) - (chess-pgn-insert-annotations (car plies)) + (chess-pgn-insert-annotations index (car plies)) (setq plies (cdr plies))) (if plies (insert ? )))) diff --git a/chess-ply.el b/chess-ply.el index ffc51a4..172c154 100644 --- a/chess-ply.el +++ b/chess-ply.el @@ -10,9 +10,9 @@ ;; coordinate transformations applied to one position in order to ;; arrive at the following position. It is also informally called "a ;; move". -;; +;; ;; A ply is represented in Lisp using a cons cell of the form: -;; +;; ;; (BASE-POSITION . ;; (FROM-COORD1 TO-COORD1 [FROM-COORD2 TO-COORD2] [KEYWORDS])) ;; @@ -28,7 +28,7 @@ ;; :checkmate ;; :draw ; a draw was offered and accepted ;; :draw-offered ; a draw was offered but not accepted -;; +;; ;; A ply may be represented in ASCII by printing the FEN string of the ;; base position, and then printing the positional transformation in ;; algebraic notation. Since the starting position is usually known, @@ -36,7 +36,7 @@ ;; by moving the chess piece(s) involved. It may be rendered verbally ;; by voicing which piece is to move, where it will move to, and what ;; will happen a result of the move (piece capture, check, etc). -;; +;; ;; Plies may be sent over network connections, postal mail, e-mail, ;; etc., so long as the current position is maintained at both sides. ;; Transmitting the base position's FEN string along with the ply @@ -82,7 +82,7 @@ (< piece ?a))) (dolist (candidate (funcall (car chess-modules) nil nil 'search position to t)) - (push (chess-ply-create position (list candidate to)) + (push (chess-ply-create position candidate to) plies)))))) plies)) diff --git a/chess-pos.el b/chess-pos.el index 039bf31..5eef9c1 100644 --- a/chess-pos.el +++ b/chess-pos.el @@ -167,7 +167,7 @@ The current side-to-move is always white." (cond ((listp elem) (copy-alist elem)) ((vectorp elem) (vconcat elem)) - (t elem)))) + (t elem)))) copy)) (defun chess-pos-create (&optional blank) diff --git a/chess-process.el b/chess-process.el index 298f8e1..b5a2544 100644 --- a/chess-process.el +++ b/chess-process.el @@ -6,6 +6,7 @@ ;;; Commentary: +(require 'chess-session) (require 'chess-game) (require 'chess-algebraic) @@ -22,8 +23,18 @@ It could be a Lisp function, which will be called to establish whatever type of connection it wishes, so long as it returns a buffer related to the resulting process.") +(make-variable-buffer-local 'chess-process-command-or-host) + (defvar chess-process-arguments nil "If `chess-process-where' is a string or Lisp function, pass these args.") +(defvar chess-process-game) +(defvar chess-process-last-pos) +(defvar chess-process-working nil) + +(make-variable-buffer-local 'chess-process-arguments) +(make-variable-buffer-local 'chess-process-game) +(make-variable-buffer-local 'chess-process-last-pos) +(make-variable-buffer-local 'chess-process-working) (defvar chess-process-triggers (list (list @@ -34,7 +45,11 @@ related to the resulting process.") (if (if (chess-game-side-to-move chess-process-game) (string= (downcase color) "white") (string= (downcase color) "black")) - (chess-game-move chess-process-game move nil)))) 1 2) + (chess-session-event + chess-current-session 'move + (chess-algebraic-to-ply + (chess-game-pos chess-process-game) move))))) + 1 2) '(".*Illegal move:\\s-*\\(.*\\)" (signal 'chess-illegal (match-string 1))) '(".+?\015" (replace-match ""))) @@ -47,79 +62,65 @@ Where the ARG*-GROUP entries specify which parenthesis groups in the regexp demarcate those arguments. Anything more complicated than this must be handled by modules that derive from this module.") -(make-variable-buffer-local 'chess-process-command-or-host) -(make-variable-buffer-local 'chess-process-arguments) (make-variable-buffer-local 'chess-process-triggers) -(defun chess-process (game handler triggers command-or-host &rest args) - "This function should only be called by specific chess engine modules." - (let ((buf (generate-new-buffer " *chess-process*"))) - (with-current-buffer buf - (setq chess-process-command-or-host command-or-host) - (if args (setq chess-process-arguments command-or-host)) - (if triggers (setq chess-process-triggers triggers))) - `(lambda (game command &rest args) - (apply ,(or (list 'quote handler) - 'chess-process-handler) game ,buf command args)))) - ;;; Code: -(defvar chess-process-game) -(defvar chess-process-last-pos) -(defvar chess-process-working nil) - -(make-variable-buffer-local 'chess-process-game) -(make-variable-buffer-local 'chess-process-last-pos) -(make-variable-buffer-local 'chess-process-working) - -(defun chess-process-handler (game buffer command &rest args) +(defun chess-process (session buffer event &rest args) "Handle any commands being sent to this instance of this module." - (ignore - (if (eq command 'shutdown) - (when (buffer-live-p buffer) - (condition-case err - (process-send-string (get-buffer-process buffer) "quit\n") - (error nil)) - (kill-buffer buffer)) + (cond + ((eq event 'initialize) + (let ((buf (generate-new-buffer " *chess-process*"))) + (with-current-buffer buf + (setq chess-process-triggers (nth 0 args) + chess-process-command-or-host (nth 1 args) + chess-process-arguments (nthcdr 2 args)) + (let ((proc + (if (stringp chess-process-command-or-host) + (prog2 + (message "Starting chess program '%s'..." + chess-process-command-or-host) + (apply 'start-process "chess-process" + (current-buffer) + chess-process-command-or-host + chess-process-arguments) + (message "Starting chess program '%s'...done" + chess-process-command-or-host)) + (prog2 + (message "Connecting to host %s:%d..." + (car chess-process-command-or-host) + (cdr chess-process-command-or-host)) + (open-network-stream + "chess-process" (current-buffer) + (car chess-process-command-or-host) + (cdr chess-process-command-or-host)) + (message "Connecting to host %s:%d...done" + (car chess-process-command-or-host) + (cdr chess-process-command-or-host)))))) + (unless (and proc (memq (process-status proc) '(run open))) + (error "Failed to start chess process")) + (set-process-filter proc 'chess-process-filter)) + buf))) + ((eq event 'shutdown) + (when (buffer-live-p buffer) + (ignore-errors + (process-send-string (get-buffer-process buffer) "quit\n")) + (kill-buffer buffer))) + (t + (ignore (with-current-buffer buffer (let (cmdstr) (cond - ((eq command 'initialize) - (setq chess-process-game game - chess-process-last-pos (point-min)) - (let ((proc - (if (stringp chess-process-command-or-host) - (prog2 - (message "Starting chess program '%s'..." - chess-process-command-or-host) - (apply 'start-process "chess-process" - (current-buffer) - chess-process-command-or-host - chess-process-arguments) - (message "Starting chess program '%s'...done" - chess-process-command-or-host)) - (prog2 - (message "Connecting to host %s:%d..." - (car chess-process-command-or-host) - (cdr chess-process-command-or-host)) - (open-network-stream - "chess-process" (current-buffer) - (car chess-process-command-or-host) - (cdr chess-process-command-or-host)) - (message "Connecting to host %s:%d...done" - (car chess-process-command-or-host) - (cdr chess-process-command-or-host)))))) - (unless (and proc (memq (process-status proc) '(run open))) - (error "Failed to start chess process")) - (set-process-filter proc 'chess-process-filter))) - ((eq command 'pass) - (setq cmdstr "go\n")) - ((eq command 'move) - (setq cmdstr (concat (chess-board-last-move - (chess-game-board game)) "\n")))) + ((eq event 'setup) + (setq chess-process-game (car args) + chess-process-last-pos (point-min))) + ((eq event 'move) + (setq cmdstr (concat (chess-ply-to-algebraic (car args)) "\n"))) + ((eq event 'pass) + (setq cmdstr "go\n"))) (if (and cmdstr (not chess-process-working)) (process-send-string (get-buffer-process (current-buffer)) - cmdstr))))))) + cmdstr)))))))) (defun chess-process-filter (proc string) "Process filter for receiving text from a chess process." @@ -153,8 +154,8 @@ must be handled by modules that derive from this module.") ((functionp command) (apply command args)) ((symbolp command) - (chess-game-send-event chess-process-game - command args)) + (chess-session-event chess-current-session + command args)) (t (eval command))))) (setq triggers (cdr triggers)))) (chess-illegal (error-message-string err))) diff --git a/chess-standard.el b/chess-standard.el index 4e11b1f..bc45d3f 100644 --- a/chess-standard.el +++ b/chess-standard.el @@ -23,6 +23,11 @@ ;; $Revision$ +(require 'chess-session) +(require 'chess-pos) +(require 'chess-ply) +(require 'chess-game) + (defgroup chess-standard nil "The rules of standard chess." :group 'chess) @@ -138,12 +143,12 @@ indices which indicate where a piece may have moved from." (1 0))) ((= (upcase piece) ?B) '((-1 -1) (-1 1) - + (1 -1) (1 1))) ((= (upcase piece) ?Q) '((-1 -1) (-1 0) (-1 1) - (0 -1) (0 1) - (1 -1) (1 0) (1 1))))) + (0 -1) (0 1) + (1 -1) (1 0) (1 1))))) ;; up the current file (setq pos (apply 'chess-add-index target dir)) (while pos @@ -74,6 +74,7 @@ a0 243 ;;; Code: (require 'chess-session) + (require 'chess-pgn) (defgroup chess nil @@ -83,8 +84,7 @@ a0 243 (defconst chess-version "2.0a7" "The version of the Emacs chess program.") (defcustom chess-modules - (list 'chess-standard - ;'chess-crafty + (list 'chess-standard 'chess-crafty (if (display-graphic-p) 'chess-images 'chess-ics1)) "Default module set to be used when starting a chess session. @@ -96,6 +96,9 @@ entry." :group 'chess) (defvar chess-current-session nil) +(defvar chess-illegal nil) +(put 'chess-illegal 'error-conditions '(error)) + :group 'chess) (defun chess () "Start a game of chess." @@ -103,6 +106,7 @@ entry." (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))) @@ -122,7 +126,9 @@ entry." (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-my-color))))))) + (chess-session-set-data session 'my-color + (not (chess-session-data session + 'my-color)))))))) (aset chess-puzzle-locations 3 puzzle-engine))))))) (provide 'chess) |