Mercurial > hg > amuse
changeset 24:8d2b1662f658
base/*.lisp: move files in amuse-base to subdirectory.
darcs-hash:20061215161617-aa3d6-1b63bd555b02ec02aa2db12d335e8b726e2108cd.gz
author | m.pearce <m.pearce@gold.ac.uk> |
---|---|
date | Fri, 15 Dec 2006 16:16:17 +0000 |
parents | e2e19baba730 |
children | fe73cc3f1605 |
files | base/classes.lisp base/conditions.lisp base/constructors.lisp base/generics.lisp base/methods.lisp base/package.lisp classes.lisp conditions.lisp constructors.lisp generics.lisp methods.lisp package.lisp |
diffstat | 12 files changed, 702 insertions(+), 702 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/classes.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,78 @@ +(cl:in-package #:amuse) + +;; collections of more than one event + +(defclass constituent () ()) +(defclass composition (constituent) ()) +(defclass monody (constituent) ()) + +;; types of information-specifiers + +(defclass moment-designator () ()) +(defclass period-designator () ()) +(defclass anchored-period-designator (moment-designator period-designator) ()) +(defclass pitch-designator () ()) +(defclass pitch-interval-designator () ()) + +;; time-related classes + +(defclass moment (moment-designator) + ((time :accessor %moment-time :initarg :time))) + +(defclass period (period-designator) + ((interval :accessor %period-interval :initarg :interval))) + +(defclass floating-period (period) ()) +(defclass anchored-period (period moment anchored-period-designator) ()) + +;; pitch-related classes + +(defclass frequency () ()) + +(defclass pitch (pitch-designator) ()) +(defclass chromatic-pitch (pitch) + ((number :accessor %chromatic-pitch-number :initarg :number))) +(defclass diatonic-pitch (pitch) + ((name :accessor %diatonic-pitch-name :initarg :name) + (accidental :accessor %diatonic-pitch-accidental :initarg :accidental) + (octave :accessor %diatonic-pitch-octave :initarg :octave))) + +(defclass pitch-interval (pitch-interval-designator) + ((span :accessor %pitch-interval-span :initarg :span))) + +;; events + +(defclass event (anchored-period) ()) +(defclass pitched-event (event pitch-designator) ()) +(defclass chromatic-pitched-event (pitched-event chromatic-pitch) ()) +(defclass percussive-event (event) ()) + +;;; Range-based `constituents' +;; Whilst these are all constituents in the CHARM sense, their +;; properties apply to a timed range rather than to a set of +;; events. As such, they can be regarded as anchored-periods with +;; properties. + +(defclass time-signature (anchored-period) ()) + +(defclass basic-time-signature (anchored-period) + ;; N.B. Can only deal with numeric signatures + ((numerator :accessor %basic-time-signature-numerator + :initarg :numerator) + (denominator :accessor %basic-time-signature-denominator + :initarg :denominator))) + +(defclass key-signature (anchored-period) ()) + +(defclass basic-key-signature (key-signature) + ;; Only has line-of-fifths distance from c, so custom signatures + ;; won't work + ((sharp-count :accessor %basic-key-signature-sharp-count + :initarg sharp-count))) + +(defclass tempo (anchored-period) + ;; accel and rit in symbolic encoding will need other structures, as + ;; will textual tempo markings. + ((bpm :accessor %tempo-bpm + :initarg :bpm))) + \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/conditions.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,34 @@ +(cl:in-package #:amuse) + +;; Some conditions we might want to be able to signal + +(define-condition undefined-action (condition) + ;; This condition would apply to an attempt to perform a meaningless + ;; operation on an object. This may, initially, include things that + ;; are a pain to implement but should really be used when it's + ;; genuinely unclear what an operation means in the given + ;; context. In such cases, a condition handler might be the best + ;; approach anyway. + ((operation :initarg :operation + :reader undefined-action-operation) + (datatype :initarg :datatype + :reader undefined-action-datatype)) + (:report (lambda (condition stream) + (format stream "The consequence of performing ~A on and object of type ~A is undefined" + (undefined-action-operation condition) + (undefined-action-datatype condition))))) + +(define-condition insufficient-information (condition) + ;; It should be possible to construct genuinely minimal musical + ;; structures. When the information in these is insufficient to + ;; answer a query, this condition should be raised. + ((operation :initarg :operation + :reader insufficient-information-operation) + (datatype :initarg :datatype + :reader insufficient-information-datatype)) + (:report (lambda (condition stream) + (format stream "The ~A object does not contain enough information to perform ~A" + (insufficient-information-datatype condition) + (insufficient-information-operation condition))))) + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/constructors.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,58 @@ +(cl:in-package #:amuse) + +;; Time classes + +(defun make-moment (time) + (make-instance 'moment :time time)) + +;; N.B. period should never be constructed directly - it's either +;; floating or anchored or some other subclass. + +(defun make-floating-period (interval) + (make-instance 'floating-period :interval interval)) + +(defun make-anchored-period (onset interval) + (make-instance 'anchored-period + :time onset + :interval interval)) + +;; Pitch classes (no, not that sort of pitch class) + +(defun make-chromatic-pitch (pitch-number) + (make-instance 'chromatic-pitch :number pitch-number)) + +(defun make-diatonic-pitch (name accidental octave) + (make-instance 'diatonic-pitch + :name name + :accidental accidental + :octave octave)) + +(defun make-pitch-interval (span) + (make-instance 'pitch-interval :span span)) + +;; Events + +(defun make-chromatic-pitched-event (pitch-number onset duration) + (make-instance 'chromatic-pitched-event + :number pitch-number + :time onset + :interval duration)) + +(defun make-basic-time-signature (numerator denominator onset duration) + (make-instance 'basic-time-signature + :numerator numerator + :denominator denominator + :time onset + :interval duration)) + +(defun make-basic-key-signature (sharp-count onset duration) + (make-instance 'basic-key-signature + :sharp-count sharp-count + :time onset + :interval duration)) + +(defun make-tempo (bpm onset duration) + (make-instance 'tempo + :bpm bpm + :time onset + :interval duration))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/generics.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,205 @@ +(cl:in-package #:amuse) + +;;; Pulling compositions from the database + +(defgeneric get-composition (identifier)) + +;;; Simple Accessors + +;; pitch-based + +(defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch + ; in its ur form? +(defgeneric chromatic-pitch (pitch-designator)) ; How simple are these +(defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed? +(defgeneric frequency (object)) ;? +(defgeneric midi-pitch-number (pitch-designator)) +(defgeneric meredith-chromatic-pitch-number (pitch-designator) + ;; David Meredith's PhD and ps13 code + (:method (p) (- (midi-pitch-number p) 21))) +(defgeneric pitch-class (pitch-designator) + (:method (p) (mod (midi-pitch-number p) 12))) +(defgeneric span (pitch-interval-designator)) + +;; time + +(defgeneric duration (period-designator)) +(defgeneric (setf duration) (value period-designator)) +(defgeneric timepoint (moment-designator)) +(defgeneric (setf timepoint) (value moment-designator)) +(defgeneric cut-off (anchored-period-designator) ; name? + (:method (apd) (time+ (moment apd) (floating-period apd)))) + +;; others + +;; I've given the time-sig accessors general names because it allows +;; for symbols in time-signatures as well as numbers - numerator is an +;; odd accessor if the time sig is C (even in common practice) but +;; it's meaning is clear. beat-units-per-bar is clearer, though, I +;; think. + +(defgeneric beat-units-per-bar (time-signature)) +(defgeneric time-signature-numerator (time-signature) + (:method (ts) (beat-units-per-bar ts))) +(defgeneric beat-units (time-signature)) +(defgeneric time-signature-denominator (time-signature) + (:method (ts) (beat-units ts))) + +(defgeneric key-signature-sharps (key-signature)) + +(defgeneric bpm (tempo)) ;; in bpm +(defgeneric microseconds-per-crotchet (tempo) + ;; As used (when rounded) in MIDI + (:method (tp) (/ 60000000 (bpm tp)))) + +;;; Coerce-type accessors + +;; Should I be including these default methods? Should the accessors +;; be direct slot accessors or the generics I'm using? Should we +;; return the object itself if it already is in the target class? + +(defgeneric anchored-period (anchored-period-designator) + (:method (apd) (make-anchored-period (onset apd) (duration apd)))) + +(defgeneric floating-period (period-designator) + (:method (pd) (make-floating-period (duration pd)))) + +(defgeneric moment (moment-designator) + (:method (md) (make-moment (timepoint md)))) + +(defgeneric onset (anchored-period-designator) + (:method (apd) (moment apd))) +(defgeneric (setf onset) (value anchored-period-designator)) + +;;; Time Protocol (or moments?) + +;; negative times/durations -> ERROR? + +;; time+: <time> <duration> -> <time> +;; <duration> <time> -> <time> (same as previous?) +;; <duration> <duration> -> <duration> (or a distinct duration+?) +;; <time> <time> -> ERROR? +;; +;; time-: <time> <time> -> <duration> +;; <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)) + +(defgeneric time> (object1 object2)) +(defgeneric time< (object1 object2) + (:method (o1 o2) (time> o2 o1))) +(defgeneric time= (object1 object2)) +(defgeneric time>= (object1 object2) + (:method (o1 o2) (or (time> o1 o2) (time= o1 o2)))) +(defgeneric time<= (object1 object2) + (:method (o1 o2) (or (time< o1 o2) (time= o1 o2)))) +(defgeneric time/= (object1 object2) + (:method (o1 o2) (not (time= o1 o2)))) + +;;; Duration protocol + +(defgeneric duration> (object1 object2)) +(defgeneric duration< (object1 object2) + (:method (o1 o2) (duration> o2 o1))) +(defgeneric duration= (object1 object2)) +(defgeneric duration>= (object1 object2) + (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2)))) +(defgeneric duration<= (object1 object2) + (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2)))) +(defgeneric duration/= (object1 object2) + (:method (o1 o2) (not (duration= o1 o2)))) + +;; for linear scaling: +(defgeneric duration* (object1 object2)) +(defgeneric duration/ (object1 number)) + +;;; Pitch protocol + +;; pitch+: <pitch> <pitch> -> ERROR +;; <pitch> <interval> -> <pitch> +;; <interval> <pitch> -> <pitch> (same as previous?) +;; <interval> <interval> -> <interval> (or a distinct interval+?) +;; +;; pitch-: <pitch> <pitch> -> <interval> +;; <pitch> <interval> -> <pitch> +;; <interval> <interval> -> <interval> +;; <interval> <pitch> -> ERROR + +(defgeneric pitch+ (object1 object2)) +(defgeneric pitch- (object1 object2)) + +(defgeneric pitch> (object1 object2)) +(defgeneric pitch< (object1 object2) + (:method (o1 o2) (pitch> o2 o1))) +(defgeneric pitch= (object1 object2)) +(defgeneric pitch>= (object1 object2) + (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2)))) +(defgeneric pitch<= (object1 object2) + (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2)))) +(defgeneric pitch/= (object1 object2) + (:method (o1 o2) (not (pitch= o1 o2)))) + +;;; Interval protocol (emphasise _pitch_ not _time_ interval?) + +(defgeneric interval> (object1 object2)) +(defgeneric interval< (object1 object2) + (:method (o1 o2) (interval> o2 o1))) +(defgeneric interval= (object1 object2)) +(defgeneric interval>= (object1 object2) + (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2)))) +(defgeneric interval<= (object1 object2) + (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2)))) +(defgeneric interval/= (object1 object2) + (:method (o1 o2) (not (interval= o1 o2)))) + +;;; Allen's (1984) interval relations +;;; . equals already defined as INTERVAL= above +;;; . inverses ommitted for now (just use CL:NOT) +;;; . can all be defined in terms of MEETS (apparently) + +(defgeneric meets (object1 object2)) +(defgeneric before (object1 object2)) +(defgeneric overlaps (object1 object2)) +(defgeneric during (object1 object2)) +(defgeneric starts (object1 object2)) +(defgeneric ends (object1 object2)) + +;;; and extensions thereof ... + +(defgeneric subinterval (object1 object2) + (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2)))) + +(defgeneric disjoint (object1 object2) + (:method (o1 o2) + (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1)))) + +;;; 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 + +(defgeneric get-applicable-time-signatures (object1 object2)) + +;;; Tempo + +(defgeneric get-applicable-tempi (object1 object2)) + +;;; Tonality (Key Signature / Mode) + +(defgeneric get-applicable-key-signatures (object1 object2)) + +;;; Dynamics +;;; Voice +;;; Boundary Strength (phrasing) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/methods.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,218 @@ +(cl:in-package #:amuse) + +(defmethod chromatic-pitch ((pitch-designator chromatic-pitch)) + pitch-designator) + +(defmethod midi-pitch-number ((pitch-designator chromatic-pitch)) + (%chromatic-pitch-number pitch-designator)) + +(defmethod midi-pitch-number ((pitch-designator pitch)) + (%chromatic-pitch-number (chromatic-pitch pitch-designator))) + +(defmethod span ((pitch-interval-designator pitch-interval)) + (%pitch-interval-span pitch-interval-designator)) + +(defmethod duration ((period-designator period)) + (%period-interval period-designator)) + +(defmethod timepoint ((moment-designator moment)) + (%moment-time moment-designator)) + +(defmethod beat-units-per-bar ((time-signature basic-time-signature)) + (%basic-time-signature-numerator time-signature)) + +(defmethod beat-units ((time-signature basic-time-signature)) + (%basic-time-signature-denominator time-signature)) + +(defmethod key-signature-sharps ((key-signature basic-key-signature)) + (%basic-key-signature-sharp-count key-signature)) + +(defmethod bpm ((tempo tempo)) + (%tempo-bpm tempo)) + +;; Time protocol + +(defmethod time+ ((object1 moment) (object2 period)) + (make-moment (+ (timepoint object1) (duration object2)))) + +(defmethod time+ ((object1 period) (object2 moment)) ;? + (time+ object2 object1)) + +(defmethod time+ ((object1 period) (object2 period)) + (make-floating-period (+ (duration object1) + (duration object2)))) + +(defmethod time+ ((object1 moment) (object2 moment)) + (error 'undefined-action :operation 'time+ :datatype (list (class-of object1) (class-of object2)))) + +(defmethod time- ((object1 moment) (object2 moment)) + (make-anchored-period (timepoint object2) + (- (timepoint object1) + (timepoint object2)))) + +(defmethod time- ((object1 moment) (object2 period)) + (make-moment (- (timepoint object1) (duration object2)))) + +(defmethod time- ((object1 period) (object2 moment)) ;? + (error 'undefined-action + :operation 'time- + :datatype (list (class-of object1) (class-of object2)))) + +(defmethod time- ((object1 period) (object2 period)) + (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))) + +(defmethod time= ((object1 moment) (object2 moment)) + (= (timepoint object1) (timepoint object2))) + +(defmethod duration> ((object1 period) (object2 period)) + (> (duration object1) (duration object2))) + +(defmethod duration= ((object1 period) (object2 period)) + (= (duration object1) (duration object2))) + +(defmethod duration* ((object1 period) (object2 number)) + (make-floating-period (* (duration object1) object2))) + +(defmethod duration* ((object1 number) (object2 period)) + (duration* object2 object1)) + +(defmethod duration/ ((object1 period) (object2 number)) + (make-floating-period (/ (duration object1) object2))) + +;; Pitch protocol + +(defmethod pitch+ ((object1 pitch-designator) + (object2 pitch-designator)) + (error 'undefined-action :operation 'pitch+ + :datatype (list (class-of object1) (class-of object2)))) + +(defmethod pitch+ ((object1 pitch-designator) + (object2 pitch-interval)) ; or should I check the + ; pitch/interval types? + (make-chromatic-pitch (+ (chromatic-pitch object1) + (span object2)))) + +(defmethod pitch+ ((object1 pitch-interval) + (object2 pitch-designator)) ;? + (pitch+ object2 object1)) + +(defmethod pitch+ ((object1 pitch-interval) + (object2 pitch-interval)) + (make-pitch-interval (+ (span object1) + (span object2)))) + +(defmethod pitch- ((object1 pitch-designator) + (object2 pitch-designator)) + (make-pitch-interval (- (chromatic-pitch object1) + (chromatic-pitch object2)))) + +(defmethod pitch- ((object1 pitch-designator) + (object2 pitch-interval)) + (make-chromatic-pitch (- (chromatic-pitch object1) + (span object2)))) + +(defmethod pitch- ((object1 pitch-interval) + (object2 pitch-interval)) + (make-pitch-interval (- (span object1) + (span object2)))) + +(defmethod pitch- ((object1 pitch-interval) + (object2 pitch-designator)) + (error 'undefined-action :operation 'pitch- + :datatype (list (class-of object1) (class-of object2)))) + +(defmethod pitch> ((object1 pitch-designator) + (object2 pitch-designator)) + (> (chromatic-pitch object1) + (chromatic-pitch object2))) + +(defmethod pitch= ((object1 pitch-designator) + (object2 pitch-designator)) + (= (chromatic-pitch object1) + (chromatic-pitch object2))) + +(defmethod interval> ((object1 pitch-interval) + (object2 pitch-interval)) + (> (span object1) + (span object2))) + +(defmethod interval= ((object1 pitch-interval) + (object2 pitch-interval)) + (= (span object1) + (span object2))) + + + +;; Allen + +(defmethod meets ((object1 anchored-period) + (object2 anchored-period)) + (or (time= (cut-off object1) object2) + (time= (cut-off object2) object1))) + +(defmethod before ((object1 anchored-period) + (object2 anchored-period)) + (time> object2 (cut-off object1))) + +(defmethod overlaps ((object1 anchored-period) + (object2 anchored-period)) + ;; FIXME: Is there a tidier method? + (or (and (time> object2 object1) ; object1 starts before object2 + (time> (cut-off object1) object2) ; object1 ends after object2 starts + (time> (cut-off object2) (cut-off object1))) ; object1 ends before object2 does + (and (time> object1 object2) ; object1 starts after object2 + (time> (cut-off object2) object1) ; object1 starts before object2 ends + (time> (cut-off object1) (cut-off object2))))) ; object1 ends after object2 does + +(defmethod during ((object1 anchored-period) + (object2 anchored-period)) + (and (time> object1 object2) + (time< (cut-off object2) (cut-off object2)))) + +(defmethod starts ((object1 anchored-period) + (object2 anchored-period)) + (time= object1 object2)) + +(defmethod ends ((object1 anchored-period) + (object2 anchored-period)) + (time= (cut-off object1) (cut-off object2))) + +;; ...and + +(defmethod period-intersection ((object1 anchored-period) + (object2 anchored-period)) + (cond + ((disjoint object1 object2) + ;; if they don't overlap, return nil, not a negative-valued + ;; period + nil) + ((let* ((start (if (time> (onset object2) (onset object1)) + (onset object2) + (onset object1))) + (duration (duration (time- (if (time> (cut-off object2) (cut-off object1)) + (cut-off object1) + (cut-off object2)) + start)))) + (make-anchored-period (timepoint start) duration))))) + + + + \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/package.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,109 @@ +(cl:defpackage #:amuse + (:use #:common-lisp) + (: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 + #:chromatic-pitched-event + #:midi-pitched-event + #:percussive-event + #:midi-percussive-event + #:time-signature + #:basic-time-signature + #:key-signature + #:basic-key-signature + #:midi-key-signature + #:tempo + #:get-composition + #:chromatic-pitch + #:diatonic-pitch + #:midi-pitch-number + #:meredith-chromatic-pitch-number + #:pitch-class + #:span + #:duration + #:timepoint + #:onset + #:cut-off + #:beat-units-per-bar + #:time-signature-numerator + #:beat-units + #:time-signature-denominator + #:key-signature-sharps + #:bpm + #:microseconds-per-crotchet + #: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 + #:get-applicable-time-signatures + #:get-applicable-tempi + #:get-applicable-key-signatures + #:make-moment + #:make-floating-period + #:make-anchored-period + #:make-chromatic-pitch + #:make-diatonic-pitch + #:make-pitch-interval + #:make-chromatic-pitched-event + #:make-midi-pitched-event + #:make-midi-percussive-event + #:make-basic-time-signature + #:make-basic-key-signature + #:make-midi-key-signature + #:make-tempo + +)) \ No newline at end of file
--- a/classes.lisp Fri Dec 15 16:11:52 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -(cl:in-package #:amuse) - -;; collections of more than one event - -(defclass constituent () ()) -(defclass composition (constituent) ()) -(defclass monody (constituent) ()) - -;; types of information-specifiers - -(defclass moment-designator () ()) -(defclass period-designator () ()) -(defclass anchored-period-designator (moment-designator period-designator) ()) -(defclass pitch-designator () ()) -(defclass pitch-interval-designator () ()) - -;; time-related classes - -(defclass moment (moment-designator) - ((time :accessor %moment-time :initarg :time))) - -(defclass period (period-designator) - ((interval :accessor %period-interval :initarg :interval))) - -(defclass floating-period (period) ()) -(defclass anchored-period (period moment anchored-period-designator) ()) - -;; pitch-related classes - -(defclass frequency () ()) - -(defclass pitch (pitch-designator) ()) -(defclass chromatic-pitch (pitch) - ((number :accessor %chromatic-pitch-number :initarg :number))) -(defclass diatonic-pitch (pitch) - ((name :accessor %diatonic-pitch-name :initarg :name) - (accidental :accessor %diatonic-pitch-accidental :initarg :accidental) - (octave :accessor %diatonic-pitch-octave :initarg :octave))) - -(defclass pitch-interval (pitch-interval-designator) - ((span :accessor %pitch-interval-span :initarg :span))) - -;; events - -(defclass event (anchored-period) ()) -(defclass pitched-event (event pitch-designator) ()) -(defclass chromatic-pitched-event (pitched-event chromatic-pitch) ()) -(defclass percussive-event (event) ()) - -;;; Range-based `constituents' -;; Whilst these are all constituents in the CHARM sense, their -;; properties apply to a timed range rather than to a set of -;; events. As such, they can be regarded as anchored-periods with -;; properties. - -(defclass time-signature (anchored-period) ()) - -(defclass basic-time-signature (anchored-period) - ;; N.B. Can only deal with numeric signatures - ((numerator :accessor %basic-time-signature-numerator - :initarg :numerator) - (denominator :accessor %basic-time-signature-denominator - :initarg :denominator))) - -(defclass key-signature (anchored-period) ()) - -(defclass basic-key-signature (key-signature) - ;; Only has line-of-fifths distance from c, so custom signatures - ;; won't work - ((sharp-count :accessor %basic-key-signature-sharp-count - :initarg sharp-count))) - -(defclass tempo (anchored-period) - ;; accel and rit in symbolic encoding will need other structures, as - ;; will textual tempo markings. - ((bpm :accessor %tempo-bpm - :initarg :bpm))) - \ No newline at end of file
--- a/conditions.lisp Fri Dec 15 16:11:52 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -(cl:in-package #:amuse) - -;; Some conditions we might want to be able to signal - -(define-condition undefined-action (condition) - ;; This condition would apply to an attempt to perform a meaningless - ;; operation on an object. This may, initially, include things that - ;; are a pain to implement but should really be used when it's - ;; genuinely unclear what an operation means in the given - ;; context. In such cases, a condition handler might be the best - ;; approach anyway. - ((operation :initarg :operation - :reader undefined-action-operation) - (datatype :initarg :datatype - :reader undefined-action-datatype)) - (:report (lambda (condition stream) - (format stream "The consequence of performing ~A on and object of type ~A is undefined" - (undefined-action-operation condition) - (undefined-action-datatype condition))))) - -(define-condition insufficient-information (condition) - ;; It should be possible to construct genuinely minimal musical - ;; structures. When the information in these is insufficient to - ;; answer a query, this condition should be raised. - ((operation :initarg :operation - :reader insufficient-information-operation) - (datatype :initarg :datatype - :reader insufficient-information-datatype)) - (:report (lambda (condition stream) - (format stream "The ~A object does not contain enough information to perform ~A" - (insufficient-information-datatype condition) - (insufficient-information-operation condition))))) - -
--- a/constructors.lisp Fri Dec 15 16:11:52 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -(cl:in-package #:amuse) - -;; Time classes - -(defun make-moment (time) - (make-instance 'moment :time time)) - -;; N.B. period should never be constructed directly - it's either -;; floating or anchored or some other subclass. - -(defun make-floating-period (interval) - (make-instance 'floating-period :interval interval)) - -(defun make-anchored-period (onset interval) - (make-instance 'anchored-period - :time onset - :interval interval)) - -;; Pitch classes (no, not that sort of pitch class) - -(defun make-chromatic-pitch (pitch-number) - (make-instance 'chromatic-pitch :number pitch-number)) - -(defun make-diatonic-pitch (name accidental octave) - (make-instance 'diatonic-pitch - :name name - :accidental accidental - :octave octave)) - -(defun make-pitch-interval (span) - (make-instance 'pitch-interval :span span)) - -;; Events - -(defun make-chromatic-pitched-event (pitch-number onset duration) - (make-instance 'chromatic-pitched-event - :number pitch-number - :time onset - :interval duration)) - -(defun make-basic-time-signature (numerator denominator onset duration) - (make-instance 'basic-time-signature - :numerator numerator - :denominator denominator - :time onset - :interval duration)) - -(defun make-basic-key-signature (sharp-count onset duration) - (make-instance 'basic-key-signature - :sharp-count sharp-count - :time onset - :interval duration)) - -(defun make-tempo (bpm onset duration) - (make-instance 'tempo - :bpm bpm - :time onset - :interval duration))
--- a/generics.lisp Fri Dec 15 16:11:52 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,205 +0,0 @@ -(cl:in-package #:amuse) - -;;; Pulling compositions from the database - -(defgeneric get-composition (identifier)) - -;;; Simple Accessors - -;; pitch-based - -(defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch - ; in its ur form? -(defgeneric chromatic-pitch (pitch-designator)) ; How simple are these -(defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed? -(defgeneric frequency (object)) ;? -(defgeneric midi-pitch-number (pitch-designator)) -(defgeneric meredith-chromatic-pitch-number (pitch-designator) - ;; David Meredith's PhD and ps13 code - (:method (p) (- (midi-pitch-number p) 21))) -(defgeneric pitch-class (pitch-designator) - (:method (p) (mod (midi-pitch-number p) 12))) -(defgeneric span (pitch-interval-designator)) - -;; time - -(defgeneric duration (period-designator)) -(defgeneric (setf duration) (value period-designator)) -(defgeneric timepoint (moment-designator)) -(defgeneric (setf timepoint) (value moment-designator)) -(defgeneric cut-off (anchored-period-designator) ; name? - (:method (apd) (time+ (moment apd) (floating-period apd)))) - -;; others - -;; I've given the time-sig accessors general names because it allows -;; for symbols in time-signatures as well as numbers - numerator is an -;; odd accessor if the time sig is C (even in common practice) but -;; it's meaning is clear. beat-units-per-bar is clearer, though, I -;; think. - -(defgeneric beat-units-per-bar (time-signature)) -(defgeneric time-signature-numerator (time-signature) - (:method (ts) (beat-units-per-bar ts))) -(defgeneric beat-units (time-signature)) -(defgeneric time-signature-denominator (time-signature) - (:method (ts) (beat-units ts))) - -(defgeneric key-signature-sharps (key-signature)) - -(defgeneric bpm (tempo)) ;; in bpm -(defgeneric microseconds-per-crotchet (tempo) - ;; As used (when rounded) in MIDI - (:method (tp) (/ 60000000 (bpm tp)))) - -;;; Coerce-type accessors - -;; Should I be including these default methods? Should the accessors -;; be direct slot accessors or the generics I'm using? Should we -;; return the object itself if it already is in the target class? - -(defgeneric anchored-period (anchored-period-designator) - (:method (apd) (make-anchored-period (onset apd) (duration apd)))) - -(defgeneric floating-period (period-designator) - (:method (pd) (make-floating-period (duration pd)))) - -(defgeneric moment (moment-designator) - (:method (md) (make-moment (timepoint md)))) - -(defgeneric onset (anchored-period-designator) - (:method (apd) (moment apd))) -(defgeneric (setf onset) (value anchored-period-designator)) - -;;; Time Protocol (or moments?) - -;; negative times/durations -> ERROR? - -;; time+: <time> <duration> -> <time> -;; <duration> <time> -> <time> (same as previous?) -;; <duration> <duration> -> <duration> (or a distinct duration+?) -;; <time> <time> -> ERROR? -;; -;; time-: <time> <time> -> <duration> -;; <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)) - -(defgeneric time> (object1 object2)) -(defgeneric time< (object1 object2) - (:method (o1 o2) (time> o2 o1))) -(defgeneric time= (object1 object2)) -(defgeneric time>= (object1 object2) - (:method (o1 o2) (or (time> o1 o2) (time= o1 o2)))) -(defgeneric time<= (object1 object2) - (:method (o1 o2) (or (time< o1 o2) (time= o1 o2)))) -(defgeneric time/= (object1 object2) - (:method (o1 o2) (not (time= o1 o2)))) - -;;; Duration protocol - -(defgeneric duration> (object1 object2)) -(defgeneric duration< (object1 object2) - (:method (o1 o2) (duration> o2 o1))) -(defgeneric duration= (object1 object2)) -(defgeneric duration>= (object1 object2) - (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2)))) -(defgeneric duration<= (object1 object2) - (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2)))) -(defgeneric duration/= (object1 object2) - (:method (o1 o2) (not (duration= o1 o2)))) - -;; for linear scaling: -(defgeneric duration* (object1 object2)) -(defgeneric duration/ (object1 number)) - -;;; Pitch protocol - -;; pitch+: <pitch> <pitch> -> ERROR -;; <pitch> <interval> -> <pitch> -;; <interval> <pitch> -> <pitch> (same as previous?) -;; <interval> <interval> -> <interval> (or a distinct interval+?) -;; -;; pitch-: <pitch> <pitch> -> <interval> -;; <pitch> <interval> -> <pitch> -;; <interval> <interval> -> <interval> -;; <interval> <pitch> -> ERROR - -(defgeneric pitch+ (object1 object2)) -(defgeneric pitch- (object1 object2)) - -(defgeneric pitch> (object1 object2)) -(defgeneric pitch< (object1 object2) - (:method (o1 o2) (pitch> o2 o1))) -(defgeneric pitch= (object1 object2)) -(defgeneric pitch>= (object1 object2) - (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2)))) -(defgeneric pitch<= (object1 object2) - (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2)))) -(defgeneric pitch/= (object1 object2) - (:method (o1 o2) (not (pitch= o1 o2)))) - -;;; Interval protocol (emphasise _pitch_ not _time_ interval?) - -(defgeneric interval> (object1 object2)) -(defgeneric interval< (object1 object2) - (:method (o1 o2) (interval> o2 o1))) -(defgeneric interval= (object1 object2)) -(defgeneric interval>= (object1 object2) - (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2)))) -(defgeneric interval<= (object1 object2) - (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2)))) -(defgeneric interval/= (object1 object2) - (:method (o1 o2) (not (interval= o1 o2)))) - -;;; Allen's (1984) interval relations -;;; . equals already defined as INTERVAL= above -;;; . inverses ommitted for now (just use CL:NOT) -;;; . can all be defined in terms of MEETS (apparently) - -(defgeneric meets (object1 object2)) -(defgeneric before (object1 object2)) -(defgeneric overlaps (object1 object2)) -(defgeneric during (object1 object2)) -(defgeneric starts (object1 object2)) -(defgeneric ends (object1 object2)) - -;;; and extensions thereof ... - -(defgeneric subinterval (object1 object2) - (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2)))) - -(defgeneric disjoint (object1 object2) - (:method (o1 o2) - (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1)))) - -;;; 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 - -(defgeneric get-applicable-time-signatures (object1 object2)) - -;;; Tempo - -(defgeneric get-applicable-tempi (object1 object2)) - -;;; Tonality (Key Signature / Mode) - -(defgeneric get-applicable-key-signatures (object1 object2)) - -;;; Dynamics -;;; Voice -;;; Boundary Strength (phrasing) -
--- a/methods.lisp Fri Dec 15 16:11:52 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,218 +0,0 @@ -(cl:in-package #:amuse) - -(defmethod chromatic-pitch ((pitch-designator chromatic-pitch)) - pitch-designator) - -(defmethod midi-pitch-number ((pitch-designator chromatic-pitch)) - (%chromatic-pitch-number pitch-designator)) - -(defmethod midi-pitch-number ((pitch-designator pitch)) - (%chromatic-pitch-number (chromatic-pitch pitch-designator))) - -(defmethod span ((pitch-interval-designator pitch-interval)) - (%pitch-interval-span pitch-interval-designator)) - -(defmethod duration ((period-designator period)) - (%period-interval period-designator)) - -(defmethod timepoint ((moment-designator moment)) - (%moment-time moment-designator)) - -(defmethod beat-units-per-bar ((time-signature basic-time-signature)) - (%basic-time-signature-numerator time-signature)) - -(defmethod beat-units ((time-signature basic-time-signature)) - (%basic-time-signature-denominator time-signature)) - -(defmethod key-signature-sharps ((key-signature basic-key-signature)) - (%basic-key-signature-sharp-count key-signature)) - -(defmethod bpm ((tempo tempo)) - (%tempo-bpm tempo)) - -;; Time protocol - -(defmethod time+ ((object1 moment) (object2 period)) - (make-moment (+ (timepoint object1) (duration object2)))) - -(defmethod time+ ((object1 period) (object2 moment)) ;? - (time+ object2 object1)) - -(defmethod time+ ((object1 period) (object2 period)) - (make-floating-period (+ (duration object1) - (duration object2)))) - -(defmethod time+ ((object1 moment) (object2 moment)) - (error 'undefined-action :operation 'time+ :datatype (list (class-of object1) (class-of object2)))) - -(defmethod time- ((object1 moment) (object2 moment)) - (make-anchored-period (timepoint object2) - (- (timepoint object1) - (timepoint object2)))) - -(defmethod time- ((object1 moment) (object2 period)) - (make-moment (- (timepoint object1) (duration object2)))) - -(defmethod time- ((object1 period) (object2 moment)) ;? - (error 'undefined-action - :operation 'time- - :datatype (list (class-of object1) (class-of object2)))) - -(defmethod time- ((object1 period) (object2 period)) - (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))) - -(defmethod time= ((object1 moment) (object2 moment)) - (= (timepoint object1) (timepoint object2))) - -(defmethod duration> ((object1 period) (object2 period)) - (> (duration object1) (duration object2))) - -(defmethod duration= ((object1 period) (object2 period)) - (= (duration object1) (duration object2))) - -(defmethod duration* ((object1 period) (object2 number)) - (make-floating-period (* (duration object1) object2))) - -(defmethod duration* ((object1 number) (object2 period)) - (duration* object2 object1)) - -(defmethod duration/ ((object1 period) (object2 number)) - (make-floating-period (/ (duration object1) object2))) - -;; Pitch protocol - -(defmethod pitch+ ((object1 pitch-designator) - (object2 pitch-designator)) - (error 'undefined-action :operation 'pitch+ - :datatype (list (class-of object1) (class-of object2)))) - -(defmethod pitch+ ((object1 pitch-designator) - (object2 pitch-interval)) ; or should I check the - ; pitch/interval types? - (make-chromatic-pitch (+ (chromatic-pitch object1) - (span object2)))) - -(defmethod pitch+ ((object1 pitch-interval) - (object2 pitch-designator)) ;? - (pitch+ object2 object1)) - -(defmethod pitch+ ((object1 pitch-interval) - (object2 pitch-interval)) - (make-pitch-interval (+ (span object1) - (span object2)))) - -(defmethod pitch- ((object1 pitch-designator) - (object2 pitch-designator)) - (make-pitch-interval (- (chromatic-pitch object1) - (chromatic-pitch object2)))) - -(defmethod pitch- ((object1 pitch-designator) - (object2 pitch-interval)) - (make-chromatic-pitch (- (chromatic-pitch object1) - (span object2)))) - -(defmethod pitch- ((object1 pitch-interval) - (object2 pitch-interval)) - (make-pitch-interval (- (span object1) - (span object2)))) - -(defmethod pitch- ((object1 pitch-interval) - (object2 pitch-designator)) - (error 'undefined-action :operation 'pitch- - :datatype (list (class-of object1) (class-of object2)))) - -(defmethod pitch> ((object1 pitch-designator) - (object2 pitch-designator)) - (> (chromatic-pitch object1) - (chromatic-pitch object2))) - -(defmethod pitch= ((object1 pitch-designator) - (object2 pitch-designator)) - (= (chromatic-pitch object1) - (chromatic-pitch object2))) - -(defmethod interval> ((object1 pitch-interval) - (object2 pitch-interval)) - (> (span object1) - (span object2))) - -(defmethod interval= ((object1 pitch-interval) - (object2 pitch-interval)) - (= (span object1) - (span object2))) - - - -;; Allen - -(defmethod meets ((object1 anchored-period) - (object2 anchored-period)) - (or (time= (cut-off object1) object2) - (time= (cut-off object2) object1))) - -(defmethod before ((object1 anchored-period) - (object2 anchored-period)) - (time> object2 (cut-off object1))) - -(defmethod overlaps ((object1 anchored-period) - (object2 anchored-period)) - ;; FIXME: Is there a tidier method? - (or (and (time> object2 object1) ; object1 starts before object2 - (time> (cut-off object1) object2) ; object1 ends after object2 starts - (time> (cut-off object2) (cut-off object1))) ; object1 ends before object2 does - (and (time> object1 object2) ; object1 starts after object2 - (time> (cut-off object2) object1) ; object1 starts before object2 ends - (time> (cut-off object1) (cut-off object2))))) ; object1 ends after object2 does - -(defmethod during ((object1 anchored-period) - (object2 anchored-period)) - (and (time> object1 object2) - (time< (cut-off object2) (cut-off object2)))) - -(defmethod starts ((object1 anchored-period) - (object2 anchored-period)) - (time= object1 object2)) - -(defmethod ends ((object1 anchored-period) - (object2 anchored-period)) - (time= (cut-off object1) (cut-off object2))) - -;; ...and - -(defmethod period-intersection ((object1 anchored-period) - (object2 anchored-period)) - (cond - ((disjoint object1 object2) - ;; if they don't overlap, return nil, not a negative-valued - ;; period - nil) - ((let* ((start (if (time> (onset object2) (onset object1)) - (onset object2) - (onset object1))) - (duration (duration (time- (if (time> (cut-off object2) (cut-off object1)) - (cut-off object1) - (cut-off object2)) - start)))) - (make-anchored-period (timepoint start) duration))))) - - - - \ No newline at end of file
--- a/package.lisp Fri Dec 15 16:11:52 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,109 +0,0 @@ -(cl:defpackage #:amuse - (:use #:common-lisp) - (: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 - #:chromatic-pitched-event - #:midi-pitched-event - #:percussive-event - #:midi-percussive-event - #:time-signature - #:basic-time-signature - #:key-signature - #:basic-key-signature - #:midi-key-signature - #:tempo - #:get-composition - #:chromatic-pitch - #:diatonic-pitch - #:midi-pitch-number - #:meredith-chromatic-pitch-number - #:pitch-class - #:span - #:duration - #:timepoint - #:onset - #:cut-off - #:beat-units-per-bar - #:time-signature-numerator - #:beat-units - #:time-signature-denominator - #:key-signature-sharps - #:bpm - #:microseconds-per-crotchet - #: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 - #:get-applicable-time-signatures - #:get-applicable-tempi - #:get-applicable-key-signatures - #:make-moment - #:make-floating-period - #:make-anchored-period - #:make-chromatic-pitch - #:make-diatonic-pitch - #:make-pitch-interval - #:make-chromatic-pitched-event - #:make-midi-pitched-event - #:make-midi-percussive-event - #:make-basic-time-signature - #:make-basic-key-signature - #:make-midi-key-signature - #:make-tempo - -)) \ No newline at end of file