;;;
;;; (the-list-is-involved-in-a-scale 
;;;          '(do re mi fa so la si do) '(C ion)) 
;;; 
(load "c:\\program files\\acl62\\music12.cl") 


(defun the-list-is-involved-in-a-scale (lst pair) 
　　(sub-set-p (translate-flat-to-sharp-in-a-list lst)  
　　　　　　　　　　(replace-j-note-with-doremi 
                       (get-chordscale (first pair) 
                       (second pair))))) 


(setf *scales* '(ion dor phr lyd mix aeo 
                 loc n h m all dor-2 loc+2 
　　　　　　　　 lyd-7 hmp5 mmp5 alt comd 
                 dim wt mixsus4 mix-6)) 


(defun C-scale (type) (list 'C type)) 
(defun get-C-scales () 
    (mapcar #'C-scale *scales*)) 
(defun +C-scale (type) (list '+C type)) 
(defun get-+C-scales () 
    (mapcar #'+C-scale *scales*)) 
(defun -D-scale (type) (list '-D type)) 
(defun get--D-scales () 
    (mapcar #'-D-scale *scales*)) 
(defun D-scale (type) (list 'D type)) 
(defun get-D-scales () 
    (mapcar #'D-scale *scales*)) 
(defun +D-scale (type) (list '+D type)) 
(defun get-+D-scales () 
    (mapcar #'+D-scale *scales*)) 
(defun -E-scale (type) (list '-E type)) 
(defun get--E-scales () 
    (mapcar #'-E-scale *scales*)) 
(defun E-sacle (type) (list 'E type)) 
(defun get-E-scales () 
    (mapcar #'E-sacle *scales*)) 
(defun F-scale (type) (list 'F type)) 
(defun get-F-scales () 
    (mapcar #'F-scale *scales*)) 
(defun +F-scale (type) (list '+F type)) 
(defun get-+F-scales () 
    (mapcar #'+F-scale *scales*)) 
(defun -G-scale (type) (list '-G type)) 
(defun get--G-scales () 
    (mapcar #'-G-scale *scales*)) 
(defun G-scale (type) (list 'G type)) 
(defun get-G-scales () 
    (mapcar #'G-scale *scales*)) 
(defun +G-scale (type) (list '+G type)) 
(defun get-+G-scales () 
    (mapcar #'+G-scale *scales*)) 
(defun -A-scale (type) (list '-A type)) 
(defun get--A-scales () 
    (mapcar #'-A-scale *scales*)) 
(defun A-scale (type) (list 'A type)) 
(defun get-A-scales () 
    (mapcar #'A-scale *scales*)) 
(defun +A-scale (type) (list '+A type)) 
(defun get-+A-scales () 
    (mapcar #'+A-scale *scales*)) 
(defun -B-scale (type) (list '-B type)) 
(defun get--B-scales () 
    (mapcar #'-B-scale *scales*)) 
(defun B-scale (type) (list 'B type)) 
(defun get-B-scales () 
    (mapcar #'B-scale *scales*)) 


;;; 
;;; 
;;; 
(defun get-C-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-C-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-+C-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-+C-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get--D-scales-whitch-involve-the-list (lst) 
　　(do ((l (get--D-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-D-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-D-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-+D-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-+D-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get--E-scales-whitch-involve-the-list (lst) 
　　(do ((l (get--E-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-E-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-E-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-F-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-F-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-+F-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-+F-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get--G-scales-whitch-involve-the-list (lst) 
　　(do ((l (get--G-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-G-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-G-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-+G-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-+G-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get--A-scales-whitch-involve-the-list (lst) 
　　(do ((l (get--A-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-A-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-A-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-+A-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-+A-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get--B-scales-whitch-involve-the-list (lst) 
　　(do ((l (get--B-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


(defun get-B-scales-whitch-involve-the-list (lst) 
　　(do ((l (get-B-scales) (cdr l)) 
　　　　　(w)) 
　　　　　((null l) w) 
　　　　(cond ((the-list-is-involved-in-a-scale 
                    lst (car l)) 
　　　　　　　　　(push (car l) w))))) 


;;; 
;;; (get-scales-whitch-involve-the-notes 
;;;        '(do re mi fa so la si do)) 
;;; 
(defun get-scales-whitch-involve-the-notes (lst) 
　(append 
      (get-C-scales-whitch-involve-the-list lst) 
　　　(get-+C-scales-whitch-involve-the-list lst) 
　　　(get--D-scales-whitch-involve-the-list lst) 
　　　(get-D-scales-whitch-involve-the-list lst) 
　　　(get-+D-scales-whitch-involve-the-list lst) 
　　　(get--E-scales-whitch-involve-the-list lst) 
　　　(get-E-scales-whitch-involve-the-list lst) 
　　　(get-F-scales-whitch-involve-the-list lst) 
  　　(get-+F-scales-whitch-involve-the-list lst) 
　　　(get--G-scales-whitch-involve-the-list lst) 
　　　(get-G-scales-whitch-involve-the-list lst) 
　　　(get-+G-scales-whitch-involve-the-list lst) 
　　　(get--A-scales-whitch-involve-the-list lst) 
　　　(get-A-scales-whitch-involve-the-list lst) 
　　　(get-+A-scales-whitch-involve-the-list lst) 
　　　(get--B-scales-whitch-involve-the-list lst) 
　　　(get-B-scales-whitch-involve-the-list lst)))