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

(make-frame-from-list
　 　'(modulation-patterns-C
         (heikou-tyou-1
            (value "Bm7-5" "E7" ("Am7")
                   "D7" "Dm7" "G7" ("CM7")))
　　　　 (heikou-tyou-2 
            (value ("CM7") "Am7" "Dm7"
                   "G7" ("Am7") "Bm7-5"))
　　　　 (zoku-tyou-1
            (value ("CM7") "Am7" "D7"
                   ("GM7") "Bm7" "Em7"))
 　　　　(zoku-tyou-2
            (value ("CM7") "-Bdim7" "Am7"
                   "-A7" ("GM7") "Bm7" "Am7"))
　　　　 (kazoku-tyou-1
            (value "Dm7" "G7" "Gm7" "C7"
                   ("FM7") "-BM7" "Gm7"
                   "C7" ("FM7")))
 　　　　(kazoku-tyou-2
            (value ("CM7") "Em7" "Am7"
                   "-BM7" "Am7" "Gm7"
　　　　　　　　　 "C7" ("FM7")))
　　　　 (hanon-up-1
            (value ("CM7") "Dm7" "Em7"
                   "A7" "-Em7" "-A7"
　　　　　　　　　 ("-DM7") "-GM7"))
　　　　 (hanon-up-2
            (value "Dm7" "G7" "-Em7"
                   "-A7" ("-DM7") "-Bm7"))
　　　　 (zenon-up-1
            (value ("CM7") "B7" "E7" "A7"
                   ("DM7") "+Fm7" "Bm7"))
　　　　 (zenon-up-2
            (value ("CM7") "FM7" "-BM7"
                   "-EM7" ("DM7") "Bm7"))
　　　　(3do-kei-1
            (value ("CM7") "Dm7" "G7"
                   ("-EM7") "Fm7" "-B7"
                   ("-EM7")))
　　　　(3do-kei-2
            (value ("CM7") "FM7" "Fm7"
                   ("EM7") "AM7" "+Fm7"
                   "B7" ("EM7")))
　　　　(zou4do
            (value "Em7" "Am7" "Dm7" "G7"
                  ("-GM7") "-Am7"))
　　　　(6do-kei-1
            (value ("CM7") "Dm7" "Gm7"
                   "C7" ("-AM7") "Cm7" 
                   "F7"))
　　　　(6do-kei-2
            (value ("CM7") "-BM7" "CM7"
                   "E7" ("AM7") "+Fm7"))
　　　　(7do-kei-1
            (value "Dm7" "G7" "Cm7" "F7"
                   "-BM7" "-EM7" "F7"
                   ("-BM7")))
　　　　(7do-kei-2
            (value "FM7" "Em7" "-Em7" "Dm7"
                   "+Cm7" ("BM7") "+Gm7"))))

(defun get-modulate-patterns (key)
　　(if (eq key 'C)
　　　　(fget-frame 'modulation-patterns-C)
　　　(modulate-key1-to-key2
           (fget-frame 'modulation-patterns-C)
           'C
            key)))

(defun list-modulate-patterns (key)
　　(print (get-modulate-patterns key)))

(defun get-modulation ()
　　(prog (key num)
　　　　(format t "~%Enter a key !")
　　　　(setf key (car (read-sentence)))
　　　　(format t "~%１．平行調")
　　　　(format t "~%２．属調")
　　　　(format t "~%３．下属調")
　　　　(format t "~%４．半音上の調")
　　　　(format t "~%５．全音上の調")
　　　　(format t "~%６．３度系の調")
　　　　(format t "~%７．増４度の調")
　　　　(format t "~%８．６度系の調")
　　　　(format t "~%９．７度系の調")
　　　　loop1
　　　　(format t "~%Enter a number !")
　　　　(setf num (car (read-sentence)))
　　　　(if (member num '(1 2 3 4 5 6 7 8 9))
　　　　　　(go loop2)
　　　　　(go loop1))
　　　　loop2
　　　　(case num
　　　　　　(1 (return (list key
　　　　　　　　　　　　　　 (modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'heikou-tyou-1)
                             'C
                             key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'heikou-tyou-2) 
                                 'C
                                 key))))
　　　　　　(2 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'zoku-tyou-1)
                                 'C 
                                 key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'zoku-tyou-2)
                                 'C
                                  key))))
　　　　　　(3 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'kazoku-tyou-1)
                                 'C
                                  key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'kazoku-tyou-2)
                                 'C
                                  key))))
　　　　　　(4 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'hanon-up-1)
                                 'C
                                  key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'hanon-up-2)
                                 'C
                                 key))))
　　　　　　(5 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C 
                                   'zenon-up-1)
                                 'C
                                  key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'zenon-up-2)
                                 'C
                                 key))))
　　　　　　(6 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   '3do-kei-1)
                                 'C
                                 key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   '3do-kei-2)
                                 'C
                                 key))))
　　　　　　(7 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   'zou4do)
                                 'C
                                  key))))
　　　　　　(8 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   '6do-kei-1)
                                 'C
                                  key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   '6do-kei-2)
                                 'C
                                  key))))
　　　　　　(9 (return (list key
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   '7do-kei-1)
                                 'C
                                  key)
　　　　　　　　　　　　　　(modulate-key1-to-key2
                                 (fget-i
                                   'modulation-patterns-C
                                   '7do-kei-2)
                                 'C
                                  key)))))))