(load "c:\\program files\\acl62\\music25.cl") 

(defun divide-a-chord (scn) 
　(let ((char (involve-char-p scn)))
　　(divide-s1-with-s2 scn char)))

(defun translate-sc-to-number (sc) 
 　(cond ((equal sc "C") 1.0) 
 　　　　((equal sc "+C") 1.5)
 　　　　((equal sc "D") 2.0)
 　　　　((equal sc "+D") 2.5)
 　　　　((equal sc "E") 3.0)
 　　　　((equal sc "F") 3.5)
 　　　　((equal sc "+F") 4.0)
 　　　　((equal sc "G") 4.5)
 　　　　((equal sc "+G") 5.0)
 　　　　((equal sc "A") 5.5)
 　　　　((equal sc "+A") 6.0)
 　　　　((equal sc "B") 6.5)))

(defun translate-number-to-sc (n) 
　　(let ((num (confine-a-number-2 
                    (confine-a-number-2 n))))
　　　(case num
　　　　　　(1.0 "C") (1.5 "+C") (2.0 "D") 
            (2.5 "+D") (3.0 "E") (3.5 "F")
            (4.0 "+F") (4.5 "G") (5.0 "+G") 
            (5.5 "A") (6.0 "+A") (6.5 "B"))))

(defun change-a-chord-by-n (chord n) 
　　(let* ((lst (divide-a-chord chord)) 
　　　　　 (num (translate-sc-to-number 
                     (first lst)))
　　　　　 (num2 (+ num n)) 
　　　　　 (sc2 (translate-number-to-sc num2))
　　　　　　(type (second lst)))
　　　(concatenate 'string sc2 type)))

(defun m2-up-a-chord (chord) 
   (change-a-chord-by-n chord 0.5))

(defun m2-down-a-chord (chord) 
   (change-a-chord-by-n chord -0.5))

(defun M2-up-a-chord (chord) 
   (change-a-chord-by-n chord 1.0))

(defun M2-down-a-chord (chord) 
   (change-a-chord-by-n chord -1.0))

(defun m3-up-a-chord (chord) 
   (change-a-chord-by-n chord 1.5))

(defun m3-down-a-chord (chord) 
   (change-a-chord-by-n chord -1.5))

(defun M3-up-a-chord (chord) 
   (change-a-chord-by-n chord 2.0))

(defun M3-down-a-chord (chord) 
   (change-a-chord-by-n chord -2.0)) 

(defun P4-up-a-chord (chord) 
   (change-a-chord-by-n chord 2.5))

(defun P4-down-a-chord (chord) 
   (change-a-chord-by-n chord -2.5))

(defun +4-5-up-a-chord (chord) 
   (change-a-chord-by-n chord 3.0))

(defun +4-5-down-a-chord (chord) 
   (change-a-chord-by-n chord -3.0))

(defun P5-up-a-chord (chord) 
   (change-a-chord-by-n chord 3.5))

(defun P5-down-a-chord (chord) 
   (change-a-chord-by-n chord -3.5))

(defun m6-up-a-chord (chord)
   (change-a-chord-by-n chord 4.0))

(defun m6-down-a-chord (chord) 
   (change-a-chord-by-n chord -4.0))

(defun M6-up-a-chord (chord) 
   (change-a-chord-by-n chord 4.5))

(defun M6-down-a-chord (chord) 
   (change-a-chord-by-n chord -4.5))

(defun m7-up-a-chord (chord) 
   (change-a-chord-by-n chord 5.0))

(defun m7-down-a-chord (chord) 
   (change-a-chord-by-n chord -5.0))

(defun M7-up-a-chord (chord) 
   (change-a-chord-by-n chord 5.5))

(defun M7-down-a-chord (chord) 
   (change-a-chord-by-n chord -5.5))

;;; 
;;; (m2-up-a-phrase 
;;;     '("CM7" (re do si la)) 
;;; 
(defun m2-up-a-phrase (lst) 
   (list (m2-up-a-chord (first lst)) 
         (m2-up (second lst))))

(defun m2-down-a-phrase (lst) 
   (list (m2-down-a-chord (first lst))
         (m2-down (second lst))))

(defun M2-up-a-phrase (lst) 
   (list (M2-up-a-chord (first lst)) 
         (M2-up (second lst))))

(defun M2-down-a-phrase (lst) 
   (list (M2-down-a-chord (first lst))
         (M2-down (second lst))))

(defun m3-up-a-phrase (lst) 
   (list (m3-up-a-chord (first lst)) 
         (m3-up (second lst))))

(defun m3-down-a-phrase (lst) 
   (list (m3-down-a-chord (first lst)) 
         (m3-down (second lst))))

(defun M3-up-a-phrase (lst) 
   (list (M3-up-a-chord (first lst)) 
         (M3-up (second lst))))

(defun M3-down-a-phrase (lst) 
   (list (M3-down-a-chord (first lst)) 
         (M3-down (second lst))))

(defun P4-up-a-phrase (lst)
   (list (P4-up-a-chord (first lst)) 
         (P4-up (second lst)))) 

(defun P4-down-a-phrase (lst) 
   (list (P4-down-a-chord (first lst)) 
         (P4-down (second lst))))

(defun +4-5-up-a-phrase (lst) 
   (list (+4-5-up-a-chord (first lst)) 
         (+4-5-up (second lst))))

(defun +4-5-down-a-phrase (lst)
   (list (+4-5-down-a-chord (first lst)) 
         (+4-5-down (second lst))))

(defun P5-up-a-phrase (lst)
   (list (P5-up-a-chord (first lst)) 
         (P5-up (second lst))))

(defun P5-down-a-phrase (lst) 
   (list (P5-down-a-chord (first lst)) 
         (P5-down (second lst))))

(defun m6-up-a-phrase (lst) 
   (list (m6-up-a-chord (first lst)) 
         (m6-up (second lst))))

(defun m6-down-a-phrase (lst) 
   (list (m6-down-a-chord (first lst)) 
         (m6-down (second lst))))

(defun M6-up-a-phrase (lst) 
   (list (M6-up-a-chord (first lst)) 
         (M6-up (second lst))))

(defun M6-down-a-phrase (lst) 
   (list (M6-down-a-chord (first lst)) 
         (M6-down (second lst))))

(defun m7-up-a-phrase (lst) 
   (list (m7-up-a-chord (first lst)) 
         (m7-up (second lst))))

(defun m7-down-a-phrase (lst) 
   (list (m7-down-a-chord (first lst)) 
         (m7-down (second lst))))

(defun M7-up-a-phrase (lst)
   (list (M7-up-a-chord (first lst)) 
         (M7-up (second lst))))

(defun M7-down-a-phrase (lst) 
   (list (M7-down-a-chord (first lst)) 
         (M7-down (second lst))))

;;; 
;;; (m2-up-phrases 
;;;    '(("CM7" (do re mi)) 
;;;      ("Dm7" (so fa mi))))
;;; 
(defun m2-up-phrases (lst) 
   (mapcar #'m2-up-a-phrase lst))

(defun m2-down-phrases (lst) 
   (mapcar #'m2-down-a-phrase lst))

(defun M2-up-phrases (lst) 
   (mapcar #'M2-up-a-phrase lst))

(defun M2-down-phrases (lst) 
   (mapcar #'M2-down-a-phrase lst))

(defun m3-up-phrases (lst) 
   (mapcar #'m3-up-a-phrase lst))

(defun m3-down-phrases (lst) 
   (mapcar #'m3-down-a-phrase lst))

(defun M3-up-phrases (lst) 
   (mapcar #'M3-up-a-phrase lst))

(defun M3-down-phrases (lst) 
   (mapcar #'M3-down-a-phrase lst))

(defun P4-up-phrases (lst) 
   (mapcar #'P4-up-a-phrase lst))

(defun P4-down-phrases (lst) 
   (mapcar #'P4-down-a-phrase lst)) 

(defun +4-5-up-phrases (lst) 
   (mapcar #'+4-5-up-a-phrase lst)) 

(defun +4-5-down-phrases (lst) 
   (mapcar #'+4-5-down-a-phrase lst)) 

(defun P5-up-phrases (lst) 
   (mapcar #'P5-up-a-phrase lst)) 

(defun P5-down-phrases (lst) 
   (mapcar #'P5-down-a-phrase lst))

(defun m6-up-phrases (lst) 
   (mapcar #'m6-up-a-phrase lst))

(defun m6-down-phrases (lst) 
   (mapcar #'m6-down-a-phrase lst))

(defun M6-up-phrases (lst) 
   (mapcar #'M6-up-a-phrase lst))

(defun M6-down-phrases (lst) 
   (mapcar #'M6-down-a-phrase lst)) 

(defun m7-up-phrases (lst) 
   (mapcar #'m7-up-a-phrase lst))

(defun m7-down-phrases (lst) 
   (mapcar #'m7-down-a-phrase lst))

(defun M7-up-phrases (lst) 
   (mapcar #'M7-up-a-phrase lst))

(defun M7-down-phrases (lst)
   (mapcar #'M7-down-a-phrase lst))