blob: 43f1c94245c23d5dd13b397863cd0717d11ee94a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
;;; chess-eco.el --- Chess opening classification -*- lexical-binding: t; -*-
;; Copyright (C) 2004, 2014 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Keywords: games
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'chess-game)
(require 'chess-ply)
(require 'chess-pos)
(require 'chess-fen)
(defgroup chess-eco nil
"Chess opening classification module."
:group 'chess)
(defcustom chess-eco-max-index 36
"*Index at which to stop chess opening announcements."
:group 'chess-eco
:type 'integer)
(defvar chess-eco-hash-table
(when (file-exists-p
(expand-file-name "chess-eco.fen"
(file-name-directory load-file-name)))
(with-temp-buffer
(message "Emacs Chess: Loading ECO openings database...")
(insert-file-contents "chess-eco.fen")
(prog1
(let ((fen-data (read (current-buffer)))
(hash (make-hash-table :size 10541 :test 'equal)))
(mapc (lambda (entry)
(puthash (car entry) (cdr entry) hash))
fen-data)
hash)
(message "Emacs Chess: Loading ECO openings database...done"))))
"List of well known chess opening positions.")
(defun chess-generate-fen-table ()
"Generate chess-eco.fen from the ply lists in chess-eco.pos."
(require 'chess-pos)
(require 'chess-ply)
(require 'chess-fen)
(require 'chess-algebraic)
(with-temp-buffer
(insert-file-contents (car command-line-args-left))
(let ((fen-buffer (get-buffer-create "chess-eco.fen"))
(pos-data (read (current-buffer))))
(with-current-buffer fen-buffer
(print (mapcar
(lambda (entry)
(message "Preparing opening %s (%s)"
(car entry) (cadr entry))
(let ((pos (chess-pos-create)))
(mapc (lambda (move)
(apply 'chess-pos-move
pos (chess-ply-changes
(chess-algebraic-to-ply pos move))))
(split-string (car (cddr entry)) " " t))
(list (chess-pos-to-fen pos) (cadr entry) (car entry))))
pos-data)
(current-buffer))
(write-file (cadr command-line-args-left))))))
(defvar-local chess-eco-last-opening nil)
(defun chess-eco-classify (game)
(when chess-eco-hash-table
(let ((plies (chess-game-plies game))
found)
(while plies
(let* ((fen (chess-pos-to-fen (chess-ply-pos (car plies))))
(entry (gethash fen chess-eco-hash-table)))
(if entry
(setq found entry))
(setq plies (cdr plies))))
found)))
(chess-message-catalog 'english
'((announce-opening . "%s (ECO code %s)")))
(defun chess-eco-handler (game event &rest _args)
"Handle for the `chess-eco' module.
If you add `chess-eco' to `chess-default-modules', this handler will
try to figure out if the current position of a game does match a
well known chess opening position."
(cond
((eq event 'initialize))
((eq event 'post-move)
(when (= (chess-game-index game) 1)
(setq chess-eco-last-opening nil))
(when (< (chess-game-index game) chess-eco-max-index)
(let ((info (chess-eco-classify game)))
(when (and info (not (eq info chess-eco-last-opening)))
(setq chess-eco-last-opening info)
(chess-message 'announce-opening (car info) (cadr info))))))))
(defun chess-eco-parse-scid-eco ()
(let ((result (list t)))
(while (re-search-forward
"\\([A-E][0-9][0-9]\\([a-z][0-9]?\\)?\\) \"\\([^\"]+\\)\"[\n ]+\\([^*]*\\|\n\\) +\\*"
nil t)
(nconc
result
(list
(list (match-string 1)
(match-string 3)
(mapconcat (lambda (move)
(if (string-match
(concat
"\\(" chess-algebraic-regexp "\\)")
move)
(match-string 1 move)
move))
(split-string (match-string 4) "[\n ]+") " ")))))
(cdr result)))
(provide 'chess-eco)
;;; chess-ecos.el ends here
|
