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 match\\(\\s-+\\(.+\\)\\)?$"
  24          (function
  25           (lambda ()
  26             (funcall chess-engine-response-handler 'accept-connect
  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 "draw$"
  51          (function
  52           (lambda ()
  53             (funcall chess-engine-response-handler 'draw))))
  54    (cons "accept draw$"
  55          (function
  56           (lambda ()
  57             (funcall chess-engine-response-handler 'accept-draw))))
  58    (cons "decline draw$"
  59          (function
  60           (lambda ()
  61             (funcall chess-engine-response-handler 'decline-draw))))
  62    (cons "abort$"
  63          (function
  64           (lambda ()
  65             (funcall chess-engine-response-handler 'abort))))
  66    (cons "accept abort$"
  67          (function
  68           (lambda ()
  69             (funcall chess-engine-response-handler 'accept-abort))))
  70    (cons "decline abort$"
  71          (function
  72           (lambda ()
  73             (funcall chess-engine-response-handler 'decline-abort))))
  74    (cons "takeback\\s-+\\([0-9]+\\)$"
  75          (function
  76           (lambda ()
  77             (funcall chess-engine-response-handler 'undo
  78                      (string-to-int (match-string 1))))))
  79    (cons "accept takeback\\s-+\\([0-9]+\\)$"
  80          (function
  81           (lambda ()
  82             (funcall chess-engine-response-handler 'accept-undo
  83                      (string-to-int (match-string 1))))))
  84    (cons "decline takeback$"
  85          (function
  86           (lambda ()
  87             (funcall chess-engine-response-handler 'decline-undo))))))
  88
  89 (defun chess-network-handler (event &rest args)
  90   "Initialize the network chess engine."
  91   (cond
  92    ((eq event 'initialize)
  93     (let ((which (read-char "Are you the c)lient or s)erver? "))
  94           proc)
  95       (message "Starting network client/server...")
  96       (setq proc (if (eq which ?s)
  97                      (start-process "*chess-network*"
  98                                     (current-buffer) "/usr/bin/nc"
  99                                     "-l" "-p" (read-string "Port: "))
 100                    (open-network-stream "*chess-network*" (current-buffer)
 101                                         (read-string "Host: ")
 102                                         (read-string "Port: "))))
 103       (if (eq which ?s)
 104           (message "Now waiting for your opponent to connect...")
 105         (process-send-string proc (format "chess match %s\n" chess-full-name))
 106         (message "You have connected; pass now or make your move."))
 107       proc))
 108
 109    ((eq event 'shutdown)
 110     (chess-engine-send nil "quit\n"))
 111
 112    ((eq event 'setup-pos)
 113     (chess-engine-send nil (format "fen %s\n"
 114                                    (chess-pos-to-string (car args)))))
 115
 116    ((eq event 'setup-game)
 117     (chess-engine-send nil (format "pgn %s\n"
 118                                    (chess-game-to-string (car args)))))
 119
 120    ((eq event 'pass)
 121     (chess-engine-send nil "pass\n"))
 122
 123    ((eq event 'busy)
 124     (chess-engine-send nil "playing\n"))
 125
 126    ((eq event 'connect)
 127     (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 128
 129    ((eq event 'accept-connect)
 130     (chess-engine-send nil (format "accept match %s\n" chess-full-name)))
 131
 132    ((eq event 'decline)
 133     (chess-engine-send nil "decline\n"))
 134
 135    ((eq event 'resign)
 136     (chess-engine-send nil "resign\n"))
 137
 138    ((eq event 'draw)
 139     (chess-engine-send nil "draw\n"))
 140
 141    ((eq event 'accept-draw)
 142     (chess-engine-send nil "accept draw\n"))
 143
 144    ((eq event 'decline-draw)
 145     (chess-engine-send nil "decline draw\n"))
 146
 147    ((eq event 'abort)
 148     (chess-engine-send nil "abort\n"))
 149
 150    ((eq event 'accept-abort)
 151     (chess-engine-send nil "accept abort\n"))
 152
 153    ((eq event 'decline-abort)
 154     (chess-engine-send nil "decline abort\n"))
 155
 156    ((eq event 'undo)
 157     (chess-engine-send nil (format "takeback %d\n" (car args))))
 158
 159    ((eq event 'accept-undo)
 160     (chess-engine-send nil (format "accept takeback %d\n" (car args))))
 161
 162    ((eq event 'decline-undo)
 163     (chess-engine-send nil "decline takeback\n"))
 164
 165    ((eq event 'move)
 166     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
 167                                    "\n")))))
 168
 169 (provide 'chess-network)
 170
 171 ;;; chess-network.el ends here