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