m@24: (cl:in-package #:amuse) 
m@24: 
m@24: ;;; Pulling compositions from the database 
m@24: 
m@24: (defgeneric get-composition (identifier))
m@24: 
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?
c@106: (defgeneric chromatic-pitch (pitch-designator))
c@106: (defgeneric diatonic-pitch (pitch-designator))
m@24: (defgeneric frequency (object)) ;?
m@81: 
m@86: (defgeneric octave (pitch-designator)
m@86:   (:documentation "Return an integer representing the octave of
m@86: pitch-designator where middle c is defined to be the lowest pitch in
m@86: octave 4."))
m@86: 
c@106: (defgeneric diatonic-pitch-octave (pitch-designator)
c@106:   (:documentation "Return an integer representing the diatonic octave
c@106: of PITCH-DESIGNATOR."))
c@106: 
m@86: (defgeneric diatonic-pitch-accidental (pitch-designator)
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: 
c@108: (defgeneric diatonic-pitch-mp (pitch-designator)
c@108:   (:documentation "Return an integer representing the morphetic pitch
c@108: \(in MIPS terms) of a diatonic pitch."))
c@108: (defgeneric diatonic-pitch-cp (pitch-designator)
c@108:   (:documentation "Return an integer representing the chromatic pitch
c@108: \(in MIPS terms) of a diatonic pitch."))
c@108: 
m@81: (defgeneric middle-c (pitch-designator) 
m@81:   (:documentation "Returns the value of middle C in the particular
m@81: representation of pitch used by PITCH-DESIGNATOR."))
d@72: (defgeneric midi-pitch-number (pitch-designator)
d@72:   (:documentation "Takes a pitch-designator (usually a pitched
d@72:   event) and returns an integer between 0 and 127 representing
d@72:   the chromatic pitch designated (60=middle C, 48 the C below
d@72:   that, etc.)"))
m@81: (defgeneric asa-pitch-string (pitch-designator)
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."))
c@112: (defgeneric asa-interval-string (pitch-designator)
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."))
m@81: (defgeneric diatonic-pitch-name (pitch-designator)
m@81:   (:documentation "Returns a char in the set
m@81: {#\A,#\B,#\C,#\D,#\E,#\F,#\G}, representing the pitch name of
m@81: PITCH-DESIGNATOR."))
m@24: (defgeneric pitch-class (pitch-designator)
d@72:   (:documentation "Takes a pitch-designator (usually a pitched
d@72:   event) and returns an integer between 0 and 12 representing
d@72:   the octave-independant pitch, with c=0, c#=1, etc.")
m@24:   (:method (p) (mod (midi-pitch-number p) 12)))
m@24: (defgeneric span (pitch-interval-designator))
m@24: 
m@24: ;; time
m@24: 
m@24: (defgeneric duration (period-designator))
m@24: (defgeneric (setf duration) (value period-designator))
m@24: (defgeneric timepoint (moment-designator))
m@24: (defgeneric (setf timepoint) (value moment-designator))
m@24: (defgeneric cut-off (anchored-period-designator) ; name?
d@72:   (:documentation "Returns a <moment> representing the point at
d@72:   which the anchored period has ended.")
m@24:   (:method (apd) (time+ (moment apd) (floating-period apd))))
m@95: (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: 
m@24: (defgeneric beat-units-per-bar (time-signature))
m@24: (defgeneric time-signature-numerator (time-signature)
m@24:   (:method (ts) (beat-units-per-bar ts)))
m@24: (defgeneric beat-units (time-signature))
m@24: (defgeneric time-signature-denominator (time-signature)
m@24:   (:method (ts) (beat-units ts)))
d@33: (defgeneric tactus-duration (time-signature)
d@33:   ;; basic, but should do?
d@33:   (:method (ts)
d@33:     (cond
d@33:       ((and (not (= (beat-units-per-bar ts) 3))
d@33: 	    (= (rem (beat-units-per-bar ts) 3) 0))
d@33:        ;; compound time
d@33:        (* (/ 4 (beat-units ts))
d@33: 	  3))
d@33:       (t (/ 4 (beat-units ts))))))
m@24: 
m@24: (defgeneric key-signature-sharps (key-signature))
m@45: (defgeneric key-signature-mode (ks))
m@24: 
m@24: (defgeneric bpm (tempo)) ;; in bpm
m@24: (defgeneric microseconds-per-crotchet (tempo)
m@24:   ;; As used (when rounded) in MIDI
m@24:   (:method (tp) (/ 60000000 (bpm tp))))
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: 
m@24: (defgeneric anchored-period (anchored-period-designator)
m@24:   (:method (apd) (make-anchored-period (onset apd) (duration apd))))
m@24: 
m@24: (defgeneric floating-period (period-designator)
m@24:   (:method (pd) (make-floating-period (duration pd))))
m@24: 
m@24: (defgeneric moment (moment-designator)
m@24:   (:method (md) (make-moment (timepoint md))))
m@24: 
m@24: (defgeneric onset (anchored-period-designator)
m@24:   (:method (apd) (moment apd)))
m@24: (defgeneric (setf onset) (value anchored-period-designator))
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@102:   (:documentation "Addition for time designators"))
d@102: (defgeneric time- (object1 object2)
d@102:   (:documentation "Subtraction for time designators"))
m@24: 
d@102: (defgeneric time> (object1 object2)
d@102:   (:documentation "> operator for time designators"))
m@24: (defgeneric time< (object1 object2)
d@102:   (:documentation "< operator for time designators")
m@24:   (:method (o1 o2) (time> o2 o1)))
d@102: (defgeneric time= (object1 object2)
d@102:   (:documentation "= operator for time designators")) 
m@24: (defgeneric time>= (object1 object2)
d@102:   (:documentation ">= operator for time designators")
m@24:   (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
m@24: (defgeneric time<= (object1 object2)
d@102:   (:documentation "<= operator for time designators")
m@24:   (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
m@24: (defgeneric time/= (object1 object2)
d@102:   (:documentation "not = operator for time designators")
m@24:   (:method (o1 o2) (not (time= o1 o2))))
m@24: 
m@24: ;;; Duration protocol 
m@24: 
m@24: (defgeneric duration> (object1 object2))
m@24: (defgeneric duration< (object1 object2)
m@24:   (:method (o1 o2) (duration> o2 o1)))
m@24: (defgeneric duration= (object1 object2)) 
m@24: (defgeneric duration>= (object1 object2) 
m@24:   (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2))))
m@24: (defgeneric duration<= (object1 object2)
m@24:   (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2))))
m@24: (defgeneric duration/= (object1 object2) 
m@24:   (:method (o1 o2) (not (duration= o1 o2))))
m@24: 
m@24: ;; for linear scaling:
m@24: (defgeneric duration* (object1 object2))
m@24: (defgeneric duration/ (object1 number))
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
m@24: ;; anchored-period-specifiers.
m@24: (defgeneric period-intersection (anchored-period-specifier1
m@24: 				 anchored-period-specifier2))
m@24: 
m@24: (defgeneric inter-onset-interval (moment-designator1 moment-designator2)
m@24:   (:method (md1 md2) (time- (moment md2) (moment md1))))
m@24: 
m@24: 
m@24: ;;; Time Signature 
m@24: 
d@33: (defgeneric get-applicable-time-signatures (anchored-period composition)
d@33:   (:method (ap c) (find-overlapping ap (time-signatures c))))
m@24: 
m@67: (defgeneric time-signature-equal (ts1 ts2))
m@67: 
m@24: ;;; Tempo 
m@24: 
d@33: (defgeneric get-applicable-tempi  (anchored-period composition)
d@33:   (:method (ap c) (find-overlapping ap (tempi c))))
m@24: 
m@67: (defgeneric tempo-equal (t1 t2))
m@67: 
m@24: ;;; Tonality (Key Signature / Mode) 
m@24: 
m@24: (defgeneric get-applicable-key-signatures (object1 object2))
m@24: 
m@67: (defgeneric key-signature-equal (ks1 ks2))
m@67: 
m@24: ;;; Dynamics 
m@24: ;;; Voice 
m@81: ;;; Boundary Strength (phrasing)