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-engine)
   7 (require 'chess-fen)
   8 (require 'chess-algebraic)
   9
  10 (defvar chess-network-regexp-alist
  11   (list
  12    (cons (concat chess-algebraic-regexp "$")
  13          (function
  14           (lambda ()
  15             (funcall chess-engine-response-handler 'move
  16                      (chess-engine-convert-algebraic (match-string 0))))))
  17    (cons "chess match\\(\\s-+\\(.+\\)\\)?$"
  18          (function
  19           (lambda ()
  20             (funcall chess-engine-response-handler 'match
  21                      (match-string 2)))))
  22    (cons "fen\\s-+\\(.+\\)"
  23          (function
  24           (lambda ()
  25             (funcall chess-engine-response-handler 'setup-pos
  26                      (chess-engine-convert-fen (match-string 1))))))
  27    (cons "pgn\\s-+\\(.+\\)"
  28          (function
  29           (lambda ()
  30             (funcall chess-engine-response-handler 'setup-game
  31                      (chess-engine-convert-pgn (match-string 1))))))
  32    (cons "pass$"
  33          (function
  34           (lambda ()
  35             (funcall chess-engine-response-handler 'pass))))
  36    (cons "quit$"
  37          (function
  38           (lambda ()
  39             (funcall chess-engine-response-handler 'quit))))
  40    (cons "resign$"
  41          (function
  42           (lambda ()
  43             (funcall chess-engine-response-handler 'resign))))
  44    (cons "draw$"
  45          (function
  46           (lambda ()
  47             (funcall chess-engine-response-handler 'draw))))
  48    (cons "abort$"
  49          (function
  50           (lambda ()
  51             (funcall chess-engine-response-handler 'abort))))
  52    (cons "takeback\\s-+\\([0-9]+\\)$"
  53          (function
  54           (lambda ()
  55             (funcall chess-engine-response-handler 'undo
  56                      (string-to-int (match-string 1))))))
  57    (cons "accept\\(\\s-+\\(.+\\)\\)?$"
  58          (function
  59           (lambda ()
  60             (funcall chess-engine-response-handler 'accept
  61                      (match-string 2)))))
  62    (cons "decline$"
  63          (function
  64           (lambda ()
  65             (funcall chess-engine-response-handler 'decline))))
  66    (cons "retract$"
  67          (function
  68           (lambda ()
  69             (funcall chess-engine-response-handler 'retract))))))
  70
  71 (chess-message-catalog 'english
  72   '((network-starting  . "Starting network client/server...")
  73     (network-waiting   . "Now waiting for your opponent to connect...")
  74     (network-connected ."You have connected; pass now or make your move.")))
  75
  76 (defun chess-network-handler (game event &rest args)
  77   "Initialize the network chess engine."
  78   (unless chess-engine-handling-event
  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         t))
  96
  97      ((eq event 'destroy)
  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 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 game)
 156           (chess-game-set-data game 'active nil))))))
 157
 158 (provide 'chess-network)
 159
 160 ;;; chess-network.el ends here