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 "flag$"
  74          (function
  75           (lambda ()
  76             (funcall chess-engine-response-handler 'call-flag))))
  77    (cons "forfeit$"
  78          (function
  79           (lambda ()
  80             (funcall chess-engine-response-handler 'flag-fell))))
  81    (cons "kibitz\\s-+\\(.+\\)$"
  82          (function
  83           (lambda ()
  84             (funcall chess-engine-response-handler 'kibitz
  85                      (chess-network-parse-multiline (match-string 1))))))
  86    (cons "chat\\s-+\\(.+\\)$"
  87          (function
  88           (lambda ()
  89             (funcall chess-engine-response-handler 'chat
  90                      (chess-network-parse-multiline (match-string 1))))))))
  91
  92 (chess-message-catalog 'english
  93   '((network-starting  . "Starting network client/server...")
  94     (network-waiting   . "Now waiting for your opponent to connect...")
  95     (takeback-sent     . "Sent request to undo %d ply(s) to your opponent")))
  96
  97 (defun chess-network-flatten-multiline (str)
  98   (while (string-match "\n" str)
  99     (setq str (replace-match "\C-k" t t str)))
 100   str)
 101
 102 (defun chess-network-parse-multiline (str)
 103   (while (string-match "\C-k" str)
 104     (setq str (replace-match "\n" t t str)))
 105   str)
 106
 107 (defvar chess-network-kind)
 108 (make-variable-buffer-local 'chess-network-kind)
 109
 110 (defun chess-network-handler (game event &rest args)
 111   "Initialize the network chess engine."
 112   (unless chess-engine-handling-event
 113     (cond
 114      ((eq event 'initialize)
 115       (let ((which (read-char "Are you the c)lient or s)erver? "))
 116             proc)
 117         (chess-message 'network-starting)
 118         (setq proc
 119               (if (eq which ?s)
 120                   (if (fboundp 'open-network-stream-server)
 121                       (open-network-stream-server "*chess-network*"
 122                                                   (current-buffer)
 123                                                   (read-string "Port: "))
 124                     (start-process "*chess-network*"
 125                                    (current-buffer) "/usr/bin/nc"
 126                                    "-l" "-p" (read-string "Port: ")))
 127                 (open-network-stream "*chess-network*" (current-buffer)
 128                                      (read-string "Host: ")
 129                                      (read-string "Port: "))))
 130         (setq chess-network-kind (if (eq which ?s) 'server 'client))
 131         t))
 132
 133      ((eq event 'ready)                 ; don't set active yet
 134       (chess-game-run-hooks game 'announce-autosave)
 135       (if (eq chess-network-kind 'server)
 136           (chess-message 'network-waiting)
 137         (chess-network-handler game 'match)))
 138
 139      ((eq event 'setup-pos)
 140       (chess-engine-send nil (format "fen %s\n"
 141                                      (chess-pos-to-string (car args)))))
 142
 143      ((eq event 'setup-game)
 144       (chess-engine-send nil (format "pgn %s\n"
 145                                      (chess-network-flatten-multiline
 146                                       (chess-game-to-string (car args))))))
 147
 148      ((eq event 'pass)
 149       (chess-engine-send nil "pass\n"))
 150
 151      ((eq event 'busy)
 152       (chess-engine-send nil "playing\n"))
 153
 154      ((eq event 'match)
 155       (setq chess-engine-pending-offer 'match)
 156       (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 157
 158      ((eq event 'draw)
 159       (if chess-engine-pending-offer
 160           (chess-engine-command nil 'retract))
 161       (setq chess-engine-pending-offer 'draw)
 162       (chess-engine-send nil "draw\n"))
 163
 164      ((eq event 'abort)
 165       (if chess-engine-pending-offer
 166           (chess-engine-command nil 'retract))
 167       (setq chess-engine-pending-offer 'abort)
 168       (chess-engine-send nil "abort\n"))
 169
 170      ((eq event 'undo)
 171       (if chess-engine-pending-offer
 172           (chess-engine-command nil 'retract))
 173       (setq chess-engine-pending-offer 'undo
 174             chess-engine-pending-arg (car args))
 175
 176       (chess-engine-send nil (format "takeback %d\n" (car args)))
 177       (chess-message 'takeback-sent (car args)))
 178
 179      ((eq event 'accept)
 180       (chess-engine-send nil (if (car args)
 181                                  (format "accept %s\n" (car args))
 182                                "accept\n")))
 183
 184      ((eq event 'decline)
 185       (chess-engine-send nil "decline\n"))
 186
 187      ((eq event 'retract)
 188       (chess-engine-send nil "retract\n"))
 189
 190      ((eq event 'illegal)
 191       (chess-engine-send nil "illegal\n"))
 192
 193      ((eq event 'call-flag)
 194       (chess-engine-send nil "flag\n"))
 195
 196      ((eq event 'kibitz)
 197       (chess-engine-send nil (format "kibitz %s\n"
 198                                      (chess-network-flatten-multiline
 199                                       (car args)))))
 200
 201      ((eq event 'chat)
 202       (chess-engine-send nil (format "chat %s\n"
 203                                      (chess-network-flatten-multiline
 204                                       (car args)))))
 205
 206      ((eq event 'set-index)
 207       (chess-engine-send nil (format "index %d\n" (car args))))
 208
 209      ((eq event 'flag-fell)
 210       (chess-engine-send nil "forfeit\n")
 211       (chess-common-handler game 'flag-fell))
 212
 213      (t
 214       (apply 'chess-common-handler game event args)))))
 215
 216 (provide 'chess-network)
 217
 218 ;;; chess-network.el ends here