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: 
d@33: ;;; Getting constituents from compositions
d@33: ;; IS this the mechanism we want to use
d@33: (defgeneric time-signatures (composition))
d@33: (defgeneric (setf time-signatures) (sequence composition))
d@33: (defgeneric tempi (composition))
d@33: (defgeneric (setf tempi) (sequence composition))
d@33: (defgeneric key-signatures (composition))
d@33: (defgeneric (setf key-signatures) (sequence composition))
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?
m@24: (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these
m@24: (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed?
m@24: (defgeneric frequency (object)) ;?
m@24: (defgeneric midi-pitch-number (pitch-designator))
m@24: (defgeneric meredith-chromatic-pitch-number (pitch-designator)
m@24:   ;; David Meredith's PhD and ps13 code
m@24:   (:method (p) (- (midi-pitch-number p) 21)))
m@24: (defgeneric pitch-class (pitch-designator)
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?
m@24:   (:method (apd) (time+ (moment apd) (floating-period apd))))
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
m@24: ;; it's 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: 
m@24: (defgeneric time+ (object1 object2))
m@24: (defgeneric time- (object1 object2))
m@24: 
m@24: (defgeneric time> (object1 object2))
m@24: (defgeneric time< (object1 object2)
m@24:   (:method (o1 o2) (time> o2 o1)))
m@24: (defgeneric time= (object1 object2)) 
m@24: (defgeneric time>= (object1 object2)
m@24:   (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
m@24: (defgeneric time<= (object1 object2)
m@24:   (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
m@24: (defgeneric time/= (object1 object2)
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@24: ;;; Boundary Strength (phrasing) 
m@24: