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

   1 ;;; chess-network.el --- Play against an opponent over the network
   2
   3 ;; Copyright (C) 2002, 2003, 2008  Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6 ;; Maintainer: Mario Lang <mlang@delysid.org>
   7 ;; Keywords: games
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'chess-common)
  25 (require 'chess-fen)
  26 (require 'chess-pgn)
  27
  28 (defvar chess-network-regexp-alist
  29   (list
  30    (cons (concat chess-algebraic-regexp "$")
  31          (function
  32           (lambda ()
  33             (funcall chess-engine-response-handler 'move
  34                      (chess-engine-convert-algebraic (match-string 0))))))
  35    (cons "chess match\\(\\s-+\\(.+\\)\\)?$"
  36          (function
  37           (lambda ()
  38             (funcall chess-engine-response-handler 'match
  39                      (match-string 2)))))
  40    (cons "fen\\s-+\\(.+\\)"
  41          (function
  42           (lambda ()
  43             (funcall chess-engine-response-handler 'setup-pos
  44                      (chess-engine-convert-fen (match-string 1))))))
  45    (cons "pgn\\s-+\\(.+\\)"
  46          (function
  47           (lambda ()
  48             (funcall chess-engine-response-handler 'setup-game
  49                      (chess-engine-convert-pgn
  50                       (chess-network-parse-multiline (match-string 1)))))))
  51    (cons "pass$"
  52          (function
  53           (lambda ()
  54             (funcall chess-engine-response-handler 'pass))))
  55    (cons "quit$"
  56          (function
  57           (lambda ()
  58             (funcall chess-engine-response-handler 'quit))))
  59    (cons "resign$"
  60          (function
  61           (lambda ()
  62             (funcall chess-engine-response-handler 'resign))))
  63    (cons "draw$"
  64          (function
  65           (lambda ()
  66             (funcall chess-engine-response-handler 'draw))))
  67    (cons "abort$"
  68          (function
  69           (lambda ()
  70             (funcall chess-engine-response-handler 'abort))))
  71    (cons "takeback\\s-+\\([0-9]+\\)$"
  72          (function
  73           (lambda ()
  74             (funcall chess-engine-response-handler 'undo
  75                      (string-to-number (match-string 1))))))
  76    (cons "accept\\(\\s-+\\(.+\\)\\)?$"
  77          (function
  78           (lambda ()
  79             (funcall chess-engine-response-handler 'accept
  80                      (match-string 2)))))
  81    (cons "decline$"
  82          (function
  83           (lambda ()
  84             (funcall chess-engine-response-handler 'decline))))
  85    (cons "retract$"
  86          (function
  87           (lambda ()
  88             (funcall chess-engine-response-handler 'retract))))
  89    (cons "illegal$"
  90          (function
  91           (lambda ()
  92             (funcall chess-engine-response-handler 'illegal))))
  93    (cons "flag$"
  94          (function
  95           (lambda ()
  96             (funcall chess-engine-response-handler 'call-flag))))
  97    (cons "forfeit$"
  98          (function
  99           (lambda ()
 100             (funcall chess-engine-response-handler 'flag-fell))))
 101    (cons "kibitz\\s-+\\(.+\\)$"
 102          (function
 103           (lambda ()
 104             (funcall chess-engine-response-handler 'kibitz
 105                      (chess-network-parse-multiline (match-string 1))))))
 106    (cons "chat\\s-+\\(.+\\)$"
 107          (function
 108           (lambda ()
 109             (funcall chess-engine-response-handler 'chat
 110                      (chess-network-parse-multiline (match-string 1))))))))
 111
 112 (chess-message-catalog 'english
 113   '((network-starting  . "Starting network client/server...")
 114     (network-waiting   . "Now waiting for your opponent to connect...")
 115     (takeback-sent     . "Sent request to undo %d ply(s) to your opponent")))
 116
 117 (defun chess-network-flatten-multiline (str)
 118   (while (string-match "\n" str)
 119     (setq str (replace-match "\C-k" t t str)))
 120   str)
 121
 122 (defun chess-network-parse-multiline (str)
 123   (while (string-match "\C-k" str)
 124     (setq str (replace-match "\n" t t str)))
 125   str)
 126
 127 (defvar chess-network-kind)
 128 (make-variable-buffer-local 'chess-network-kind)
 129
 130 (defun chess-network-handler (game event &rest args)
 131   "Initialize the network chess engine."
 132   (unless chess-engine-handling-event
 133     (cond
 134      ((eq event 'initialize)
 135       (let* ((cursor-in-echo-area t)
 136              (which (read-char "Are you the c)lient or s)erver? "))
 137              proc)
 138         (chess-message 'network-starting)
 139         (setq proc
 140               (if (eq which ?s)
 141                   (if (fboundp 'open-network-stream-server)
 142                       (open-network-stream-server "*chess-network*"
 143                                                   (current-buffer)
 144                                                   (string-to-number
 145                                                    (read-string "Port: ")))
 146                     (start-process "*chess-network*"
 147                                    (current-buffer) "/usr/bin/nc"
 148                                    "-l" "-p" (read-string "Port: ")))
 149                 (open-network-stream "*chess-network*" (current-buffer)
 150                                      (read-string "Host: ")
 151                                      (read-string "Port: "))))
 152         (setq chess-engine-process proc
 153               chess-network-kind (if (eq which ?s) 'server 'client))
 154         t))
 155
 156      ((eq event 'ready)                 ; don't set active yet
 157       (chess-game-run-hooks game 'announce-autosave)
 158       (if (eq chess-network-kind 'server)
 159           (chess-message 'network-waiting)
 160         (chess-network-handler game 'match)))
 161
 162      ((eq event 'setup-pos)
 163       (chess-engine-send nil (format "fen %s\n"
 164                                      (chess-pos-to-fen (car args)))))
 165
 166      ((eq event 'setup-game)
 167       (chess-engine-send nil (format "pgn %s\n"
 168                                      (chess-network-flatten-multiline
 169                                       (chess-game-to-pgn (car args) nil t)))))
 170
 171      ((eq event 'pass)
 172       (chess-engine-send nil "pass\n"))
 173
 174      ((eq event 'busy)
 175       (chess-engine-send nil "playing\n"))
 176
 177      ((eq event 'match)
 178       (setq chess-engine-pending-offer 'match)
 179       (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 180
 181      ((eq event 'draw)
 182       (if chess-engine-pending-offer
 183           (chess-engine-command nil 'retract))
 184       (setq chess-engine-pending-offer 'draw)
 185       (chess-engine-send nil "draw\n"))
 186
 187      ((eq event 'abort)
 188       (if chess-engine-pending-offer
 189           (chess-engine-command nil 'retract))
 190       (setq chess-engine-pending-offer 'abort)
 191       (chess-engine-send nil "abort\n"))
 192
 193      ((eq event 'undo)
 194       (if chess-engine-pending-offer
 195           (chess-engine-command nil 'retract))
 196       (setq chess-engine-pending-offer 'undo
 197             chess-engine-pending-arg (car args))
 198
 199       (chess-engine-send nil (format "takeback %d\n" (car args)))
 200       (chess-message 'takeback-sent (car args)))
 201
 202      ((eq event 'accept)
 203       (chess-engine-send nil (if (car args)
 204                                  (format "accept %s\n" (car args))
 205                                "accept\n")))
 206
 207      ((eq event 'decline)
 208       (chess-engine-send nil "decline\n"))
 209
 210      ((eq event 'retract)
 211       (chess-engine-send nil "retract\n"))
 212
 213      ((eq event 'illegal)
 214       (chess-engine-send nil "illegal\n"))
 215
 216      ((eq event 'call-flag)
 217       (chess-engine-send nil "flag\n"))
 218
 219      ((eq event 'kibitz)
 220       (chess-engine-send nil (format "kibitz %s\n"
 221                                      (chess-network-flatten-multiline
 222                                       (car args)))))
 223
 224      ((eq event 'chat)
 225       (chess-engine-send nil (format "chat %s\n"
 226                                      (chess-network-flatten-multiline
 227                                       (car args)))))
 228
 229      ((eq event 'set-index)
 230       (chess-engine-send nil (format "index %d\n" (car args))))
 231
 232      ((eq event 'flag-fell)
 233       (chess-engine-send nil "forfeit\n")
 234       (chess-common-handler game 'flag-fell))
 235
 236      (t
 237       (apply 'chess-common-handler game event args)))))
 238
 239 (provide 'chess-network)
 240
 241 ;;; chess-network.el ends here