annotate base/generics.lisp @ 108:b445959f4cc1

MIPS generic functions and methods for diatonic pitches Define and implement DIATONIC-PITCH-MP and DIATONIC-PITCH-CP for mips-pitches (soon to be diatonic-pitches). Supersedes MEREDITH-FOO darcs-hash:20070726131018-dc3a5-3421fb2c4beceae2370932768fefa1115050cfdd.gz
author c.rhodes <c.rhodes@gold.ac.uk>
date Thu, 26 Jul 2007 14:10:18 +0100
parents 8528c316fbcc
children 034ef8412ddb
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
m@89 7 (defgeneric monody (object)
m@89 8 (:documentation "Returns a monody."))
m@89 9 (defgeneric ensure-monody (object)
m@89 10 (:documentation "Returns a generalised boolean."))
m@89 11
d@33 12 ;;; Getting constituents from compositions
d@33 13 ;; IS this the mechanism we want to use
d@72 14 (defgeneric time-signatures (composition)
d@72 15 (:documentation "Returns all time-signatures in a composition
d@72 16 Probably shouldn't be exported - can be replaced
d@72 17 by (get-applicable-time-signature commposition composition)"))
d@72 18 (defgeneric (setf time-signatures) (sequence composition)
d@72 19 (:documentation "Sets all time-signatures in a composition.
d@72 20 Is this wanted here?"))
d@72 21 (defgeneric tempi (composition)
d@72 22 (:documentation "Returns all tempi in a composition Probably
d@72 23 shouldn't be exported - can be replaced
d@72 24 by (get-applicable-tempi commposition composition)"))
d@72 25 (defgeneric (setf tempi) (sequence composition)
d@72 26 (:documentation "Sets all tempi in a composition.
d@72 27 Is this wanted here?"))
d@72 28 (defgeneric key-signatures (composition)
d@72 29 (:documentation "Returns all key-signatures in a composition
d@72 30 Probably shouldn't be exported - can be replaced
d@72 31 by (get-applicable-key-signature commposition composition)"))
d@72 32 (defgeneric (setf key-signatures) (sequence composition)
d@72 33 (:documentation "Sets all key sigs in a composition.
d@72 34 Is this wanted here?"))
d@33 35
m@24 36 ;;; Simple Accessors
m@24 37
m@24 38 ;; pitch-based
m@24 39
m@24 40 (defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch
m@24 41 ; in its ur form?
c@106 42 (defgeneric chromatic-pitch (pitch-designator))
c@106 43 (defgeneric diatonic-pitch (pitch-designator))
m@24 44 (defgeneric frequency (object)) ;?
m@81 45
m@86 46 (defgeneric octave (pitch-designator)
m@86 47 (:documentation "Return an integer representing the octave of
m@86 48 pitch-designator where middle c is defined to be the lowest pitch in
m@86 49 octave 4."))
m@86 50
c@106 51 (defgeneric diatonic-pitch-octave (pitch-designator)
c@106 52 (:documentation "Return an integer representing the diatonic octave
c@106 53 of PITCH-DESIGNATOR."))
c@106 54
m@86 55 (defgeneric diatonic-pitch-accidental (pitch-designator)
m@86 56 (:documentation "Return an integer representing the inflection of a
m@86 57 diatonic pitch where where negative values indicate numbers of flats,
m@86 58 0 indicates natural and positive values indicate numbers of sharps."))
m@86 59
c@108 60 (defgeneric diatonic-pitch-mp (pitch-designator)
c@108 61 (:documentation "Return an integer representing the morphetic pitch
c@108 62 \(in MIPS terms) of a diatonic pitch."))
c@108 63 (defgeneric diatonic-pitch-cp (pitch-designator)
c@108 64 (:documentation "Return an integer representing the chromatic pitch
c@108 65 \(in MIPS terms) of a diatonic pitch."))
c@108 66
m@81 67 (defgeneric middle-c (pitch-designator)
m@81 68 (:documentation "Returns the value of middle C in the particular
m@81 69 representation of pitch used by PITCH-DESIGNATOR."))
d@72 70 (defgeneric midi-pitch-number (pitch-designator)
d@72 71 (:documentation "Takes a pitch-designator (usually a pitched
d@72 72 event) and returns an integer between 0 and 127 representing
d@72 73 the chromatic pitch designated (60=middle C, 48 the C below
d@72 74 that, etc.)"))
m@81 75 (defgeneric asa-pitch-string (pitch-designator)
m@81 76 (:documentation "Returns a string representing the designated ASA
m@81 77 pitch name which has three parts: a letter name in the set
m@81 78 {A,B,C,D,E,F,G}, an inflection in the set {n,f,s,ff,ss,fff,sss,...}
m@81 79 and an octave number. E.g., Cn4 = Middle C."))
m@81 80 (defgeneric diatonic-pitch-name (pitch-designator)
m@81 81 (:documentation "Returns a char in the set
m@81 82 {#\A,#\B,#\C,#\D,#\E,#\F,#\G}, representing the pitch name of
m@81 83 PITCH-DESIGNATOR."))
m@24 84 (defgeneric pitch-class (pitch-designator)
d@72 85 (:documentation "Takes a pitch-designator (usually a pitched
d@72 86 event) and returns an integer between 0 and 12 representing
d@72 87 the octave-independant pitch, with c=0, c#=1, etc.")
m@24 88 (:method (p) (mod (midi-pitch-number p) 12)))
m@24 89 (defgeneric span (pitch-interval-designator))
m@24 90
m@24 91 ;; time
m@24 92
m@24 93 (defgeneric duration (period-designator))
m@24 94 (defgeneric (setf duration) (value period-designator))
m@24 95 (defgeneric timepoint (moment-designator))
m@24 96 (defgeneric (setf timepoint) (value moment-designator))
m@24 97 (defgeneric cut-off (anchored-period-designator) ; name?
d@72 98 (:documentation "Returns a <moment> representing the point at
d@72 99 which the anchored period has ended.")
m@24 100 (:method (apd) (time+ (moment apd) (floating-period apd))))
m@95 101 (defgeneric crotchet (object)
m@95 102 (:documentation "Returns a period, the duration of which represents
m@95 103 a crotchet in the time representation used by object."))
m@24 104
m@24 105 ;; others
m@24 106
m@24 107 ;; I've given the time-sig accessors general names because it allows
m@24 108 ;; for symbols in time-signatures as well as numbers - numerator is an
m@24 109 ;; odd accessor if the time sig is C (even in common practice) but
d@100 110 ;; its meaning is clear. beat-units-per-bar is clearer, though, I
m@24 111 ;; think.
m@24 112
m@24 113 (defgeneric beat-units-per-bar (time-signature))
m@24 114 (defgeneric time-signature-numerator (time-signature)
m@24 115 (:method (ts) (beat-units-per-bar ts)))
m@24 116 (defgeneric beat-units (time-signature))
m@24 117 (defgeneric time-signature-denominator (time-signature)
m@24 118 (:method (ts) (beat-units ts)))
d@33 119 (defgeneric tactus-duration (time-signature)
d@33 120 ;; basic, but should do?
d@33 121 (:method (ts)
d@33 122 (cond
d@33 123 ((and (not (= (beat-units-per-bar ts) 3))
d@33 124 (= (rem (beat-units-per-bar ts) 3) 0))
d@33 125 ;; compound time
d@33 126 (* (/ 4 (beat-units ts))
d@33 127 3))
d@33 128 (t (/ 4 (beat-units ts))))))
m@24 129
m@24 130 (defgeneric key-signature-sharps (key-signature))
m@45 131 (defgeneric key-signature-mode (ks))
m@24 132
m@24 133 (defgeneric bpm (tempo)) ;; in bpm
m@24 134 (defgeneric microseconds-per-crotchet (tempo)
m@24 135 ;; As used (when rounded) in MIDI
m@24 136 (:method (tp) (/ 60000000 (bpm tp))))
m@24 137
m@24 138 ;;; Coerce-type accessors
m@24 139
m@24 140 ;; Should I be including these default methods? Should the accessors
m@24 141 ;; be direct slot accessors or the generics I'm using? Should we
m@24 142 ;; return the object itself if it already is in the target class?
m@24 143
m@24 144 (defgeneric anchored-period (anchored-period-designator)
m@24 145 (:method (apd) (make-anchored-period (onset apd) (duration apd))))
m@24 146
m@24 147 (defgeneric floating-period (period-designator)
m@24 148 (:method (pd) (make-floating-period (duration pd))))
m@24 149
m@24 150 (defgeneric moment (moment-designator)
m@24 151 (:method (md) (make-moment (timepoint md))))
m@24 152
m@24 153 (defgeneric onset (anchored-period-designator)
m@24 154 (:method (apd) (moment apd)))
m@24 155 (defgeneric (setf onset) (value anchored-period-designator))
m@24 156
m@24 157 ;;; Time Protocol (or moments?)
m@24 158
m@24 159 ;; negative times/durations -> ERROR?
m@24 160
m@24 161 ;; time+: <time> <duration> -> <time>
m@24 162 ;; <duration> <time> -> <time> (same as previous?)
m@24 163 ;; <duration> <duration> -> <duration> (or a distinct duration+?)
m@24 164 ;; <time> <time> -> ERROR?
m@24 165 ;;
m@24 166 ;; time-: <time> <time> -> <duration>
m@24 167 ;; <time> <duration> -> <time>
m@24 168 ;; <duration> <duration> -> <duration> (or a distinct duration-?)
m@24 169 ;; <duration> <time> -> ERROR?
m@24 170 ;; <anchored> <anchored> -> (time- (moment o1) (moment o2)) ? or error?
m@24 171
d@102 172 (defgeneric time+ (object1 object2)
d@102 173 (:documentation "Addition for time designators"))
d@102 174 (defgeneric time- (object1 object2)
d@102 175 (:documentation "Subtraction for time designators"))
m@24 176
d@102 177 (defgeneric time> (object1 object2)
d@102 178 (:documentation "> operator for time designators"))
m@24 179 (defgeneric time< (object1 object2)
d@102 180 (:documentation "< operator for time designators")
m@24 181 (:method (o1 o2) (time> o2 o1)))
d@102 182 (defgeneric time= (object1 object2)
d@102 183 (:documentation "= operator for time designators"))
m@24 184 (defgeneric time>= (object1 object2)
d@102 185 (:documentation ">= operator for time designators")
m@24 186 (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
m@24 187 (defgeneric time<= (object1 object2)
d@102 188 (:documentation "<= operator for time designators")
m@24 189 (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
m@24 190 (defgeneric time/= (object1 object2)
d@102 191 (:documentation "not = operator for time designators")
m@24 192 (:method (o1 o2) (not (time= o1 o2))))
m@24 193
m@24 194 ;;; Duration protocol
m@24 195
m@24 196 (defgeneric duration> (object1 object2))
m@24 197 (defgeneric duration< (object1 object2)
m@24 198 (:method (o1 o2) (duration> o2 o1)))
m@24 199 (defgeneric duration= (object1 object2))
m@24 200 (defgeneric duration>= (object1 object2)
m@24 201 (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2))))
m@24 202 (defgeneric duration<= (object1 object2)
m@24 203 (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2))))
m@24 204 (defgeneric duration/= (object1 object2)
m@24 205 (:method (o1 o2) (not (duration= o1 o2))))
m@24 206
m@24 207 ;; for linear scaling:
m@24 208 (defgeneric duration* (object1 object2))
m@24 209 (defgeneric duration/ (object1 number))
m@24 210
m@24 211 ;;; Pitch protocol
m@24 212
m@24 213 ;; pitch+: <pitch> <pitch> -> ERROR
m@24 214 ;; <pitch> <interval> -> <pitch>
m@24 215 ;; <interval> <pitch> -> <pitch> (same as previous?)
m@24 216 ;; <interval> <interval> -> <interval> (or a distinct interval+?)
m@24 217 ;;
m@24 218 ;; pitch-: <pitch> <pitch> -> <interval>
m@24 219 ;; <pitch> <interval> -> <pitch>
m@24 220 ;; <interval> <interval> -> <interval>
m@24 221 ;; <interval> <pitch> -> ERROR
m@24 222
m@24 223 (defgeneric pitch+ (object1 object2))
m@24 224 (defgeneric pitch- (object1 object2))
m@24 225
m@24 226 (defgeneric pitch> (object1 object2))
m@24 227 (defgeneric pitch< (object1 object2)
m@24 228 (:method (o1 o2) (pitch> o2 o1)))
m@24 229 (defgeneric pitch= (object1 object2))
m@24 230 (defgeneric pitch>= (object1 object2)
m@24 231 (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2))))
m@24 232 (defgeneric pitch<= (object1 object2)
m@24 233 (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2))))
m@24 234 (defgeneric pitch/= (object1 object2)
m@24 235 (:method (o1 o2) (not (pitch= o1 o2))))
m@24 236
m@24 237 ;;; Interval protocol (emphasise _pitch_ not _time_ interval?)
m@24 238
m@24 239 (defgeneric interval> (object1 object2))
m@24 240 (defgeneric interval< (object1 object2)
m@24 241 (:method (o1 o2) (interval> o2 o1)))
m@24 242 (defgeneric interval= (object1 object2))
m@24 243 (defgeneric interval>= (object1 object2)
m@24 244 (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2))))
m@24 245 (defgeneric interval<= (object1 object2)
m@24 246 (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2))))
m@24 247 (defgeneric interval/= (object1 object2)
m@24 248 (:method (o1 o2) (not (interval= o1 o2))))
m@24 249
m@24 250 ;;; Allen's (1984) interval relations
m@24 251 ;;; . equals already defined as INTERVAL= above
m@24 252 ;;; . inverses ommitted for now (just use CL:NOT)
m@24 253 ;;; . can all be defined in terms of MEETS (apparently)
m@24 254
m@24 255 (defgeneric meets (object1 object2))
m@24 256 (defgeneric before (object1 object2))
m@24 257 (defgeneric overlaps (object1 object2))
m@24 258 (defgeneric during (object1 object2))
m@24 259 (defgeneric starts (object1 object2))
m@24 260 (defgeneric ends (object1 object2))
m@24 261
m@24 262 ;;; and extensions thereof ...
m@24 263
m@24 264 (defgeneric subinterval (object1 object2)
m@24 265 (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2))))
m@24 266
m@24 267 (defgeneric disjoint (object1 object2)
m@24 268 (:method (o1 o2)
m@24 269 (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1))))
m@24 270
m@24 271 ;;; More time-based functions
d@33 272
d@33 273 (defgeneric period= (object1 object2)
d@33 274 (:method (x y) nil))
d@33 275
d@33 276 (defgeneric find-overlapping (anchored-period sequence)
d@33 277 ;; Returns all members of a sequence of period signifiers that overlap
d@33 278 ;; with the supplied period
d@33 279 (:method (ap s) (remove-if #'(lambda (x) (amuse:disjoint ap x)) s)))
d@33 280
m@24 281 ;; Return the anchored-period representing the intersection of two
m@24 282 ;; anchored-period-specifiers.
m@24 283 (defgeneric period-intersection (anchored-period-specifier1
m@24 284 anchored-period-specifier2))
m@24 285
m@24 286 (defgeneric inter-onset-interval (moment-designator1 moment-designator2)
m@24 287 (:method (md1 md2) (time- (moment md2) (moment md1))))
m@24 288
m@24 289
m@24 290 ;;; Time Signature
m@24 291
d@33 292 (defgeneric get-applicable-time-signatures (anchored-period composition)
d@33 293 (:method (ap c) (find-overlapping ap (time-signatures c))))
m@24 294
m@67 295 (defgeneric time-signature-equal (ts1 ts2))
m@67 296
m@24 297 ;;; Tempo
m@24 298
d@33 299 (defgeneric get-applicable-tempi (anchored-period composition)
d@33 300 (:method (ap c) (find-overlapping ap (tempi c))))
m@24 301
m@67 302 (defgeneric tempo-equal (t1 t2))
m@67 303
m@24 304 ;;; Tonality (Key Signature / Mode)
m@24 305
m@24 306 (defgeneric get-applicable-key-signatures (object1 object2))
m@24 307
m@67 308 (defgeneric key-signature-equal (ks1 ks2))
m@67 309
m@24 310 ;;; Dynamics
m@24 311 ;;; Voice
m@81 312 ;;; Boundary Strength (phrasing)