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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Play against an opponent over the network
   4 ;;
   5 ;; $Revision$
   6
   7 (require 'chess-engine)
   8 (require 'chess-fen)
   9 (require 'chess-algebraic)
  10
  11 (defvar chess-network-regexp-alist
  12   (list
  13    (cons (concat chess-algebraic-regexp "$")
  14          (function
  15           (lambda ()
  16             (funcall chess-engine-response-handler 'move
  17                      (chess-engine-convert-algebraic (match-string 0))))))
  18    (cons "chess match\\(\\s-+\\(.+\\)\\)?$"
  19          (function
  20           (lambda ()
  21             (funcall chess-engine-response-handler 'match
  22                      (match-string 2)))))
  23    (cons "fen\\s-+\\(.+\\)"
  24          (function
  25           (lambda ()
  26             (funcall chess-engine-response-handler 'setup-pos
  27                      (chess-engine-convert-fen (match-string 1))))))
  28    (cons "pgn\\s-+\\(.+\\)"
  29          (function
  30           (lambda ()
  31             (funcall chess-engine-response-handler 'setup-game
  32                      (chess-engine-convert-pgn (match-string 1))))))
  33    (cons "pass$"
  34          (function
  35           (lambda ()
  36             (funcall chess-engine-response-handler 'pass))))
  37    (cons "quit$"
  38          (function
  39           (lambda ()
  40             (funcall chess-engine-response-handler 'quit))))
  41    (cons "resign$"
  42          (function
  43           (lambda ()
  44             (funcall chess-engine-response-handler 'resign))))
  45    (cons "draw$"
  46          (function
  47           (lambda ()
  48             (funcall chess-engine-response-handler 'draw))))
  49    (cons "abort$"
  50          (function
  51           (lambda ()
  52             (funcall chess-engine-response-handler 'abort))))
  53    (cons "takeback\\s-+\\([0-9]+\\)$"
  54          (function
  55           (lambda ()
  56             (funcall chess-engine-response-handler 'undo
  57                      (string-to-int (match-string 1))))))
  58    (cons "accept\\(\\s-+\\(.+\\)\\)?$"
  59          (function
  60           (lambda ()
  61             (funcall chess-engine-response-handler 'accept
  62                      (match-string 2)))))
  63    (cons "decline$"
  64          (function
  65           (lambda ()
  66             (funcall chess-engine-response-handler 'decline))))
  67    (cons "retract$"
  68          (function
  69           (lambda ()
  70             (funcall chess-engine-response-handler 'retract))))))
  71
  72 (chess-message-catalog 'english
  73   '((network-starting  . "Starting network client/server...")
  74     (network-waiting   . "Now waiting for your opponent to connect...")
  75     (network-connected ."You have connected; pass now or make your move.")))
  76
  77 (defun chess-network-handler (event &rest args)
  78   "Initialize the network chess engine."
  79   (cond
  80    ((eq event 'initialize)
  81     (let ((which (read-char "Are you the c)lient or s)erver? "))
  82           proc)
  83       (chess-message 'network-starting)
  84       (setq proc (if (eq which ?s)
  85                      (start-process "*chess-network*"
  86                                     (current-buffer) "/usr/bin/nc"
  87                                     "-l" "-p" (read-string "Port: "))
  88                    (open-network-stream "*chess-network*" (current-buffer)
  89                                         (read-string "Host: ")
  90                                         (read-string "Port: "))))
  91       (if (eq which ?s)
  92           (chess-message 'network-waiting)
  93         (chess-network-handler 'match)
  94         (chess-message 'network-connected))
  95       proc))
  96
  97    ((eq event 'shutdown)
  98     (chess-engine-send nil "quit\n"))
  99
 100    ((eq event 'setup-pos)
 101     (chess-engine-send nil (format "fen %s\n"
 102                                    (chess-pos-to-string (car args)))))
 103
 104    ((eq event 'setup-game)
 105     (chess-engine-send nil (format "pgn %s\n"
 106                                    (chess-game-to-string (car args)))))
 107
 108    ((eq event 'pass)
 109     (chess-engine-send nil "pass\n"))
 110
 111    ((eq event 'busy)
 112     (chess-engine-send nil "playing\n"))
 113
 114    ((eq event 'match)
 115     (setq chess-engine-pending-offer 'match)
 116     (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 117
 118    ((eq event 'resign)
 119     (chess-engine-send nil "resign\n")
 120     (chess-game-set-data chess-engine-game 'active nil))
 121
 122    ((eq event 'draw)
 123     (if chess-engine-pending-offer
 124         (chess-engine-command nil 'retract))
 125     (setq chess-engine-pending-offer 'draw)
 126     (chess-engine-send nil "draw\n"))
 127
 128    ((eq event 'abort)
 129     (if chess-engine-pending-offer
 130         (chess-engine-command nil 'retract))
 131     (setq chess-engine-pending-offer 'abort)
 132     (chess-engine-send nil "abort\n"))
 133
 134    ((eq event 'undo)
 135     (if chess-engine-pending-offer
 136         (chess-engine-command nil 'retract))
 137     (setq chess-engine-pending-offer 'undo
 138           chess-engine-pending-arg (car args))
 139     (chess-engine-send nil (format "takeback %d\n" (car args))))
 140
 141    ((eq event 'accept)
 142     (chess-engine-send nil "accept\n"))
 143
 144    ((eq event 'decline)
 145     (chess-engine-send nil "decline\n"))
 146
 147    ((eq event 'retract)
 148     (chess-engine-send nil "retract\n"))
 149
 150    ((eq event 'illegal)
 151     (chess-engine-send nil "illegal\n"))
 152
 153    ((eq event 'move)
 154     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n"))
 155     (if (chess-game-over-p chess-engine-game)
 156         (chess-game-set-data chess-engine-game 'active nil)))))
 157
 158 (provide 'chess-network)
 159
 160 ;;; chess-network.el ends here