blob: 56fab5a41fa66ae6c0d65c21182b8addb00270d9 (
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
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Convert a chess game to/from PGN notation
;;
;; $Revision$
(require 'chess-game)
(require 'chess-algebraic)
(defun chess-pgn-read-plies (position &optional top-level)
(let ((plies (list t)) prevpos done)
(while (not (or done (eobp)))
(cond
((looking-at "[1-9][0-9]*\\.[. ]*")
(goto-char (match-end 0)))
((looking-at chess-algebraic-regexp)
(goto-char (match-end 0))
(setq prevpos position)
(let ((ply (chess-algebraic-to-ply position (match-string 0))))
(setq position (chess-ply-next-pos ply))
(nconc plies (list ply))))
((and top-level
(looking-at "\\(\\*\\|1-0\\|0-1\\|1/2-1/2\\)"))
(goto-char (match-end 0))
(chess-game-set-tag game "Result" (match-string-no-properties 0))
(setq done t))
((looking-at "{")
(forward-char)
(let ((begin (point)))
(search-forward "}")
(forward-char)
(chess-pos-add-annotation prevpos (buffer-substring-no-properties
begin (- (point) 2)))))
((looking-at "(")
(forward-char)
(skip-chars-forward " \t\n")
(chess-pos-add-annotation prevpos (chess-pgn-read-plies
(chess-pos-copy prevpos))))
((and (not top-level)
(looking-at ")"))
(forward-char)
(setq done t))
(t (error "Error parsing PGN syntax")))
(skip-chars-forward " \t\n"))
(cdr plies)))
(defun chess-pgn-to-game ()
"Convert PGN notation at point into a chess game."
(when (search-forward "[" nil t)
(let ((game (chess-game-create)))
(setcar game nil)
(backward-char)
(while (looking-at "^\\s-*\\[\\(\\S-+\\)\\s-+\\(\".+?\"\\)\\][ \t\n]+")
(chess-game-set-tag game (match-string-no-properties 1)
(read (match-string-no-properties 2)))
(goto-char (match-end 0)))
(let ((fen (chess-game-tag game "FEN")))
(chess-game-set-plies
game (chess-pgn-read-plies
(if fen
(chess-fen-to-position fen)
(chess-pos-copy chess-starting-position)) t)))
game)))
(defun chess-pgn-insert-annotations (ply)
(dolist (ann (chess-pos-annotations (chess-ply-pos ply)))
(if (stringp ann)
(insert (format " {%s}" ann))
(assert (listp ann))
(chess-pgn-insert-plies index ann))))
(defun chess-pgn-insert-plies (index plies &optional for-black indented)
"NYI: Still have to implement INDENTED argument."
(while plies
(unless for-black
(insert (format "%d. %s" index
(chess-ply-to-algebraic (car plies))))
(chess-pgn-insert-annotations (car plies))
(setq plies (cdr plies) index (1+ index)))
(when plies
(when for-black
(insert (format "%d. ..." index))
(setq for-black nil))
(insert (format " %s" (chess-ply-to-algebraic (car plies))))
(chess-pgn-insert-annotations (car plies))
(setq plies (cdr plies)))
(if plies
(insert ? ))))
(defun chess-game-to-pgn (game &optional indented)
"Convert a chess GAME to PGN notation.
If INDENTED is non-nil, indent the move texts."
(let ((fen (chess-game-tag game "FEN"))
(first-pos (chess-ply-pos (chess-game-ply game 0))))
(when (and fen (not (equal fen (chess-pos-to-fen first-pos))))
(chess-game-del-tag game "FEN")
(setq fen nil))
(if (and (not fen)
(not (equal chess-starting-position first-pos)))
(chess-game-set-tag game "FEN" (chess-pos-to-fen first-pos))))
(dolist (tag (chess-game-tags game))
(insert (format "[%s \"%s\"]\n" (car tag) (cdr tag))))
(insert ?\n)
(let ((begin (point)))
(chess-pgn-insert-plies 1 (chess-game-plies game))
(insert (or (chess-game-tag game "Result") "*") ?\n)
(fill-region begin (point))))
(provide 'chess-pgn)
;;; chess-pgn.el ends here
|
