Mercurial > hg > amuse
changeset 18:70e76c1c87b7
Bug fixes and exports in package.lisp
darcs-hash:20061213114049-f76cc-4c4175a1ad8b24e1c5df82c9fb67445ac32977d9.gz
| author | David Lewis <d.lewis@gold.ac.uk> |
|---|---|
| date | Wed, 13 Dec 2006 11:40:49 +0000 |
| parents | 930e9880ed3f |
| children | 2f331bbdfab8 |
| files | classes.lisp constructors.lisp generics.lisp methods.lisp package.lisp |
| diffstat | 5 files changed, 128 insertions(+), 12 deletions(-) [+] |
line wrap: on
line diff
--- a/classes.lisp Tue Dec 12 14:44:22 2006 +0000 +++ b/classes.lisp Wed Dec 13 11:40:49 2006 +0000 @@ -44,4 +44,5 @@ (defclass event (anchored-period) ()) (defclass pitched-event (event pitch-designator) ()) +(defclass midi-pitched-event (pitched-event chromatic-pitch) ()) (defclass percussive-event (event) ())
--- a/constructors.lisp Tue Dec 12 14:44:22 2006 +0000 +++ b/constructors.lisp Wed Dec 13 11:40:49 2006 +0000 @@ -30,3 +30,10 @@ (defun make-pitch-interval (span) (make-instance 'pitch-interval :span span)) +;; Events + +(defun make-midi-pitched-event (pitch-number onset duration) + (make-instance 'midi-pitched-event + :number pitch-number + :time onset + :interval duration)) \ No newline at end of file
--- a/generics.lisp Tue Dec 12 14:44:22 2006 +0000 +++ b/generics.lisp Wed Dec 13 11:40:49 2006 +0000 @@ -11,6 +11,12 @@ (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed? (defgeneric frequency (object)) ;? +(defgeneric chromatic-pitch-number (pitch-designator)) +(defgeneric meredith-chromatic-pitch-number (pitch-designator) + ;; David Meredith's PhD and ps13 code + (:method (p) (- (midi-chromatic-pitch-number p) 21))) +(defgeneric pitch-class (pitch-designator) + (:method (p) (mod (chromatic-pitch-number p) 12))) (defgeneric span (pitch-interval-designator)) (defgeneric duration (period-designator)) @@ -21,7 +27,7 @@ (:method (apd) (timepoint apd))) (defgeneric (setf onset) (value anchored-period-designator)) (defgeneric cut-off (anchored-period-designator) ; name? - (:method (apd) (time+ (onset apd) (duration apd)))) + (:method (apd) (time+ (moment apd) (floating-period apd)))) ;;; Coerce-type accessors @@ -51,6 +57,7 @@ ;; <time> <duration> -> <time> ;; <duration> <duration> -> <duration> (or a distinct duration-?) ;; <duration> <time> -> ERROR? +;; <anchored> <anchored> -> (time- (moment o1) (moment o2)) ? or error? (defgeneric time+ (object1 object2)) (defgeneric time- (object1 object2)) @@ -143,13 +150,14 @@ (:method (o1 o2) (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1)))) -;; Another time-based function, returning the anchored-period -;; representing the intersection of two +;;; More time-based functions +;; Return the anchored-period representing the intersection of two ;; anchored-period-specifiers. (defgeneric period-intersection (anchored-period-specifier1 anchored-period-specifier2)) - +(defgeneric inter-onset-interval (moment-designator1 moment-designator2) + (:method (md1 md2) (time- (moment md2) (moment md1)))) ;;; Time Signature
--- a/methods.lisp Tue Dec 12 14:44:22 2006 +0000 +++ b/methods.lisp Wed Dec 13 11:40:49 2006 +0000 @@ -9,6 +9,15 @@ (defmethod span ((pitch-interval-designator pitch-interval)) (%pitch-interval-span pitch-interval-designator)) +(defmethod chromatic-pitch ((pitch-designator chromatic-pitch)) + pitch-designator) + +(defmethod chromatic-pitch-number ((pitch-designator chromatic-pitch)) + (%chromatic-pitch-number pitch-designator)) + +(defmethod chromatic-pitch-number ((pitch-designator pitch)) + (%chromatic-pitch-number (chromatic-pitch pitch-designator))) + ;; Time protocol (defmethod time+ ((object1 moment) (object2 period)) @@ -25,9 +34,9 @@ (error 'undefined-action :operation 'time+ :datatype (list (class-of object1) (class-of object2)))) (defmethod time- ((object1 moment) (object2 moment)) - (make-anchored-period object1 - (- (duration object2) - (duration object1)))) + (make-anchored-period (timepoint object2) + (- (timepoint object1) + (timepoint object2)))) (defmethod time- ((object1 moment) (object2 period)) (make-moment (- (timepoint object1) (duration object2)))) @@ -41,6 +50,19 @@ (make-floating-period (- (duration object2) (duration object1)))) +;; these ones are less certain. I've just put them in, but think I +;; should remove them and force the user to specify what they mean +;; when they give objects that are both moments *and* periods to these +;; functions. + +(defmethod time- ((object1 anchored-period) (object2 anchored-period)) ;? + (time- (moment object1) (moment object2))) + +(defmethod time- (object1 (object2 anchored-period)) ;? + (time- object1 (moment object2))) + +(defmethod time- ((object1 anchored-period) object2) ;? + (time- (moment object1) object2)) (defmethod time> ((object1 moment) (object2 moment)) (> (timepoint object1) (timepoint object2))) @@ -55,13 +77,13 @@ (= (duration object1) (duration object2))) (defmethod duration* ((object1 period) (object2 number)) - (* (duration object1) object2)) + (make-floating-period (* (duration object1) object2))) (defmethod duration* ((object1 number) (object2 period)) (duration* object2 object1)) (defmethod duration/ ((object1 period) (object2 number)) - (/ (duration object1) object2)) + (make-floating-period (/ (duration object1) object2))) ;; Pitch protocol
--- a/package.lisp Tue Dec 12 14:44:22 2006 +0000 +++ b/package.lisp Wed Dec 13 11:40:49 2006 +0000 @@ -1,5 +1,83 @@ (cl:defpackage #:amuse (:use #:common-lisp) - (:export)) - - + (:export #:constituent + #:composition + #:monody + #:moment-designator + #:period-designator + #:anchored-period-designator + #:pitch-designator + #:pitch-interval-designator + #:moment + #:period + #:floating-period + #:anchored-period + #:frequency + #:pitch + #:chromatic-pitch + #:diatonic-pitch + #:pitch-interval + #:pitched-event + #:midi-pitched-event + #:percussive-event + #:get-composition + #:chromatic-pitch + #:diatonic-pitch + #:chromatic-pitch-number + #:meredith-chromatic-pitch-number + #:pitch-class + #:span + #:duration + #:timepoint + #:onset + #:cut-off + #:anchored-period + #:floating-period + #:moment + #:time+ + #:time- + #:time> + #:time< + #:time= + #:time>= + #:time<= + #:time/= + #:duration> + #:duration< + #:duration= + #:duration>= + #:duration<= + #:duration/= + #:duration* + #:duration/ + #:pitch+ + #:pitch- + #:pitch> + #:pitch< + #:pitch= + #:pitch>= + #:pitch<= + #:pitch/= + #:interval> + #:interval< + #:interval= + #:interval>= + #:interval<= + #:interval/= + #:meets + #:before + #:overlaps + #:during + #:starts + #:ends + #:subinterval + #:disjoint + #:period-intersection + #:inter-onset-interval + #:make-moment + #:make-floating-period + #:make-anchored-period + #:make-chromatic-pitch + #:make-diatonic-pitch + #:make-pitch-interval + #:make-midi-pitched-event)) \ No newline at end of file