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

;;;
;;;(chord-scale '("CM7" ion))--->(do re mi fa so la si do)
;;;
;;;(get-forth-interval-forward '("CM7" ion))--->(do si mi la re so)
;;;(get-forth-interval-forward '("Dm7" dor))--->(do fa +la si mi la re so)
;;;(get-forth-interval-forward '("G7" alt))--->(fa +la +re +so +do si mi la re so)
;;;
(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)))))

;;;
;;;(get-forth-interval-backward '("CM7" ion))--->(do so re la mi si)
;;;(get-forth-interval-backward '("Dm7" dor))--->(do so re la mi si +la fa)
;;;(get-forth-interval-backward '("G7" alt))--->(so re la mi si +do +so +re +la fa)
;;;
(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)))))

;;;
;;;(get-position-of-an-element 're '(do re mi fa))--->2
;;;(rotate-list-right '(do re mi fa) 2)--->(mi fa do re)
;;;(rotate-list-left '(do re mi fa) 2)--->(mi fa do re)
;;;
;;;(rotate-forth-interval-forward '("CM7" ion) 'mi)
;;;(mi la re so do si)
;;;(rotate-forth-interval-forward '("Dm7" dor) 'si)
;;;(si mi la re so do fa +la)
;;;(rotate-forth-interval-forward '("G7" all) '+so)
;;;(+so +do si mi la re so fa +la +re)
;;;
(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))))

;;;
;;;(rotate-forth-interval-backward '("CM7" ion) 'mi)
;;;(mi si do so re la)
;;;(rotate-forth-interval-backward '("Dm7" dor) 'si)
;;;(si +la fa do so re la mi)
;;;(rotate-forth-interval-backward '("G7" all) 'si)
;;;(si +do +so +re +la fa so re la mi)
;;;(rotate-forth-interval-backward '("G7" all) 'mi)
;;;(mi si +do +so +re +la fa so re la)
;;;
(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))))

;;;
;;;(get-forth-interval-forward-end-with-note '("CM7" ion) 'mi)
;;;(la re so do si mi)
;;;(get-forth-interval-forward-end-with-note '("Dm7" dor) 'la)
;;;(re so do fa +la si mi la)
;;;(get-forth-interval-forward-end-with-note '("G7" all) 'si)
;;;(mi la re so fa +la +re +so +do si)
;;;(get-forth-interval-forward-end-with-note '("G7" all) 'mi)
;;;(la re so fa +la +re +so +do si mi)
;;;
(defun get-forth-interval-forward-end-with-note (pair note)
　　(reverse (rotate-forth-interval-backward pair note)))

;;;
;;;(get-forth-interval-backward-end-with-note '("CM7" ion) 'mi)
;;;(si do so re la mi)
;;;(get-forth-interval-backward-end-with-note '("Dm7" dor) 'la)
;;;(mi si +la fa do so re la)
;;;(get-forth-interval-backward-end-with-note '("G7" all) 'si)
;;;(+do +so +re +la fa so re la mi si)
;;;(get-forth-interval-backward-end-with-note '("G7" all) 'mi)
;;;
(defun get-forth-interval-backward-end-with-note (pair note)
　　(reverse (rotate-forth-interval-forward pair note)))

;;;
;;;(get-forth-interval-forward-at-random '("G7" alt))
;;;(+so +do si mi la re so fa +la +re)
;;;(get-forth-interval-forward-at-random '("CM7" ion))
;;;(si mi la re so do)
;;;(get-forth-interval-forward-at-random '("Dm7" dor))
;;;(so do fa +la si mi la re)
;;;(get-forth-interval-forward-at-random '("G7" all))
;;;(re so fa +la +re +so +do si mi la)
;;;
(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))))

;;;
;;;(get-forth-interval-backward-at-random '("CM7" ion))
;;;(mi si do so re la)
;;;(get-forth-interval-backward-at-random '("Dm7" dor))
;;;(mi si +la fa do so re la)
;;;(get-forth-interval-backward-at-random '("G7" all))
;;;(si +do +so +re +la fa so re la mi)
;;;
(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))))

;;;
;;;(get-forth-interval-at-random '("CM7" ion))
;;;(si do so re la mi)
;;;(get-forth-interval-at-random '("Dm7" dor))
;;;(si mi la re so do fa +la)
;;;(get-forth-interval-at-random '("G7" all))
;;;(so fa +la +re +so +do si mi la re)
;;;
(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))))

;;;
;;;(cut-list-at-length 2 '(a b c d e))--->(a b)
;;;(cut-list-at-length 3 '(a b c d e))--->(a b c)
;;;
(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)))