(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))
;;;
(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))
;;;
(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))))))))