comparison base/generics.lisp @ 24:8d2b1662f658

base/*.lisp: move files in amuse-base to subdirectory. darcs-hash:20061215161617-aa3d6-1b63bd555b02ec02aa2db12d335e8b726e2108cd.gz
author m.pearce <m.pearce@gold.ac.uk>
date Fri, 15 Dec 2006 16:16:17 +0000
parents
children d1010755f507
comparison
equal deleted inserted replaced
23:e2e19baba730 24:8d2b1662f658
1 (cl:in-package #:amuse)
2
3 ;;; Pulling compositions from the database
4
5 (defgeneric get-composition (identifier))
6
7 ;;; Simple Accessors
8
9 ;; pitch-based
10
11 (defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch
12 ; in its ur form?
13 (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these
14 (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed?
15 (defgeneric frequency (object)) ;?
16 (defgeneric midi-pitch-number (pitch-designator))
17 (defgeneric meredith-chromatic-pitch-number (pitch-designator)
18 ;; David Meredith's PhD and ps13 code
19 (:method (p) (- (midi-pitch-number p) 21)))
20 (defgeneric pitch-class (pitch-designator)
21 (:method (p) (mod (midi-pitch-number p) 12)))
22 (defgeneric span (pitch-interval-designator))
23
24 ;; time
25
26 (defgeneric duration (period-designator))
27 (defgeneric (setf duration) (value period-designator))
28 (defgeneric timepoint (moment-designator))
29 (defgeneric (setf timepoint) (value moment-designator))
30 (defgeneric cut-off (anchored-period-designator) ; name?
31 (:method (apd) (time+ (moment apd) (floating-period apd))))
32
33 ;; others
34
35 ;; I've given the time-sig accessors general names because it allows
36 ;; for symbols in time-signatures as well as numbers - numerator is an
37 ;; odd accessor if the time sig is C (even in common practice) but
38 ;; it's meaning is clear. beat-units-per-bar is clearer, though, I
39 ;; think.
40
41 (defgeneric beat-units-per-bar (time-signature))
42 (defgeneric time-signature-numerator (time-signature)
43 (:method (ts) (beat-units-per-bar ts)))
44 (defgeneric beat-units (time-signature))
45 (defgeneric time-signature-denominator (time-signature)
46 (:method (ts) (beat-units ts)))
47
48 (defgeneric key-signature-sharps (key-signature))
49
50 (defgeneric bpm (tempo)) ;; in bpm
51 (defgeneric microseconds-per-crotchet (tempo)
52 ;; As used (when rounded) in MIDI
53 (:method (tp) (/ 60000000 (bpm tp))))
54
55 ;;; Coerce-type accessors
56
57 ;; Should I be including these default methods? Should the accessors
58 ;; be direct slot accessors or the generics I'm using? Should we
59 ;; return the object itself if it already is in the target class?
60
61 (defgeneric anchored-period (anchored-period-designator)
62 (:method (apd) (make-anchored-period (onset apd) (duration apd))))
63
64 (defgeneric floating-period (period-designator)
65 (:method (pd) (make-floating-period (duration pd))))
66
67 (defgeneric moment (moment-designator)
68 (:method (md) (make-moment (timepoint md))))
69
70 (defgeneric onset (anchored-period-designator)
71 (:method (apd) (moment apd)))
72 (defgeneric (setf onset) (value anchored-period-designator))
73
74 ;;; Time Protocol (or moments?)
75
76 ;; negative times/durations -> ERROR?
77
78 ;; time+: <time> <duration> -> <time>
79 ;; <duration> <time> -> <time> (same as previous?)
80 ;; <duration> <duration> -> <duration> (or a distinct duration+?)
81 ;; <time> <time> -> ERROR?
82 ;;
83 ;; time-: <time> <time> -> <duration>
84 ;; <time> <duration> -> <time>
85 ;; <duration> <duration> -> <duration> (or a distinct duration-?)
86 ;; <duration> <time> -> ERROR?
87 ;; <anchored> <anchored> -> (time- (moment o1) (moment o2)) ? or error?
88
89 (defgeneric time+ (object1 object2))
90 (defgeneric time- (object1 object2))
91
92 (defgeneric time> (object1 object2))
93 (defgeneric time< (object1 object2)
94 (:method (o1 o2) (time> o2 o1)))
95 (defgeneric time= (object1 object2))
96 (defgeneric time>= (object1 object2)
97 (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
98 (defgeneric time<= (object1 object2)
99 (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
100 (defgeneric time/= (object1 object2)
101 (:method (o1 o2) (not (time= o1 o2))))
102
103 ;;; Duration protocol
104
105 (defgeneric duration> (object1 object2))
106 (defgeneric duration< (object1 object2)
107 (:method (o1 o2) (duration> o2 o1)))
108 (defgeneric duration= (object1 object2))
109 (defgeneric duration>= (object1 object2)
110 (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2))))
111 (defgeneric duration<= (object1 object2)
112 (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2))))
113 (defgeneric duration/= (object1 object2)
114 (:method (o1 o2) (not (duration= o1 o2))))
115
116 ;; for linear scaling:
117 (defgeneric duration* (object1 object2))
118 (defgeneric duration/ (object1 number))
119
120 ;;; Pitch protocol
121
122 ;; pitch+: <pitch> <pitch> -> ERROR
123 ;; <pitch> <interval> -> <pitch>
124 ;; <interval> <pitch> -> <pitch> (same as previous?)
125 ;; <interval> <interval> -> <interval> (or a distinct interval+?)
126 ;;
127 ;; pitch-: <pitch> <pitch> -> <interval>
128 ;; <pitch> <interval> -> <pitch>
129 ;; <interval> <interval> -> <interval>
130 ;; <interval> <pitch> -> ERROR
131
132 (defgeneric pitch+ (object1 object2))
133 (defgeneric pitch- (object1 object2))
134
135 (defgeneric pitch> (object1 object2))
136 (defgeneric pitch< (object1 object2)
137 (:method (o1 o2) (pitch> o2 o1)))
138 (defgeneric pitch= (object1 object2))
139 (defgeneric pitch>= (object1 object2)
140 (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2))))
141 (defgeneric pitch<= (object1 object2)
142 (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2))))
143 (defgeneric pitch/= (object1 object2)
144 (:method (o1 o2) (not (pitch= o1 o2))))
145
146 ;;; Interval protocol (emphasise _pitch_ not _time_ interval?)
147
148 (defgeneric interval> (object1 object2))
149 (defgeneric interval< (object1 object2)
150 (:method (o1 o2) (interval> o2 o1)))
151 (defgeneric interval= (object1 object2))
152 (defgeneric interval>= (object1 object2)
153 (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2))))
154 (defgeneric interval<= (object1 object2)
155 (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2))))
156 (defgeneric interval/= (object1 object2)
157 (:method (o1 o2) (not (interval= o1 o2))))
158
159 ;;; Allen's (1984) interval relations
160 ;;; . equals already defined as INTERVAL= above
161 ;;; . inverses ommitted for now (just use CL:NOT)
162 ;;; . can all be defined in terms of MEETS (apparently)
163
164 (defgeneric meets (object1 object2))
165 (defgeneric before (object1 object2))
166 (defgeneric overlaps (object1 object2))
167 (defgeneric during (object1 object2))
168 (defgeneric starts (object1 object2))
169 (defgeneric ends (object1 object2))
170
171 ;;; and extensions thereof ...
172
173 (defgeneric subinterval (object1 object2)
174 (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2))))
175
176 (defgeneric disjoint (object1 object2)
177 (:method (o1 o2)
178 (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1))))
179
180 ;;; More time-based functions
181 ;; Return the anchored-period representing the intersection of two
182 ;; anchored-period-specifiers.
183 (defgeneric period-intersection (anchored-period-specifier1
184 anchored-period-specifier2))
185
186 (defgeneric inter-onset-interval (moment-designator1 moment-designator2)
187 (:method (md1 md2) (time- (moment md2) (moment md1))))
188
189
190 ;;; Time Signature
191
192 (defgeneric get-applicable-time-signatures (object1 object2))
193
194 ;;; Tempo
195
196 (defgeneric get-applicable-tempi (object1 object2))
197
198 ;;; Tonality (Key Signature / Mode)
199
200 (defgeneric get-applicable-key-signatures (object1 object2))
201
202 ;;; Dynamics
203 ;;; Voice
204 ;;; Boundary Strength (phrasing)
205