blob: ee39a8eacd3eb89c3d14c0269a4b49c19064a212 (
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
|
;;; chess-random.el --- Generate Fischer Random style positions -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; 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:
;; Just call `chess-fischer-random-position' to generate such a
;; position.
;;; Code:
(require 'chess-pos)
(defvar pieces-vector [?r ?n ?b ?q ?k ?b ?n ?r])
(defun chess-shuffle-vector (vector)
"Randomly permute the elements of VECTOR (all permutations equally likely)"
(let ((i 0)
j
temp
(len (length vector)))
(while (< i len)
(setq j (+ i (random (- len i))))
(setq temp (aref vector i))
(aset vector i (aref vector j))
(aset vector j temp)
(setq i (1+ i))))
vector)
;;;###autoload
(defun chess-fischer-random-position ()
"Generate a Fischer Random style position."
(let (pieces position)
(while (null position)
(setq pieces (chess-shuffle-vector pieces-vector))
(let (first-bishop first-rook king)
(catch 'retry
(dotimes (i 8)
(let ((piece (aref pieces i)))
(cond
((= ?b piece)
(if first-bishop
(if (= (mod i 2) first-bishop)
(throw 'retry t))
(setq first-bishop (mod i 2))))
((= ?k piece)
(if (null first-rook)
(throw 'retry t))
(setq king i))
((= ?r piece)
(if first-rook
(if (null king)
(throw 'retry t))
(setq first-rook i))))))
(setq position (chess-pos-create)))))
;; set the home row pieces
(dotimes (i 8)
(chess-pos-set-piece position (chess-rf-to-index 0 i)
(aref pieces i))
(chess-pos-set-piece position (chess-rf-to-index 7 i)
(upcase (aref pieces i))))
position))
(provide 'chess-random)
;;; chess-random.el ends here
|
