code.delx.au - gnu-emacs-elpa/blob - chess-network.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Play against an opponent over the network
   4 ;;
   5 ;; $Revision$
   6
   7 (require 'chess-engine)
   8 (require 'chess-fen)
   9 (require 'chess-algebraic)
  10
  11 (defvar chess-network-now-moving nil)
  12
  13 (defvar chess-network-regexp-alist
  14   (list (cons (concat "\\(Black\\|White\\):\\s-*"
  15                       chess-algebraic-regexp "\\s-+")
  16               'chess-network-perform-move)
  17         (cons "PASS"
  18               (function
  19                (lambda ()
  20                  (message "Your opponent has passed the move to you"))))
  21         (cons "CONNECT\\s-+\\(.*\\)"
  22               (function
  23                (lambda ()
  24                  ;; jww (2002-04-07): Set the appropriate Black or
  25                  ;; White tag at this point
  26                  (message "Your opponent, %s, has connected"
  27                           (match-string 1)))))
  28         (cons "SETBOARD\\s-+\\(.*\\)"
  29               (function
  30                (lambda ()
  31                  (let* ((position (chess-fen-to-pos (match-string 1)))
  32                         (ply (chess-ply-create position)))
  33                    (chess-game-set-plies (chess-engine-game nil)
  34                                          (list ply))))))
  35         (cons "QUIT"
  36               (function
  37                (lambda ()
  38                  (message "Your opponent has quit playing"))))))
  39
  40 (defun chess-network-perform-move ()
  41   (let ((position (chess-engine-position nil))
  42         (move (match-string 2)) ply)
  43     (when (string= (if (chess-pos-side-to-move position)
  44                        "White" "Black")
  45                    (match-string 1))
  46       (setq ply (chess-algebraic-to-ply position move))
  47       (unless ply
  48         (error "Could not convert engine move: %s" move))
  49       (let ((chess-network-now-moving t))
  50         (funcall chess-engine-response-handler 'move ply)))))
  51
  52 (defun chess-network-handler (event &rest args)
  53   "Initialize the network chess engine."
  54   (cond
  55    ((eq event 'initialize)
  56     (let ((which (read-char "Are you the c)lient or s)erver? "))
  57           proc)
  58       (message "Starting network client/server...")
  59       (setq proc (if (eq which ?s)
  60                      (start-process "*chess-network*"
  61                                     (current-buffer) "/usr/bin/nc"
  62                                     "-l" "-p" (read-string "Port: "))
  63                    (open-network-stream "*chess-network*" (current-buffer)
  64                                         (read-string "Host: ")
  65                                         (read-string "Port: "))))
  66       (if (eq which ?s)
  67           (message "Now waiting for your opponent to connect...")
  68         (process-send-string proc (format "CONNECT %s\n" (user-full-name)))
  69         (message "You have connected; pass now or make your move."))
  70       proc))
  71
  72    ((eq event 'shutdown)
  73     (ignore-errors
  74      (chess-engine-send nil "QUIT\n")))
  75
  76    ((eq event 'setup)
  77     (chess-engine-send nil (format "SETBOARD %s\n"
  78                                    (chess-pos-to-fen (car args)))))
  79
  80    ((eq event 'pass)
  81     (chess-engine-send nil "PASS\n"))
  82
  83    ((eq event 'move)
  84     (unless chess-network-now-moving
  85       (chess-engine-send
  86        nil (concat (if (chess-pos-side-to-move (chess-ply-pos (car args)))
  87                        "White:"
  88                      "Black:")
  89                    (chess-ply-to-algebraic (car args))
  90                    "\n"))))))
  91
  92 (provide 'chess-network)
  93
  94 ;;; chess-network.el ends here