;;;
;;; c:\\program files\\acl62\\music6.cl
;;;
(load "c:\\program files\\acl62\\music5.cl")

;;;
;;; (get-elements-of-melody '("CM7" ion))
;;;
(defun get-elements-of-melody (l)
(append (get-guide-tone (car l)) (get-tension-note (involve-atom-p (car l)) (cadr l))))

(defun chord-scale (l)
(get-chordscale (involve-atom-p (car l)) (cadr l)))

(defun chord-tone (l)
(get-chord-tone (car l)))

(defun guide-tone (l)
(get-guide-tone (car l)))

(defun tension-note (l)
(get-tension-note (involve-atom-p (car l)) (cadr l)))

(defun UST (l)
(get-UST (car l)))

(defun function-of-chord (l)
(get-function-of-chord (intern (car l))))

;;;
;;; (interpret-a-pair-aux '("CM7" ion))
;;;g-user(25): (interpret-a-pair-aux '("CM7" ion))
;;;
;;; ***** (CM7 ion) *****
;;; chord-scale: (do re mi fa so la si do)
;;; chord-tone: (do mi so si)
;;; tension-notes: (re la)
;;; guide-tone: (mi si)
;;; elements-of-melody: (mi si re la)

(defun interpret-a-pair-aux (l)
(format t "~% ***** ~a *****" l)
(format t "~% chord-scale: ~a" (chord-scale l))
(format t "~% chord-tone: ~a" (chord-tone l))
(format t "~% tension-notes: ~a" (tension-note l))
(format t "~% guide-tone: ~a" (guide-tone l))
(format t "~% elements-of-melody: ~a" (get-elements-of-melody l)))

;;;cg-user(26): (interpret-a-pair '("CM7" ion "Dm7" dor))
;;;
;;;**********************************************
;;;************* (CM7 ion Dm7 dor) **************
;;; ***** (CM7 ion) *****
;;; chord-scale: (do re mi fa so la si do)
;;; chord-tone: (do mi so si)
;;; tension-notes: (re la)
;;; guide-tone: (mi si)
;;; elements-of-melody: (mi si re la)
;;;
;;; ***** (Dm7 dor) *****
;;; chord-scale: (re mi fa so la si do re)
;;; chord-tone: (re fa la do)
;;; tension-notes: (mi so)
;;; guide-tone: (fa do)
;;; elements-of-melody: (fa do mi so)
;;;
;;;nil

(defun interpret-a-pair (l)
(format t "~%*********************************")
(format t "~%************* ~a **************" l)
(do ((lst l (cddr lst)))
((null lst))
(interpret-a-pair-aux (list (first lst) (second lst)))
(read-sentence)))

;;;cg-user(30): (interpret-pairs '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;*********************************
;;;************* (CM7 ion A7 hmp5) **************
;;; ***** (CM7 ion) *****
;;; chord-scale: (do re mi fa so la si do)
;;; chord-tone: (do mi so si)
;;; tension-notes: (re la)
;;; guide-tone: (mi si)
;;; elements-of-melody: (mi si re la)
;;;
;;; ***** (A7 hmp5) *****
;;; chord-scale: (la +la do do re mi fa so la)
;;; chord-tone: (la do mi so)
;;; tension-notes: (+la do fa)
;;; guide-tone: (do so)
;;; elements-of-melody: (do so +la do fa)
;;;
;;;*********************************
;;;************* (Dm7 dor G7 alt) **************
;;; ***** (Dm7 dor) *****
;;; chord-scale: (re mi fa so la si do re)
;;; chord-tone: (re fa la do)
;;; tension-notes: (mi so)
;;; guide-tone: (fa do)
;;; elements-of-melody: (fa do mi so)
;;;
;;; ***** (G7 alt) *****
;;; chord-scale: (so +so +la si do re fa so)
;;; chord-tone: (so si re fa)
;;; tension-notes: (+so +la do re)
;;; guide-tone: (si fa)
;;; elements-of-melody: (si fa +so +la do re)
;;;
;;;*********************************
;;;************* (CM7 ion) **************
;;; ***** (CM7 ion) *****
;;; chord-scale: (do re mi fa so la si do)
;;; chord-tone: (do mi so si)
;;; tension-notes: (re la)
;;; guide-tone: (mi si)
;;; elements-of-melody: (mi si re la)
;;;
;;;nil

(defun interpret-pairs (l)
(do ((lst l (cdr lst)))
((null lst))
(interpret-a-pair (car lst))))

(defun get-an-element-of-melody-at-random (l)
(let ((lst (get-elements-of-melody l)))
(nth (random (length lst)) lst)))

(defun get-UST-from-a-pair (l)
(cdr (second (assoc (second l) (get-UST (first l))))))

(defun get-a-note-from-UST-at-random (chord)
(let ((lst (get-chord-tone chord)))
(nth (random (length lst)) lst)))

(defun get-a-number-between-1-and-8 ()
(nth (random 8) '(1 2 3 4 5 6 7 8)))

;;;
;;;cg-user(31): (get-n-elements-of-melody '("CM7" ion) 4)
;;;(mi la la si)
(defun get-n-elements-of-melody (l n)
(do ((num n (1- num))
(w))
((= num 0) w)
(push (get-an-element-of-melody-at-random l) w)))

(defun get-elements-of-melody-at-random (l)
(get-n-elements-of-melody l (get-a-number-between-1-and-8)))

;;;
;;;cg-user(32): (get-n-notes-from-UST "CM7" 4)
;;;(si so si mi)
(defun get-n-notes-from-UST (chord n)
(do ((num n (1- num))
(w))
((= num 0) w)
(push (get-a-note-from-UST-at-random chord) w)))

(defun get-notes-from-UST-at-random (chord)
(get-n-notes-from-UST chord (get-a-number-between-1-and-8)))

;;;
;;;cg-user(33): (replace-UST-with-melody '("CM7" "A7" "Dm7" "G7" "CM7"))
;;;((so so do si si mi si do) (la la mi mi do) (fa re fa fa do) (so so fa so) (si si do))
(defun replace-UST-with-melody (l)
(cond ((null l) nil)
((stringp l) (get-notes-from-UST-at-random l))
((atom l) l)
(t
(cons (replace-UST-with-melody (car l))
(replace-UST-with-melody (cdr l))))))

(defun display-melody-of-UST (l)
(let ((lst (replace-UST-with-melody l)))
(do ((l1 lst (cdr l1)))
((null l1))
(format t "~%~a" (car l1)))))

;;;
;;;
;;;
(defun translate-sound-to-number (s)
(cond ((equal s 'do) 1.0)
((or (equal s '+do) (equal s '-re)) 1.5)
((equal s 're) 2.0)
((or (equal s '+re) (equal s '-mi)) 2.5)
((equal s 'mi) 3.0)
((equal s 'fa) 3.5)
((or (equal s '+fa) (equal s '-so)) 4.0)
((equal s 'so) 4.5)
((or (equal s '+so) (equal s '-la)) 5.0)
((equal s 'la) 5.5)
((or (equal s '+la) (equal s '-si)) 6.0)
((equal s 'si) 6.5)))

;;;
;;; (get-position-of-a-note-in-a-scale-aux 'so '("CM7" ion))
;;; 4
(defun get-position-of-a-note-in-a-scale-aux (note pair)
(let* ((key (involve-atom-p (first pair)))
(scale (butlast (get-chordscale key (second pair))))
(num1 (translate-sound-to-number note))
(num (if (null num1) 1 num1))
(position (get-position-of-an-element note scale)))
(if (not (null position))
(1- position)
(do ((i (+ 0.5 num) (+ i 0.5)))
((= i 15.0))
(let ((j (get-position-of-an-element
(translate-number-to-sound i 0.0 (involve-atom-p (first pair)))
scale)))
(cond ((not (null j)) (return (- j 2)))))))))

;;;
;;; (get-position-of-a-note-in-a-scale 'so '("CM7" ion))
;;; 4
(defun get-position-of-a-note-in-a-scale (note pair)
(let ((num (get-position-of-a-note-in-a-scale-aux note pair)))
(if (>= num 0)
num
(+ num (length (get-chordscale
(involve-atom-p (first pair))
(second pair)))))))

;;;
;;; (rotate-a-scale-left-from-a-note 'so '("CM7" ion))
;;; (so la si do re mi fa so)

(defun rotate-a-scale-left-from-a-note (note pair)
(let* ((key (involve-atom-p (first pair)))
(scale (butlast (get-chordscale key (second pair))))
(position (get-position-of-a-note-in-a-scale note pair))
(lst (rotate-list-left scale position)))
(append lst (list (car lst)))))

(defun rotate-a-scale-right-from-a-note (note pair)
(reverse (rotate-a-scale-left-from-a-note note pair)))

;;;
;;; (rotate-a-scale-from-a-note 'so '("CM7" ion) 'left)
;;; (so la si do re mi fa so)
(defun rotate-a-scale-from-a-note (note pair direction)
(if (equal direction 'left)
(rotate-a-scale-left-from-a-note note pair)
(rotate-a-scale-right-from-a-note note pair)))

;;;
;;; (get-a-tension-note-at-random '("CM7" ion))
;;; la
(defun get-a-tension-note-at-random (pair)
(let ((lst (get-tension-note (involve-atom-p (first pair)) (second pair))))
(nth (random (length lst)) lst)))

;;; (get-an-element-of-melody-at-random '("CM7" ion))
;;; si
;;;
;;;cg-user(10): (rotate-a-scale-from-tension-left-or-right '("CM7" ion))
;;;(la si do re mi fa so la)
(defun rotate-a-scale-from-tension-left-or-right (pair)
(case (random 2)
(0 (rotate-a-scale-left-from-a-note
(get-a-tension-note-at-random pair)
pair))
(1 (rotate-a-scale-right-from-a-note
(get-a-tension-note-at-random pair)
pair))))

;;;
;;;cg-user(11): (rotate-a-scale-from-elm-left-or-right '("CM7" ion))
;;;(si do re mi fa so la si)

(defun rotate-a-scale-from-elm-left-or-right (pair)
(case (random 2)
(0 (rotate-a-scale-left-from-a-note
(get-an-element-of-melody-at-random pair)
pair))
(1 (rotate-a-scale-right-from-a-note
(get-an-element-of-melody-at-random pair)
pair))))

;;;
;;; (get-notes-around-a-note-in-a-scale 'so '("CM7" ion))
;;; (fa so la)

(defun get-notes-around-a-note-in-a-scale (note pair)
(let ((lst-r (rotate-a-scale-right-from-a-note note pair))
(lst-l (rotate-a-scale-left-from-a-note note pair))
(pos (get-position-of-a-note-in-a-scale-aux note pair)))
(append (list (cond ((member note lst-r :test #'equal)
(second lst-r))
((< pos 0)
(second lst-r))
(t
(first lst-r))))
(if (member note lst-r :test #'equal)
(list note)
nil)
(list (cond ((member note lst-l :test #'equal)
(second lst-l))
((< pos 0)
(first lst-l))
(t
(second lst-l)))))))

;;;
;;;(get-a-note-around-a-note-in-a-scale 're '("CM7" ion))
;;;do

(defun get-a-note-around-a-note-in-a-scale (note pair)
(let ((lst (get-notes-around-a-note-in-a-scale note pair)))
(case (random 3)
(0 (first lst))
(1 (second lst))
(2 (third lst)))))

;;;
;;;(rotate-a-scale-from-a-note-left-or-right 're '("CM7" ion))
;;;(re mi fa so la si do re)
;;;
(defun rotate-a-scale-from-a-note-left-or-right (note pair)
(case (random 2)
(0 (rotate-a-scale-left-from-a-note note pair))
(1 (rotate-a-scale-right-from-a-note note pair))))

;;;
;;;(rotate-a-scale-from-a-note-and-cut 'la '("CM7" ion))
;;;(la si do re)

(defun rotate-a-scale-from-a-note-and-cut (note pair)
(let ((lst (rotate-a-scale-from-a-note-left-or-right note pair)))
(cut-list-at-length (nth (random 8) '(1 2 3 4 5 6 7 8)) lst)))

;;;
;;;(rotate-a-scale-from-tension-and-cut '("CM7" ion))
;;;(la so fa mi re do si la)

(defun rotate-a-scale-from-tension-and-cut (pair)
(let ((lst (rotate-a-scale-from-tension-left-or-right pair)))
(cut-list-at-length (nth (random 8) '(1 2 3 4 5 6 7 8)) lst)))

;;;
;;;(rotate-a-scale-from-elm-and-cut '("CM7" ion))
;;;(re mi fa so la)

(defun rotate-a-scale-from-elm-and-cut (pair)
(let ((lst (rotate-a-scale-from-elm-left-or-right pair)))
(cut-list-at-length (nth (random 8) '(1 2 3 4 5 6 7 8)) lst)))

;;;
;;;(make-a-phrase-with-scale-from-tension '("CM7" ion))
;;;(la si si la so fa)
;;;
(defun make-a-phrase-with-scale-from-tension (pair)
(do ((i 8 (1- i))
(w (rotate-a-scale-from-tension-and-cut pair)))
((or (= i 0) (> (length w) 8))
(cut-list-at-length (nth (random 8) '(1 2 3 4 5 6 7 8)) w))
(setf w (append w
(rotate-a-scale-from-a-note-and-cut
(get-a-note-around-a-note-in-a-scale (car (last w)) pair)
pair)))))

;;;
;;;(make-a-phrase-with-scale-from-elm '("CM7" ion))
;;;(si do re mi fa so la)

(defun make-a-phrase-with-scale-from-elm (pair)
(do ((i 8 (1- i))
(w (rotate-a-scale-from-elm-and-cut pair)))
((or (= i 0) (> (length w) 8))
(cut-list-at-length (nth (random 8) '(1 2 3 4 5 6 7 8)) w))
(setf w (append w
(rotate-a-scale-from-a-note-and-cut
(get-a-note-around-a-note-in-a-scale (car (last w)) pair)
pair)))))