]> code.delx.au - gnu-emacs-elpa/blobdiff - chess-network.el
Try to improve the promotion situation on ICS by allowing chess-ply to query for...
[gnu-emacs-elpa] / chess-network.el
index dee0647e1be3cb551fe00eb8fc94c86f15ebb8b0..efc9d280a403fe64cef8d5aa9db307e4764e5344 100644 (file)
@@ -2,11 +2,8 @@
 ;;
 ;; Play against an opponent over the network
 ;;
-;; $Revision$
 
-(require 'chess-engine)
-(require 'chess-fen)
-(require 'chess-algebraic)
+(require 'chess-common)
 
 (defvar chess-network-regexp-alist
   (list
@@ -29,7 +26,8 @@
         (function
          (lambda ()
            (funcall chess-engine-response-handler 'setup-game
-                    (chess-engine-convert-pgn (match-string 1))))))
+                    (chess-engine-convert-pgn
+                     (chess-network-parse-multiline (match-string 1)))))))
    (cons "pass$"
         (function
          (lambda ()
@@ -54,7 +52,7 @@
         (function
          (lambda ()
            (funcall chess-engine-response-handler 'undo
-                    (string-to-int (match-string 1))))))
+                    (string-to-number (match-string 1))))))
    (cons "accept\\(\\s-+\\(.+\\)\\)?$"
         (function
          (lambda ()
    (cons "retract$"
         (function
          (lambda ()
-           (funcall chess-engine-response-handler 'retract))))))
+           (funcall chess-engine-response-handler 'retract))))
+   (cons "illegal$"
+        (function
+         (lambda ()
+           (funcall chess-engine-response-handler 'illegal))))
+   (cons "flag$"
+        (function
+         (lambda ()
+           (funcall chess-engine-response-handler 'call-flag))))
+   (cons "forfeit$"
+        (function
+         (lambda ()
+           (funcall chess-engine-response-handler 'flag-fell))))
+   (cons "kibitz\\s-+\\(.+\\)$"
+        (function
+         (lambda ()
+           (funcall chess-engine-response-handler 'kibitz
+                    (chess-network-parse-multiline (match-string 1))))))
+   (cons "chat\\s-+\\(.+\\)$"
+        (function
+         (lambda ()
+           (funcall chess-engine-response-handler 'chat
+                    (chess-network-parse-multiline (match-string 1))))))))
+
+(chess-message-catalog 'english
+  '((network-starting  . "Starting network client/server...")
+    (network-waiting   . "Now waiting for your opponent to connect...")
+    (takeback-sent     . "Sent request to undo %d ply(s) to your opponent")))
+
+(defun chess-network-flatten-multiline (str)
+  (while (string-match "\n" str)
+    (setq str (replace-match "\C-k" t t str)))
+  str)
+
+(defun chess-network-parse-multiline (str)
+  (while (string-match "\C-k" str)
+    (setq str (replace-match "\n" t t str)))
+  str)
+
+(defvar chess-network-kind)
+(make-variable-buffer-local 'chess-network-kind)
 
-(defun chess-network-handler (event &rest args)
+(defun chess-network-handler (game event &rest args)
   "Initialize the network chess engine."
-  (cond
-   ((eq event 'initialize)
-    (let ((which (read-char "Are you the c)lient or s)erver? "))
-         proc)
-      (message "Starting network client/server...")
-      (setq proc (if (eq which ?s)
-                    (start-process "*chess-network*"
-                                   (current-buffer) "/usr/bin/nc"
-                                   "-l" "-p" (read-string "Port: "))
-                  (open-network-stream "*chess-network*" (current-buffer)
-                                       (read-string "Host: ")
-                                       (read-string "Port: "))))
-      (if (eq which ?s)
-         (message "Now waiting for your opponent to connect...")
-       (chess-network-handler 'match)
-       (message "You have connected; pass now or make your move."))
-      proc))
-
-   ((eq event 'shutdown)
-    (chess-engine-send nil "quit\n"))
-
-   ((eq event 'setup-pos)
-    (chess-engine-send nil (format "fen %s\n"
-                                  (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 'match)
-    (setq chess-engine-pending-offer 'match)
-    (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
-
-   ((eq event 'resign)
-    (chess-engine-send nil "resign\n")
-    (and (chess-engine-game nil)
-        (chess-game-set-data (chess-engine-game nil) 'active nil)))
-
-   ((eq event 'draw)
-    (if chess-engine-pending-offer
-       (chess-engine-command nil 'retract))
-    (setq chess-engine-pending-offer 'draw)
-    (chess-engine-send nil "draw\n"))
-
-   ((eq event 'abort)
-    (if chess-engine-pending-offer
-       (chess-engine-command nil 'retract))
-    (setq chess-engine-pending-offer 'abort)
-    (chess-engine-send nil "abort\n"))
-
-   ((eq event 'undo)
-    (if chess-engine-pending-offer
-       (chess-engine-command nil 'retract))
-    (setq chess-engine-pending-offer 'undo
-         chess-engine-pending-arg (car args))
-    (chess-engine-send nil (format "takeback %d\n" (car args))))
-
-   ((eq event 'accept)
-    (chess-engine-send nil "accept\n"))
-
-   ((eq event 'decline)
-    (chess-engine-send nil "decline\n"))
-
-   ((eq event 'retract)
-    (chess-engine-send nil "retract\n"))
-
-   ((eq event 'move)
-    (chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
-                                  "\n")))))
+  (unless chess-engine-handling-event
+    (cond
+     ((eq event 'initialize)
+      (let ((which (read-char "Are you the c)lient or s)erver? "))
+           proc)
+       (chess-message 'network-starting)
+       (setq proc
+             (if (eq which ?s)
+                 (if (fboundp 'open-network-stream-server)
+                     (open-network-stream-server "*chess-network*"
+                                                 (current-buffer)
+                                                 (string-to-number
+                                                  (read-string "Port: ")))
+                   (start-process "*chess-network*"
+                                  (current-buffer) "/usr/bin/nc"
+                                  "-l" "-p" (read-string "Port: ")))
+               (open-network-stream "*chess-network*" (current-buffer)
+                                    (read-string "Host: ")
+                                    (read-string "Port: "))))
+       (setq chess-engine-process proc
+             chess-network-kind (if (eq which ?s) 'server 'client))
+       t))
+
+     ((eq event 'ready)                        ; don't set active yet
+      (chess-game-run-hooks game 'announce-autosave)
+      (if (eq chess-network-kind 'server)
+         (chess-message 'network-waiting)
+       (chess-network-handler game 'match)))
+
+     ((eq event 'setup-pos)
+      (chess-engine-send nil (format "fen %s\n"
+                                    (chess-pos-to-string (car args)))))
+
+     ((eq event 'setup-game)
+      (chess-engine-send nil (format "pgn %s\n"
+                                    (chess-network-flatten-multiline
+                                     (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 'match)
+      (setq chess-engine-pending-offer 'match)
+      (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
+
+     ((eq event 'draw)
+      (if chess-engine-pending-offer
+         (chess-engine-command nil 'retract))
+      (setq chess-engine-pending-offer 'draw)
+      (chess-engine-send nil "draw\n"))
+
+     ((eq event 'abort)
+      (if chess-engine-pending-offer
+         (chess-engine-command nil 'retract))
+      (setq chess-engine-pending-offer 'abort)
+      (chess-engine-send nil "abort\n"))
+
+     ((eq event 'undo)
+      (if chess-engine-pending-offer
+         (chess-engine-command nil 'retract))
+      (setq chess-engine-pending-offer 'undo
+           chess-engine-pending-arg (car args))
+
+      (chess-engine-send nil (format "takeback %d\n" (car args)))
+      (chess-message 'takeback-sent (car args)))
+
+     ((eq event 'accept)
+      (chess-engine-send nil (if (car args)
+                                (format "accept %s\n" (car args))
+                              "accept\n")))
+
+     ((eq event 'decline)
+      (chess-engine-send nil "decline\n"))
+
+     ((eq event 'retract)
+      (chess-engine-send nil "retract\n"))
+
+     ((eq event 'illegal)
+      (chess-engine-send nil "illegal\n"))
+
+     ((eq event 'call-flag)
+      (chess-engine-send nil "flag\n"))
+
+     ((eq event 'kibitz)
+      (chess-engine-send nil (format "kibitz %s\n"
+                                    (chess-network-flatten-multiline
+                                     (car args)))))
+
+     ((eq event 'chat)
+      (chess-engine-send nil (format "chat %s\n"
+                                    (chess-network-flatten-multiline
+                                     (car args)))))
+
+     ((eq event 'set-index)
+      (chess-engine-send nil (format "index %d\n" (car args))))
+
+     ((eq event 'flag-fell)
+      (chess-engine-send nil "forfeit\n")
+      (chess-common-handler game 'flag-fell))
+
+     (t
+      (apply 'chess-common-handler game event args)))))
 
 (provide 'chess-network)