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

   1 ;;; chess-sjeng.el --- Play against sjeng!
   2
   3 ;; Copyright (C) 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Keywords: games
   7
   8 ;; This file 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 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Code:
  24
  25 (require 'chess-common)
  26
  27 (defgroup chess-sjeng nil
  28   "The publically available chess engine 'sjeng'."
  29   :group 'chess-engine
  30   :link '(url-link "http://sjeng.sourceforge.net"))
  31
  32 (defcustom chess-sjeng-path (executable-find "sjeng")
  33   "*The path to the sjeng executable."
  34   :type 'file
  35   :group 'chess-sjeng)
  36
  37 (defvar chess-sjeng-evaluation nil)
  38
  39 (make-variable-buffer-local 'chess-sjeng-evaluation)
  40
  41 (defvar chess-sjeng-regexp-alist
  42   (list
  43    (cons (concat "move\\s-+\\(" chess-algebraic-regexp "\\)\\s-*$")
  44          (function
  45           (lambda ()
  46             (funcall chess-engine-response-handler 'move
  47                      (chess-engine-convert-algebraic (match-string 1) t)))))
  48    (cons "tellics set 1\\s-+\\(.+\\)$"
  49          (function
  50           (lambda ()
  51             (setq chess-engine-opponent-name (match-string 1)))))
  52    (cons "{\\(Black\\|White\\) resigns}"
  53          (function
  54           (lambda ()
  55             (funcall chess-engine-response-handler 'resign))))
  56    (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)"
  57          (function
  58           (lambda ()
  59             (error (match-string 1)))))
  60    (cons "command not legal now"
  61          (function
  62           (lambda ()
  63             (error (match-string 0)))))))
  64
  65 (defun chess-sjeng-handler (game event &rest args)
  66   (unless chess-engine-handling-event
  67     (cond
  68      ((eq event 'initialize)
  69       (let ((proc (chess-common-handler game 'initialize "sjeng")))
  70         (when (and proc (processp proc)
  71                    (eq (process-status proc) 'run))
  72           (process-send-string proc "xboard\nnew\n")
  73           (setq chess-engine-process proc)
  74           t)))
  75
  76      ((eq event 'setup-pos)
  77       (chess-engine-send nil (format "setboard %s\n"
  78                                      (chess-pos-to-string (car args)))))
  79
  80      ((eq event 'move)
  81       (when (= 1 (chess-game-index game))
  82         (chess-game-set-tag game "White" chess-full-name)
  83         (chess-game-set-tag game "Black" chess-engine-opponent-name))
  84
  85       (chess-engine-send
  86        nil
  87        (concat (chess-index-to-coord (chess-ply-source (car args)))
  88                (chess-index-to-coord (chess-ply-target (car args)))
  89                (if (chess-ply-keyword (car args) :promote)
  90                    (string (downcase (chess-ply-keyword (car args) :promote)))
  91                  "")
  92                "\n"))
  93       (if (chess-game-over-p game)
  94           (chess-game-set-data game 'active nil)))
  95
  96      ((eq event 'setup-game)
  97       (let ((file (chess-with-temp-file
  98                       (insert (chess-game-to-string (car args)) ?\n))))
  99         (chess-engine-send nil (format "read %s\n" file))))
 100
 101      ((eq event 'set-option)
 102       (cond
 103        ((eq (car args) 'resign)
 104         (if (cadr args)
 105             (chess-engine-send nil "resign 9\n")
 106           (chess-engine-send nil "resign -1\n")))
 107        ((eq (car args) 'ponder)
 108         (if (cadr args)
 109             (chess-engine-send nil "hard\n")
 110           (chess-engine-send nil "easy\n")))))
 111
 112      (t
 113       (if (and (eq event 'undo)
 114                (= 1 (mod (car args) 2)))
 115           (error "Cannot undo until after sjeng moves"))
 116
 117       (apply 'chess-common-handler game event args)))))
 118
 119 (provide 'chess-sjeng)
 120
 121 ;;; chess-sjeng.el ends here