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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; A module for connecting two engines.  If one is a protocol
   4 ;; transport (like chess-network), and the other is a computing engine
   5 ;; (like chess-gnuchess), this will allow you to expose a bot over the
   6 ;; channel.
   7 ;;
   8
   9 (require 'chess)
  10 (require 'chess-engine)
  11
  12 (defun chess-link-response-handler (event &rest args)
  13   "This function handles responses from the bot's computing engine."
  14   (let ((first-engine
  15          (chess-game-data (chess-engine-game nil) 'first-engine))
  16         (second-engine
  17          (chess-game-data (chess-engine-game nil) 'second-engine))
  18         return-value)
  19     (cond
  20      ((eq event 'match)
  21       (chess-engine-command nil 'accept)
  22       t)
  23
  24      (t
  25       (let ((chess-engine-inhibit-auto-pass t))
  26         (setq return-value
  27               (apply 'chess-engine-default-handler event args)))
  28
  29       ;; but now transfer the event to the other engine
  30       (apply 'chess-engine-command
  31              (if (eq (current-buffer) first-engine)
  32                  second-engine
  33                first-engine) event args)
  34
  35       return-value))))
  36
  37 (defun chess-link-connect (first-engine second-engine)
  38   "Connect two engines, so that they rely events back and forth."
  39   (chess-engine-set-response-handler first-engine
  40                                      'chess-link-response-handler)
  41   (chess-engine-set-response-handler second-engine
  42                                      'chess-link-response-handler))
  43
  44 ;;;###autoload
  45 (defun chess-link (first-engine-type second-engine-type)
  46   "Play out a game between two engines, and watch the progress.
  47 If you want to run an engine as a bot, make the transport the first
  48 engine, and the computer the second engine."
  49   (interactive "sFirst engine: \nsSecond engine: ")
  50   (setq first-engine-type (intern (concat "chess-" first-engine-type))
  51         second-engine-type (intern (concat "chess-" second-engine-type)))
  52   (let* ((my-color t)                   ; we start out as white always
  53          (display (chess-create-display my-color))
  54          (game (chess-display-game display)))
  55     (chess-game-set-data game 'my-color my-color)
  56     (chess-module-set-leader display)
  57     (chess-display-disable-popup display)
  58     (condition-case err
  59         (when (and (require first-engine-type)
  60                    (require second-engine-type))
  61           (let ((first-engine
  62                  (chess-engine-create first-engine-type game))
  63                 (second-engine
  64                  (chess-engine-create second-engine-type game)))
  65
  66             (chess-game-set-data game 'first-engine first-engine)
  67             (chess-engine-command first-engine 'ready)
  68
  69             (chess-game-set-data game 'second-engine second-engine)
  70             (chess-link-connect first-engine second-engine)
  71             (chess-engine-command second-engine 'ready)
  72
  73             ;; tell the first engine to start moving
  74             (chess-engine-command first-engine 'pass))
  75
  76           (chess-display-update display)
  77           (chess-display-popup display))
  78       (error
  79        (chess-module-destroy display)
  80        (error (error-message-string err))))))
  81
  82 (provide 'chess-link)
  83
  84 ;;; chess-link.el ends here