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

(defun get-chord-tone-2 (pair) 
　　(translate-flat-to-sharp-in-a-list 
        (replace-j-note-with-doremi 
            (get-chord-tone (car pair))))) 

(defun get-chord-scale-2 (pair) 
　　(translate-flat-to-sharp-in-a-list 
         (replace-j-note-with-doremi 
            (chord-scale pair)))) 

(defun get-tension-note-2 (pair) 
　　(translate-flat-to-sharp-in-a-list 
         (replace-j-note-with-doremi 
            (tension-note pair)))) 

(defun get-guide-tone-2 (pair) 
　　(translate-flat-to-sharp-in-a-list 
         (replace-j-note-with-doremi 
            (guide-tone pair)))) 

(defun get-elements-of-melody-2 (pair) 
　　(translate-flat-to-sharp-in-a-list 
         (replace-j-note-with-doremi 
            (get-elements-of-melody pair)))) 

(defun generate-a-note-at-random (pair) 
　　(let* ((lst (get-elements-of-melody-2 pair)) 
 　　　　　(num (length lst))) 
　　　　(nth (random num) lst))) 

(defun translate-number-to-sound-2 (n offset) 
　　(let ((num (confine-a-number (+ n offset))))
　　　(case num 
　　　　(1.0 'do) (1.5 '+do) (2.0 're) (2.5 '+re) 
　　　　(3.0 'mi) (3.5 'fa) (4.0 '+fa) (4.5 'so)
　　　　(5.0 '+so) (5.5 'la) (6.0 '+la) 
        (6.5 'si)))) 

(defun translate-sound-to-number-2 (c) 
　　(case c 
　　　　(do 1.0) (+do 1.5) (re 2.0) (+re 2.5) 
　　　　(mi 3.0) (fa 3.5) (+fa 4.0) (so 4.5) 
　　　　(+so 5.0) (la 5.5) (+la 6.0) (si 6.5))) 

(defun distance-of-two-sound-2 (s1 s2) 
　　(let* ((n1 (translate-sound-to-number-2 s1)) 
　　　　　 (n2 (translate-sound-to-number-2 s2)) 
　 　　　　(num (- n2 n1))) 
　　　　(cond ((>= num 7.0) (- num 6.0)) 
　　　　　　　((<= num 0.0) (+ num 6.0)) 
　　　　　　　(t num)))) 

(defun sharp-a-note (note) 
　　(let ((num 
            (translate-sound-to-number-2 note)))
　　　(translate-number-to-sound-2 
            (+ 0.5 num) 0.0))) 

(defun flat-a-note (note) 
　　(let* ((num 
             (translate-sound-to-number-2 note))
　　　　　 (n1 (- num 0.5)) 
　　　　　 (n2 (cond ((>= n1 7.0) (- n1 6.0)) 
　　　　　 　　　　　((<= n1 0.5) (+ n1 6.0)) 
　　　　　 　　　　　(t n1)))) 
       (translate-number-to-sound-2 n2 0.0)))

(defun member-of-chord-tone-2 (note pair)

　　(car (member note (get-chord-tone-2 pair)))) 

(defun member-of-tension-note-2 (note pair) 
　　(car (member note (get-tension-note-2 pair))))

(defun member-of-scale-note-2 (note pair) 
　　(car (member note 
            (append (get-chord-tone-2 pair) 
                    (get-tension-note-2 pair))))) 

(defun member-of-element-note-2 (note pair)
　　(car (member note 
            (append (get-guide-tone-2 pair) 
                    (get-tension-note-2 pair)))))

(defun member-of-guide-tone-2 (note pair)
　　(car (member note (get-guide-tone-2 pair))))

(defun sharp-till-chord-tone (note pair) 
　　(do ((nt note (sharp-a-note nt)) 
　 　　　(w)) 
　　　　((member-of-chord-tone-2 nt pair) 
             (push nt w) (reverse w)) 
　　　(cond ((member-of-scale-note-2 nt pair) 
　　　　　　　　(push nt w))))) 

(defun flat-till-chord-tone (note pair) 
　　(do ((nt note (flat-a-note nt)) 
 　　　　(w)) 
  　　　((member-of-chord-tone-2 nt pair) 
             (push nt w) (reverse w)) 
　　　(cond ((member-of-scale-note-2 nt pair) 
 　　　　　　(push nt w))))) 

(defun generate-a-phrase-aux (pair) 
　　(do ((i 8 (1- i)) 
　　　　　(w)) 
　　　　((<= i 0) (reverse w)) 
　　　(let ((nt (generate-a-note-at-random pair)))
　　　　　(cond ((member-of-guide-tone-2 nt pair) 
 　　　　　　　　(push nt w)) 
　　　　　　　　((member-of-tension-note-2 nt pair)
 　　　　　　　　(push 
                   (case (random 2) 
 　　　　　　　　　　(0 (flat-till-chord-tone 
                            nt pair))
 　　　　　　　　　　(1 (sharp-till-chord-tone 
                            nt pair)))
                 w))
　　　　　　　　(t (push 
　　　　　　　　　　(case (random 2) 
　　　　　　　　　　　(0 (flat-till-chord-tone 
                             nt pair))
　　　　　　　　　　　(1 (sharp-till-chord-tone 
                             nt pair)))
                    w))))))

(defun generate-a-phrase-of-n-notes (pair n) 
　　(cut-list-at-length 
         n 
         (generate-a-phrase-aux pair))) 

(defun generate-a-phrase-at-random (pair) 
　　(generate-a-phrase-of-n-notes 
         pair (1+ (random 6)))) 

(defun make-a-phrase (l) 
　　(do ((lst l (cddr lst))) 
　　　　　((null lst)) 
　　　(format t "~%***** On ~a *****" l) 
　　　(format t "~%***** On ~a *****" 
           (list (first lst) (second lst))) 
　　　(format t "~%Chord Scale: ~a" 
           (chord-scale (list (first lst) 
                              (second lst))))
　　　(format t "~%~a" 
           (generate-a-phrase-at-random 
               (list (first lst) (second lst)))) 
　　　(format t "~%~a" 
           (generate-a-phrase-at-random 
               (list (first lst) (second lst)))) 
　　　(format t "~%~a" 
           (generate-a-phrase-at-random 
               (list (first lst) (second lst)))) 
　　　(format t "~%~a" 
           (generate-a-phrase-at-random 
               (list (first lst) (second lst)))) 
　　　(format t "~%~a" 
           (generate-a-phrase-at-random 
               (list (first lst) (second lst)))))) 

(defun make-phrases (l) 
　　(do ((lst l (cdr lst))) 
　　　　((null lst)) 
　　　(make-a-phrase (car lst))))

;;; 
;;; (auto-comp2 *w3*) etc. 
;;; 
(defun auto-comp2 (wn) 
　　(tagbody 
　　　　(my-randomize) 
　　　　(format t "~%********** ~a ************" 
           (second (first wn))) 
　　　　(format t "~%The original key is ~a." 
           (first (first wn)))
　　　　(format t "~%Enter a key.") 
　　　　loop1 
　　　　(setf l1 (read-sentence)) 
　　　　(if (not (key-p (car l1))) (go loop1)) 
　　　　(if (equal (car l1) (first (first wn))) 
　　　　　　　　(setf l2 (cdr wn)) 
　　　　　　　(setf l2 (modulate-key1-to-key2 
                          (cdr wn) 
                          (first (first wn)) 
                          (car l1)))) 
　　　　(format t "~%****** The key is ~a. *****"
              (car l1)) 
　　　　(make-phrases l2)))