;;;
;;; (load "c:\\program files\\acl62\\music57.cl")
;;;
(load "c:\\program files\\acl62\\music56.cl")
(load "c:\\program files\\acl62\\music26.cl")

(defun get-note-for-degree-of-C (char)
  (case char
      (1 'do) (3 'mi) (5 'so) (7 'si) (9 're) (11 'fa) (13 'la) (6 'la)
      (p9 '+re) (-9 '-re) (p11 '+fa) (-13 '-la) (-5 '-so) (p5 '+so) (-7 '-si)))

;;;
;;;(get-notes-for-degree-of-C-list '(-9 9 p9 11 p11 -13 13))
;;;(-re re +re fa +fa -la la)
;;;
(defun get-notes-for-degree-of-C-list (lst)
  (mapcar #'get-note-for-degree-of-C lst))

;;;
;;;(get-notes-for-degree 'C '(-9 9 p9 11 p11 -13 13))
;;;(C (+do re +re fa +fa +so la))
;;;(get-notes-for-degree '+C '(-9 9 p9 11 p11 -13 13))
;;;(+C (re +re mi +fa so la +la))
;;;(get-notes-for-degree '-D '(-9 9 p9 11 p11 -13 13))
;;;(-D (re +re mi +fa so la +la))
;;;(get-notes-for-degree 'D '(-9 9 p9 11 p11 -13 13))
;;;(D (+re mi fa so +so +la si))
;;;(get-notes-for-degree '+D '(-9 9 p9 11 p11 -13 13))
;;;(+D (mi fa +fa +so la si do))
;;;cg-user(53): (get-notes-for-degree '-E '(-9 9 p9 11 p11 -13 13))
;;;(-E (mi fa +fa +so la si do))
;;;(get-notes-for-degree 'E '(-9 9 p9 11 p11 -13 13))
;;;(E (fa +fa so la +la do +do))
;;;(get-notes-for-degree 'F '(-9 9 p9 11 p11 -13 13))
;;;(F (+fa so +so +la si +do re))
;;;(get-notes-for-degree '+F '(-9 9 p9 11 p11 -13 13))
;;;(+F (so +so la si do re +re))
;;;(get-notes-for-degree '-A '(-9 9 p9 11 p11 -13 13))
;;;(-A (la +la si +do re mi fa))
;;;(get-notes-for-degree '-G '(-9 9 p9 11 p11 -13 13))
;;;(-G (so +so la si do re +re))
;;;(get-notes-for-degree 'G '(-9 9 p9 11 p11 -13 13))
;;;(G (+so la +la do +do +re mi))
;;;(get-notes-for-degree '+G '(-9 9 p9 11 p11 -13 13))
;;;(+G (la +la si +do re mi fa))
;;;(get-notes-for-degree '-A '(-9 9 p9 11 p11 -13 13))
;;;(-A (la +la si +do re mi fa))
;;;(get-notes-for-degree 'A '(-9 9 p9 11 p11 -13 13))
;;;(A (+la si do re +re fa +fa))
;;;(get-notes-for-degree '+A '(-9 9 p9 11 p11 -13 13))
;;;(get-notes-for-degree '-B '(-9 9 p9 11 p11 -13 13))
;;;(-B (si do +do +re mi +fa so))
;;;(get-notes-for-degree 'B '(-9 9 p9 11 p11 -13 13))
;;;(B (do +do re mi fa so +so))
;;;(get-notes-for-degree 'C '(-9 9 p9 11 p11 -13 13))
;;;(C (+do re +re fa +fa +so la))
;;;
(defun get-notes-for-degree (base lst)
  (let ((lst2 (translate-flat-to-sharp-in-a-list (get-notes-for-degree-of-C-list lst))))
   (case base
       (C (list 'C lst2))
       (+C (list '+C (m2-up lst2)))
       (-D (list '-D (m2-up lst2)))
       (D (list 'D (M2-up lst2)))
       (+D (list '+D (m3-up lst2)))
       (-E (list '-E (m3-up lst2)))
       (E (list 'E (M3-up lst2)))
       (F (list 'F (P4-up lst2)))
       (+F (list '+F (+4-5-up lst2)))
       (-G (list '-G (+4-5-up lst2)))
       (G (list 'G (P5-up lst2)))
       (+G (list '+G (m6-up lst2)))
       (-A (list '-A (m6-up lst2)))
       (A (list 'A (M6-up lst2)))
       (+A (list '+A (m7-up lst2)))
       (-B (list '-B (m7-up lst2)))
       (B (list 'B (M7-up lst2))))))

(defun get-degree-of-note-in-C (note)
  (case note
      (do 1) (mi 3) (so 5) (si 7) (-si -7) (+la -7) (re 9) (+do -9) (-re -9) (+re 'p9) (-mi 'p9)
      (fa 11) (+fa 'p11) (-so 'p11) (la 13) (-la -13) (+so -13) (-so -5) (+fa -5) (-la 'p5) (+so 'p5)))

;;;
;;;(get-degree-of-notes-in-C-list '(-re re +re fa +fa -la la))
;;;(-9 9 p9 11 p11 -13 13)
;;;
(defun get-degree-of-notes-in-C-list (lst)
  (mapcar #'get-degree-of-note-in-C lst))

;;;
;;;(get-degree-for-notes 'C '(-re re +re fa +fa -la la))
;;;(C (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '+C '(re +re mi +fa so la +la))
;;;(+C (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '-D '(re +re mi +fa so la +la))
;;;(-D (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'D '(+re mi fa so +so +la si))
;;;(D (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '+D '(mi fa +fa +so la si do))
;;;(+D (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '-E '(mi fa +fa +so la si do))
;;;(-E (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'E '(fa +fa so la +la do +do))
;;;(E (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'F '(+fa so +so +la si +do re))
;;;(F (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '+F '(so +so la si do re +re))
;;;(+F (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '-G '(so +so la si do re +re))
;;;(-G (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'G '(+so la +la do +do +re mi))
;;;(G (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '+G '(la +la si +do re mi fa))
;;;(+G (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '-A '(la +la si +do re mi fa))
;;;(-A (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'A '(+la si do re +re fa +fa))
;;;(A (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '+A '(si do +do +re mi +fa so))
;;;(+A (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes '-B '(si do +do +re mi +fa so))
;;;(-B (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'B '(do +do re mi fa so +so))
;;;(B (-9 9 p9 11 p11 -13 13))
;;;(get-degree-for-notes 'C '(+do re +re fa +fa +so la))
;;;(C (-9 9 p9 11 p11 -13 13))
;;;
(defun get-degree-for-notes (base lst)
  (let ((lst2 (get-degree-of-notes-in-C-list lst)))
   (case base
       (C (list 'C lst2))
       (+C (list '+C (get-degree-of-notes-in-C-list (m2-down (translate-flat-to-sharp-in-a-list lst)))))
       (-D (list '-D (get-degree-of-notes-in-C-list (m2-down (translate-flat-to-sharp-in-a-list lst)))))
       (D (list 'D (get-degree-of-notes-in-C-list (M2-down (translate-flat-to-sharp-in-a-list lst)))))
       (+D (list '+D (get-degree-of-notes-in-C-list (m3-down (translate-flat-to-sharp-in-a-list lst)))))
       (-E (list '-E (get-degree-of-notes-in-C-list (m3-down (translate-flat-to-sharp-in-a-list lst)))))
       (E (list 'E (get-degree-of-notes-in-C-list (M3-down (translate-flat-to-sharp-in-a-list lst)))))
       (F (list 'F (get-degree-of-notes-in-C-list (P4-down (translate-flat-to-sharp-in-a-list lst)))))
       (+F (list '+F (get-degree-of-notes-in-C-list (+4-5-down (translate-flat-to-sharp-in-a-list lst)))))
       (-G (list '-G (get-degree-of-notes-in-C-list (+4-5-down (translate-flat-to-sharp-in-a-list lst)))))
       (G (list 'G (get-degree-of-notes-in-C-list (P5-down (translate-flat-to-sharp-in-a-list lst)))))
       (+G (list '+G (get-degree-of-notes-in-C-list (m6-down (translate-flat-to-sharp-in-a-list lst)))))
       (-A (list '-A (get-degree-of-notes-in-C-list (m6-down (translate-flat-to-sharp-in-a-list lst)))))
       (A (list 'A (get-degree-of-notes-in-C-list (M6-down (translate-flat-to-sharp-in-a-list lst)))))
       (+A (list '+A (get-degree-of-notes-in-C-list (m7-down (translate-flat-to-sharp-in-a-list lst)))))
       (-B (list '-B (get-degree-of-notes-in-C-list (m7-down (translate-flat-to-sharp-in-a-list lst)))))
       (B (list 'B (get-degree-of-notes-in-C-list (M7-down (translate-flat-to-sharp-in-a-list lst))))))))