m@24: (cl:in-package #:amuse) 
m@24: 
j@287: ;;; Identifiers
j@287: 
j@287: (defgeneric identifier (object))
j@287: 
j@287: (defgeneric event-id (object))
j@287: 
j@287: (defgeneric composition-id (object))
j@287: 
m@24: ;;; Pulling compositions from the database 
m@24: 
d@123: (defgeneric get-composition (identifier)
d@123:   (:documentation "Returns a composition of type dependant on
d@123:   identifier"))
m@24: 
d@169: (defgeneric get-constituents (constituent-identifier)
d@169:   (:documentation "Returns a list of constituents matching the
d@169:   criteria in identifier"))
d@169: 
m@89: (defgeneric monody (object)
m@89:   (:documentation "Returns a monody."))
m@89: (defgeneric ensure-monody (object)
m@89:   (:documentation "Returns a generalised boolean."))
m@89: 
d@33: ;;; Getting constituents from compositions
d@33: ;; IS this the mechanism we want to use
d@72: (defgeneric time-signatures (composition)
d@72:   (:documentation "Returns all time-signatures in a composition
d@72:   Probably shouldn't be exported - can be replaced
d@72:   by (get-applicable-time-signature commposition composition)"))
d@72: (defgeneric (setf time-signatures) (sequence composition)
d@72:   (:documentation "Sets all time-signatures in a composition.
d@72:   Is this wanted here?"))
d@72: (defgeneric tempi (composition)
d@72:   (:documentation "Returns all tempi in a composition Probably
d@72:   shouldn't be exported - can be replaced
d@72:   by (get-applicable-tempi commposition composition)"))
d@72: (defgeneric (setf tempi) (sequence composition)
d@72:   (:documentation "Sets all tempi in a composition.
d@72:   Is this wanted here?"))
d@72: (defgeneric key-signatures (composition)
d@72:   (:documentation "Returns all key-signatures in a composition
d@72:   Probably shouldn't be exported - can be replaced
d@72:   by (get-applicable-key-signature commposition composition)"))
d@72: (defgeneric (setf key-signatures) (sequence composition)
d@72:   (:documentation "Sets all key sigs in a composition.
d@72:   Is this wanted here?"))
d@33: 
m@24: ;;; Simple Accessors
m@24: 
m@24: ;; pitch-based
m@24: 
m@24: (defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch
m@24: 				      ; in its ur form?
d@136: (defgeneric chromatic-pitch (pitch))
d@136: (defgeneric diatonic-pitch (pitch))
m@24: (defgeneric frequency (object)) ;?
m@81: 
d@136: (defgeneric octave (pitch)
m@86:   (:documentation "Return an integer representing the octave of
d@136: pitch where middle c is defined to be the lowest pitch in
m@86: octave 4."))
m@86: 
d@136: (defgeneric diatonic-pitch-octave (pitch)
c@106:   (:documentation "Return an integer representing the diatonic octave
d@136: of pitch."))
c@106: 
d@136: (defgeneric diatonic-pitch-accidental (pitch)
m@86:   (:documentation "Return an integer representing the inflection of a
m@86: diatonic pitch where where negative values indicate numbers of flats,
m@86: 0 indicates natural and positive values indicate numbers of sharps."))
m@86: 
d@136: (defgeneric diatonic-pitch-mp (pitch)
c@108:   (:documentation "Return an integer representing the morphetic pitch
c@108: \(in MIPS terms) of a diatonic pitch."))
d@136: (defgeneric diatonic-pitch-cp (pitch)
c@108:   (:documentation "Return an integer representing the chromatic pitch
c@108: \(in MIPS terms) of a diatonic pitch."))
c@108: 
d@136: (defgeneric middle-c (pitch) 
m@81:   (:documentation "Returns the value of middle C in the particular
d@136: representation of pitch used by PITCH."))
d@136: (defgeneric midi-pitch-number (pitch)
d@136:   (:documentation "Takes a pitch (usually a pitched event) and
d@136:   returns an integer between 0 and 127 representing the chromatic
d@136:   pitch represented (60=middle C, 48 the C below that, etc.)"))
d@136: (defgeneric asa-pitch-string (pitch)
m@81:   (:documentation "Returns a string representing the designated ASA
m@81: pitch name which has three parts: a letter name in the set
m@81: {A,B,C,D,E,F,G}, an inflection in the set {n,f,s,ff,ss,fff,sss,...}
m@81: and an octave number. E.g., Cn4 = Middle C."))
d@136: (defgeneric asa-interval-string (pitch)
c@112:   (:documentation "Returns a string representing the designated ASA
c@112: interval name which has two or three parts: a direction in the set
c@112: {r,f} (absent for unisons/primes), a type in the set
c@112: {p,ma,mi,a,d,aa,dd,aaa,ddd,...}, and a size number.  E.g. rma2 =
c@112: rising major second."))
d@136: (defgeneric diatonic-pitch-name (pitch)
m@81:   (:documentation "Returns a char in the set
m@81: {#\A,#\B,#\C,#\D,#\E,#\F,#\G}, representing the pitch name of
d@136: PITCH."))
d@136: (defgeneric pitch-class (pitch)
d@136:   (:documentation "Takes a pitch (usually a pitched event) and
d@136:   returns an integer between 0 and 12 representing the
d@136:   octave-independant pitch, with c=0, c#=1, etc.")
m@24:   (:method (p) (mod (midi-pitch-number p) 12)))
d@136: (defgeneric span (pitch-interval))
m@24: 
m@24: ;; time
m@24: 
d@136: (defgeneric duration (period)
d@136:   (:documentation "Returns a real. Probably should only apply do
d@136:   standard-periods (rather than periods? or should it return
d@136:   something other than a value in other cases)"))
d@136: (defgeneric (setf duration) (value period)
d@136:   (:documentation "As with duration, perhaps this should work only
d@136:   with standard-periods"))
d@136: (defgeneric timepoint (moment)
d@136:   (:documentation "Returns a number for a moment. Does this make
d@136:   any sense on an abstrace class? Should it just apply to
d@136:   standard-moment?"))
d@136: (defgeneric (setf timepoint) (value moment)
d@136:   (:documentation "Sets timepoint. What does this mean for an
d@136:  abstract class? Should it just apply to standard-moment"))
d@136: (defgeneric cut-off (anchored-period) ; name?
d@72:   (:documentation "Returns a <moment> representing the point at
d@121:   which the anchored period has ended. By default, is calculated
d@121:   as the result of running time+ on the onset and period of the
d@121:   object.")
d@136:   (:method (apd) (time+ (moment apd) (period apd))))
d@136: (defgeneric crotchet (object)
m@95:   (:documentation "Returns a period, the duration of which represents
m@95: a crotchet in the time representation used by object."))
m@24: 
m@24: ;; others
m@24: 
m@24: ;; I've given the time-sig accessors general names because it allows
m@24: ;; for symbols in time-signatures as well as numbers - numerator is an
m@24: ;; odd accessor if the time sig is C (even in common practice) but
d@100: ;; its meaning is clear. beat-units-per-bar is clearer, though, I
m@24: ;; think.
m@24: 
d@123: (defgeneric beat-units-per-bar (time-signature)
d@123:   (:documentation "In a standard, fraction-like time-signature or
d@123:   a symbolic equivalent, this is the numerator."))
m@24: (defgeneric time-signature-numerator (time-signature)
d@123:   (:method (ts) (beat-units-per-bar ts))
d@123:   (:documentation "Not obviously meaningful for non fraction-like
d@123:   time signatures"))
d@123: (defgeneric beat-units (time-signature)
d@123:   (:documentation "In a standard, fraction-like time-signature or
d@134:   a symbolic equivalent, this is the denominator (n.b.  the
d@134:   difference between this and @code{tactus-duration} is only
d@134:   visible for compound time, where this returns the lower portion
d@134:   of the time signature, but @code{tactus-duration} returns the
d@134:   higher-level unit)."))
m@24: (defgeneric time-signature-denominator (time-signature)
d@123:   (:method (ts) (beat-units ts))
d@123:   (:documentation "Not obviously meaningful for non fraction-like
d@123:   time signatures"))
d@33: (defgeneric tactus-duration (time-signature)
j@305:   ;; basic, but should do? NO! This defines 6/4 as compound. We need
j@305:   ;; proper simplep and compoundp predicates.
d@33:   (:method (ts)
j@305:     (warn "FIXME: tactus-duration is broken")
d@33:     (cond
j@305:       ;; ((and (not (= (beat-units-per-bar ts) 3))
j@305:       ;; 	    (= (rem (beat-units-per-bar ts) 3) 0))
j@305:       ((and (= (beat-units ts) 8)
d@33: 	    (= (rem (beat-units-per-bar ts) 3) 0))
d@33:        ;; compound time
d@33:        (* (/ 4 (beat-units ts))
d@33: 	  3))
d@123:       (t (/ 4 (beat-units ts)))))
d@123:   (:documentation "Returns a number of crotchets to represent the
d@123:   tactus, based on some idea of time signature patterns. Should,
d@123:   in future, return a duration rather than a number."))
m@24: 
d@123: (defgeneric key-signature-sharps (key-signature)
d@123:   (:documentation "Simple query for normal key-signatures."))
d@123: (defgeneric key-signature-mode (ks)
d@123:   (:documentation "Query that only makes sense for midi-like key
d@123:   signatures"))
m@24: 
d@123: (defgeneric bpm (tempo)
d@123:   (:documentation "Basic tempo query")) ;; in bpm
m@24: (defgeneric microseconds-per-crotchet (tempo)
m@24:   ;; As used (when rounded) in MIDI
d@123:   (:method (tp) (/ 60000000 (bpm tp)))
d@123:   (:documentation "Basic tempo query for MIDI. N.B. This will be
d@123:   a fraction and must be rounded before being used for output."))
m@24: 
m@24: ;;; Coerce-type accessors
m@24: 
m@24: ;; Should I be including these default methods?  Should the accessors
m@24: ;; be direct slot accessors or the generics I'm using? Should we
m@24: ;; return the object itself if it already is in the target class?
m@24: 
d@136: (defgeneric anchored-period (anchored-period)
d@123:   (:method (apd) (make-anchored-period (onset apd) (duration apd)))
d@123:   (:documentation "Coerce any anchored period to a plain anchored
d@123:   period"))
m@24: 
d@136: (defgeneric period (period)
d@136:   (:method (pd) (make-period (duration pd)))
d@123:   (:documentation "Coerce any period to a floating period"))
m@24: 
d@136: (defgeneric moment (moment)
d@123:   (:method (md) (make-moment (timepoint md)))
d@136:   (:documentation "Coerce any moment, including an
d@123:   anchored-period to a moment"))
m@24: 
d@136: (defgeneric onset (anchored-period)
d@139:   (:method (ap) (moment ap))
d@123:   (:documentation "Return a moment for the start of an anchored period"))
d@136: (defgeneric (setf onset) (value anchored-period))
m@24: 
m@24: ;;; Time Protocol (or moments?)
m@24: 
m@24: ;; negative times/durations -> ERROR? 
m@24: 
m@24: ;; time+: <time>      <duration> -> <time>
m@24: ;;        <duration>  <time>     -> <time> (same as previous?) 
m@24: ;;        <duration>  <duration> -> <duration> (or a distinct duration+?) 
m@24: ;;        <time>      <time>     -> ERROR? 
m@24: ;; 
m@24: ;; time-: <time>      <time>     -> <duration>
m@24: ;;        <time>      <duration> -> <time> 
m@24: ;;        <duration>  <duration> -> <duration> (or a distinct duration-?) 
m@24: ;;        <duration>  <time>     -> ERROR? 
m@24: ;;        <anchored>  <anchored> -> (time- (moment o1) (moment o2)) ? or error?
m@24: 
d@102: (defgeneric time+ (object1 object2)
d@136:   (:documentation "Addition for time objects"))
d@102: (defgeneric time- (object1 object2)
d@136:   (:documentation "Subtraction for time objects"))
m@24: 
d@102: (defgeneric time> (object1 object2)
d@136:   (:documentation "> operator for moments"))
m@24: (defgeneric time< (object1 object2)
d@136:   (:documentation "< operator for moments")
m@24:   (:method (o1 o2) (time> o2 o1)))
d@102: (defgeneric time= (object1 object2)
d@136:   (:documentation "= operator for moments")) 
m@24: (defgeneric time>= (object1 object2)
d@136:   (:documentation ">= operator for moments")
m@24:   (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
m@24: (defgeneric time<= (object1 object2)
d@136:   (:documentation "<= operator for moments")
m@24:   (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
m@24: (defgeneric time/= (object1 object2)
d@136:   (:documentation "not = operator for moments")
m@24:   (:method (o1 o2) (not (time= o1 o2))))
m@24: 
m@24: ;;; Duration protocol 
m@24: 
d@118: (defgeneric duration> (object1 object2)
d@136:   (:documentation "> operator for periods"))
m@24: (defgeneric duration< (object1 object2)
d@136:   (:documentation "< operator for periods")
m@24:   (:method (o1 o2) (duration> o2 o1)))
d@118: (defgeneric duration= (object1 object2)
d@136:   (:documentation "= operator for periods")) 
m@24: (defgeneric duration>= (object1 object2) 
d@136:   (:documentation ">= operator for periods")
m@24:   (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2))))
m@24: (defgeneric duration<= (object1 object2)
d@136:   (:documentation "<= operator for periods")
m@24:   (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2))))
m@24: (defgeneric duration/= (object1 object2) 
d@136:   (:documentation "not = operator for periods")
m@24:   (:method (o1 o2) (not (duration= o1 o2))))
m@24: 
m@24: ;; for linear scaling:
d@118: (defgeneric duration* (object1 object2)
d@136:   (:documentation "Multiplication operator for
d@136:   periods. Intuitively, this makes sense, but it may cause us
d@118:   trouble with some implementations in the future."))
d@118: (defgeneric duration/ (object1 number)
d@136:   (:documentation "Division operator for periods. This may turn
d@136:   out not to mean much. Division is probably useful, but we may
d@136:   need to define what we mean with care."))
m@24: 
m@24: ;;; Pitch protocol 
m@24: 
m@24: ;; pitch+: <pitch>    <pitch>     -> ERROR
m@24: ;;         <pitch>    <interval>  -> <pitch> 
m@24: ;;         <interval> <pitch>     -> <pitch> (same as previous?) 
m@24: ;;         <interval> <interval>  -> <interval> (or a distinct interval+?) 
m@24: ;; 
m@24: ;; pitch-: <pitch>    <pitch>     -> <interval>
m@24: ;;         <pitch>    <interval>  -> <pitch> 
m@24: ;;         <interval> <interval>  -> <interval>
m@24: ;;         <interval> <pitch>     -> ERROR 
m@24: 
m@24: (defgeneric pitch+ (object1 object2))
m@24: (defgeneric pitch- (object1 object2))
m@24: 
m@24: (defgeneric pitch> (object1 object2))
m@24: (defgeneric pitch< (object1 object2)
m@24:   (:method (o1 o2) (pitch> o2 o1)))
m@24: (defgeneric pitch= (object1 object2)) 
m@24: (defgeneric pitch>= (object1 object2) 
m@24:   (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2))))
m@24: (defgeneric pitch<= (object1 object2)
m@24:   (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2))))
m@24: (defgeneric pitch/= (object1 object2) 
m@24:   (:method (o1 o2) (not (pitch= o1 o2))))
m@24: 
m@24: ;;; Interval protocol (emphasise _pitch_ not _time_ interval?) 
m@24: 
m@24: (defgeneric interval> (object1 object2))
m@24: (defgeneric interval< (object1 object2)
m@24:   (:method (o1 o2) (interval> o2 o1)))
m@24: (defgeneric interval= (object1 object2)) 
m@24: (defgeneric interval>= (object1 object2) 
m@24:   (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2))))
m@24: (defgeneric interval<= (object1 object2)
m@24:   (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2))))
m@24: (defgeneric interval/= (object1 object2) 
m@24:   (:method (o1 o2) (not (interval= o1 o2))))
m@24: 
m@24: ;;; Allen's (1984) interval relations 
m@24: ;;;  . equals already defined as INTERVAL= above 
m@24: ;;;  . inverses ommitted for now (just use CL:NOT) 
m@24: ;;;  . can all be defined in terms of MEETS (apparently)
m@24: 
m@24: (defgeneric meets (object1 object2))
m@24: (defgeneric before (object1 object2))
m@24: (defgeneric overlaps (object1 object2))
m@24: (defgeneric during (object1 object2))
m@24: (defgeneric starts (object1 object2))
m@24: (defgeneric ends (object1 object2))
m@24: 
m@24: ;;; and extensions thereof ...
m@24: 
m@24: (defgeneric subinterval (object1 object2)
m@24:   (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2))))
m@24: 
m@24: (defgeneric disjoint (object1 object2)
m@24:   (:method (o1 o2) 
m@24:     (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1))))
m@24: 
m@24: ;;; More time-based functions
d@33: 
d@33: (defgeneric period= (object1 object2)
d@33:   (:method (x y) nil))
d@33: 
d@33: (defgeneric find-overlapping (anchored-period sequence)
d@33:   ;; Returns all members of a sequence of period signifiers that overlap
d@33:   ;; with the supplied period
d@33:   (:method (ap s) (remove-if #'(lambda (x) (amuse:disjoint ap x)) s)))
d@33: 
m@24: ;; Return the anchored-period representing the intersection of two
d@136: ;; anchored-period.
d@136: (defgeneric period-intersection (anchored-period1
d@136: 				 anchored-period2))
m@24: 
d@136: (defgeneric inter-onset-interval (moment1 moment2)
d@136:   (:method (moment1 moment2) (time- (moment moment2) (moment moment1))))
m@24: 
m@24: 
m@24: ;;; Time Signature 
m@24: 
d@33: (defgeneric get-applicable-time-signatures (anchored-period composition)
d@123:   (:method (ap c) (find-overlapping ap (time-signatures c)))
d@136:   (:documentation "Return a list of TIME-SIGNATURE-PERIODs that are
d@123:   relevant to <anchored-period>. The period may contain
d@123:   information such as staff position and voicing, and the method
d@123:   may use this to filter its response"))
m@24: 
d@123: (defgeneric time-signature-equal (ts1 ts2)
d@123:   (:documentation "Comparison operator. The definition of
d@123:   equality is left open for implementers"))
m@67: 
m@24: ;;; Tempo 
m@24: 
d@33: (defgeneric get-applicable-tempi  (anchored-period composition)
d@123:   (:method (ap c) (find-overlapping ap (tempi c)))
d@136:   (:documentation "Return a list of TEMPO-PERIODs that are
d@136:   relevant to <anchored-period>. The period may contain
d@136:   information such as staff position and voicing, and the method
d@136:   may use this to filter its response"))
m@24: 
d@123: (defgeneric tempo-equal (t1 t2)
d@123:   (:documentation "Comparison operator. The definition of
d@123:   equality is left open for implementers"))
m@67: 
m@24: ;;; Tonality (Key Signature / Mode) 
m@24: 
d@123: (defgeneric get-applicable-key-signatures (object1 object2)
d@136:   (:documentation "Return a list of KEY-SIGNATURE-PERIODs that are
d@123:   relevant to <anchored-period>. The period may contain
d@123:   information such as staff position and voicing, and the method
d@123:   may use this to filter its response"))
m@24: 
d@123: (defgeneric key-signature-equal (ks1 ks2)
d@123:   (:documentation "Comparison operator. The definition of
d@123:   equality is left open to implementers"))
m@67: 
d@136: ;;; Some generic constructors - are these useful? (DL 31/8/07)
d@136: (defgeneric make-moment (value)
d@136:   (:documentation "Returns MOMENT of subclass appropriate to the
d@136:   class of value. Probably guessed."))
d@136: (defgeneric make-period (value)
d@136:   (:documentation "Returns PERIOD of subclass appropriate to the
d@136:   class of value. Probably guessed."))
d@136: (defgeneric make-anchored-period (start-value duration-value)
d@136:   (:documentation "Returns ANCHORED-PERIOD of subclass
d@136:   appropriate to the class of value. Probably guessed."))
d@136: 
d@160:  (defgeneric trim-enclosing-silence (composition)
d@156:   (:documentation "Returns a composition of the same type as
d@156:   composition provided, with leading and following silences/rests
d@156:   removed, but preserving all relevant information. Where
d@156:   relevant, any silence in a bar containing musical material may
d@160:   be preserved."))
d@136: 
m@24: ;;; Dynamics 
m@24: ;;; Voice 
m@81: ;;; Boundary Strength (phrasing) 
d@175: 
d@175: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
d@175: ;;
d@175: ;; Experimental:
d@175: ;;
d@175: 
d@175: ;;; Proposed new metre functions
d@175: ;; These should provide sufficient functionality that the users need
d@175: ;; not refer to get-applicable-time-signatures unless they really mean
d@175: ;; it. In turn, this means that barline based representations have a
d@175: ;; better chance at guessing.
d@175: 
d@175: ;; Notes:
d@175: ;; * iteration is possible with
d@175: ;;     (do ((beat (current-beat (make-moment 0) composition))
d@175: ;;                (current-beat (cut-off beat) composition))) ...
d@175: ;;   [That's probably not very efficient. there must be better ways]
d@175: ;; * gsharp and tabcode can answer bar questions, but not beat
d@175: ;; questions. Appropriate conditions and restarts will be needed.
d@175: ;; * a good test of this functionality will prob be amuse-harmony.
d@175: 
d@175: (defgeneric bar-period (time-signature implementation-object)
d@175:   (:documentation "Returns a <period> with a duration equal to the
d@175:   duration of a bar in the given time signature for the given
d@175:   implementation. FIXME: this isn't guaranteed to be
d@175:   meaningful (double time signatures break this"))
d@175: (defgeneric current-bar (moment composition)
d@175:   (:documentation "Returns an <anchored-period> representing the
d@175:   bar which contains moment"))
d@175: 
d@175: (defgeneric beat-period (moment time-signature implementation-object)
j@307:   (:documentation "Takes a moment, time signature object and crotchet
j@307:   and returns an <anchored-period> for the containing beat containing
j@307:   moment. This is more useful when there's a complex time
j@307:   signature (not currently possible) in which tactus is different in
j@307:   different parts of the bar (e.g. 3+3+2/8)"))
d@175: (defgeneric current-beat (moment composition)
d@175:   (:documentation "Returns an <anchored-period> representing the
d@175:   tactus unit which contains moment"))
d@175: 
j@307: (defgeneric ioi-from-bar (moment)
j@307:   (:documentation "Returns the IOI of moment (i.e. an event) from the
j@307:   bar line."))
j@307: 
j@307: (defgeneric onset-in-bar (moment)
j@307:   (:documentation "The position of moment in the bar, measured in
j@307:   beats."))
d@175: 
d@175: ;;;;;;;;;;;;;;
d@175: ;;
d@175: ;;
d@175: 
d@175: (defgeneric get-applicable-clefs (anchored-period constituent))
j@276: 
j@320: ;;;=====================================================================
j@304: ;;; Copying events in time
j@320: ;;;=====================================================================
j@276: 
j@304: (defgeneric move-to-first-bar (composition))
j@276: 
j@278: (defgeneric copy-event (event))
j@278: 
j@278: (defgeneric voice (event))
j@304: 
j@304: 
j@320: ;;;=====================================================================
j@304: ;;; Searching for events
j@320: ;;;=====================================================================
j@304: 
j@304: (defgeneric find-next-event (source-event &key predicate test
j@304: 					  break-test search-list))
j@304: 
j@320: ;;;=====================================================================
j@304: ;;; Sorting Compositions
j@320: ;;;=====================================================================
j@304: 
j@304: (defgeneric event< (event1 event2 attribute-list))
j@304: 
j@304: (defgeneric sort-composition (composition attribute-list))