betza wip 1

(defun rook (&key (length :infinity) (directions '(:forward :backward :left :right)))
  "Lists all possible destinations of a Rook.
   Represents infinite-range moves as :n and :-n.
   Betza equivalent /f?r?l?b?R[0-9]*/"
  (if (eql length :infinity)
      ;; Infinite-length items use :n
      (loop
     for dir     in '(:forward :backward :left     :right)
     for vectors in '((0 . :n) (0 . :-n) (:-n . 0) (:n . 0))
     if (member dir directions) collect vectors)
      ;; Otherwise list them all.
      (loop for dir in directions
     for horizontal =     (member dir '(:forward :backward))
     for relative   = (if (member dir '(:left :backward))    -1 1)
     append (loop for i from 1 to length
            collect (if horizontal
                (cons 0 (* i relative))
                (cons (* i relative) 0)))))

(defun bishop (&key (length :infinity) (directions '(:forward :backward :left :right)))
  "Lists all possible destinations of a Bishop.
   Represents infinite-range moves as :n and :-n.
   Betza equivalent /\[[fb]?[rl]?\]B[0-9]*/"
  (flet ((diagonal-directions (dirs)
       (remove-duplicates
        (loop
           for dir in dirs
           appending (cond
               ((eql dir :forward ) (list :ne :nw))
               ((eql dir :backward) (list :se :sw))
               ((eql dir :left)     (list :nw :sw))
               ((eql dir :right)    (list :ne :se))
               ((member dir (list :ne :se :sw :nw)) (list dir))
               (t nil))))))
    (if (eql length :infinity)
    (loop
       for dir     in '(:ne :se :sw :nw)
       for vectors in '((:n . :n) (:n . :-n) (:-n . :-n) (:-n . :n))
       if (member dir (diagonal-directions directions)) collect vectors)
    (loop
          with calculated-dirs = (diagonal-directions directions)
          for dirs in (list :ne :se :sw :nw)
          for mult-x = (if (member dirs '(:nw :sw)) -1 1)
          for mult-y = (if (member dirs '(:se :sw)) -1 1)
          append (when (member dirs calculated-dirs)
               (loop for i from 1 to length collect (cons (* mult-x i) (* mult-y i))))))))