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

   1 ;;; chess-sjeng.el --- Play chess against sjeng!
   2
   3 ;; Copyright (C) 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Keywords: games, processes
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Code:
  22
  23 (require 'chess-common)
  24
  25 (defgroup chess-sjeng nil
  26   "The publically available chess engine 'sjeng'."
  27   :group 'chess-engine
  28   :link '(url-link "http://sjeng.sourceforge.net"))
  29
  30 (defcustom chess-sjeng-path (executable-find "sjeng")
  31   "*The path to the sjeng executable."
  32   :type 'file
  33   :group 'chess-sjeng)
  34
  35 (defvar chess-sjeng-evaluation nil)
  36
  37 (make-variable-buffer-local 'chess-sjeng-evaluation)
  38
  39 (defvar chess-sjeng-regexp-alist
  40   (list
  41    (cons (concat "move\\s-+\\(" chess-algebraic-regexp "\\)\\s-*$")
  42          (function
  43           (lambda ()
  44             (funcall chess-engine-response-handler 'move
  45                      (chess-engine-convert-algebraic (match-string 1) t)))))
  46    (cons "tellics set 1\\s-+\\(.+\\)$"
  47          (function
  48           (lambda ()
  49             (setq chess-engine-opponent-name (match-string 1)))))
  50    (cons "{\\(Black\\|White\\) resigns}"
  51          (function
  52           (lambda ()
  53             (funcall chess-engine-response-handler 'resign))))
  54    (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)"
  55          (function
  56           (lambda ()
  57             (error (match-string 1)))))
  58    (cons "command not legal now"
  59          (function
  60           (lambda ()
  61             (error (match-string 0)))))))
  62
  63 (defun chess-sjeng-handler (game event &rest args)
  64   (unless chess-engine-handling-event
  65     (cond
  66      ((eq event 'initialize)
  67       (let ((proc (chess-common-handler game 'initialize "sjeng")))
  68         (when (and proc (processp proc)
  69                    (eq (process-status proc) 'run))
  70           (process-send-string proc "xboard\nnew\n")
  71           (setq chess-engine-process proc)
  72           t)))
  73
  74      ((eq event 'setup-pos)
  75       (chess-engine-send nil (format "setboard %s\n"
  76                                      (chess-pos-to-string (car args)))))
  77
  78      ((eq event 'move)
  79       (when (= 1 (chess-game-index game))
  80         (chess-game-set-tag game "White" chess-full-name)
  81         (chess-game-set-tag game "Black" chess-engine-opponent-name))
  82
  83       (chess-engine-send
  84        nil
  85        (concat (chess-index-to-coord (chess-ply-source (car args)))
  86                (chess-index-to-coord (chess-ply-target (car args)))
  87                (if (chess-ply-keyword (car args) :promote)
  88                    (string (downcase (chess-ply-keyword (car args) :promote)))
  89                  "")
  90                "\n"))
  91       (if (chess-game-over-p game)
  92           (chess-game-set-data game 'active nil)))
  93
  94      ((eq event 'setup-game)
  95       (let ((file (chess-with-temp-file
  96                       (insert (chess-game-to-string (car args)) ?\n))))
  97         (chess-engine-send nil (format "read %s\n" file))))
  98
  99      ((eq event 'set-option)
 100       (cond
 101        ((eq (car args) 'resign)
 102         (if (cadr args)
 103             (chess-engine-send nil "resign 9\n")
 104           (chess-engine-send nil "resign -1\n")))
 105        ((eq (car args) 'ponder)
 106         (if (cadr args)
 107             (chess-engine-send nil "hard\n")
 108           (chess-engine-send nil "easy\n")))))
 109
 110      (t
 111       (if (and (eq event 'undo)
 112                (= 1 (mod (car args) 2)))
 113           (error "Cannot undo until after sjeng moves"))
 114
 115       (apply 'chess-common-handler game event args)))))
 116
 117 (provide 'chess-sjeng)
 118
 119 ;;; chess-sjeng.el ends here