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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Define handler functions that are common to the (relatively)
   4 ;; standard chess engine communication protocol:
   5 ;;
   6 ;;   http://www.tim-mann.org/xboard/engine-intf.html
   7 ;;
   8
   9 (require 'chess-engine)
  10
  11 (defvar chess-common-engine-name nil)
  12 (defvar chess-common-temp-files nil)
  13 (make-variable-buffer-local 'chess-common-engine-name)
  14 (make-variable-buffer-local 'chess-common-temp-files)
  15
  16 (defmacro chess-with-temp-file (&rest body)
  17   `(let ((file (make-temp-file "chess")))
  18      (with-temp-file file
  19        ,@body)
  20      (push file chess-common-temp-files)
  21      file))
  22
  23 (put 'chess-with-temp-file 'lisp-indent-function 1)
  24
  25 (chess-message-catalog 'english
  26   '((starting-engine       . "Starting chess program '%s'...")
  27     (starting-engine-done  . "Starting chess program '%s'...done")
  28     (could-not-find-engine . "Cannot find %s executable; check `%s'")
  29     (draw-offer-declined   . "Your draw offer was declined")
  30     (illegal-move          . "Illegal move")
  31     (not-yet-implemented   . "This feature is not yet implemented")))
  32
  33 (defun chess-common-handler (game event &rest args)
  34   "Initialize the network chess engine."
  35   (cond
  36    ((eq event 'initialize)
  37     (let* ((name (car args))
  38            (path (intern (concat "chess-" name "-path")))
  39            proc)
  40       (chess-message 'starting-engine name)
  41       (unless (boundp path)
  42         (chess-error 'could-not-find-engine name path))
  43       (setq proc (start-process (concat "chess-" name)
  44                                 (current-buffer) (symbol-value path)))
  45       (chess-message 'starting-engine-done name)
  46       proc))
  47
  48    ((eq event 'ready)
  49     (chess-game-set-data game 'active t)
  50     (chess-game-run-hooks game 'check-autosave))
  51
  52    ((eq event 'destroy)
  53     (let ((proc (get-buffer-process (current-buffer))))
  54       (if (and (processp proc)
  55                (memq (process-status proc) '(run open)))
  56           (chess-engine-send nil "quit\n")))
  57
  58     (dolist (file chess-common-temp-files)
  59       (if (file-exists-p file)
  60           (delete-file file)))
  61     (setq chess-common-temp-files nil))
  62
  63    ((eq event 'pass)
  64     (chess-engine-send nil "go\n"))
  65
  66    ((eq event 'draw)
  67     (chess-message 'draw-offer-declined))
  68
  69    ((eq event 'resign)
  70     (chess-engine-send nil "resign\n")
  71     (chess-game-set-data game 'active nil))
  72
  73    ((eq event 'new)
  74     (chess-engine-send nil "new\n")
  75     (chess-engine-set-position nil))
  76
  77    ((eq event 'force)
  78     (chess-error 'not-yet-implemented))
  79
  80    ((eq event 'undo)
  81     (dotimes (i (car args))
  82       (chess-engine-send nil "undo\n"))
  83     (if (= 1 (mod (car args) 2))
  84         (chess-engine-send nil "go\n"))
  85
  86     ;; prevent us from handling the `undo' event which this triggers
  87     (let ((chess-engine-handling-event t))
  88       (chess-game-undo game (car args))))
  89
  90    ((eq event 'flag-fell)
  91     (chess-game-set-data game 'active nil)
  92     (let ((chess-game-inhibit-events t))
  93       (chess-game-end game :flag-fell)))
  94
  95    ((eq event 'move)
  96     (when (= 1 (chess-game-index game))
  97       (chess-game-set-tag game "White" chess-full-name)
  98       (chess-game-set-tag game "Black" chess-engine-opponent-name))
  99
 100     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
 101                                    "\n"))
 102     (if (chess-game-over-p game)
 103         (chess-game-set-data game 'active nil)))))
 104
 105 (provide 'chess-common)
 106
 107 ;;; chess-common.el ends here