From 244bfdc122b7427b3f3f96bef00415e579aff67d Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 9 Apr 2002 00:00:13 +0000 Subject: Add support for generating randomized starting position, ala Fischer Random. --- chess-random.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 chess-random.el (limited to 'chess-random.el') diff --git a/chess-random.el b/chess-random.el new file mode 100644 index 0000000..3155373 --- /dev/null +++ b/chess-random.el @@ -0,0 +1,62 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Generate Fischer Random style positions +;; +;; Just call `chess-fischer-random-position' to generate such a +;; position. +;; +;; $Revision$ + +(require 'chess-pos) + +(defvar pieces-vector [?r ?n ?b ?q ?k ?b ?n ?r]) + +(defun 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 () + (let (pieces position) + (while (null position) + (setq pieces (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))))) + (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 -- cgit v1.2.3