]> code.delx.au - gnu-emacs-elpa/commitdiff
lots of work, several new event types, better support in chess-engine
authorJohn Wiegley <johnw@newartisans.com>
Wed, 10 Apr 2002 21:08:12 +0000 (21:08 +0000)
committerJohn Wiegley <johnw@newartisans.com>
Wed, 10 Apr 2002 21:08:12 +0000 (21:08 +0000)
for establishing the starting game position

chess-announce.el
chess-crafty.el
chess-display.el
chess-engine.el
chess-game.el
chess-gnuchess.el
chess-ics.el
chess-irc.el
chess-network.el
chess.el
lispdoc.el

index ba3e052752de4183af0d252d3b3659df45d6eaf0..ff1c7f1e3c0327f09782da95779c76e8e7ba56a3 100644 (file)
@@ -43,7 +43,7 @@ See `chess-display-type' for the different kinds of displays."
    ((memq event '(move game-over))
     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
           (pos (chess-ply-pos ply)))
-      (unless (eq (chess-game-get-data game 'my-color)
+      (unless (eq (chess-game-data game 'my-color)
                  (chess-pos-side-to-move pos))
        (let* ((changes (chess-ply-changes ply))
               (source (car changes))
index 3b58f11f37f52e0eee65b39f614164c43fbd5ee1..260ebb5845660980935bc24825426706a488d6e0 100644 (file)
@@ -18,6 +18,9 @@
   :type 'file
   :group 'chess-crafty)
 
+(defvar chess-crafty-temp-files nil)
+(make-variable-buffer-local 'chess-crafty-temp-files)
+
 (defvar chess-crafty-regexp-alist
   (list (cons (concat "\\s-*\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\("
                      chess-algebraic-regexp "\\)\\s-*$")
       proc))
 
    ((eq event 'shutdown)
-    (chess-engine-send nil "quit\n"))
+    (chess-engine-send nil "quit\n")
+    (dolist (file chess-crafty-temp-files)
+      (if (file-exists-p file)
+         (delete-file file))))
+
+   ((eq event 'ready)
+    (let ((game (chess-engine-game nil)))
+      (if game
+         (chess-game-set-data game 'active t))))
 
-   ((eq event 'setup)
+   ((eq event 'setup-pos)
     (chess-engine-send nil (format "setboard %s\n"
                                   (chess-pos-to-fen (car args)))))
 
+   ((eq event 'setup-game)
+    (let ((file (make-temp-file "cra")))
+      (with-temp-file file
+       (insert (chess-game-to-string (car args)) ?\n))
+      (chess-engine-send nil (format "read %s\n" file))
+      (push file chess-crafty-temp-files)))
+
    ((eq event 'pass)
     (chess-engine-send nil "go\n"))
 
index 4fe35de1901d15e35fd40f2b62b46c2e489575ef..dc5182ebd46eb6f00ad1b643a791d628306922cb 100644 (file)
        (chess-display-set-ply new-display chess-display-ply))
        (chess-display-position
        (chess-display-set-game new-display chess-display-position))))
-    (chess-display-update new-display t)
+    ;; the display will have already been updated by the `set-' calls,
+    ;; it's just not visible yet
+    (chess-display-popup new-display)
     new-display))
 
 (defsubst chess-display-style (display)
   (chess-with-current-buffer display
     chess-display-perspective))
 
-(defun chess-display-set-perspective (display perspective)
+(defun chess-display-set-perspective* (display perspective)
   (chess-with-current-buffer display
     (setq chess-display-perspective perspective)
-    (erase-buffer)                     ; force a complete redraw
+    (erase-buffer)))                   ; force a complete redraw
+
+(defun chess-display-set-perspective (display perspective)
+  (chess-with-current-buffer display
+    (chess-display-set-perspective* nil perspective)
     (chess-display-update nil)))
 
 (defsubst chess-display-main-p (display)
@@ -228,6 +234,24 @@ modeline."
     (chess-game-add-hook game 'chess-display-event-handler display)
     (chess-display-update nil t)))
 
+(defun chess-display-copy-game (display game)
+  (chess-with-current-buffer display
+    (setq chess-display-index (chess-game-index game))
+    (if (null chess-display-game)
+       (chess-display-set-game nil game)
+      (chess-game-set-tags chess-display-game (chess-game-tags game))
+      ;; this call triggers `setup-game' for us
+      (chess-game-set-plies chess-display-game
+                           (chess-game-plies game)))))
+
+(defun chess-display-set-start-position (display position my-color)
+  (chess-with-current-buffer display
+    (let ((game (chess-display-game nil)))
+      (if (null game)
+         (chess-display-set-position nil position)
+       (chess-game-set-data game 'my-color my-color)
+       (chess-game-set-start-position game position)))))
+
 (defun chess-display-detach-game (display)
   "Set the display game.
 This will cause the first ply in the game's main variation to be
@@ -243,7 +267,7 @@ modeline."
   (chess-with-current-buffer display
     chess-display-game))
 
-(defun chess-display-set-index (display index)
+(defun chess-display-set-index* (display index)
   (chess-with-current-buffer display
     (unless chess-display-index
       (error "There is no game or variation currently being displayed."))
@@ -252,8 +276,12 @@ modeline."
                (> index (if chess-display-game
                             (chess-game-index chess-display-game)
                           (chess-var-index chess-display-variation))))
-      (setq chess-display-index index)
-      (chess-display-update nil))))
+      (setq chess-display-index index))))
+
+(defun chess-display-set-index (display index)
+  (chess-with-current-buffer display
+    (chess-display-set-index* nil index)
+    (chess-display-update nil)))
 
 (defsubst chess-display-index (display)
   (chess-with-current-buffer display
@@ -266,7 +294,8 @@ modeline."
             (chess-display-position nil)
             (chess-display-perspective nil))
     (chess-display-set-modeline)
-    (if popup
+    (if (and popup (not chess-display-no-popup)
+            (chess-display-main-p nil))
        (chess-display-popup nil))))
 
 (defun chess-display-move (display ply)
@@ -284,7 +313,8 @@ If only START is given, it must be in algebraic move notation."
        (error "What to do here??  NYI")))
      (chess-display-variation
       (chess-var-move chess-display-variation ply)
-      (chess-display-set-index nil (chess-var-index chess-display-variation)))
+      (chess-display-set-index*
+       nil (chess-var-index chess-display-variation)))
      (chess-display-ply
       (setq chess-display-ply ply))
      (chess-display-position           ; an ordinary position
@@ -307,8 +337,7 @@ that is supported by most displays, and is the default mode."
 (defun chess-display-popup (display)
   "Popup the given DISPLAY, so that it's visible to the user."
   (chess-with-current-buffer display
-    (unless chess-display-no-popup
-      (funcall chess-display-event-handler 'popup))))
+    (funcall chess-display-event-handler 'popup)))
 
 (defun chess-display-enable-popup (display)
   "Popup the given DISPLAY, so that it's visible to the user."
@@ -336,36 +365,40 @@ that is supported by most displays, and is the default mode."
 (defun chess-display-event-handler (game display event &rest args)
   "This display module presents a standard chessboard.
 See `chess-display-type' for the different kinds of displays."
-  (with-current-buffer display
-    (cond
-     ((eq event 'shutdown)
-      (chess-display-destroy nil))
+  (unless (memq event '(set-data set-tags set-tag))
+    (with-current-buffer display
+      (cond
+       ((eq event 'shutdown)
+       (chess-display-destroy nil))
 
-     ((eq event 'destroy)
-      (chess-display-detach-game nil))
+       ((eq event 'destroy)
+       (chess-display-detach-game nil))
 
-     ((eq event 'pass)
-      (let ((my-color (if chess-display-game
-                         (chess-game-get-data chess-display-game
-                                              'my-color)
-                       (chess-display-perspective nil))))
+       ((eq event 'pass)
+       (let ((my-color (if chess-display-game
+                           (chess-game-data chess-display-game 'my-color)
+                         (chess-display-perspective nil))))
+         (if chess-display-game
+             (chess-game-set-data chess-display-game 'my-color
+                                  (not my-color)))
+         (chess-display-set-perspective* nil (not my-color))))
+
+       ((eq event 'orient)
+       ;; Set the display's perspective to whichever color I'm playing
        (if chess-display-game
-           (chess-game-set-data chess-display-game 'my-color
-                                (not my-color)))
-       (chess-display-set-perspective nil (not my-color))))
+           (chess-display-set-perspective*
+            nil (chess-game-data chess-display-game 'my-color))))
 
-     ((memq event '(move game-over resign))
-      (chess-display-set-index nil (chess-game-index
-                                   (chess-display-game nil)))))
+       ((memq event '(move game-over resign))
+       (chess-display-set-index*
+        nil (chess-game-index (chess-display-game nil)))))
 
-    (if (eq event 'resign)
-       (message-box "%s resigns" (if (car args) "White" "Black")))
+      (if (eq event 'resign)
+         (message-box "%s resigns" (if (car args) "White" "Black")))
 
-    (unless (eq event 'shutdown)
-      (chess-display-update nil))
-
-    (if (memq event '(pass move game-over resign))
-       (chess-display-popup nil))))
+      (unless (eq event 'shutdown)
+       (chess-display-update nil (memq event
+                                       '(pass move game-over resign)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -400,8 +433,8 @@ See `chess-display-type' for the different kinds of displays."
     (define-key map [?.] 'chess-display-move-forward)
     (define-key map [(meta ?>)] 'chess-display-move-last)
 
-    (define-key map [(meta ?w)] 'chess-display-copy-board)
-    (define-key map [(control ?y)] 'chess-display-paste-board)
+    (define-key map [(meta ?w)] 'chess-display-kill-board)
+    (define-key map [(control ?y)] 'chess-display-yank-board)
 
     (define-key map [(control ?l)] 'chess-display-redraw)
 
@@ -445,6 +478,7 @@ See `chess-display-type' for the different kinds of displays."
 (defun chess-display-redraw ()
   "Just redraw the current display."
   (interactive)
+  (erase-buffer)
   (chess-display-update nil))
 
 (defun chess-display-mode ()
@@ -509,7 +543,7 @@ Basically, it means we are playing, not editing or reviewing."
   (interactive "sSet from FEN string: ")
   (chess-display-set-position nil (chess-fen-to-pos fen)))
 
-(defun chess-display-copy-board (&optional arg)
+(defun chess-display-kill-board (&optional arg)
   "Send the current board configuration to the user."
   (interactive "P")
   (let ((x-select-enable-clipboard t))
@@ -519,13 +553,14 @@ Basically, it means we are playing, not editing or reviewing."
                    (buffer-string)))
       (kill-new (chess-pos-to-fen (chess-display-position nil))))))
 
-(defun chess-display-paste-board ()
+(defun chess-display-yank-board ()
   "Send the current board configuration to the user."
   (interactive)
   (let ((x-select-enable-clipboard t)
-       (display (current-buffer)))
+       (display (current-buffer))
+       (text (current-kill 0)))
     (with-temp-buffer
-      (insert (current-kill 0))
+      (insert text)
       (goto-char (point-max))
       (while (and (bolp) (not (bobp)))
        (delete-backward-char 1))
@@ -533,7 +568,7 @@ Basically, it means we are playing, not editing or reviewing."
       (cond
        ((search-forward "[Event" nil t)
        (goto-char (match-beginning 0))
-       (chess-display-set-game display (chess-pgn-to-game)))
+       (chess-display-copy-game display (chess-pgn-to-game)))
        ((looking-at (concat chess-algebraic-regexp "$"))
        (let ((move (buffer-string)))
          (with-current-buffer display
index 0644ed2044dacc3d51da04a5e236d92e00a7d189..6fd739d16dd49bfb6a5f16b0e6ce20768d4e88ba 100644 (file)
     (setq chess-engine-position (chess-ply-next-pos ply)))))
 
 (defun chess-engine-default-handler (event &rest args)
-  (let ((chess-engine-handling-event t))
+  (let ((chess-engine-handling-event t)
+       (game (chess-engine-game nil)))
     (cond
      ((eq event 'move)
-      (let ((ply (chess-algebraic-to-ply (chess-engine-position nil)
-                                        (car args))))
-       (if (null ply)
-           (message "Received invalid move from engine: %s" (car args))
-         ;; if the game index is still 0, then our opponent is white,
-         ;; and we need to pass over the move
-         (let ((game (chess-engine-game nil)))
-           (when (and game (chess-game-get-data game 'my-color)
+      (when (and game (chess-game-data game 'active))
+       (let ((ply (if (stringp (car args))
+                      (chess-algebraic-to-ply (chess-engine-position nil)
+                                              (car args))
+                    (car args))))
+         (if (null ply)
+             (message "Received invalid move from engine: %s" (car args))
+           ;; if the game index is still 0, then our opponent is white,
+           ;; and we need to pass over the move
+           (when (and game (chess-game-data game 'my-color)
                       (= (chess-game-index game) 0))
              (message "Your opponent played the first move, you are now black")
              (chess-game-run-hooks game 'pass)
              ;; if no one else flipped my-color, we'll do it
-             (if (chess-game-get-data game 'my-color)
-                 (chess-game-set-data game 'my-color nil))))
-         (chess-engine-do-move ply)))
-      t)
+             (if (chess-game-data game 'my-color)
+                 (chess-game-set-data game 'my-color nil)))
+           (chess-engine-do-move ply)))
+       t))
 
      ((eq event 'pass)
-      (if (and (chess-game-get-data (chess-engine-game nil) 'active)
-              (= (chess-game-index (chess-engine-game nil)) 0))
-         (message "Your opponent has passed the first move to you"))
-      t)
+      (when (and game (chess-game-data game 'active))
+       (message "Your opponent has passed the move to you")
+       t))
 
      ((eq event 'connect)
-      (unless (chess-game-get-data (chess-engine-game nil) 'active)
+      (if (and game (chess-game-data game 'active))
+         (chess-engine-command nil 'busy)
        (if (y-or-n-p
             (if (and (car args) (> (length (car args)) 0))
                 (format "Do you wish to play a chess game against %s? "
                         (car args))
               (format "Do you wish to play a chess game against an anonymous opponent? ")))
-           (progn
-             (chess-game-set-data (chess-engine-game nil) 'active t)
-             (chess-engine-send nil (format "accept %s" (user-full-name))))
-         (chess-engine-send nil "decline"))
-       t))
+           (chess-engine-command nil 'accept)
+         (chess-engine-send nil 'decline)))
+      t)
 
      ((eq event 'accept)
-      (unless (chess-game-get-data (chess-engine-game nil) 'active)
+      (unless (and game (chess-game-data game 'active))
        (if (and (car args) (> (length (car args)) 0))
            (message "Your opponent, %s, is now ready to play" (car args))
          (message "Your opponent is now ready to play"))
-       (chess-game-set-data (chess-engine-game nil) 'active t)
+       (let ((chess-game-inhibit-events t))
+         (if game
+             (chess-game-set-start-position game chess-starting-position)
+           (setq game (chess-engine-set-game nil (chess-game-create))))
+         (chess-game-set-data game 'my-color t)
+         (chess-game-set-data game 'active t))
+       (chess-game-run-hooks game 'orient)
        t))
 
+     ((eq event 'setup-pos)
+      (let ((position (if (stringp (car args))
+                         (chess-fen-to-pos (car args))
+                       (car args))))
+       (when position
+         (chess-engine-set-start-position nil position t)
+         t)))
+
+     ((eq event 'setup-game)
+      (let ((new-game (if (stringp (car args))
+                         (chess-pgn-to-game (car args))
+                       (car args))))
+       (when new-game
+         (if (null game)
+             (chess-engine-set-game nil new-game)
+           (let ((chess-game-inhibit-events t))
+             (chess-engine-copy-game nil new-game)
+             (chess-game-set-data game 'active t)
+             (if (string= chess-full-name (chess-game-tag game "White"))
+                 (chess-game-set-data game 'my-color t)
+               (chess-game-set-data game 'my-color nil)))
+           (chess-game-run-hooks game 'orient))
+         t)))
+
      ((eq event 'quit)
-      (message "Your opponent has quit playing"))
+      (message "Your opponent has quit playing")
+      (if game
+         (chess-game-set-data game 'active nil))
+      t)
 
      ((eq event 'resign)
-      (if chess-engine-game
-         (chess-game-resign chess-engine-game)))
+      (when game
+       (chess-game-resign game)
+       (chess-game-set-data game 'active nil)
+       t)))))
 
-     ((eq event 'setup)
-      (chess-game-set-start-position (chess-engine-game nil)
-                                    (chess-fen-to-pos (car args)))))))
+(defun chess-engine-set-start-position (engine position my-color)
+  (chess-with-current-buffer engine
+    (let ((game (chess-engine-game nil)))
+      (if (null game)
+         (chess-engine-set-position nil position)
+       (let ((chess-game-inhibit-events t))
+         (chess-game-set-start-position game position)
+         (chess-game-set-data game 'active t)
+         (chess-game-set-data game 'my-color my-color))
+       (chess-game-run-hooks game 'orient)))))
 
 (defun chess-engine-create (module &optional user-handler &rest args)
   (let ((regexp-alist (intern-soft (concat (symbol-name module)
        (chess-engine-detach-game nil))
     (setq chess-engine-game nil
          chess-engine-position position)
-    (chess-engine-command nil 'setup position)))
+    (chess-engine-command nil 'setup-pos position)))
 
 (defun chess-engine-position (engine)
   (chess-with-current-buffer engine
             (chess-game-pos chess-engine-game))
        chess-engine-position)))
 
-(defun chess-engine-set-game (engine game)
+(defun chess-engine-set-game (engine game &optional no-setup)
   (chess-with-current-buffer engine
     (if chess-engine-game
        (chess-engine-detach-game nil))
     (setq chess-engine-game game
          chess-engine-position nil)
     (chess-game-add-hook game 'chess-engine-event-handler engine)
-    (chess-engine-command nil 'setup (chess-game-pos game))))
+    (unless no-setup
+      (chess-engine-command nil 'setup-game game))))
+
+(defsubst chess-engine-set-game* (engine game)
+  "This function is a special variant of `chess-engine-set-game'.
+It should be used only if:
+  ENGINE is an engine which is newly created, and has not been used.
+  GAME is a new game at the starting position, which has not been used.
+
+This function exists because all engines start out assuming the
+starting position, which in effect means that `setup-game's work has
+already been done, and therefore does not need to be duplicated.
+
+There is no harm in calling `chess-engine-set-game' instead of this
+function in all cases; this is merely a bandwidth-saver."
+  (chess-engine-set-game engine game t))
+
+(defun chess-engine-copy-game (engine game)
+  (chess-with-current-buffer engine
+    (if (null chess-engine-game)
+       (chess-engine-set-game nil game)
+      (chess-game-set-tags chess-engine-game game)
+      ;; this call triggers `setup-game' for us
+      (chess-game-set-plies chess-engine-game game))))
 
 (defun chess-engine-detach-game (engine)
   (chess-with-current-buffer engine
index 60a9ddf61a8339a4bafdc91c3457bb293dd6b748..af64241cf27dfdff945380ae0b5e5999ae91af6a 100644 (file)
@@ -14,6 +14,8 @@
 (defvar chess-illegal nil)
 (put 'chess-illegal 'error-conditions '(error))
 
+(defvar chess-game-inhibit-events nil)
+
 (defconst chess-game-default-tags
   `(("Event"      . "Computer chess game")
     ("Round"      . "-")
@@ -59,8 +61,9 @@ matches."
 
 (defsubst chess-game-run-hooks (game &rest args)
   "Return the tags alist associated with GAME."
-  (dolist (hook (chess-game-hooks game))
-    (apply (car hook) game (cdr hook) args)))
+  (unless chess-game-inhibit-events
+    (dolist (hook (chess-game-hooks game))
+      (apply (car hook) game (cdr hook) args))))
 
 
 (defsubst chess-game-tags (game)
@@ -101,10 +104,11 @@ matches."
   (let ((alist (chess-game-data-alist game)))
     (if (null alist)
        (setcar (nthcdr 2 game) (list (cons key value)))
-      (push (cons key value) alist))
+      (push (cons key value) alist)
+      (setcar (nthcdr 2 game) alist))
     (chess-game-run-hooks game 'set-data key)))
 
-(defun chess-game-get-data (game key)
+(defun chess-game-data (game key)
   (let ((alist (chess-game-data-alist game)))
     (if alist
        (cdr (assq key alist)))))
@@ -124,7 +128,7 @@ matches."
 (defsubst chess-game-set-plies (game plies)
   "Return the tags alist associated with GAME."
   (setcdr (nthcdr 2 game) (list plies))
-  (chess-game-run-hooks game 'setup (chess-ply-pos (car (last plies)))))
+  (chess-game-run-hooks game 'setup-game game))
 
 (defsubst chess-game-set-start-position (game position)
   "Return the tags alist associated with GAME."
@@ -159,6 +163,10 @@ matches."
       (chess-game-set-plies game (list ply)))))
 
 
+(defsubst chess-game-to-string (game &optional indented)
+  (chess-game-to-pgn game indented t))
+
+
 (defun chess-game-create (&optional position tags)
   "Create a new chess game object.
 Optionally use the given starting POSITION.
index c26bf45de4df60c46ba4c33f6c2f153bdca7721e..0e641fef672b432affd588b4230be0c27f3b5c1f 100644 (file)
       (if (file-exists-p file)
          (delete-file file))))
 
-   ((eq event 'setup)
+   ((eq event 'ready)
+    (let ((game (chess-engine-game nil)))
+      (if game
+         (chess-game-set-data game 'active t))))
+
+   ((eq event 'setup-pos)
     (if (equal (car args) chess-starting-position)
        (chess-engine-send nil "new\n")
       (let ((file (make-temp-file "gch")))
        (with-temp-file file
-         (insert (chess-pos-to-fen (car args)) ?\n))
+         (insert (chess-pos-to-string (car args)) ?\n))
        (chess-engine-send nil (format "epdload %s\n" file))
        (push file chess-gnuchess-temp-files))))
 
+   ((eq event 'setup-game)
+    (let ((file (make-temp-file "gch")))
+      (with-temp-file file
+       (insert (chess-game-to-string (car args)) ?\n))
+      (chess-engine-send nil (format "pgnload %s\n" file))
+      (push file chess-gnuchess-temp-files)))
+
    ((eq event 'pass)
     (chess-engine-send nil (concat (if (chess-pos-side-to-move
                                        (chess-engine-position nil))
index 0d046ca6e84169e0e360245b62257c7ca4cc3fb3..f6fea328112af0ffa2ac322dd548a789edf691cf 100644 (file)
@@ -88,15 +88,15 @@ who is black."
     (setq parts (cdr parts))
 
     ;; move in elaborated notation
+    (setq ply (if (string= (car parts) "none")
+                 (chess-ply-create position)
+               (chess-algebraic-to-ply position (substring (car parts) 2))))
     (setq parts (cdr parts))
 
     ;; time elapsed
     (setq parts (cdr parts))
 
     ;; move in algebraic notation
-    (setq ply (if (string= (car parts) "none")
-                 (chess-ply-create position)
-               (chess-algebraic-to-ply position (car parts))))
     (setq parts (cdr parts))
 
     ;; unknown
@@ -109,21 +109,21 @@ who is black."
 (defun chess-ics-handle-move ()
   (let ((begin (match-beginning 1))
        (end (match-end 1))
-       (info (chess-ics12-parse (match-string 2))))
-    (if (> (chess-game-index (chess-engine-game nil)) 0)
+       (info (chess-ics12-parse (match-string 2)))
+       (game (chess-engine-game nil)))
+    (assert game)
+    (if (> (chess-game-index game) 0)
        (if (eq (chess-pos-side-to-move (chess-ply-pos (car info)))
                (chess-pos-side-to-move (chess-engine-position nil)))
            (chess-engine-do-move (car info)))
-      (chess-game-set-plies (chess-engine-game nil)
-                           (list (car info)))
-      (unless (string= (cadr info) ics-handle)
-       (chess-game-run-hooks (chess-engine-game nil) 'pass)))
+      (chess-engine-set-start-position nil (chess-ply-pos (car info))
+                                      (string= (cadr info) ics-handle)))
     (delete-region begin end)
     t))
 
 (defvar chess-ics-regexp-alist
   (list (cons "\\(<12> \\(.+\\)\\)" 'chess-ics-handle-move)
-       (cons "You accept the match offer from \\([^\\.]+\\)."
+       (cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+"
              (function
               (lambda ()
                 (funcall chess-engine-response-handler 'connect
@@ -189,6 +189,15 @@ who is black."
     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
                                   "\n")))
 
+   ((eq event 'accept)
+    (chess-engine-send nil "accept\n"))
+
+   ((eq event 'decline)
+    (chess-engine-send nil "decline\n"))
+
+   ((eq event 'resign)
+    (chess-engine-send nil "resign\n"))
+
    ((eq event 'send)
     (comint-send-string (get-buffer-process (current-buffer)) (car args)))))
 
index dbc9cdfa429031ea70f8620c735e37d5e59af34c..a66f9971a12ee90175e2b02cd432f47a864de723 100644 (file)
@@ -60,7 +60,7 @@
        (when (and proc (eq (process-status proc) 'open))
          (process-send-string proc (format "USER %s 0 * :%s\n"
                                            (user-login-name)
-                                           (user-full-name)))
+                                           chess-full-name))
          (process-send-string proc (format "NICK %s\n" chess-irc-nick))
          (set-process-filter proc 'chess-irc-filter)
          (set-process-buffer proc (current-buffer))
@@ -89,7 +89,7 @@ NOTE: This function is meant to be called from a display buffer!"
       (cdr (assq 'chess-engine-event-handler
                 (chess-game-hooks (chess-display-game nil))))
     (setq chess-irc-opponent nick)
-    (chess-engine-send nil (format "name %s\n" (user-full-name)))))
+    (chess-engine-send nil (format "chess match %s\n" chess-full-name))))
 
 ;; This filter translates IRC syntax into basic chess-network protocol
 (defun chess-irc-filter (proc string)
index ebc3b8fb2eb95f51d38deecc417082f74fb2861f..b48f77689c827f27aa6ae56b68e2804ff7a5a89a 100644 (file)
        (cons "fen\\s-+\\(.+\\)"
              (function
               (lambda ()
-                (funcall chess-engine-response-handler 'setup
+                (funcall chess-engine-response-handler 'setup-pos
+                         (match-string 1)))))
+       (cons "pgn\\s-+\\(.+\\)"
+             (function
+              (lambda ()
+                (funcall chess-engine-response-handler 'setup-game
                          (match-string 1)))))
        (cons "pass$"
              (function
                                        (read-string "Port: "))))
       (if (eq which ?s)
          (message "Now waiting for your opponent to connect...")
-       (process-send-string proc (format "name %s\n" (user-full-name)))
+       (process-send-string proc (format "chess match %s\n" chess-full-name))
        (message "You have connected; pass now or make your move."))
       proc))
 
    ((eq event 'shutdown)
     (chess-engine-send nil "quit\n"))
 
-   ((eq event 'setup)
+   ((eq event 'setup-pos)
     (chess-engine-send nil (format "fen %s\n"
-                                  (chess-pos-to-fen (car args)))))
+                                  (chess-pos-to-string (car args)))))
+
+   ((eq event 'setup-game)
+    (chess-engine-send nil (format "pgn %s\n"
+                                  (chess-game-to-string (car args)))))
 
    ((eq event 'pass)
     (chess-engine-send nil "pass\n"))
 
+   ((eq event 'busy)
+    (chess-engine-send nil "playing\n"))
+
+   ((eq event 'accept)
+    (chess-engine-send nil (format "accept %s\n" chess-full-name)))
+
+   ((eq event 'decline)
+    (chess-engine-send nil "decline\n"))
+
    ((eq event 'resign)
     (chess-engine-send nil "resign\n"))
 
index 2c17206115defcddab725d6f68811212fdca5715..c789d05243d459f692cd71a79841e493e87fdbac 100644 (file)
--- a/chess.el
+++ b/chess.el
@@ -84,7 +84,7 @@ a0 243
 (defgroup chess nil
   "An Emacs chess playing program."
   :group 'games)
-(defconst chess-version "2.0a4"
+(defconst chess-version "2.0a5"
 (defconst chess-version "2.0a7"
   "The version of the Emacs chess program.")
 
@@ -107,19 +107,25 @@ minibuffer, which works well for Emacspeak users."
   :type 'boolean
   :group 'chess)
 
+(defcustom chess-full-name (user-full-name)
+  "The full name to use when playing chess."
+  :type 'string
+  :group 'chess)
+
 (defun chess (&optional arg)
   "Start a game of chess."
   (interactive "P")
-  (let ((game (chess-game-create))     ; start out as white always
-       (my-color t)
-       display engine)
+      chess-default-engine)))
+
+
+  (require chess-default-display)
+  (let* ((my-color t)                  ; we start out as white always
+        (display (chess-display-create chess-default-display my-color))
         (game (chess-game-create)))
 
 
-    (require chess-default-display)
-    (let ((display (chess-display-create chess-default-display my-color)))
-      (chess-display-set-game display game)
-      (chess-display-set-main display))
+       (chess-display-disable-popup display))
+    (chess-display-set-game display game)
     (chess-display-set-main display)
     (let ((engine-module
           (if arg
@@ -127,11 +133,19 @@ minibuffer, which works well for Emacspeak users."
                           "chess-none"))
             chess-default-engine)))
     (let ((engine-module (or engine chess-default-engine)))
-       (chess-engine-set-game (chess-engine-create engine-module) game)
+       (let ((engine (chess-engine-create engine-module)))
+                            engine-ctor-args)))
+         (chess-engine-set-game* engine game)
+         ;; 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))
        (when chess-announce-moves
          (require 'chess-announce)
-         (chess-announce-for-game game))))))
+         (chess-announce-for-game game))))
+                 (chess-announce-for-game game)))))))
+    (chess-display-update display t)))
     (cons display engine)))
 
 ;;;###autoload
index 88994b250c0e0f87f7cecec60f32e6390aadde19..ba5fdfd12ef9b2647f5334175f27049ec33a5f07 100644 (file)
@@ -1,3 +1,5 @@
+(require 'pp)
+
 (defun update-lispdoc-tags ()
   (interactive)
   (save-excursion