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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Obtain movements and other information from an engine
   4 ;;
   5 ;; $Revision$
   6
   7 ;;; Commentary:
   8
   9 (require 'chess-game)
  10
  11 (defgroup chess-engine nil
  12   "Code for reading movements and other commands from an engine."
  13   :group 'chess)
  14
  15 (defvar chess-engine-regexp-alist nil)
  16 (defvar chess-engine-event-handler nil)
  17 (defvar chess-engine-response-handler nil)
  18 (defvar chess-engine-current-marker nil)
  19 (defvar chess-engine-position nil)
  20 (defvar chess-engine-game nil)
  21
  22 (make-variable-buffer-local 'chess-engine-regexp-alist)
  23 (make-variable-buffer-local 'chess-engine-event-handler)
  24 (make-variable-buffer-local 'chess-engine-response-handler)
  25 (make-variable-buffer-local 'chess-engine-current-marker)
  26 (make-variable-buffer-local 'chess-engine-position)
  27 (make-variable-buffer-local 'chess-engine-game)
  28
  29 (defvar chess-engine-process nil)
  30 (defvar chess-engine-last-pos nil)
  31 (defvar chess-engine-working nil)
  32
  33 (make-variable-buffer-local 'chess-engine-process)
  34 (make-variable-buffer-local 'chess-engine-last-pos)
  35 (make-variable-buffer-local 'chess-engine-working)
  36
  37 ;;; Code:
  38
  39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40 ;;
  41 ;; User interface
  42 ;;
  43
  44 (defmacro chess-with-current-buffer (buffer &rest body)
  45   `(let ((buf ,buffer))
  46      (if buf
  47          (with-current-buffer buf
  48            ,@body)
  49        ,@body)))
  50
  51 (defun chess-engine-do-move (ply)
  52   (cond
  53    (chess-engine-game
  54     (chess-game-move chess-engine-game ply))
  55    (chess-engine-position
  56     (setq chess-engine-position (chess-ply-next-pos ply)))))
  57
  58 (defun chess-engine-default-handler (event &rest args)
  59   (cond
  60    ((eq event 'move)
  61     (chess-engine-do-move (car args)))
  62
  63    ((eq event 'pass)
  64     (message "Your opponent has passed the first move to you"))
  65
  66    ((eq event 'connect)
  67     (message "Your opponent, %s, is now ready to play" (car args)))
  68
  69    ((eq event 'quit)
  70     (message "Your opponent has quit playing"))
  71
  72    ((eq event 'setup)
  73     (chess-game-set-start-position (chess-engine-game nil)
  74                                    (chess-fen-to-pos (car args))))))
  75
  76 (defun chess-engine-create (module &optional user-handler &rest args)
  77   (let ((regexp-alist (intern-soft (concat (symbol-name module)
  78                                            "-regexp-alist")))
  79         (handler (intern-soft (concat (symbol-name module) "-handler"))))
  80     (with-current-buffer (generate-new-buffer " *chess-engine*")
  81       (setq chess-engine-regexp-alist (symbol-value regexp-alist)
  82             chess-engine-event-handler handler
  83             chess-engine-response-handler (or user-handler
  84                                               'chess-engine-default-handler))
  85       (let ((proc (apply handler 'initialize args)))
  86         (when (processp proc)
  87           (unless (memq (process-status proc) '(run open))
  88             (error "Failed to start chess engine process"))
  89           (setq chess-engine-process proc)
  90           (set-process-buffer proc (current-buffer))
  91           (set-process-filter proc 'chess-engine-filter))
  92         (setq chess-engine-current-marker (point-marker)))
  93       (current-buffer))))
  94
  95 (defun chess-engine-destroy (engine)
  96   (let ((buf (or engine (current-buffer))))
  97     (if (buffer-live-p buf)
  98         (kill-buffer buf))))
  99
 100 (defun chess-engine-command (engine event &rest args)
 101   (chess-with-current-buffer engine
 102     (apply chess-engine-event-handler event args)))
 103
 104 ;; 'ponder
 105 ;; 'search-depth
 106 ;; 'wall-clock
 107
 108 (defun chess-engine-set-option (engine option value)
 109   (chess-with-current-buffer engine
 110     ))
 111
 112 (defun chess-engine-option (engine option) 'ponder 'search-depth 'wall-clock
 113   (chess-with-current-buffer engine
 114     ))
 115
 116 (defun chess-engine-set-position (engine position)
 117   (chess-with-current-buffer engine
 118     (if chess-engine-game
 119         (chess-engine-detach-game nil))
 120     (setq chess-engine-game nil
 121           chess-engine-position position)
 122     (chess-engine-command nil 'setup position)))
 123
 124 (defun chess-engine-position (engine)
 125   (chess-with-current-buffer engine
 126     (or (and chess-engine-game
 127              (chess-game-pos chess-engine-game))
 128         chess-engine-position)))
 129
 130 (defun chess-engine-set-game (engine game)
 131   (chess-with-current-buffer engine
 132     (if chess-engine-game
 133         (chess-engine-detach-game nil))
 134     (setq chess-engine-game game
 135           chess-engine-position nil)
 136     (chess-game-add-hook game 'chess-engine-event-handler engine)
 137     (chess-engine-command nil 'setup (chess-game-pos game))))
 138
 139 (defun chess-engine-detach-game (engine)
 140   (chess-with-current-buffer engine
 141     (if chess-engine-game
 142         (chess-game-remove-hook chess-engine-game
 143                                 'chess-engine-event-handler))))
 144
 145 (defun chess-engine-game (engine)
 146   (chess-with-current-buffer engine
 147     chess-engine-game))
 148
 149 (defun chess-engine-index (engine)
 150   (chess-with-current-buffer engine
 151     (if chess-engine-game
 152         (chess-game-index chess-engine-game))))
 153
 154 (defun chess-engine-move (engine ply)
 155   (chess-with-current-buffer engine
 156     (chess-engine-do-move ply)
 157     (chess-engine-command engine 'move ply)))
 158
 159 (defun chess-engine-pass (engine)
 160   (chess-with-current-buffer engine
 161     (chess-engine-command engine 'pass)))
 162
 163 (defun chess-engine-send (engine string)
 164   "Send the given STRING to ENGINE."
 165   (chess-with-current-buffer engine
 166     (let ((proc chess-engine-process))
 167       (if proc
 168           (if (memq (process-status proc) '(run open))
 169               (process-send-string proc string)
 170             (error "The engine you were using is no longer running"))
 171         (chess-engine-command nil 'send string)))))
 172
 173 (defun chess-engine-submit (engine string)
 174   "Submit the given STRING, so ENGINE sees it in its input stream."
 175   (chess-with-current-buffer engine
 176     (let ((proc chess-engine-process))
 177       (if (and (processp proc)
 178                (not (memq (process-status proc) '(run open))))
 179           (error "The engine you were using is no longer running"))
 180       (chess-engine-filter nil string))))
 181
 182 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 183 ;;
 184 ;; Primary event handler
 185 ;;
 186
 187 (defun chess-engine-event-handler (game engine event &rest args)
 188   "Handle any commands being sent to this instance of this module."
 189   (with-current-buffer engine
 190     (assert (eq game (chess-engine-game nil)))
 191     (apply chess-engine-event-handler event args)
 192     (cond
 193      ((eq event 'shutdown)
 194       (chess-engine-destroy engine)))))
 195
 196 (defun chess-engine-filter (proc string)
 197   "Filter for receiving text for an engine from an outside source."
 198   (let ((buf (if (processp proc)
 199                  (process-buffer proc)
 200                (current-buffer))))
 201     (when (buffer-live-p buf)
 202       (with-current-buffer buf
 203         (let ((moving (= (point) chess-engine-current-marker)))
 204           (save-excursion
 205             ;; Insert the text, advancing the marker.
 206             (goto-char chess-engine-current-marker)
 207             (insert string)
 208             (set-marker chess-engine-current-marker (point)))
 209           (if moving (goto-char chess-engine-current-marker)))
 210         (unless chess-engine-working
 211           (setq chess-engine-working t)
 212           (unwind-protect
 213               (progn
 214                 (if chess-engine-last-pos
 215                     (goto-char chess-engine-last-pos)
 216                   (goto-char (point-min)))
 217                 (beginning-of-line)
 218                 (while (not (eobp))
 219                   (condition-case err
 220                       (let ((triggers chess-engine-regexp-alist))
 221                         (while triggers
 222                           ;; this could be accelerated by joining
 223                           ;; together the regexps
 224                           (if (looking-at (caar triggers))
 225                               (progn
 226                                 (funcall (cdar triggers))
 227                                 (setq triggers nil))
 228                             (setq triggers (cdr triggers)))))
 229                     (chess-illegal (error-message-string err)))
 230                   (forward-line)))
 231             (setq chess-engine-last-pos (point)
 232                   chess-engine-working nil)))))))
 233
 234 (provide 'chess-engine)
 235
 236 ;;; chess-engine.el ends here