;;;
;;; (load "c:\\program files\\acl62\\music58.cl")
;;;
(load "c:\\program files\\acl62\\music57.cl")


(defun get-forth-interval-forward (pair)
  (let ((lst '(do fa +la +re +so +do +fa si mi la re so))
        (lst2 (get-chord-with-tension-from-pair pair)))
    (do ((l lst (cdr l))
         (w))
        ((null l) (reverse w))
      (if (member (car l) lst2)
          (push (car l) w)))))

(defun get-forth-interval-backward (pair)
  (let ((lst '(do so re la mi si +fa +do +so +re +la fa))
        (lst2 (get-chord-with-tension-from-pair pair)))
    (do ((l lst (cdr l))
         (w))
        ((null l) (reverse w))
      (if (member (car l) lst2)
          (push (car l) w)))))

(defun rotate-forth-interval-forward (pair note)
  (let ((lst (get-forth-interval-forward pair)))
    (rotate-list-left lst 
           (- (get-position-of-an-element note lst) 1))))

(defun rotate-forth-interval-backward (pair note)
  (let ((lst (get-forth-interval-backward pair)))
    (rotate-list-left lst 
           (- (get-position-of-an-element note lst) 1))))

(defun get-forth-interval-forward-end-with-note (pair note)
  (reverse (rotate-forth-interval-backward pair note)))

(defun get-forth-interval-backward-end-with-note (pair note)
  (reverse (rotate-forth-interval-forward pair note)))

(defun get-forth-interval-forward-at-random (pair)
  (let ((lst (get-forth-interval-forward pair)))
    (rotate-forth-interval-forward 
          pair (nth (random (length lst)) lst))))

(defun get-forth-interval-backward-at-random (pair)
  (let ((lst (get-forth-interval-backward pair)))
    (rotate-forth-interval-backward
          pair (nth (random (length lst)) lst))))

(defun get-forth-interval-at-random (pair)
  (case (random 2)
    (0 (get-forth-interval-forward-at-random pair))
    (1 (get-forth-interval-backward-at-random pair))))

(defun get-forth-interval-at-random-and-cut (pair)
  (let ((lst (get-forth-interval-at-random pair)))
    (cut-list-at-length 
        (+ (random (length lst)) 1) lst)))

(defun get-forth-interval-at-random-and-cut-2 (pair)
  (let ((lst (get-forth-interval-at-random pair)))
    (cut-list-at-length (+ (random 4) 1) lst)))