;;;
;;; c:\\program files\\acl62\\music54.cl
;;;
(load "c:\\program files\\acl62\\music27.cl")
(load "c:\\program files\\acl62\\music52.cl")

(make-frame-from-list
　　'(Left-Hand-Voicing (v-C (value (mi so la re) (mi so si re) (la re mi so) (si re mi so)
　　　　　　　　　　　　　　　　　　　　　　　(mi la re) (mi si re) (la mi so) (la re so) (re mi so)
　　　　　　　　　　　　　　　　　　　　　　　(do si) (si do) (re mi)))
　　　　　　　　　　　　　　　(v-Cm7 (value (+re so la re) (la re +re so) (+re so +la re) (+la re +re so)
　　　　　　　　　　　　　　　　　　　　　　　　　(+re la re) (la re so) (re +re so) (+re +la re) (+la +re so) (re +re so)
　　　　　　　　　　　　　　　　　　　　　　　　　(re +re) (do +la)))
　　　　　　　　　　　　　　　(v-Cm7-5 (value (+re +fa +la re) (+la re +re +fa)
　　　　　　　　　　　　　　　　　　　　　　　　　　(+re +la re) (+la +re +fa)
　　　　　　　　　　　　　　　　　　　　　　　　　　(do +la) (fa +fa)))
　　　　　　　　　　　　　　　(v-C7 (value (+la re mi la) (+la +do mi la) (+la +do mi +so) (mi la +la re) (mi la +la +do)
　　　　　　　　　　　　　　　　　　　　　　　　(+la mi la) (+la mi +so) (mi +la re) (mi +la +re)
　　　　　　　　　　　　　　　　　　　　　　　　(mi +la) (+la mi) (do +la)))
　　　　　　　　　　　　　　　(v-Cdim7 (value (+re +fa la re) (la re +re +fa)
　　　　　　　　　　　　　　　　　　　　　　　　　　(+re la re) (la +re +so)
　　　　　　　　　　　　　　　　　　　　　　　　　　(do la)))))

;;;
;;;(get-lhv-aux "FM7")
;;;((la do re so) (la do mi so) (re so la do) (mi so la do) (la re so) (la mi so) (re la do) (re so do)
;;; (so la do) (fa mi) ...)
;;;
(defun get-lhv-aux (chord-name)
　　(let ((char (intern (involve-char-p chord-name)))
　　　　　(type (intern (get-chord-type2 chord-name))))
　　　　(case char
　　　　　　　　(C (case type
　　　　　　　　　　　　　　(M7 (fget 'Left-Hand-Voicing 'v-C 'value))
　　　　　　　　　　　　　　(m7 (fget 'Left-Hand-Voicing 'v-Cm7 'value))
　　　　　　　　　　　　　　(m7-5 (fget 'Left-Hand-Voicing 'v-Cm7-5 'value))
　　　　　　　　　　　　　　(|7| (fget 'Left-Hand-Voicing 'v-C7 'value))
　　　　　　　　　　　　　　(dim7 (fget 'Left-Hand-Voicing 'v-Cdim7 'value))))
　　　　　　　　(+C (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(-D (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m2-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(D (case type
　　　　　　　　　　　　　　(M7 (mapcar #'M2-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'M2-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'M2-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'M2-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'M2-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(+D (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(-E (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m3-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(E (case type
　　　　　　　　　　　　　　(M7 (mapcar #'M3-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'M3-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'M3-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'M3-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'M3-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(F (case type
　　　　　　　　　　　　　　(M7 (mapcar #'P4-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'P4-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'P4-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'P4-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'P4-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(+F (case type
　　　　　　　　　　　　　　(M7 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(-G (case type
　　　　　　　　　　　　　　(M7 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'+4-5-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(G (case type
　　　　　　　　　　　　　　(M7 (mapcar #'P5-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'P5-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'P5-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'P5-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'P5-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(+G (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(-A (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m6-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(A (case type
　　　　　　　　　　　　　　(M7 (mapcar #'M6-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'M6-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'M6-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'M6-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'M6-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(+A (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(-B (case type
　　　　　　　　　　　　　　(M7 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'m7-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value)))))
　　　　　　　　(B (case type
　　　　　　　　　　　　　　(M7 (mapcar #'M7-up (fget 'Left-Hand-Voicing 'v-C 'value)))
　　　　　　　　　　　　　　(m7 (mapcar #'M7-up (fget 'Left-Hand-Voicing 'v-Cm7 'value)))
　　　　　　　　　　　　　　(m7-5 (mapcar #'M7-up (fget 'Left-Hand-Voicing 'v-Cm7-5 'value)))
　　　　　　　　　　　　　　(|7| (mapcar #'M7-up (fget 'Left-Hand-Voicing 'v-C7 'value)))
　　　　　　　　　　　　　　(dim7 (mapcar #'M7-up (fget 'Left-Hand-Voicing 'v-Cdim7 'value))))))))

(defun get-lhv (cn)
　　(list cn (get-lhv-aux cn)))

;;;
;;;(show-lhv "G7")
;;;
;;;(G7
;;; ((fa la si mi) (fa +so si mi) (fa +so si +re) (si mi fa la) (si mi fa +so) (fa si mi) (fa si +re)
;;; (si fa la) (si fa +la) (si fa) (fa si) (so fa)))
;;;
(defun show-lhv (cn)
　　(format t "~%~a" (list cn (get-lhv-aux cn))))

;;;
;;;(get-a-lhv-at-random "-EM7")
;;;
;;; Enter an integer!
;;;900
;;;
;;;("-EM7" **lhv (so do fa) **chord (-mi so -si re) **tension (fa do la))
;;;
(defun get-a-lhv-at-random (cn)
　　(my-randomize)
　　(let ((lst (get-lhv-aux cn))
　　　　　(chord-tone (get-chord-tone cn))
　　　　　(tensions (get-all-tension-notes cn)))
　　　　(list cn '**lhv (nth (random (length lst)) lst) '**chord chord-tone '**tension tensions)))

;;;
;;;(get-a-lhv-at-random-from-pair '("CM7" ion))--->(re mi so)
;;;
(defun get-a-lhv-at-random-from-pair (pair)
　　(let ((lhvs (get-lhv-aux (car pair))))
　　　(nth (random (length lhvs)) lhvs)))