;;; 
;;; (get-elements-of-melody '("CM7" ion)) 
;;; 
(defun get-elements-of-melody (l) 
　　(append (get-guide-tone (car l)) 
            (get-tension-note (involve-atom-p 
                 (car l)) (cadr l)))) 

(defun chord-scale (l) 
　　(get-chordscale 
         (involve-atom-p (car l)) (cadr l))) 

(defun chord-tone (l) 
　　(get-chord-tone (car l))) 

(defun guide-tone (l) 
　　(get-guide-tone (car l))) 

(defun tension-note (l) 
　　(get-tension-note 
        (involve-atom-p (car l)) (cadr l))) 

(defun UST (l) 
　　(get-UST (car l))) 

(defun function-of-chord (l) 
　　(get-function-of-chord (intern (car l)))) 

;;; 
;;; (interpret-a-pair-aux '("CM7" ion)) 
;;; 
(defun interpret-a-pair-aux (l) 
　　(format t "~% ***** ~a ***** について" l) 
　　(format t "~% コードスケール ~a" 
         (chord-scale l)) 
　　(format t "~% コード構成音 ~a" 
         (chord-tone l)) 
　　(format t "~% テンションノート ~a" 
         (tension-note l)) 
　　(format t "~% ガイドトーン ~a" 
         (guide-tone l)) 
　　(format t "~% 旋律の要素 ~a" 
         (get-elements-of-melody l)) 
　　(format t "~% 旋律例１ ~%~a ~a ~a ~a ~a" 
　　　　(get-elements-of-melody-at-random l)
　　　　(get-elements-of-melody-at-random l) 
　　　　(get-elements-of-melody-at-random l) 
　　　　(get-elements-of-melody-at-random l) 
　　　　(get-elements-of-melody-at-random l)) 
　　(format t "~% UST ~a" (UST l)) 
　　(format t "~% USTによる旋律例２ 
               ~%~a ~%~a ~%~a ~%~a ~%~a"
　　　　(replace-UST-with-melody 
             (assoc (second l) (UST l))) 
　　　　(replace-UST-with-melody 
             (assoc (second l) (UST l))) 
　　　　(replace-UST-with-melody 
             (assoc (second l) (UST l))) 
　　　　(replace-UST-with-melody 
             (assoc (second l) (UST l))) 
　　　　(replace-UST-with-melody 
             (assoc (second l) (UST l)))) 
　　(format t "~% スケールによる旋律例３ 
              ~%~a ~%~a ~%~a ~%~a ~%~a ~%~a"
　　　　(make-a-phrase-with-scale-from-tension l) 
　　　　(make-a-phrase-with-scale-from-tension l) 
　　　　(make-a-phrase-with-scale-from-tension l) 
　　　　(make-a-phrase-with-scale-from-elm l) 
　　　　(make-a-phrase-with-scale-from-elm l) 
　　　　(make-a-phrase-with-scale-from-elm l)) 
　　(values)) 

(defun interpret-a-pair (l) 
　　(format t
　　　 "~%*********************************")
　　(format t "~%****** ~a ******" l) 
　　(do ((lst l (cddr lst))) 
　　　　　((null lst)) 
           (interpret-a-pair-aux 
                 (list (first lst) (second lst)))
　　　　 (read-sentence))) 

(defun interpret-pairs (l) 
　　(do ((lst l (cdr lst)))
　　　　　((null lst)) 
　　　　(interpret-a-pair (car lst)))) 

(defun get-an-element-of-melody-at-random (l) 
　　(let ((lst (get-elements-of-melody l))) 
　　　　(nth (random (length lst)) lst))) 

(defun get-UST-from-a-pair (l) 
　　(cdr (second (assoc (second l) 
                        (get-UST (first l))))))

(defun get-a-note-from-UST-at-random (chord) 
　　(let ((lst (get-chord-tone chord))) 
　　　　(nth (random (length lst)) lst))) 

(defun get-a-number-between-1-and-8 () 
　　(nth (random 8) '(1 2 3 4 5 6 7 8))) 

(defun get-n-elements-of-melody (l n) 
　　(do ((num n (1- num)) 
　　　　　(w)) 
　　　　((= num 0) w) 
　　　(push 
        (get-an-element-of-melody-at-random l) 
        w))) 

(defun get-elements-of-melody-at-random (l) 
　　(get-n-elements-of-melody 
          l 
          (get-a-number-between-1-and-8))) 

(defun get-n-notes-from-UST (chord n) 
　　(do ((num n (1- num)) 
　　　　　(w)) 
　　　　((= num 0) w) 
　　　(push 
        (get-a-note-from-UST-at-random chord) 
        w))) 

(defun get-notes-from-UST-at-random (chord) 
　　(get-n-notes-from-UST 
         chord 
         (get-a-number-between-1-and-8))) 

(defun replace-UST-with-melody (l) 
　　(cond ((null l) nil) 
　　　　　　((stringp l) 
             (get-notes-from-UST-at-random l)) 
　　　　　　((atom l) l) 
　　　　　　(t 
　　　　　　　(cons (replace-UST-with-melody (car l)) 
　　　　　　　　　　(replace-UST-with-melody (cdr l)))))) 

(defun display-melody-of-UST (l) 
　　(let ((lst (replace-UST-with-melody l))) 
　　　(do ((l1 lst (cdr l1))) 
　　　　　　((null l1)) 
　　　　(format t "~%~a" (car l1))))) 

;;; 
;;; 
;;; 
(defun translate-sound-to-number (s) 
　　(cond ((equal s "ド") 1.0) 
　　　　　　((or (equal s "#ド") (equal s "♭レ")) 1.5) 
　　　　　　((equal s "レ") 2.0) 
　　　　　　((or (equal s "#レ") (equal s "♭ミ")) 2.5) 
　　　　　　((equal s "ミ") 3.0) 
　　　　　　((equal s "ファ") 3.5) 
　　　　　　((or (equal s "#ファ") (equal s "♭ソ")) 4.0) 
　　　　　　((equal s "ソ") 4.5) 
　　　　　　((or (equal s "#ソ") (equal s "♭ラ")) 5.0) 
　　　　　　((equal s "ラ") 5.5) 
　　　　　　((or (equal s "#ラ") (equal s "♭シ")) 6.0) 
　　　　　　((equal s "シ") 6.5))) 

;;; 
;;;(get-position-of-a-note-in-a-scale-aux "ソ" 
;;;                                       '("CM7" ion))
;;; 
(defun get-position-of-a-note-in-a-scale-aux (note pair) 
　　(let* ((key (involve-atom-p (first pair))) 
　　　　　　(scale (butlast 
                     (get-chordscale key (second pair)))) 
　　　　　　(num1 (translate-sound-to-number note)) 
　　　　　　(num (if (null num1) 1 num1)) 
　　　　　　(position 
               (get-position-of-an-element note scale))) 
　　　(if (not (null position)) 
　　　　　(1- position) 
　　　　(do ((i (+ 0.5 num) (+ i 0.5))) 
　　　　　　　((= i 15.0)) 
　　　　　(let ((j (get-position-of-an-element 
　　　　　　　　　　(translate-number-to-sound 
                        i 
                        0.0 
                        (involve-atom-p (first pair))) 
　　　　　　　　　　scale))) 
　　　　　　(cond ((not (null j)) 
　　　　　　　　　　　(return (- j 2))))))))) 

;;; 
;;; (get-position-of-a-note-in-a-scale "ソ" '("CM7" ion)) 
;;; 
(defun get-position-of-a-note-in-a-scale (note pair) 
　　(let ((num 
           (get-position-of-a-note-in-a-scale-aux 
                note 
                pair))) 
　　　　(if (>= num 0) 
　　　　　　num 
　　　　　(+ num (length 
                    (get-chordscale 
　　　　　　　　　　　　(involve-atom-p (first pair)) 
　　　　　　　　　　　　(second pair))))))) 

;;; 
;;;(rotate-a-scale-left-from-a-note "ソ" '("CM7" ion))
;;; 
(defun rotate-a-scale-left-from-a-note (note pair) 
　　(let* ((key (involve-atom-p (first pair))) 
　　　　　　(scale (butlast 
                      (get-chordscale 
                          key 
                          (second pair)))) 
　　　　　　(position 
                (get-position-of-a-note-in-a-scale 
                    note 
                    pair)) 
　　　　　　(lst (rotate-list-left scale position))) 
　　　　(append lst (list (car lst))))) 

(defun rotate-a-scale-right-from-a-note (note pair) 
　　(reverse 
       (rotate-a-scale-left-from-a-note note pair))) 

;;; 
;;; (rotate-a-scale-from-a-note "ソ" '("CM7" ion) 'left)
;;; 
(defun rotate-a-scale-from-a-note (note pair direction)
　　(if (equal direction 'left) 
　　　　(rotate-a-scale-left-from-a-note note pair) 
　　　(rotate-a-scale-right-from-a-note note pair))) 

;;; 
;;; (get-a-tension-note-at-random '("CM7" ion)) 
;;; 
(defun get-a-tension-note-at-random (pair) 
　　(let ((lst (get-tension-note 
                  (involve-atom-p (first pair)) 
                  (second pair)))) 
　　　　(nth (random (length lst)) lst))) 

;;; (get-an-element-of-melody-at-random '("CM7" ion)) 

(defun rotate-a-scale-from-tension-left-or-right (pair) 
　　(case (random 2) 
　　　　(0 (rotate-a-scale-left-from-a-note 
               (get-a-tension-note-at-random pair) 
               pair)) 
　　　　(1 (rotate-a-scale-right-from-a-note 
               (get-a-tension-note-at-random pair) 
               pair)))) 

(defun rotate-a-scale-from-elm-left-or-right (pair) 
　　(case (random 2) 
　　　　(0 (rotate-a-scale-left-from-a-note 
               (get-an-element-of-melody-at-random
                   pair) pair))
　　　　(1 (rotate-a-scale-right-from-a-note 
               (get-an-element-of-melody-at-random 
                   pair)　pair)))) 

;;; 
;;; (get-notes-around-a-note-in-a-scale "ソ" 
;;;                                    '("CM7" ion))
;;; 
(defun get-notes-around-a-note-in-a-scale (note pair) 
　　(let ((lst-r 
            (rotate-a-scale-right-from-a-note note pair)) 
　　　　　(lst-l 
            (rotate-a-scale-left-from-a-note note pair)) 
　　　　　(pos 
           (get-position-of-a-note-in-a-scale-aux 
                    note pair))) 
　　　　(append (list 
                  (cond ((member note lst-r :test #'equal) 
　　　　　　　　　　　　 (second lst-r)) 
　　　　　　　　　　　　((< pos 0) (second lst-r)) 
　　　　　　　　　　　　 (t (first lst-r)))) 
　　　　　　　　　　(if (member note lst-r :test #'equal) 
　　　　　　　　　　　　(list note) 
　　　　　　　　　　　nil) 
　　　　　　　　　　(list (cond ((member note lst-l 
                                       :test #'equal) 
　　　　　　　　　　　　　　　　　　(second lst-l)) 
　　　　　　　　　　　　　　　　　((< pos 0) 
　　　　　　　　　　　　　　　　　　(first lst-l)) 
　　　　　　　　　　　　　　　　　(t 
　　　　　　　　　　　　　　　　　　(second lst-l))))))) 

(defun get-a-note-around-a-note-in-a-scale (note pair) 
　　(let ((lst 
            (get-notes-around-a-note-in-a-scale 
                 note 
                 pair))) 
　　　　(case (random 3) 
　　　　　　(0 (first lst)) 
　　　　　　(1 (second lst)) 
　　　　　　(2 (third lst))))) 

;;; 
;;; 
;;; 
(defun rotate-a-scale-from-a-note-left-or-right (note pair) 
　　(case (random 2) 
　　　　(0 (rotate-a-scale-left-from-a-note 
                 note 
                 pair)) 
　　　　(1 (rotate-a-scale-right-from-a-note 
                 note 
                 pair)))) 

(defun rotate-a-scale-from-a-note-and-cut (note pair) 
　　(let ((lst 
            (rotate-a-scale-from-a-note-left-or-right 
                  note 
                  pair))) 
　　　　(cut-list-at-length (nth (random 8) 
                                 '(1 2 3 4 5 6 7 8)) lst)))

(defun rotate-a-scale-from-tension-and-cut (pair) 
　　(let ((lst 
            (rotate-a-scale-from-tension-left-or-right 
                pair))) 
　　　　(cut-list-at-length 
             (nth (random 8) '(1 2 3 4 5 6 7 8)) lst)))

(defun rotate-a-scale-from-elm-and-cut (pair) 
　　(let ((lst 
            (rotate-a-scale-from-elm-left-or-right 
                pair))) 
　　　　(cut-list-at-length 
            (nth (random 8) '(1 2 3 4 5 6 7 8)) lst)))

;;; 
;;; 
;;; 
(defun make-a-phrase-with-scale-from-tension (pair) 
　　(do ((i 8 (1- i)) 
　　　　　(w (rotate-a-scale-from-tension-and-cut 
                 pair))) 
　　　　((or (= i 0) (> (length w) 8)) 
　　　(cut-list-at-length 
         (nth (random 8) '(1 2 3 4 5 6 7 8)) w)) 
　　(setf w (append w 
　　　　　　　　(rotate-a-scale-from-a-note-and-cut
　　　　　　　　(get-a-note-around-a-note-in-a-scale 
                    (car (last w)) pair) pair))))) 

(defun make-a-phrase-with-scale-from-elm (pair) 
　　(do ((i 8 (1- i)) 
　　　　　(w (rotate-a-scale-from-elm-and-cut pair))) 
　　　　((or (= i 0) (> (length w) 8)) 
　　　(cut-list-at-length 
          (nth (random 8) '(1 2 3 4 5 6 7 8)) w)) 
　　(setf w (append w 
　　　　　　　(rotate-a-scale-from-a-note-and-cut
　　　　　　　(get-a-note-around-a-note-in-a-scale 
                  (car (last w)) pair) pair)))))