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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Play against crafty!
   4 ;;
   5
   6 (require 'chess-common)
   7 (require 'chess-var)
   8
   9 (defgroup chess-crafty nil
  10   "The publically available chess engine 'crafty'."
  11   :group 'chess-engine)
  12
  13 (defcustom chess-crafty-path (or (executable-find "crafty")
  14                                  (executable-find "wcrafty"))
  15   "*The path to the crafty executable."
  16   :type 'file
  17   :group 'chess-crafty)
  18
  19 (defvar chess-crafty-evaluation nil)
  20
  21 (make-variable-buffer-local 'chess-crafty-evaluation)
  22
  23 (defvar chess-crafty-analyzing-p nil
  24   "Non-nil if Crafty is currently in analysis mode.")
  25
  26 (make-variable-buffer-local 'chess-crafty-analyzing-p)
  27
  28 (defvar chess-crafty-regexp-alist
  29   (list
  30    (cons (concat "move\\s-+\\(" chess-algebraic-regexp "\\)\\s-*$")
  31          (function
  32           (lambda ()
  33             (funcall chess-engine-response-handler 'move
  34                      (chess-engine-convert-algebraic (match-string 1) t)))))
  35    (cons "total evaluation\\.+\\s-+\\([-+0-9.]+\\)"
  36          (function
  37           (lambda ()
  38             (setq chess-crafty-evaluation
  39                   (string-to-number (match-string 1))))))
  40    (cons "tellicsnoalias kibitz Hello from\\s-+\\(.+\\)$"
  41          (function
  42           (lambda ()
  43             (setq chess-engine-opponent-name (match-string 1)))))
  44    (cons "Analyze Mode: type \"exit\" to terminate.$"
  45          (function
  46           (lambda ()
  47             (setq chess-crafty-analyzing-p t))))
  48    (cons (concat "\t ?\\([0-9]+\\)\\s-+"
  49                  "\\(-?[0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+"
  50                  "\\(" ;; The list of moves
  51                    "\\( *[1-9][0-9]*\\. "
  52                      "\\(\\.\\.\\.\\|" chess-algebraic-regexp "\\)"
  53                      "\\( " chess-algebraic-regexp "\\)?\\)+\\)$")
  54          (function
  55           (lambda ()
  56             (when chess-crafty-analyzing-p
  57               ;; We can translate this information to EPD opcodes
  58               (let ((depth (read (match-string 1)))
  59                     (centipawn (read (match-string 2)))
  60                     (nodes (match-string 4))
  61                     (pos (chess-engine-position nil)))
  62                 (chess-pos-set-epd pos 'acd depth)
  63                 (chess-pos-set-epd pos 'ce centipawn)
  64                 (chess-pos-set-epd
  65                  pos
  66                  'pv ; predicted variation
  67                  (save-restriction
  68                    (narrow-to-region (match-beginning 5) (match-end 5))
  69                    (let ((var (chess-var-create pos)))
  70                      (goto-char (point-min))
  71                      (while (not (eobp))
  72                        (cond
  73                         ((looking-at "[1-9][0-9]*\\.[ .]*")
  74                          (goto-char (match-end 0)))
  75                         ((looking-at chess-algebraic-regexp)
  76                          (goto-char (match-end 0))
  77                          (let ((ply (chess-algebraic-to-ply
  78                                      (chess-var-pos var)
  79                                      (match-string-no-properties 0))))
  80                            (unless ply
  81                              (error "unable to read move '%s'"
  82                                     (match-string-no-properties 0)))
  83                            (chess-var-move var ply))))
  84                        (skip-chars-forward " "))
  85                      var))))))))
  86    (cons "analyze complete.$"
  87          (function
  88           (lambda ()
  89             (setq chess-crafty-analyzing-p nil))))
  90    (cons "{\\(Black\\|White\\) resigns}"
  91          (function
  92           (lambda ()
  93             (funcall chess-engine-response-handler 'resign))))
  94    (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)"
  95          (function
  96           (lambda ()
  97             (error (match-string 1)))))
  98    (cons "command not legal now"
  99          (function
 100           (lambda ()
 101             (error (match-string 0)))))))
 102
 103 (defun chess-crafty-handler (game event &rest args)
 104   (unless chess-engine-handling-event
 105     (cond
 106      ((eq event 'initialize)
 107       (let ((proc (chess-common-handler game 'initialize "crafty")))
 108         (when (and proc (processp proc)
 109                    (eq (process-status proc) 'run))
 110           (process-send-string proc "xboard\n")
 111           (setq chess-engine-process proc)
 112           t)))
 113
 114      ((eq event 'setup-pos)
 115       (chess-engine-send nil (format "setboard %s\n"
 116                                      (chess-pos-to-string (car args)))))
 117
 118      ((eq event 'evaluate)
 119       (setq chess-crafty-evaluation nil)
 120       (chess-engine-send nil "display general\nscore\ndisplay nogeneral\n")
 121       (let ((limit 50))
 122         (while (and (null chess-crafty-evaluation)
 123                     (> (setq limit (1- limit)) 0))
 124           (sit-for 0 100 t))
 125         chess-crafty-evaluation))
 126
 127      ((eq event 'analyze)
 128       (if (car args)
 129           (chess-engine-send nil "analyze\npost\n")
 130         (chess-engine-send nil "exit\nnopost\n")))
 131
 132      ((eq event 'setup-game)
 133       (let ((file (chess-with-temp-file
 134                       (insert (chess-game-to-string (car args)) ?\n))))
 135         (chess-engine-send nil (format "read %s\n" file))))
 136
 137      ((eq event 'set-option)
 138       (cond
 139        ((eq (car args) 'resign)
 140         (if (cadr args)
 141             (chess-engine-send nil "resign 9\n")
 142           (chess-engine-send nil "resign -1\n")))
 143        ((eq (car args) 'ponder)
 144         (if (cadr args)
 145             (chess-engine-send nil "hard\n")
 146           (chess-engine-send nil "easy\n")))
 147        ((eq (car args) 'search-depth)
 148         (assert (and (integerp (cadr args)) (>= (cadr args) 0)))
 149         (chess-engine-send nil (format "sd %d\n" (cadr args))))
 150        ((eq (car args) 'search-time)
 151         (assert (and (integerp (cadr args)) (> (cadr args) 0)))
 152         (chess-engine-send nil (format "st %d\n" (cadr args))))))
 153
 154      (t
 155       (if (and (eq event 'undo)
 156                (= 1 (mod (car args) 2)))
 157           (error "Cannot undo until after crafty moves"))
 158
 159       (apply 'chess-common-handler game event args)))))
 160
 161 (provide 'chess-crafty)
 162
 163 ;;; chess-crafty.el ends here