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     (network-connected ."You have connected; pass now or make your move.")))
  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 (defun chess-network-handler (game event &rest args)
 108   "Initialize the network chess engine."
 109   (unless chess-engine-handling-event
 110     (cond
 111      ((eq event 'initialize)
 112       (let ((which (read-char "Are you the c)lient or s)erver? "))
 113             proc)
 114         (chess-message 'network-starting)
 115         (setq proc
 116               (if (eq which ?s)
 117                   (if (fboundp 'open-network-stream-server)
 118                       (open-network-stream-server "*chess-network*"
 119                                                   (current-buffer)
 120                                                   (read-string "Port: "))
 121                     (start-process "*chess-network*"
 122                                    (current-buffer) "/usr/bin/nc"
 123                                    "-l" "-p" (read-string "Port: ")))
 124                 (open-network-stream "*chess-network*" (current-buffer)
 125                                      (read-string "Host: ")
 126                                      (read-string "Port: "))))
 127         (if (eq which ?s)
 128             (chess-message 'network-waiting)
 129           (chess-network-handler game 'match)
 130           (chess-message 'network-connected))
 131         t))
 132
 133      ((eq event 'ready)                 ; don't set active yet
 134       (chess-game-run-hooks game 'announce-autosave))
 135
 136      ((eq event 'setup-pos)
 137       (chess-engine-send nil (format "fen %s\n"
 138                                      (chess-pos-to-string (car args)))))
 139
 140      ((eq event 'setup-game)
 141       (chess-engine-send nil (format "pgn %s\n"
 142                                      (chess-network-flatten-multiline
 143                                       (chess-game-to-string (car args))))))
 144
 145      ((eq event 'pass)
 146       (chess-engine-send nil "pass\n"))
 147
 148      ((eq event 'busy)
 149       (chess-engine-send nil "playing\n"))
 150
 151      ((eq event 'match)
 152       (setq chess-engine-pending-offer 'match)
 153       (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 154
 155      ((eq event 'draw)
 156       (if chess-engine-pending-offer
 157           (chess-engine-command nil 'retract))
 158       (setq chess-engine-pending-offer 'draw)
 159       (chess-engine-send nil "draw\n"))
 160
 161      ((eq event 'abort)
 162       (if chess-engine-pending-offer
 163           (chess-engine-command nil 'retract))
 164       (setq chess-engine-pending-offer 'abort)
 165       (chess-engine-send nil "abort\n"))
 166
 167      ((eq event 'undo)
 168       (if chess-engine-pending-offer
 169           (chess-engine-command nil 'retract))
 170       (setq chess-engine-pending-offer 'undo
 171             chess-engine-pending-arg (car args))
 172       (chess-engine-send nil (format "takeback %d\n" (car args))))
 173
 174      ((eq event 'accept)
 175       (chess-engine-send nil "accept\n"))
 176
 177      ((eq event 'decline)
 178       (chess-engine-send nil "decline\n"))
 179
 180      ((eq event 'retract)
 181       (chess-engine-send nil "retract\n"))
 182
 183      ((eq event 'illegal)
 184       (chess-engine-send nil "illegal\n"))
 185
 186      ((eq event 'call-flag)
 187       (chess-engine-send nil "flag\n"))
 188
 189      ((eq event 'kibitz)
 190       (chess-engine-send nil (format "kibitz %s\n"
 191                                      (chess-network-flatten-multiline
 192                                       (car args)))))
 193
 194      ((eq event 'chat)
 195       (chess-engine-send nil (format "chat %s\n"
 196                                      (chess-network-flatten-multiline
 197                                       (car args)))))
 198
 199      ((eq event 'set-index)
 200       (chess-engine-send nil (format "index %d\n" (car args))))
 201
 202      ((eq event 'flag-fell)
 203       (chess-engine-send nil "forfeit\n")
 204       (chess-common-handler game 'flag-fell))
 205
 206      (t
 207       (apply 'chess-common-handler game event args)))))
 208
 209 (provide 'chess-network)
 210
 211 ;;; chess-network.el ends here