annotate base/generics.lisp @ 67:8b31d54c95be

base/: {TIME-SIGNATURE,KEY-SIGNATURE,TEMPO}-EQUAL moved here from implementations/mtp/ darcs-hash:20070706093228-c0ce4-9ca0951f98303474fb5da95fc20ebdb2c3fa4db0.gz
author Marcus Pearce <m.pearce@gold.ac.uk>
date Fri, 06 Jul 2007 10:32:28 +0100
parents 0f31919a855d
children 9960645779f0
rev   line source
m@24 1 (cl:in-package #:amuse)
m@24 2
m@24 3 ;;; Pulling compositions from the database
m@24 4
m@24 5 (defgeneric get-composition (identifier))
m@24 6
d@33 7 ;;; Getting constituents from compositions
d@33 8 ;; IS this the mechanism we want to use
d@33 9 (defgeneric time-signatures (composition))
d@33 10 (defgeneric (setf time-signatures) (sequence composition))
d@33 11 (defgeneric tempi (composition))
d@33 12 (defgeneric (setf tempi) (sequence composition))
d@33 13 (defgeneric key-signatures (composition))
d@33 14 (defgeneric (setf key-signatures) (sequence composition))
d@33 15
m@24 16 ;;; Simple Accessors
m@24 17
m@24 18 ;; pitch-based
m@24 19
m@24 20 (defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch
m@24 21 ; in its ur form?
m@24 22 (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these
m@24 23 (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed?
m@24 24 (defgeneric frequency (object)) ;?
m@24 25 (defgeneric midi-pitch-number (pitch-designator))
m@24 26 (defgeneric meredith-chromatic-pitch-number (pitch-designator)
m@24 27 ;; David Meredith's PhD and ps13 code
m@24 28 (:method (p) (- (midi-pitch-number p) 21)))
m@24 29 (defgeneric pitch-class (pitch-designator)
m@24 30 (:method (p) (mod (midi-pitch-number p) 12)))
m@24 31 (defgeneric span (pitch-interval-designator))
m@24 32
m@24 33 ;; time
m@24 34
m@24 35 (defgeneric duration (period-designator))
m@24 36 (defgeneric (setf duration) (value period-designator))
m@24 37 (defgeneric timepoint (moment-designator))
m@24 38 (defgeneric (setf timepoint) (value moment-designator))
m@24 39 (defgeneric cut-off (anchored-period-designator) ; name?
m@24 40 (:method (apd) (time+ (moment apd) (floating-period apd))))
m@24 41
m@24 42 ;; others
m@24 43
m@24 44 ;; I've given the time-sig accessors general names because it allows
m@24 45 ;; for symbols in time-signatures as well as numbers - numerator is an
m@24 46 ;; odd accessor if the time sig is C (even in common practice) but
m@24 47 ;; it's meaning is clear. beat-units-per-bar is clearer, though, I
m@24 48 ;; think.
m@24 49
m@24 50 (defgeneric beat-units-per-bar (time-signature))
m@24 51 (defgeneric time-signature-numerator (time-signature)
m@24 52 (:method (ts) (beat-units-per-bar ts)))
m@24 53 (defgeneric beat-units (time-signature))
m@24 54 (defgeneric time-signature-denominator (time-signature)
m@24 55 (:method (ts) (beat-units ts)))
d@33 56 (defgeneric tactus-duration (time-signature)
d@33 57 ;; basic, but should do?
d@33 58 (:method (ts)
d@33 59 (cond
d@33 60 ((and (not (= (beat-units-per-bar ts) 3))
d@33 61 (= (rem (beat-units-per-bar ts) 3) 0))
d@33 62 ;; compound time
d@33 63 (* (/ 4 (beat-units ts))
d@33 64 3))
d@33 65 (t (/ 4 (beat-units ts))))))
m@24 66
m@24 67 (defgeneric key-signature-sharps (key-signature))
m@45 68 (defgeneric key-signature-mode (ks))
m@24 69
m@24 70 (defgeneric bpm (tempo)) ;; in bpm
m@24 71 (defgeneric microseconds-per-crotchet (tempo)
m@24 72 ;; As used (when rounded) in MIDI
m@24 73 (:method (tp) (/ 60000000 (bpm tp))))
m@24 74
m@24 75 ;;; Coerce-type accessors
m@24 76
m@24 77 ;; Should I be including these default methods? Should the accessors
m@24 78 ;; be direct slot accessors or the generics I'm using? Should we
m@24 79 ;; return the object itself if it already is in the target class?
m@24 80
m@24 81 (defgeneric anchored-period (anchored-period-designator)
m@24 82 (:method (apd) (make-anchored-period (onset apd) (duration apd))))
m@24 83
m@24 84 (defgeneric floating-period (period-designator)
m@24 85 (:method (pd) (make-floating-period (duration pd))))
m@24 86
m@24 87 (defgeneric moment (moment-designator)
m@24 88 (:method (md) (make-moment (timepoint md))))
m@24 89
m@24 90 (defgeneric onset (anchored-period-designator)
m@24 91 (:method (apd) (moment apd)))
m@24 92 (defgeneric (setf onset) (value anchored-period-designator))
m@24 93
m@24 94 ;;; Time Protocol (or moments?)
m@24 95
m@24 96 ;; negative times/durations -> ERROR?
m@24 97
m@24 98 ;; time+: <time> <duration> -> <time>
m@24 99 ;; <duration> <time> -> <time> (same as previous?)
m@24 100 ;; <duration> <duration> -> <duration> (or a distinct duration+?)
m@24 101 ;; <time> <time> -> ERROR?
m@24 102 ;;
m@24 103 ;; time-: <time> <time> -> <duration>
m@24 104 ;; <time> <duration> -> <time>
m@24 105 ;; <duration> <duration> -> <duration> (or a distinct duration-?)
m@24 106 ;; <duration> <time> -> ERROR?
m@24 107 ;; <anchored> <anchored> -> (time- (moment o1) (moment o2)) ? or error?
m@24 108
m@24 109 (defgeneric time+ (object1 object2))
m@24 110 (defgeneric time- (object1 object2))
m@24 111
m@24 112 (defgeneric time> (object1 object2))
m@24 113 (defgeneric time< (object1 object2)
m@24 114 (:method (o1 o2) (time> o2 o1)))
m@24 115 (defgeneric time= (object1 object2))
m@24 116 (defgeneric time>= (object1 object2)
m@24 117 (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
m@24 118 (defgeneric time<= (object1 object2)
m@24 119 (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
m@24 120 (defgeneric time/= (object1 object2)
m@24 121 (:method (o1 o2) (not (time= o1 o2))))
m@24 122
m@24 123 ;;; Duration protocol
m@24 124
m@24 125 (defgeneric duration> (object1 object2))
m@24 126 (defgeneric duration< (object1 object2)
m@24 127 (:method (o1 o2) (duration> o2 o1)))
m@24 128 (defgeneric duration= (object1 object2))
m@24 129 (defgeneric duration>= (object1 object2)
m@24 130 (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2))))
m@24 131 (defgeneric duration<= (object1 object2)
m@24 132 (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2))))
m@24 133 (defgeneric duration/= (object1 object2)
m@24 134 (:method (o1 o2) (not (duration= o1 o2))))
m@24 135
m@24 136 ;; for linear scaling:
m@24 137 (defgeneric duration* (object1 object2))
m@24 138 (defgeneric duration/ (object1 number))
m@24 139
m@24 140 ;;; Pitch protocol
m@24 141
m@24 142 ;; pitch+: <pitch> <pitch> -> ERROR
m@24 143 ;; <pitch> <interval> -> <pitch>
m@24 144 ;; <interval> <pitch> -> <pitch> (same as previous?)
m@24 145 ;; <interval> <interval> -> <interval> (or a distinct interval+?)
m@24 146 ;;
m@24 147 ;; pitch-: <pitch> <pitch> -> <interval>
m@24 148 ;; <pitch> <interval> -> <pitch>
m@24 149 ;; <interval> <interval> -> <interval>
m@24 150 ;; <interval> <pitch> -> ERROR
m@24 151
m@24 152 (defgeneric pitch+ (object1 object2))
m@24 153 (defgeneric pitch- (object1 object2))
m@24 154
m@24 155 (defgeneric pitch> (object1 object2))
m@24 156 (defgeneric pitch< (object1 object2)
m@24 157 (:method (o1 o2) (pitch> o2 o1)))
m@24 158 (defgeneric pitch= (object1 object2))
m@24 159 (defgeneric pitch>= (object1 object2)
m@24 160 (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2))))
m@24 161 (defgeneric pitch<= (object1 object2)
m@24 162 (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2))))
m@24 163 (defgeneric pitch/= (object1 object2)
m@24 164 (:method (o1 o2) (not (pitch= o1 o2))))
m@24 165
m@24 166 ;;; Interval protocol (emphasise _pitch_ not _time_ interval?)
m@24 167
m@24 168 (defgeneric interval> (object1 object2))
m@24 169 (defgeneric interval< (object1 object2)
m@24 170 (:method (o1 o2) (interval> o2 o1)))
m@24 171 (defgeneric interval= (object1 object2))
m@24 172 (defgeneric interval>= (object1 object2)
m@24 173 (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2))))
m@24 174 (defgeneric interval<= (object1 object2)
m@24 175 (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2))))
m@24 176 (defgeneric interval/= (object1 object2)
m@24 177 (:method (o1 o2) (not (interval= o1 o2))))
m@24 178
m@24 179 ;;; Allen's (1984) interval relations
m@24 180 ;;; . equals already defined as INTERVAL= above
m@24 181 ;;; . inverses ommitted for now (just use CL:NOT)
m@24 182 ;;; . can all be defined in terms of MEETS (apparently)
m@24 183
m@24 184 (defgeneric meets (object1 object2))
m@24 185 (defgeneric before (object1 object2))
m@24 186 (defgeneric overlaps (object1 object2))
m@24 187 (defgeneric during (object1 object2))
m@24 188 (defgeneric starts (object1 object2))
m@24 189 (defgeneric ends (object1 object2))
m@24 190
m@24 191 ;;; and extensions thereof ...
m@24 192
m@24 193 (defgeneric subinterval (object1 object2)
m@24 194 (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2))))
m@24 195
m@24 196 (defgeneric disjoint (object1 object2)
m@24 197 (:method (o1 o2)
m@24 198 (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1))))
m@24 199
m@24 200 ;;; More time-based functions
d@33 201
d@33 202 (defgeneric period= (object1 object2)
d@33 203 (:method (x y) nil))
d@33 204
d@33 205 (defgeneric find-overlapping (anchored-period sequence)
d@33 206 ;; Returns all members of a sequence of period signifiers that overlap
d@33 207 ;; with the supplied period
d@33 208 (:method (ap s) (remove-if #'(lambda (x) (amuse:disjoint ap x)) s)))
d@33 209
m@24 210 ;; Return the anchored-period representing the intersection of two
m@24 211 ;; anchored-period-specifiers.
m@24 212 (defgeneric period-intersection (anchored-period-specifier1
m@24 213 anchored-period-specifier2))
m@24 214
m@24 215 (defgeneric inter-onset-interval (moment-designator1 moment-designator2)
m@24 216 (:method (md1 md2) (time- (moment md2) (moment md1))))
m@24 217
m@24 218
m@24 219 ;;; Time Signature
m@24 220
d@33 221 (defgeneric get-applicable-time-signatures (anchored-period composition)
d@33 222 (:method (ap c) (find-overlapping ap (time-signatures c))))
m@24 223
m@67 224 (defgeneric time-signature-equal (ts1 ts2))
m@67 225
m@24 226 ;;; Tempo
m@24 227
d@33 228 (defgeneric get-applicable-tempi (anchored-period composition)
d@33 229 (:method (ap c) (find-overlapping ap (tempi c))))
m@24 230
m@67 231 (defgeneric tempo-equal (t1 t2))
m@67 232
m@24 233 ;;; Tonality (Key Signature / Mode)
m@24 234
m@24 235 (defgeneric get-applicable-key-signatures (object1 object2))
m@24 236
m@67 237 (defgeneric key-signature-equal (ks1 ks2))
m@67 238
m@24 239 ;;; Dynamics
m@24 240 ;;; Voice
m@24 241 ;;; Boundary Strength (phrasing)
m@24 242