d@88: (cl:in-package #:amuse-geerdes) d@88: j@288: ;; Identifiers j@288: ;; FIXME: use standard constructor names? j@288: ;; FIXME: use standard composition-identifier? j@288: (defun g-id (cat-id) j@288: "Make a geerdes-identifier based on a catalogue id" j@288: (make-instance 'geerdes-identifier-cat-id j@288: :cat-id cat-id)) j@288: j@288: (defun g-id-file-id (file-id) j@288: "Make a geerdes-identifier based on the file id. This is used as j@288: the standard composition-id." j@288: (make-instance 'geerdes-identifier-file-id j@288: :file-id file-id)) j@288: j@288: (defun make-geerdes-event-identifier (event-id) j@288: (make-instance 'geerdes-event-identifier j@288: :event-id event-id)) j@288: j@288: ;; Events j@288: d@88: (defgeneric %initialise-notes (composition)) d@88: (defmethod %initialise-notes ((composition geerdes-composition)) d@88: (let ((notes) (l 0) (last-time 0) (monody-notes) d@88: (monody (make-instance 'geerdes-monody :file-id (file-id composition))) j@281: (timebase (midi-timebase composition))) d@88: (dolist (row (%midi-events composition)) d@88: (let* ((note (if (pitched-row-p row) d@136: (make-geerdes-pitched-event (%fast-pitch row) d@136: (%fast-velocity row) d@136: (%fast-patch row) d@136: (%fast-channel row) d@136: (%fast-track row) d@136: (%fast-onset row timebase) d@136: (%fast-duration row timebase) j@298: (%fast-id row) j@298: composition) d@136: (make-geerdes-percussive-event (%fast-pitch row) d@136: (%fast-velocity row) d@136: (%fast-patch row) d@136: (%fast-channel row) d@136: (%fast-track row) d@136: (%fast-onset row timebase) d@136: (%fast-duration row timebase) j@298: (%fast-id row) j@298: composition)))) d@88: (when (%fast-monodyp row) d@133: (let ((monody-note (copy-event note))) d@133: (setf (duration monody-note) (%fast-monody-duration row timebase)) d@133: (push monody-note monody-notes))) d@88: (when (> (timepoint (cut-off note)) last-time) d@88: (setf last-time (timepoint (cut-off note)))) d@88: (push note notes) d@88: (incf l))) d@88: (sequence:adjust-sequence composition l :initial-contents (reverse notes)) d@88: (setf (duration composition) last-time d@88: (timepoint composition) 0) d@88: (when monody-notes d@88: (setf (%monody composition) (sequence:adjust-sequence monody (length monody-notes) d@88: :initial-contents (reverse monody-notes)) d@88: (timepoint (%monody composition)) (timepoint (elt monody 0)) d@88: (duration (%monody composition)) (- (timepoint (cut-off (car monody-notes))) d@88: (timepoint (elt monody 0))))) d@88: composition)) d@88: d@88: (defgeneric %initialise-constituents (composition)) d@88: (defmethod %initialise-constituents ((composition geerdes-composition)) d@88: ;; FIXME: Should the duration of composition be affected by this? On d@88: ;; the one hand, it makes no difference to the musical content, but d@88: ;; on the other, it seems illogical to reach outside the period. j@281: (let ((timebase (midi-timebase composition)) d@88: (time-sigs) d@88: (tempi) d@88: (mystery 0)) d@88: (dolist (row (%midi-constituents composition)) d@88: (cond d@88: ((%fast-tempo row) d@136: (push (make-standard-tempo-period d@88: (microsecond-per-crotchet-to-bpm d@88: (%fast-tempo row)) d@88: (%fast-onset row timebase) d@88: (%fast-duration row timebase)) d@88: tempi)) d@88: ((%fast-numerator row) d@136: (push (make-standard-time-signature-period d@88: (%fast-numerator row) d@88: (%fast-denominator row) d@88: (%fast-onset row timebase) d@88: (%fast-duration row timebase)) d@88: time-sigs)) d@88: (t (incf mystery)))) d@88: (setf (time-signatures composition) (reverse time-sigs) d@88: (tempi composition) (reverse tempi)) d@88: (when (%monody composition) d@88: (setf (time-signatures (%monody composition)) (time-signatures composition) d@88: (tempi (%monody composition)) (tempi composition))) d@88: (format t "There are ~D constituents not processed~%" mystery) d@88: composition)) d@88: d@88: (defun %fast-track (row) d@88: (first row)) d@88: (defun %fast-channel (row) d@88: (second row)) d@88: (defun %fast-onset (row timebase) d@88: (/ (third row) timebase)) d@88: (defun %fast-duration (row timebase) d@88: (/ (fourth row) timebase)) d@88: (defun %fast-patch (event-row) d@88: (fifth event-row)) d@88: (defun %fast-pitch (event-row) d@88: (sixth event-row)) d@88: (defun %fast-velocity (event-row) d@88: (seventh event-row)) d@88: (defun %fast-id (event-row) d@88: (eighth event-row)) d@88: (defun %fast-monodyp (event-row) d@88: (ninth event-row)) d@133: (defun %fast-monody-duration (event-row timebase) d@133: (/ (tenth event-row) timebase)) d@88: d@88: (defun %fast-tempo (tp-row) d@88: (eighth tp-row)) d@88: (defun %fast-numerator (ts-row) d@88: (ninth ts-row)) d@88: (defun %fast-denominator (ts-row) d@88: (tenth ts-row)) d@88: d@88: (defun pitched-row-p (event-row) d@88: (and (not (= (%fast-channel event-row) 10)) d@88: (< (%fast-patch event-row) 112))) d@88: j@288: (defun make-geerdes-pitched-event (pitch-number velocity patch channel j@298: track onset duration event-id j@298: composition) d@88: (make-instance 'geerdes-pitched-event d@88: :number pitch-number d@88: :velocity velocity d@88: :patch patch d@88: :channel channel d@88: :track track d@88: :time onset d@88: :interval duration j@288: :identifier (make-geerdes-event-identifier j@298: event-id) j@298: :composition composition)) d@88: d@88: (defun make-geerdes-percussive-event (pitch-number velocity patch j@288: channel track onset duration j@298: event-id composition) d@88: (make-instance 'geerdes-percussive-event d@88: :sound pitch-number d@88: :velocity velocity d@88: :patch patch d@88: :channel channel d@88: :track track d@88: :time onset d@88: :interval duration j@288: :identifier (make-geerdes-event-identifier j@298: event-id) j@298: :composition composition)) d@88: d@88: (defmethod copy-event ((event geerdes-pitched-event)) d@88: (with-slots ((channel amuse-midi::channel) d@88: (track amuse-midi::track) d@88: (number amuse::number) d@88: (time amuse::time) d@88: (interval amuse::interval) d@88: (velocity amuse-midi::velocity) j@288: (patch amuse-midi::patch) j@298: identifier j@298: composition) d@88: event d@88: (make-instance 'geerdes-pitched-event d@88: :channel channel d@88: :track track d@88: :number number d@88: :time time d@88: :interval interval d@88: :velocity velocity d@88: :patch patch j@298: :identifier identifier j@298: :composition composition))) j@288: d@133: (defmethod copy-event ((event geerdes-percussive-event)) d@88: (with-slots ((channel amuse-midi::channel) d@88: (track amuse-midi::track) d@88: (time amuse::time) d@88: (interval amuse::interval) d@88: (velocity amuse-midi::velocity) d@88: (patch amuse-midi::patch) j@288: (sound amuse-midi::sound) j@298: identifier j@298: composition) d@88: event d@88: (make-instance 'geerdes-percussive-event d@133: :channel channel d@88: :track track d@88: :time time d@88: :interval interval d@88: :velocity velocity d@88: :patch patch d@88: :sound sound j@298: :identifier identifier j@298: :composition composition))) d@88: d@88: ;; We want any function that generates a sequence from a geerdes d@88: ;; composition to preserve all slot values: d@154: #+nil d@88: (defmethod sequence:make-sequence-like :around ((o geerdes-composition) d@88: length d@88: &key (initial-element nil iep) d@88: (initial-contents nil icp)) d@88: (declare (ignore iep icp length initial-element initial-contents)) d@88: (let ((result (call-next-method))) d@88: (setf (%db-entry result) (%db-entry o)) d@88: result))