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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Standard Chess rules module
;;
;; This module implements the following events:
;;
;; `move'
;;
;; Make a move on the current board, if it is legal.
;;
;; `search'
;;
;; Pieces can be located by searching all legal paths a piece might
;; use to reach a particular square. Thus, to find all white pawn(s)
;; that could make it to e4 (either by taking a piece, or by moving
;; there) you'd call:
;;
;; (chess-standard-search-position POSITION (chess-coord-to-index "e4") ?P)
;;
;; This returns a list of indices specifying all white pawns that
;; could reach e4 in one move. NOTE: The general search order is from
;; upper-left clockwise.
;; $Revision$
(defgroup chess-standard nil
"The rules of standard chess."
:group 'chess)
;;; Code:
(defun chess-standard-validate-ply (ply &optoinal search-func)
"Validate the given PLY against standard chess rules."
(let* ((pos (chess-ply-pos ply))
(color (chess-pos-side-to-move pos))
(source (car (chess-ply-changes ply)))
(piece (chess-pos-piece pos source))
(target (cadr (chess-ply-changes ply))))
(if (eq piece ? )
(signal 'chess-illegal
"Cannot move from a square that is empty"))
(if (if color
(> piece ?a)
(< piece ?a))
(signal 'chess-illegal
"Cannot move your opponents pieces"))
(let ((enemy-piece (chess-pos-piece pos target)))
(if (and (not (eq enemy-piece ? ))
(if color
(< enemy-piece ?a)
(> enemy-piece ?a)))
(signal 'chess-illegal
"Cannot move on top of your own pieces")))
(unless (funcall (or search-func
'chess-standard-search-position) pos target piece)
(signal 'chess-illegal "Illegal move"))))
(defun chess-standard-search-position (position target piece)
"Look on POSITION from TARGET for a PIECE that can move there.
This routine looks along legal paths of movement for PIECE.
If PIECE is t or nil, legal piece movements for any piece of that
color will be considered (t for white, nil for black). Otherwise, the
case of the PIECE determines color.
The return value is a list of candidates, which means a list of
indices which indicate where a piece may have moved from."
(let* ((color (if (char-valid-p piece)
(< piece ?a)
piece))
(bias (if color -1 1))
p pos candidates)
;; jww (2002-04-07): Don't return candidates that leave the king
;; in check.
(cond
;; if the piece is `t', it means to find the candidates resulting
;; from any piece movement. This is useful for testing whether a
;; king is in check, for example.
((memq piece '(t nil))
(setq candidates (list t))
(dolist (p '(?P ?R ?N ?B ?K ?Q))
(nconc candidates
(chess-standard-search-position position target
(if piece p (downcase p)))))
(setq candidates (cdr candidates)))
;; pawn movement, which is diagonal 1 when taking, but forward
;; 1 or 2 when moving (the most complex piece, actually)
((= (upcase piece) ?P)
(let ((p (chess-pos-piece position target)))
(if (if (= p ? )
;; check for en passant
(and (= (chess-index-rank target) (if color 2 5))
(setq pos (chess-add-index target bias 0))
(chess-pos-piece-p position pos (if color ?p ?P))
(and (chess-pos-en-passant position)
(= (chess-pos-en-passant position) target))
(setq candidates (list pos)))
(if color (> p ?a) (< p ?a)))
(let ((cands (list t)))
(setq pos (chess-add-index target (- bias) -1))
(if (and pos (chess-pos-piece-p position pos piece))
(nconc cands (list pos)))
(setq pos (chess-add-index target (- bias) 1))
(if (and pos (chess-pos-piece-p position pos piece))
(nconc cands (list pos)))
(if candidates
(nconc candidates (cdr cands))
(setq candidates (cdr cands))))
(if (setq pos (chess-add-index target (- bias) 0))
(if (chess-pos-piece-p position pos piece)
(setq candidates (list pos))
(when (and (= ? (chess-pos-piece position pos))
(= (if color 4 3) (chess-index-rank target)))
(setq pos (chess-add-index pos (- bias) 0))
(if (and pos (chess-pos-piece-p position pos piece))
(setq candidates (list pos)))))))))
;; the rook, bishop and queen are the easiest; just look along
;; rank and file and/or diagonal for the nearest pieces!
((memq (upcase piece) '(?R ?B ?Q))
(setq candidates (list t))
(dolist (dir (cond
((= (upcase piece) ?R)
'( (-1 0)
(0 -1) (0 1)
(1 0)))
((= (upcase piece) ?B)
'((-1 -1) (-1 1)
(1 -1) (1 1)))
((= (upcase piece) ?Q)
'((-1 -1) (-1 0) (-1 1)
(0 -1) (0 1)
(1 -1) (1 0) (1 1)))))
;; up the current file
(setq pos (apply 'chess-add-index target dir))
(while pos
(if (chess-pos-piece-p position pos piece)
(progn
(nconc candidates (list pos))
(setq pos nil))
(if (/= (chess-pos-piece position pos) ? )
(setq pos nil)
(setq pos (apply 'chess-add-index pos dir))))))
(setq candidates (cdr candidates)))
;; the king is a trivial case of the queen, except when castling
((= (upcase piece) ?K)
(let ((dirs '((-1 -1) (-1 0) (-1 1)
(0 -1) (0 1)
(1 -1) (1 0) (1 1))))
(while dirs
;; up the current file
(setq pos (apply 'chess-add-index target (car dirs)))
(if (and pos (chess-pos-piece-p position pos piece))
(setq candidates (list pos) dirs nil)
(setq dirs (cdr dirs)))))
(let ((rank (if color 7 0)))
;; if we can still castle, then the king and rook are in their
;; squares; also, make sure that the user is not attempting to
;; castle through check
(if (and
(null candidates)
(or (and (equal target (chess-rf-to-index rank 6))
(chess-pos-can-castle position (if color ?K ?k))
(setq pos (chess-rf-to-index rank 5))
(chess-pos-piece-p position pos ? )
(not (chess-standard-search-position position
pos (not color)))
(setq pos (chess-rf-to-index rank 6))
(chess-pos-piece-p position pos ? )
(not (chess-standard-search-position position
pos (not color))))
(and (equal target (cons rank 2))
(chess-pos-can-castle position (if color ?Q ?q))
(setq pos (chess-rf-to-index rank 1))
(chess-pos-piece-p position pos ? )
(not (chess-standard-search-position position
pos (not color)))
(setq pos (chess-rf-to-index rank 2))
(chess-pos-piece-p position pos ? )
(not (chess-standard-search-position position
pos (not color)))
(setq pos (chess-rf-to-index rank 3))
(chess-pos-piece-p position pos ? )
(not (chess-standard-search-position position
pos (not color))))))
(setq candidates (list (chess-rf-to-index rank 4))))))
;; the knight is a zesty little piece; there may be more than
;; one, but at only one possible square in each direction
((= (upcase piece) ?N)
(setq candidates (list t))
(dolist (dir '((-2 -1) (-2 1)
(-1 -2) (-1 2)
(1 -2) (1 2)
(2 -1) (2 1)))
;; up the current file
(if (and (setq pos (apply 'chess-add-index target dir))
(chess-pos-piece-p position pos piece))
(nconc candidates (list pos))))
(setq candidates (cdr candidates)))
(t (error "Unrecognized piece identifier")))
;; prune from the discovered candidates list any moves which would
;; leave the king in check; castling through check has already
;; been eliminated.
(if (char-valid-p piece)
(let ((cand candidates) last-cand pos king-pos)
(while cand
;; determine the resulting position
(setq pos (chess-pos-move (chess-pos-copy position)
(car cand) target))
;; find the king (only once if the king isn't moving)
(if (or (null king-pos)
(eq (downcase piece) ?k))
(setq king-pos (chess-pos-search pos (if color ?K ?k))))
;; can anybody from the opposite side reach him? if so,
;; drop the candidate
(if (chess-standard-search-position pos (car king-pos)
(not color))
(if last-cand
(setcdr last-cand (cdr cand))
(setq candidates (cdr candidates)))
(setq last-cand cand))
(setq cand (cdr cand)))))
;; return the final list of candidate moves
candidates))
(provide 'chess-standard)
;;; chess-standard.el ends here
|
