code.delx.au - gnu-emacs-elpa/blob - chess-random.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Generate Fischer Random style positions
   4 ;;
   5 ;; Just call `chess-fischer-random-position' to generate such a
   6 ;; position.
   7 ;;
   8
   9 (require 'chess-pos)
  10
  11 (defvar pieces-vector [?r ?n ?b ?q ?k ?b ?n ?r])
  12
  13 (defun chess-shuffle-vector (vector)
  14   "Randomly permute the elements of VECTOR (all permutations equally likely)"
  15   (let ((i 0)
  16         j
  17         temp
  18         (len (length vector)))
  19     (while (< i len)
  20       (setq j (+ i (random (- len i))))
  21       (setq temp (aref vector i))
  22       (aset vector i (aref vector j))
  23       (aset vector j temp)
  24       (setq i (1+ i))))
  25   vector)
  26
  27 ;;;###autoload
  28 (defun chess-fischer-random-position ()
  29   "Generate a Fischer Random style position."
  30   (let (pieces position)
  31     (while (null position)
  32       (setq pieces (chess-shuffle-vector pieces-vector))
  33       (let (first-bishop first-rook king)
  34         (catch 'retry
  35           (dotimes (i 8)
  36             (let ((piece (aref pieces i)))
  37               (cond
  38                ((= ?b piece)
  39                 (if first-bishop
  40                     (if (= (mod i 2) first-bishop)
  41                         (throw 'retry t))
  42                   (setq first-bishop (mod i 2))))
  43                ((= ?k piece)
  44                 (if (null first-rook)
  45                     (throw 'retry t))
  46                 (setq king i))
  47                ((= ?r piece)
  48                 (if first-rook
  49                     (if (null king)
  50                         (throw 'retry t))
  51                   (setq first-rook i))))))
  52           (setq position (chess-pos-create)))))
  53
  54     ;; set the home row pieces
  55     (dotimes (i 8)
  56       (chess-pos-set-piece position (chess-rf-to-index 0 i)
  57                            (aref pieces i))
  58       (chess-pos-set-piece position (chess-rf-to-index 7 i)
  59                            (upcase (aref pieces i))))
  60
  61     position))
  62
  63 (provide 'chess-random)
  64
  65 ;;; chess-random.el ends here