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                                                   (string-to-int
 124                                                    (read-string "Port: ")))
 125                     (start-process "*chess-network*"
 126                                    (current-buffer) "/usr/bin/nc"
 127                                    "-l" "-p" (read-string "Port: ")))
 128                 (open-network-stream "*chess-network*" (current-buffer)
 129                                      (read-string "Host: ")
 130                                      (read-string "Port: "))))
 131         (setq chess-engine-process proc
 132               chess-network-kind (if (eq which ?s) 'server 'client))
 133         t))
 134
 135      ((eq event 'ready)                 ; don't set active yet
 136       (chess-game-run-hooks game 'announce-autosave)
 137       (if (eq chess-network-kind 'server)
 138           (chess-message 'network-waiting)
 139         (chess-network-handler game 'match)))
 140
 141      ((eq event 'setup-pos)
 142       (chess-engine-send nil (format "fen %s\n"
 143                                      (chess-pos-to-string (car args)))))
 144
 145      ((eq event 'setup-game)
 146       (chess-engine-send nil (format "pgn %s\n"
 147                                      (chess-network-flatten-multiline
 148                                       (chess-game-to-string (car args))))))
 149
 150      ((eq event 'pass)
 151       (chess-engine-send nil "pass\n"))
 152
 153      ((eq event 'busy)
 154       (chess-engine-send nil "playing\n"))
 155
 156      ((eq event 'match)
 157       (setq chess-engine-pending-offer 'match)
 158       (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 159
 160      ((eq event 'draw)
 161       (if chess-engine-pending-offer
 162           (chess-engine-command nil 'retract))
 163       (setq chess-engine-pending-offer 'draw)
 164       (chess-engine-send nil "draw\n"))
 165
 166      ((eq event 'abort)
 167       (if chess-engine-pending-offer
 168           (chess-engine-command nil 'retract))
 169       (setq chess-engine-pending-offer 'abort)
 170       (chess-engine-send nil "abort\n"))
 171
 172      ((eq event 'undo)
 173       (if chess-engine-pending-offer
 174           (chess-engine-command nil 'retract))
 175       (setq chess-engine-pending-offer 'undo
 176             chess-engine-pending-arg (car args))
 177
 178       (chess-engine-send nil (format "takeback %d\n" (car args)))
 179       (chess-message 'takeback-sent (car args)))
 180
 181      ((eq event 'accept)
 182       (chess-engine-send nil (if (car args)
 183                                  (format "accept %s\n" (car args))
 184                                "accept\n")))
 185
 186      ((eq event 'decline)
 187       (chess-engine-send nil "decline\n"))
 188
 189      ((eq event 'retract)
 190       (chess-engine-send nil "retract\n"))
 191
 192      ((eq event 'illegal)
 193       (chess-engine-send nil "illegal\n"))
 194
 195      ((eq event 'call-flag)
 196       (chess-engine-send nil "flag\n"))
 197
 198      ((eq event 'kibitz)
 199       (chess-engine-send nil (format "kibitz %s\n"
 200                                      (chess-network-flatten-multiline
 201                                       (car args)))))
 202
 203      ((eq event 'chat)
 204       (chess-engine-send nil (format "chat %s\n"
 205                                      (chess-network-flatten-multiline
 206                                       (car args)))))
 207
 208      ((eq event 'set-index)
 209       (chess-engine-send nil (format "index %d\n" (car args))))
 210
 211      ((eq event 'flag-fell)
 212       (chess-engine-send nil "forfeit\n")
 213       (chess-common-handler game 'flag-fell))
 214
 215      (t
 216       (apply 'chess-common-handler game event args)))))
 217
 218 (provide 'chess-network)
 219
 220 ;;; chess-network.el ends here