;;;
;;; c:\\program files\\acl62\\music38.cl
;;;
(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)))))))