;;;
;;; c:\\program files\\acl62\\music13.cl
;;;
(load "c:\\program files\\acl62\\music12.cl")

;;;
;;; (the-list-is-involved-in-a-scale '(do re mi fa so la si do) '(C ion))
;;;
(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)))