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 (defun chess-network-handler (event &rest args)
  73   "Initialize the network chess engine."
  74   (cond
  75    ((eq event 'initialize)
  76     (let ((which (read-char "Are you the c)lient or s)erver? "))
  77           proc)
  78       (message "Starting network client/server...")
  79       (setq proc (if (eq which ?s)
  80                      (start-process "*chess-network*"
  81                                     (current-buffer) "/usr/bin/nc"
  82                                     "-l" "-p" (read-string "Port: "))
  83                    (open-network-stream "*chess-network*" (current-buffer)
  84                                         (read-string "Host: ")
  85                                         (read-string "Port: "))))
  86       (if (eq which ?s)
  87           (message "Now waiting for your opponent to connect...")
  88         (chess-network-handler 'match)
  89         (message "You have connected; pass now or make your move."))
  90       proc))
  91
  92    ((eq event 'shutdown)
  93     (chess-engine-send nil "quit\n"))
  94
  95    ((eq event 'setup-pos)
  96     (chess-engine-send nil (format "fen %s\n"
  97                                    (chess-pos-to-string (car args)))))
  98
  99    ((eq event 'setup-game)
 100     (chess-engine-send nil (format "pgn %s\n"
 101                                    (chess-game-to-string (car args)))))
 102
 103    ((eq event 'pass)
 104     (chess-engine-send nil "pass\n"))
 105
 106    ((eq event 'busy)
 107     (chess-engine-send nil "playing\n"))
 108
 109    ((eq event 'match)
 110     (setq chess-engine-pending-offer 'match)
 111     (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 112
 113    ((eq event 'resign)
 114     (chess-engine-send nil "resign\n")
 115     (chess-game-set-data chess-engine-game 'active nil))
 116
 117    ((eq event 'draw)
 118     (if chess-engine-pending-offer
 119         (chess-engine-command nil 'retract))
 120     (setq chess-engine-pending-offer 'draw)
 121     (chess-engine-send nil "draw\n"))
 122
 123    ((eq event 'abort)
 124     (if chess-engine-pending-offer
 125         (chess-engine-command nil 'retract))
 126     (setq chess-engine-pending-offer 'abort)
 127     (chess-engine-send nil "abort\n"))
 128
 129    ((eq event 'undo)
 130     (if chess-engine-pending-offer
 131         (chess-engine-command nil 'retract))
 132     (setq chess-engine-pending-offer 'undo
 133           chess-engine-pending-arg (car args))
 134     (chess-engine-send nil (format "takeback %d\n" (car args))))
 135
 136    ((eq event 'accept)
 137     (chess-engine-send nil "accept\n"))
 138
 139    ((eq event 'decline)
 140     (chess-engine-send nil "decline\n"))
 141
 142    ((eq event 'retract)
 143     (chess-engine-send nil "retract\n"))
 144
 145    ((eq event 'move)
 146     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n"))
 147     (if (chess-game-over-p chess-engine-game)
 148         (chess-game-set-data chess-engine-game 'active nil)))))
 149
 150 (provide 'chess-network)
 151
 152 ;;; chess-network.el ends here