From fe851e20e7c1a4f7da6478d1afebb5faa8dcc72d Mon Sep 17 00:00:00 2001
From: John Wiegley <johnw@newartisans.com>
Date: Mon, 8 Apr 2002 04:24:04 +0000
Subject: Added support for network play

---
 chess-crafty.el  | 26 ++++++++---------
 chess-engine.el  |  3 +-
 chess-game.el    |  2 +-
 chess-network.el | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 105 insertions(+), 15 deletions(-)
 create mode 100644 chess-network.el

diff --git a/chess-crafty.el b/chess-crafty.el
index 245b350..0bdc782 100644
--- a/chess-crafty.el
+++ b/chess-crafty.el
@@ -14,24 +14,24 @@
   (list (cons
 	 (concat "\\s-*\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\("
 		 chess-algebraic-regexp "\\)\\s-*$")
-	 (function
-	  (lambda ()
-	    (let ((position (chess-engine-position nil))
-		  (move (match-string 2))
-		  ply)
-	      (when (string= (if (chess-pos-side-to-move position)
-				 "White" "Black")
-			     (match-string 1))
-		(setq ply (chess-algebraic-to-ply position move))
-		(unless ply
-		  (error "Could not convert engine move: %s" move))
-		(let ((chess-crafty-now-moving t))
-		  (funcall chess-engine-response-handler 'move ply)))))))
+	 'chess-crafty-perform-move)
 	(cons "Illegal move:\\s-*\\(.*\\)"
 	      (function
 	       (lambda ()
 		 (signal 'chess-illegal (match-string 1)))))))
 
+(defun chess-crafty-perform-move ()
+  (let ((position (chess-engine-position nil))
+	(move (match-string 2)) ply)
+    (when (string= (if (chess-pos-side-to-move position)
+		       "White" "Black")
+		   (match-string 1))
+      (setq ply (chess-algebraic-to-ply position move))
+      (unless ply
+	(error "Could not convert engine move: %s" move))
+      (let ((chess-crafty-now-moving t))
+	(funcall chess-engine-response-handler 'move ply)))))
+
 (defun chess-crafty-handler (event &rest args)
   (cond
    ((eq event 'initialize)
diff --git a/chess-engine.el b/chess-engine.el
index bfd30c7..4b6fc4c 100644
--- a/chess-engine.el
+++ b/chess-engine.el
@@ -69,7 +69,8 @@
 	(unless (and proc (memq (process-status proc) '(run open)))
 	  (error "Failed to start chess engine process"))
 	(set-process-buffer proc (current-buffer))
-	(set-process-filter proc 'chess-engine-filter))
+	(set-process-filter proc 'chess-engine-filter)
+	(set-marker (process-mark proc) (point)))
       (current-buffer))))
 
 (defun chess-engine-destroy (engine)
diff --git a/chess-game.el b/chess-game.el
index d0bfe12..532bd82 100644
--- a/chess-game.el
+++ b/chess-game.el
@@ -92,7 +92,7 @@
 
 (defsubst chess-game-set-plies (game plies)
   "Return the tags alist associated with GAME."
-  (setcdr (nthcdr 1 game) plies)
+  (setcdr (nthcdr 1 game) (list plies))
   (chess-game-run-hooks game 'set-plies))
 
 (defsubst chess-game-pos (game &optional index)
diff --git a/chess-network.el b/chess-network.el
new file mode 100644
index 0000000..f2dedb2
--- /dev/null
+++ b/chess-network.el
@@ -0,0 +1,89 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Play against an opponent over the network
+;;
+;; $Revision$
+
+(require 'chess-engine)
+(require 'chess-fen)
+(require 'chess-algebraic)
+
+(defvar chess-network-now-moving nil)
+
+(defvar chess-network-regexp-alist
+  (list (cons (concat "\\(Black\\|White\\):\\s-*"
+		      chess-algebraic-regexp "\\s-+")
+	      'chess-network-perform-move)
+	(cons "PASS"
+	      (function
+	       (lambda ()
+		 (message "Your opponent has passed the move to you"))))
+	(cons "CONNECT\\s-+\\(.*\\)"
+	      (function
+	       (lambda ()
+		 ;; jww (2002-04-07): Set the appropriate Black or
+		 ;; White tag at this point
+		 (message "Your opponent, %s, has connected"
+			  (match-string 1)))))
+	(cons "SETBOARD\\s-+\\(.*\\)"
+	      (function
+	       (lambda ()
+		 (let* ((position (chess-fen-to-pos (match-string 1)))
+			(ply (chess-ply-create position)))
+		   (chess-game-set-plies (chess-engine-game nil)
+					 (list ply))))))))
+
+(defun chess-network-perform-move ()
+  (let ((position (chess-engine-position nil))
+	(move (match-string 2)) ply)
+    (when (string= (if (chess-pos-side-to-move position)
+		       "White" "Black")
+		   (match-string 1))
+      (setq ply (chess-algebraic-to-ply position move))
+      (unless ply
+	(error "Could not convert engine move: %s" move))
+      (let ((chess-network-now-moving t))
+	(funcall chess-engine-response-handler 'move ply)))))
+
+(defun chess-network-handler (event &rest args)
+  "Initialize the network chess engine."
+  (cond
+   ((eq event 'initialize)
+    (let ((which (read-char "cAre 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...")
+	(process-send-string proc (format "CONNECT %s\n" (user-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)
+    (chess-engine-send nil (format "SETBOARD %s\n"
+				   (chess-pos-to-fen (car args)))))
+
+   ((eq event 'pass)
+    (chess-engine-send nil "PASS\n"))
+
+   ((eq event 'move)
+    (unless chess-network-now-moving
+      (chess-engine-send
+       nil (concat (if (chess-pos-side-to-move (chess-ply-pos (car args)))
+		       "White:"
+		     "Black:")
+		   (chess-ply-to-algebraic (car args))
+		   "\n"))))))
+
+(provide 'chess-network)
+
+;;; chess-network.el ends here
-- 
cgit v1.2.3