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