;;;
;;; c:\\program files\\acl62\\music26.cl
;;;
(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))