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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Play against an opponent over the network
   4 ;;
   5
   6 (require 'chess-common)
   7 (require 'chess-fen)
   8 (require 'chess-algebraic)
   9
  10 (defvar chess-network-regexp-alist
  11   (list
  12    (cons (concat chess-algebraic-regexp "$")
  13          (function
  14           (lambda ()
  15             (funcall chess-engine-response-handler 'move
  16                      (chess-engine-convert-algebraic (match-string 0))))))
  17    (cons "chess match\\(\\s-+\\(.+\\)\\)?$"
  18          (function
  19           (lambda ()
  20             (funcall chess-engine-response-handler 'match
  21                      (match-string 2)))))
  22    (cons "fen\\s-+\\(.+\\)"
  23          (function
  24           (lambda ()
  25             (funcall chess-engine-response-handler 'setup-pos
  26                      (chess-engine-convert-fen (match-string 1))))))
  27    (cons "pgn\\s-+\\(.+\\)"
  28          (function
  29           (lambda ()
  30             (funcall chess-engine-response-handler 'setup-game
  31                      (chess-engine-convert-pgn
  32                       (chess-network-parse-multiline (match-string 1)))))))
  33    (cons "pass$"
  34          (function
  35           (lambda ()
  36             (funcall chess-engine-response-handler 'pass))))
  37    (cons "quit$"
  38          (function
  39           (lambda ()
  40             (funcall chess-engine-response-handler 'quit))))
  41    (cons "resign$"
  42          (function
  43           (lambda ()
  44             (funcall chess-engine-response-handler 'resign))))
  45    (cons "draw$"
  46          (function
  47           (lambda ()
  48             (funcall chess-engine-response-handler 'draw))))
  49    (cons "abort$"
  50          (function
  51           (lambda ()
  52             (funcall chess-engine-response-handler 'abort))))
  53    (cons "takeback\\s-+\\([0-9]+\\)$"
  54          (function
  55           (lambda ()
  56             (funcall chess-engine-response-handler 'undo
  57                      (string-to-int (match-string 1))))))
  58    (cons "accept\\(\\s-+\\(.+\\)\\)?$"
  59          (function
  60           (lambda ()
  61             (funcall chess-engine-response-handler 'accept
  62                      (match-string 2)))))
  63    (cons "decline$"
  64          (function
  65           (lambda ()
  66             (funcall chess-engine-response-handler 'decline))))
  67    (cons "retract$"
  68          (function
  69           (lambda ()
  70             (funcall chess-engine-response-handler 'retract))))
  71    (cons "illegal$"
  72          (function
  73           (lambda ()
  74             (funcall chess-engine-response-handler 'illegal))))
  75    (cons "kibitz\\s-+\\(.+\\)$"
  76          (function
  77           (lambda ()
  78             (funcall chess-engine-response-handler 'kibitz
  79                      (chess-network-parse-multiline (match-string 1))))))
  80    (cons "chat\\s-+\\(.+\\)$"
  81          (function
  82           (lambda ()
  83             (funcall chess-engine-response-handler 'chat
  84                      (chess-network-parse-multiline (match-string 1))))))))
  85
  86 (chess-message-catalog 'english
  87   '((network-starting  . "Starting network client/server...")
  88     (network-waiting   . "Now waiting for your opponent to connect...")
  89     (network-connected ."You have connected; pass now or make your move.")))
  90
  91 (defun chess-network-flatten-multiline (str)
  92   (while (string-match "\n" str)
  93     (setq str (replace-match "\C-k" t t str)))
  94   str)
  95
  96 (defun chess-network-parse-multiline (str)
  97   (while (string-match "\C-k" str)
  98     (setq str (replace-match "\n" t t str)))
  99   str)
 100
 101 (defun chess-network-handler (game event &rest args)
 102   "Initialize the network chess engine."
 103   (unless chess-engine-handling-event
 104     (cond
 105      ((eq event 'initialize)
 106       (let ((which (read-char "Are you the c)lient or s)erver? "))
 107             proc)
 108         (chess-message 'network-starting)
 109         (setq proc (if (eq which ?s)
 110                        (start-process "*chess-network*"
 111                                       (current-buffer) "/usr/bin/nc"
 112                                       "-l" "-p" (read-string "Port: "))
 113                      (open-network-stream "*chess-network*" (current-buffer)
 114                                           (read-string "Host: ")
 115                                           (read-string "Port: "))))
 116         (if (eq which ?s)
 117             (chess-message 'network-waiting)
 118           (chess-network-handler 'match)
 119           (chess-message 'network-connected))
 120         t))
 121
 122      ((eq event 'ready))                ; don't set active yet
 123
 124      ((eq event 'setup-pos)
 125       (chess-engine-send nil (format "fen %s\n"
 126                                      (chess-pos-to-string (car args)))))
 127
 128      ((eq event 'setup-game)
 129       (chess-engine-send nil (format "pgn %s\n"
 130                                      (chess-network-flatten-multiline
 131                                       (chess-game-to-string (car args))))))
 132
 133      ((eq event 'pass)
 134       (chess-engine-send nil "pass\n"))
 135
 136      ((eq event 'busy)
 137       (chess-engine-send nil "playing\n"))
 138
 139      ((eq event 'match)
 140       (setq chess-engine-pending-offer 'match)
 141       (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 142
 143      ((eq event 'resign)
 144       (chess-engine-send nil "resign\n")
 145       (chess-game-set-data game 'active nil))
 146
 147      ((eq event 'draw)
 148       (if chess-engine-pending-offer
 149           (chess-engine-command nil 'retract))
 150       (setq chess-engine-pending-offer 'draw)
 151       (chess-engine-send nil "draw\n"))
 152
 153      ((eq event 'abort)
 154       (if chess-engine-pending-offer
 155           (chess-engine-command nil 'retract))
 156       (setq chess-engine-pending-offer 'abort)
 157       (chess-engine-send nil "abort\n"))
 158
 159      ((eq event 'undo)
 160       (if chess-engine-pending-offer
 161           (chess-engine-command nil 'retract))
 162       (setq chess-engine-pending-offer 'undo
 163             chess-engine-pending-arg (car args))
 164       (chess-engine-send nil (format "takeback %d\n" (car args))))
 165
 166      ((eq event 'accept)
 167       (chess-engine-send nil "accept\n"))
 168
 169      ((eq event 'decline)
 170       (chess-engine-send nil "decline\n"))
 171
 172      ((eq event 'retract)
 173       (chess-engine-send nil "retract\n"))
 174
 175      ((eq event 'illegal)
 176       (chess-engine-send nil "illegal\n"))
 177
 178      ((eq event 'kibitz)
 179       (chess-engine-send nil (format "kibitz %s\n"
 180                                      (chess-network-flatten-multiline
 181                                       (car args)))))
 182
 183      ((eq event 'chat)
 184       (chess-engine-send nil (format "chat %s\n"
 185                                      (chess-network-flatten-multiline
 186                                       (car args)))))
 187
 188      ((eq event 'set-index)
 189       (chess-engine-send nil (format "index %d\n" (car args))))
 190
 191      (t
 192       (apply 'chess-common-handler game event args)))))
 193
 194 (provide 'chess-network)
 195
 196 ;;; chess-network.el ends here