d@88: (cl:in-package #:amuse-geerdes) d@88: 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))) d@88: (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) d@136: (%fast-id row)) 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) d@136: (%fast-id row))))) 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. d@88: (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: d@88: (defun make-geerdes-pitched-event (pitch-number velocity patch d@88: channel track onset duration id) 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 d@88: :id id)) d@88: d@88: (defun make-geerdes-percussive-event (pitch-number velocity patch d@88: channel track onset duration id) 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 d@88: :id id)) d@88: d@88: (defgeneric copy-event (event)) 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) d@88: (patch amuse-midi::patch) id) 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 d@88: :id id))) 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) d@88: (sound amuse-midi::sound) id) 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 d@88: :id id))) d@88: d@88: ;; We want any function that generates a sequence from a geerdes d@88: ;; composition to preserve all slot values: 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))