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   (let (pieces position)
  30     (while (null position)
  31       (setq pieces (chess-shuffle-vector pieces-vector))
  32       (let (first-bishop first-rook king)
  33         (catch 'retry
  34           (dotimes (i 8)
  35             (let ((piece (aref pieces i)))
  36               (cond
  37                ((= ?b piece)
  38                 (if first-bishop
  39                     (if (= (mod i 2) first-bishop)
  40                         (throw 'retry t))
  41                   (setq first-bishop (mod i 2))))
  42                ((= ?k piece)
  43                 (if (null first-rook)
  44                     (throw 'retry t))
  45                 (setq king i))
  46                ((= ?r piece)
  47                 (if first-rook
  48                     (if (null king)
  49                         (throw 'retry t))
  50                   (setq first-rook i))))))
  51           (setq position (chess-pos-create)))))
  52
  53     ;; set the home row pieces
  54     (dotimes (i 8)
  55       (chess-pos-set-piece position (chess-rf-to-index 0 i)
  56                            (aref pieces i))
  57       (chess-pos-set-piece position (chess-rf-to-index 7 i)
  58                            (upcase (aref pieces i))))
  59
  60     position))
  61
  62 (provide 'chess-random)
  63
  64 ;;; chess-random.el ends here