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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
;;; chess-input.el --- Keyboard entry of algebraic notation, using shortcut notation -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2005, 2014 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Mario Lang <mlang@delysid.org>
;; Keywords: games
;; This 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, or (at your option) any later
;; version.
;;
;; This 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This scheme was adapted from the way SCID (<http://scid.sourceforge.net/>),
;; by Shane Hudson, behaves. It is based on standard algebraic notation.
;; You do not need to type all characters from the corresponding SAN of a move,
;; chess-input will automatically pick the move once it is unambiguous.
;;
;; Additionally, optional characters from SAN are treated as such.
;; You do not need to type x or =, although you can, if you prefer to.
;; For instance, "bxc8=N#" can be selected by typing `b c 8 n'.
;;; Code:
(require 'chess-algebraic)
(require 'chess-ply)
(require 'chess-pos)
(defvar-local chess-input-move-string "")
(defvar-local chess-input-moves-pos nil)
(defvar-local chess-input-moves nil)
(defvar-local chess-input-position-function nil)
(defvar-local chess-input-my-color-function nil)
(defvar-local chess-input-move-function nil)
(defun chess-input-test-move (ply)
"Return the given PLY if it matches the user's current input."
(let* ((move (chess-ply-to-algebraic ply))
(i 0) (x 0) (l (length move))
(xl (length chess-input-move-string)))
(unless (or (and (equal (downcase chess-input-move-string) "ok")
(string-match "\\`O-O[+#]?\\'" move))
(and (equal (downcase chess-input-move-string) "oq")
(string-match "\\`O-O-O[+#]?\\'" move)))
(while (and (< i l) (< x xl))
(let ((move-char (aref move i))
(entry-char (aref chess-input-move-string x)))
(cond
((or (and (= move-char ?x) (/= entry-char ?x))
(and (= move-char ?=) (/= entry-char ?=)))
(setq i (1+ i)))
((/= entry-char (if (< entry-char ?a) move-char (downcase move-char)))
(setq ply nil i l))
(t (setq i (1+ i) x (1+ x)))))))
ply))
(defsubst chess-input-display-moves (&optional move-list)
(if (> (length chess-input-move-string) 0)
(message "[%s] %s" chess-input-move-string
(mapconcat #'chess-ply-to-algebraic
(or move-list
(delq nil (mapcar 'chess-input-test-move
(cdr chess-input-moves))))
" "))))
(defun chess-input-shortcut-delete ()
(interactive)
(when (and chess-input-move-string
(stringp chess-input-move-string)
(> (length chess-input-move-string) 0))
(setq chess-input-move-string
(substring chess-input-move-string 0 (1- (length chess-input-move-string))))
(chess-input-display-moves)))
(defun chess-input-shortcut (&optional display-only)
(interactive)
(let* ((position (funcall chess-input-position-function))
(color (funcall chess-input-my-color-function))
char)
(unless (memq last-command '(chess-input-shortcut
chess-input-shortcut-delete))
(setq chess-input-move-string nil))
(unless display-only
(setq chess-input-move-string
(concat chess-input-move-string
(char-to-string last-command-event))))
(unless (and chess-input-moves
(eq position chess-input-moves-pos)
(or (> (length chess-input-move-string) 1)
(eq (car chess-input-moves) last-command-event)))
(setq char (if (eq (downcase last-command-event) ?o)
?k
last-command-event))
(if (or (memq (upcase char) '(?K ?Q ?N ?B ?R ?P))
(and (>= char ?a) (<= char ?h)))
(setq chess-input-moves-pos position
chess-input-moves
(cons
char
(sort
(if (eq char ?b)
(append (chess-legal-plies
position :piece (if color ?P ?p) :file 1)
(chess-legal-plies
position :piece (if color ?B ?b)))
(if (and (>= char ?a)
(<= char ?h))
(chess-legal-plies position
:piece (if color ?P ?p)
:file (- char ?a))
(chess-legal-plies position
:piece (if color
(upcase char)
(downcase char)))))
(function
(lambda (left right)
(string-lessp (chess-ply-to-algebraic left)
(chess-ply-to-algebraic right))))))))))
(let ((moves (delq nil (mapcar 'chess-input-test-move
(cdr chess-input-moves)))))
(cond
((or (= (length moves) 1)
;; if there is an exact match except for case, it must be an
;; abiguity between a bishop and a b-pawn move. In this
;; case, always take the b-pawn move; to select the bishop
;; move, use B to begin the keyboard shortcut
(and (= (length moves) 2)
(string= (downcase (chess-ply-to-algebraic (car moves)))
(downcase (chess-ply-to-algebraic (cadr moves))))
(setq moves (cdr moves))))
(funcall chess-input-move-function nil (car moves))
(setq chess-input-move-string nil
chess-input-moves nil
chess-input-moves-pos nil))
((null moves)
(chess-input-shortcut-delete))
(t
(chess-input-display-moves moves)))))
(provide 'chess-input)
;;; chess-input.el ends here
|
