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

   1 ;;; chess-eco.el --- Chess opening classification
   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 (eval-when-compile
  26   (require 'cl))
  27
  28 (require 'chess-pos)
  29 (require 'chess-fen)
  30
  31 (defgroup chess-eco nil
  32   "Chess opening classification module."
  33   :group 'chess)
  34
  35 (defcustom chess-eco-max-index 36
  36   "*Index at which to stop chess opening announcements."
  37   :group 'chess-eco
  38   :type 'integer)
  39
  40 (defvar chess-eco-hash-table
  41   (when (file-exists-p
  42          (expand-file-name "chess-eco.fen"
  43                            (file-name-directory load-file-name)))
  44     (with-temp-buffer
  45       (message "Emacs Chess: Loading ECO openings database...")
  46       (insert-file-contents "chess-eco.fen")
  47       (prog1
  48           (let ((fen-data (read (current-buffer)))
  49                 (hash (make-hash-table :size 10541 :test 'equal)))
  50             (mapc (lambda (entry)
  51                     (puthash (car entry) (cdr entry) hash))
  52                   fen-data)
  53             hash)
  54         (message "Emacs Chess: Loading ECO openings database...done"))))
  55   "List of well known chess opening positions.")
  56
  57 (defun chess-generate-fen-table ()
  58   "Generate chess-eco.fen from the ply lists in chess-eco.pos."
  59   (require 'chess-pos)
  60   (require 'chess-ply)
  61   (require 'chess-fen)
  62   (require 'chess-algebraic)
  63   (with-temp-buffer
  64     (insert-file-contents (car command-line-args-left))
  65     (let ((fen-buffer (get-buffer-create "chess-eco.fen"))
  66           (pos-data (read (current-buffer))))
  67       (with-current-buffer fen-buffer
  68         (print (mapcar
  69                 (lambda (entry)
  70                   (message "Preparing opening %s (%s)"
  71                            (car entry) (cadr entry))
  72                   (let ((pos (chess-pos-create)))
  73                     (mapc (lambda (move)
  74                             (apply 'chess-pos-move
  75                                    pos (chess-ply-changes
  76                                         (chess-algebraic-to-ply pos move))))
  77                           (split-string (car (cddr entry)) " " t))
  78                     (list (chess-pos-to-fen pos) (cadr entry) (car entry))))
  79                 pos-data)
  80                (current-buffer))
  81         (write-file (cadr command-line-args-left))))))
  82
  83 (defvar chess-eco-last-opening nil)
  84 (make-variable-buffer-local 'chess-eco-last-opening)
  85
  86 (defun chess-eco-classify (game)
  87   (when chess-eco-hash-table
  88     (let ((plies (chess-game-plies game))
  89           found)
  90       (while plies
  91         (let* ((fen (chess-pos-to-fen (chess-ply-pos (car plies))))
  92                (entry (gethash fen chess-eco-hash-table)))
  93           (if entry
  94               (setq found entry))
  95           (setq plies (cdr plies))))
  96       found)))
  97
  98 (chess-message-catalog 'english
  99   '((announce-opening . "%s (ECO code %s)")))
 100
 101 (defun chess-eco-handler (game event &rest args)
 102   "Handle for the `chess-eco' module.
 103 If you add `chess-eco' to `chess-default-modules', this handler will
 104 try to figure out if the current position of a game does match a
 105 well known chess opening position."
 106   (cond
 107    ((eq event 'initialize))
 108
 109    ((eq event 'post-move)
 110     (when (= (chess-game-index game) 1)
 111       (setq chess-eco-last-opening nil))
 112     (when (< (chess-game-index game) chess-eco-max-index)
 113       (let ((info (chess-eco-classify game)))
 114         (when (and info (not (eq info chess-eco-last-opening)))
 115           (setq chess-eco-last-opening info)
 116           (chess-message 'announce-opening (car info) (cadr info))))))))
 117
 118 (defun chess-eco-parse-scid-eco ()
 119   (let ((result (list t)))
 120     (while (re-search-forward
 121             "\\([A-E][0-9][0-9]\\([a-z][0-9]?\\)?\\) \"\\([^\"]+\\)\"[\n ]+\\([^*]*\\|\n\\) +\\*"
 122             nil t)
 123       (nconc
 124        result
 125        (list
 126         (list (match-string 1)
 127               (match-string 3)
 128               (mapconcat (lambda (move)
 129                            (if (string-match
 130                                 (concat
 131                                  "\\(" chess-algebraic-regexp "\\)")
 132                                      move)
 133                                     (match-string 1 move)
 134                                   move))
 135                               (split-string (match-string 4) "[\n ]+") " ")))))
 136     (cdr result)))
 137
 138 (provide 'chess-eco)
 139
 140 ;;; chess-ecos.el ends here