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-regexp-alist
  12   (list
  13    (cons (concat chess-algebraic-regexp "$")
  14          (function
  15           (lambda ()
  16             (funcall chess-engine-response-handler 'move
  17                      (chess-engine-convert-algebraic (match-string 0))))))
  18    (cons "chess match\\(\\s-+\\(.+\\)\\)?$"
  19          (function
  20           (lambda ()
  21             (funcall chess-engine-response-handler 'connect
  22                      (match-string 2)))))
  23    (cons "accept\\(\\s-+\\(.+\\)\\)?$"
  24          (function
  25           (lambda ()
  26             (funcall chess-engine-response-handler 'accept
  27                      (match-string 2)))))
  28    (cons "fen\\s-+\\(.+\\)"
  29          (function
  30           (lambda ()
  31             (funcall chess-engine-response-handler 'setup-pos
  32                      (chess-engine-convert-fen (match-string 1))))))
  33    (cons "pgn\\s-+\\(.+\\)"
  34          (function
  35           (lambda ()
  36             (funcall chess-engine-response-handler 'setup-game
  37                      (chess-engine-convert-pgn (match-string 1))))))
  38    (cons "pass$"
  39          (function
  40           (lambda ()
  41             (funcall chess-engine-response-handler 'pass))))
  42    (cons "quit$"
  43          (function
  44           (lambda ()
  45             (funcall chess-engine-response-handler 'quit))))
  46    (cons "resign$"
  47          (function
  48           (lambda ()
  49             (funcall chess-engine-response-handler 'resign))))
  50    (cons "abort$"
  51          (function
  52           (lambda ()
  53             (funcall chess-engine-response-handler 'abort))))))
  54
  55 (defun chess-network-handler (event &rest args)
  56   "Initialize the network chess engine."
  57   (cond
  58    ((eq event 'initialize)
  59     (let ((which (read-char "Are you the c)lient or s)erver? "))
  60           proc)
  61       (message "Starting network client/server...")
  62       (setq proc (if (eq which ?s)
  63                      (start-process "*chess-network*"
  64                                     (current-buffer) "/usr/bin/nc"
  65                                     "-l" "-p" (read-string "Port: "))
  66                    (open-network-stream "*chess-network*" (current-buffer)
  67                                         (read-string "Host: ")
  68                                         (read-string "Port: "))))
  69       (if (eq which ?s)
  70           (message "Now waiting for your opponent to connect...")
  71         (process-send-string proc (format "chess match %s\n" chess-full-name))
  72         (message "You have connected; pass now or make your move."))
  73       proc))
  74
  75    ((eq event 'shutdown)
  76     (chess-engine-send nil "quit\n"))
  77
  78    ((eq event 'setup-pos)
  79     (chess-engine-send nil (format "fen %s\n"
  80                                    (chess-pos-to-string (car args)))))
  81
  82    ((eq event 'setup-game)
  83     (chess-engine-send nil (format "pgn %s\n"
  84                                    (chess-game-to-string (car args)))))
  85
  86    ((eq event 'pass)
  87     (chess-engine-send nil "pass\n"))
  88
  89    ((eq event 'busy)
  90     (chess-engine-send nil "playing\n"))
  91
  92    ((eq event 'accept)
  93     (chess-engine-send nil (format "accept %s\n" chess-full-name)))
  94
  95    ((eq event 'decline)
  96     (chess-engine-send nil "decline\n"))
  97
  98    ((eq event 'resign)
  99     (chess-engine-send nil "resign\n"))
 100
 101    ((eq event 'abort)
 102     (chess-engine-send nil "abort\n"))
 103
 104    ((eq event 'move)
 105     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
 106                                    "\n")))))
 107
 108 (provide 'chess-network)
 109
 110 ;;; chess-network.el ends here