(load "c:\\program files\\acl62\\music16.cl") 


;;; 
;;; (get-triads '("CM7" ion) 
;;; 
(defun get-triads (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(lst (append ll 
                         (list (first ll) 
                               (second ll) 
                               (third ll) 
                               (fourth ll)))) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (1- nn))
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn 4) (reverse w)) 
　　　　　(setf l (rotate-list-right lst nn)) 
　　　　　(push (list (first l) (third l) 
                      (fifth l)) 
                 w)))) 

(defun get-chords-from-scale (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(nl (length ll)) 
　　　　　　(lst (append ll ll)) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (1- nn)) 
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn nl) (reverse w)) 
　　　　　(setf l (rotate-list-right lst nn)) 
　　　　　(push (list (first l) (third l) 
                      (fifth l) (seventh l)) 
                 w)))) 

(defun 4th-interval-chords (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(nl (length ll)) 
　　　　　　(lst (append ll ll)) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (1- nn)) 
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn nl) (reverse w)) 
　　　　　(setf l (rotate-list-right lst nn)) 
　　　　　(push (list (first l) (fourth l) 
                      (seventh l) (tenth l)) 
                 w))))

(defun 4th-interval-triads (pair) 
　 (let* ((ll (butlast (chord-scale pair))) 
　　　　　(nl (length ll)) 
　　　　　(lst (append ll ll)) 
  　　　　(n (length lst))) 
　　　(do ((nn n (1- nn)) 
 　　　　　(l) 
 　　　　　(w)) 
　　　　　((<= nn nl) (reverse w)) 
 　　　　　(setf l (rotate-list-right 
                        lst nn)) 
　　　　　　(push (list (first l) (fourth l) 
                        (seventh l)) w)))) 

;;; 
;;; 
;;; 
(defun 3rd-interval (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(lst (append ll ll)) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (- nn 2)) 
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn -1) (reverse w)) 
　　　　　(setf l (rotate-list-right 
                       lst nn)) 
　　　　　(push (first l) w)))) 

(defun 4th-interval (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　　(lst (append ll ll ll)) 
　　　　　　　(n (length lst))) 
　　　　　(do ((nn n (- nn 3)) 
　　　　　　　　(l) 
　　　　　　　　(w)) 
　　　　　　　　((<= nn -1) (reverse w)) 
　　　　　　(setf l (rotate-list-right 
                         lst nn)) 
　　　　　　(push (first l) w)))) 

(defun 5th-interval (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(lst (append ll ll ll ll)) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (- nn 4)) 
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn -1) (reverse w)) 
　　　　　(setf l (rotate-list-right 
                      lst nn)) 
　　　　　(push (first l) w)))) 

(defun 6th-interval (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(lst (append ll ll ll ll ll)) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (- nn 5)) 
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn -1) (reverse w)) 
　　　　　(setf l (rotate-list-right 
                       lst nn)) 
　　　　　(push (first l) w)))) 

(defun 7th-interval (pair) 
　　(let* ((ll (butlast (chord-scale pair))) 
　　　　　　(lst (append ll ll ll ll ll ll)) 
　　　　　　(n (length lst))) 
　　　　(do ((nn n (- nn 6)) 
　　　　　　　(l) 
　　　　　　　(w)) 
　　　　　　((<= nn -1) (reverse w)) 
　　　　　　 (setf l (rotate-list-right 
                          lst nn)) 
 　　　　　　(push (first l) w))))