m@46: (cl:in-package #:amuse-mtp) m@46: m@46: ;;; Compositions m@46: m@46: #.(clsql:locally-enable-sql-reader-syntax) m@46: m@53: (defgeneric get-dataset (identifer)) m@53: m@53: (defmethod get-dataset ((identifier mtp-dataset-identifier)) m@53: (let* ((dataset-id (dataset-id identifier)) m@53: (where-clause [= [dataset-id] dataset-id]) m@53: (data (clsql:select [*] :from [mtp-dataset] :where where-clause)) m@53: (dataset (make-mtp-dataset :dataset-id (first data) m@53: :description (second data) m@53: :timebase (third data) m@53: :midc (fourth data))) m@53: (compositions nil) m@53: (composition-count m@53: (1+ m@53: (car m@53: (clsql:select [max [composition-id]] :from [mtp-composition] m@53: :where where-clause :flatp t :field-names nil))))) m@53: (dotimes (composition-id composition-count) m@53: (push (get-composition m@53: (make-mtp-composition-identifier dataset-id composition-id)) m@53: compositions)) m@53: (sequence:adjust-sequence dataset (length compositions) m@53: :initial-contents (nreverse compositions)) m@53: dataset)) m@53: m@46: (defmethod get-composition ((identifier mtp-composition-identifier)) m@46: (let* ((dataset-id (dataset-id identifier)) m@46: (composition-id (composition-id identifier)) m@46: (where-clause [and [= [dataset-id] dataset-id] m@46: [= [composition-id] composition-id]]) m@46: (description m@51: (car (clsql:select [description] :from [mtp-composition] m@46: :where where-clause :flatp t :field-names nil))) m@46: (event-count m@46: (1+ m@46: (car m@51: (clsql:select [max [event-id]] :from [mtp-event] m@46: :where where-clause :flatp t :field-names nil)))) m@46: (events nil)) m@46: (dotimes (event-id event-count) m@46: (push (get-event dataset-id composition-id event-id) events)) m@46: (let* ((interval (+ (timepoint (car events)) (duration (car events)))) m@46: (composition m@46: (make-mtp-composition :dataset-id dataset-id m@46: :composition-id composition-id m@46: :description description m@46: :time 0 m@46: :interval interval))) m@46: (sequence:adjust-sequence composition (length events) m@46: :initial-contents (nreverse events)) m@46: composition))) m@46: m@46: (defun get-event (dataset-id composition-id event-id) m@46: (let* ((attributes m@46: (list (list 'amuse::time [onset]) m@46: (list 'amuse::interval [dur]) m@46: (list 'deltast [deltast]) m@46: (list 'cpitch [cpitch]) m@46: (list 'mpitch [mpitch]) m@46: (list 'accidental [accidental]) m@46: (list 'keysig [keysig]) m@46: (list 'mode [mode]) m@46: (list 'barlength [barlength]) m@46: (list 'pulses [pulses]) m@46: (list 'phrase [phrase]) m@46: (list 'tempo [tempo]) m@46: (list 'dyn [dyn]) m@46: (list 'voice [voice]))) m@46: (mtp-event m@46: (make-mtp-event :dataset-id dataset-id m@46: :composition-id composition-id m@46: :event-id event-id))) m@46: (dolist (a attributes mtp-event) m@46: (let ((value m@51: (clsql:select (cadr a) :from [mtp-event] m@46: :where [and [= [dataset-id] dataset-id] m@46: [= [composition-id] composition-id] m@46: [= [event-id] event-id]] m@46: :flatp t m@46: :field-names nil))) m@46: (setf (slot-value mtp-event (car a)) (car value)))))) m@46: m@46: #.(clsql:restore-sql-reader-syntax-state) m@46: m@46: m@46: ;;; Constituents from compositions: time-signatures m@46: m@46: (defgeneric time-signature-equal (ts1 ts2)) m@46: (defmethod time-signature-equal ((ts1 basic-time-signature) m@46: (ts2 basic-time-signature)) m@46: (let ((n1 (time-signature-numerator ts1)) m@46: (n2 (time-signature-numerator ts2)) m@46: (d1 (time-signature-denominator ts1)) m@46: (d2 (time-signature-denominator ts2))) m@46: (and n1 n2 (= n1 n2) m@46: d1 d2 (= d1 d2)))) m@46: m@46: (defgeneric time-signature (event)) m@46: (defmethod time-signature ((e mtp-event)) m@46: (let ((pulses (%mtp-pulses e)) m@46: (barlength (%mtp-barlength e)) m@46: (timebase (timebase-for-event e))) m@46: (make-basic-time-signature pulses (/ timebase (/ barlength pulses)) m@46: (timepoint e) nil))) m@46: m@46: #.(clsql:locally-enable-sql-reader-syntax) m@46: (defun timebase-for-event (event) m@51: (car (clsql:select [timebase] :from [mtp-dataset] m@46: :where [= [dataset-id] m@46: (dataset-id event)] m@46: :flatp t m@46: :field-names nil))) m@46: #.(clsql:restore-sql-reader-syntax-state) m@46: m@46: (defmethod time-signatures ((c mtp-composition)) m@46: (let ((results nil) m@46: (interval 0) m@46: (current nil)) m@46: (sequence:dosequence (event c) m@46: (let ((ts (time-signature event))) m@46: (when (and (%mtp-barlength event) m@46: (%mtp-pulses event) m@46: (or (null current) m@46: (not (time-signature-equal ts current)))) m@46: (unless (null current) m@46: (setf (duration current) interval) m@46: (push current results)) m@46: (setf interval 0 m@46: current ts))) m@46: (incf interval (%mtp-deltast event)) m@46: (incf interval (duration event))) m@46: (when current m@46: (setf (duration current) interval) m@46: (push current results)) m@46: (nreverse results))) m@46: m@46: ;;; Constituents from compositions: key-signatures m@46: m@46: (defgeneric key-signature-equal (ks1 ks2)) m@46: (defmethod key-signature-equal ((ks1 midi-key-signature) m@46: (ks2 midi-key-signature)) m@46: (let ((s1 (key-signature-sharps ks1)) m@46: (s2 (key-signature-sharps ks2)) m@46: (m1 (key-signature-mode ks1)) m@46: (m2 (key-signature-mode ks2))) m@46: (and s1 s2 (= s1 s2) m@46: m1 m2 (= m1 m2)))) m@46: m@46: (defgeneric key-signature (event)) m@46: (defmethod key-signature ((e mtp-event)) m@46: (let ((keysig (%mtp-keysig e)) m@46: (mode (%mtp-mode e)) m@46: (onset (timepoint e))) m@46: (amuse:make-midi-key-signature keysig mode onset nil))) m@46: m@46: (defmethod key-signatures ((c mtp-composition)) m@46: (let ((results nil) m@46: (interval 0) m@46: (current nil)) m@46: (sequence:dosequence (event c) m@46: (let ((ks (key-signature event))) m@46: (when (and (%mtp-keysig event) m@46: (%mtp-mode event) m@46: (or (null current) m@46: (not (key-signature-equal ks current)))) m@46: (unless (null current) m@46: (setf (duration current) interval) m@46: (push current results)) m@46: (setf interval 0 m@46: current ks))) m@46: (incf interval (%mtp-deltast event)) m@46: (incf interval (duration event))) m@46: (when current m@46: (setf (duration current) interval) m@46: (push current results)) m@46: (nreverse results))) m@46: m@46: ;;; Constituents from compositions: tempi m@46: m@46: (defmethod tempi ((c mtp-composition)) m@46: (let ((results nil) m@46: (interval 0) m@46: (current nil)) m@46: (sequence:dosequence (event c) m@46: (when (and (%mtp-tempo event) m@46: (or (null current) m@46: (not (= (bpm current) (%mtp-tempo event))))) m@46: (unless (null current) m@46: (setf (duration current) interval) m@46: (push current results)) m@46: (let ((new (amuse:make-tempo (%mtp-tempo event) m@46: (timepoint event) m@46: nil))) m@46: (setf interval 0 m@46: current new))) m@46: (incf interval (%mtp-deltast event)) m@46: (incf interval (duration event))) m@46: (when current m@46: (setf (duration current) interval) m@46: (push current results)) m@46: (nreverse results))) m@46: m@46: m@46: ;;; Events: Pitch m@46: m@46: (defmethod chromatic-pitch ((e mtp-event)) m@46: (make-chromatic-pitch (%mtp-cpitch e))) m@46: m@46: (defmethod midi-pitch-number ((e mtp-event)) m@46: (%mtp-cpitch e)) m@46: m@46: (defmethod diatonic-pitch ((e mtp-event)) m@46: ;; (make-diatonic-pitch (event-mpitch e) m@46: ;; (event-accidental e) m@46: ;; octave) m@46: )