;;;
;;; c:\\program files\\acl62\\music25.cl
;;;


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

(defun translate-doremi-to-number (doremi) 
  (case doremi 
    (do 1.0) (+do 1.5) (re 2.0) 
        (+re 2.5) (mi 3.0) (fa 3.5) 
        (+fa 4.0) (so 4.5) (+so 5.0)
        (la 5.5)  (+la 6.0) (si 6.5)))

(defun confine-a-number-2 (n) 
  (cond ((>= n 7.0) (- n 6.0))
     ((<= n 0.5) (+ n 6.0))
     (t n)))

(defun translate-number-to-doremi (n)
  (let ((num (confine-a-number-2 
                  (confine-a-number-2 n))))
   (case num 
      (1.0 'do) (1.5 '+do) (2.0 're)
            (2.5 '+re) (3.0 'mi) (3.5 'fa)
            (4.0 '+fa) (4.5 'so) (5.0 '+so)
            (5.5 'la) (6.0 '+la) (6.5 'si))))

(defun up-a-note (doremi n)
  (let* ((num 
             (translate-doremi-to-number doremi))
      (nn (+ num n)))
   (translate-number-to-doremi nn)))

(defun down-a-note (doremi n)
  (let* ((num 
             (translate-doremi-to-number doremi))
      (nn (- num n)))
   (translate-number-to-doremi nn)))

(defun m2-up (lst)
   (mapcar #'(lambda (e) (up-a-note e 0.5)) lst))

(defun m2-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 0.5)) lst))

(defun M2-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 1.0)) lst))

(defun M2-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 1.0)) lst))

(defun m3-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 1.5)) lst))

(defun m3-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 1.5)) lst))

(defun M3-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 2.0)) lst))

(defun M3-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 2.0)) lst))

(defun P4-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 2.5)) lst))

(defun P4-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 2.5)) lst))

(defun +4-5-up (lst)
   (mapcar #'(lambda (e) (up-a-note e 3.0)) lst))

(defun +4-5-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 3.0)) lst))

(defun P5-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 3.5)) lst))

(defun P5-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 3.5)) lst))

(defun m6-up (lst)
   (mapcar #'(lambda (e) (up-a-note e 4.0)) lst))

(defun m6-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 4.0)) lst))

(defun M6-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 4.5)) lst))

(defun M6-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 4.5)) lst))

(defun m7-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 5.0)) lst))

(defun m7-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 5.0)) lst))

(defun M7-up (lst) 
   (mapcar #'(lambda (e) (up-a-note e 5.5)) lst))

(defun M7-down (lst) 
   (mapcar #'(lambda (e) (down-a-note e 5.5)) lst))