Mercurial > hg > amuse
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/generics.lisp Fri Dec 15 16:16:17 2006 +0000 @@ -0,0 +1,205 @@ +(cl:in-package #:amuse) + +;;; Pulling compositions from the database + +(defgeneric get-composition (identifier)) + +;;; Simple Accessors + +;; pitch-based + +(defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch + ; in its ur form? +(defgeneric chromatic-pitch (pitch-designator)) ; How simple are these +(defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed? +(defgeneric frequency (object)) ;? +(defgeneric midi-pitch-number (pitch-designator)) +(defgeneric meredith-chromatic-pitch-number (pitch-designator) + ;; David Meredith's PhD and ps13 code + (:method (p) (- (midi-pitch-number p) 21))) +(defgeneric pitch-class (pitch-designator) + (:method (p) (mod (midi-pitch-number p) 12))) +(defgeneric span (pitch-interval-designator)) + +;; time + +(defgeneric duration (period-designator)) +(defgeneric (setf duration) (value period-designator)) +(defgeneric timepoint (moment-designator)) +(defgeneric (setf timepoint) (value moment-designator)) +(defgeneric cut-off (anchored-period-designator) ; name? + (:method (apd) (time+ (moment apd) (floating-period apd)))) + +;; others + +;; I've given the time-sig accessors general names because it allows +;; for symbols in time-signatures as well as numbers - numerator is an +;; odd accessor if the time sig is C (even in common practice) but +;; it's meaning is clear. beat-units-per-bar is clearer, though, I +;; think. + +(defgeneric beat-units-per-bar (time-signature)) +(defgeneric time-signature-numerator (time-signature) + (:method (ts) (beat-units-per-bar ts))) +(defgeneric beat-units (time-signature)) +(defgeneric time-signature-denominator (time-signature) + (:method (ts) (beat-units ts))) + +(defgeneric key-signature-sharps (key-signature)) + +(defgeneric bpm (tempo)) ;; in bpm +(defgeneric microseconds-per-crotchet (tempo) + ;; As used (when rounded) in MIDI + (:method (tp) (/ 60000000 (bpm tp)))) + +;;; Coerce-type accessors + +;; Should I be including these default methods? Should the accessors +;; be direct slot accessors or the generics I'm using? Should we +;; return the object itself if it already is in the target class? + +(defgeneric anchored-period (anchored-period-designator) + (:method (apd) (make-anchored-period (onset apd) (duration apd)))) + +(defgeneric floating-period (period-designator) + (:method (pd) (make-floating-period (duration pd)))) + +(defgeneric moment (moment-designator) + (:method (md) (make-moment (timepoint md)))) + +(defgeneric onset (anchored-period-designator) + (:method (apd) (moment apd))) +(defgeneric (setf onset) (value anchored-period-designator)) + +;;; Time Protocol (or moments?) + +;; negative times/durations -> ERROR? + +;; time+: <time> <duration> -> <time> +;; <duration> <time> -> <time> (same as previous?) +;; <duration> <duration> -> <duration> (or a distinct duration+?) +;; <time> <time> -> ERROR? +;; +;; time-: <time> <time> -> <duration> +;; <time> <duration> -> <time> +;; <duration> <duration> -> <duration> (or a distinct duration-?) +;; <duration> <time> -> ERROR? +;; <anchored> <anchored> -> (time- (moment o1) (moment o2)) ? or error? + +(defgeneric time+ (object1 object2)) +(defgeneric time- (object1 object2)) + +(defgeneric time> (object1 object2)) +(defgeneric time< (object1 object2) + (:method (o1 o2) (time> o2 o1))) +(defgeneric time= (object1 object2)) +(defgeneric time>= (object1 object2) + (:method (o1 o2) (or (time> o1 o2) (time= o1 o2)))) +(defgeneric time<= (object1 object2) + (:method (o1 o2) (or (time< o1 o2) (time= o1 o2)))) +(defgeneric time/= (object1 object2) + (:method (o1 o2) (not (time= o1 o2)))) + +;;; Duration protocol + +(defgeneric duration> (object1 object2)) +(defgeneric duration< (object1 object2) + (:method (o1 o2) (duration> o2 o1))) +(defgeneric duration= (object1 object2)) +(defgeneric duration>= (object1 object2) + (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2)))) +(defgeneric duration<= (object1 object2) + (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2)))) +(defgeneric duration/= (object1 object2) + (:method (o1 o2) (not (duration= o1 o2)))) + +;; for linear scaling: +(defgeneric duration* (object1 object2)) +(defgeneric duration/ (object1 number)) + +;;; Pitch protocol + +;; pitch+: <pitch> <pitch> -> ERROR +;; <pitch> <interval> -> <pitch> +;; <interval> <pitch> -> <pitch> (same as previous?) +;; <interval> <interval> -> <interval> (or a distinct interval+?) +;; +;; pitch-: <pitch> <pitch> -> <interval> +;; <pitch> <interval> -> <pitch> +;; <interval> <interval> -> <interval> +;; <interval> <pitch> -> ERROR + +(defgeneric pitch+ (object1 object2)) +(defgeneric pitch- (object1 object2)) + +(defgeneric pitch> (object1 object2)) +(defgeneric pitch< (object1 object2) + (:method (o1 o2) (pitch> o2 o1))) +(defgeneric pitch= (object1 object2)) +(defgeneric pitch>= (object1 object2) + (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2)))) +(defgeneric pitch<= (object1 object2) + (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2)))) +(defgeneric pitch/= (object1 object2) + (:method (o1 o2) (not (pitch= o1 o2)))) + +;;; Interval protocol (emphasise _pitch_ not _time_ interval?) + +(defgeneric interval> (object1 object2)) +(defgeneric interval< (object1 object2) + (:method (o1 o2) (interval> o2 o1))) +(defgeneric interval= (object1 object2)) +(defgeneric interval>= (object1 object2) + (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2)))) +(defgeneric interval<= (object1 object2) + (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2)))) +(defgeneric interval/= (object1 object2) + (:method (o1 o2) (not (interval= o1 o2)))) + +;;; Allen's (1984) interval relations +;;; . equals already defined as INTERVAL= above +;;; . inverses ommitted for now (just use CL:NOT) +;;; . can all be defined in terms of MEETS (apparently) + +(defgeneric meets (object1 object2)) +(defgeneric before (object1 object2)) +(defgeneric overlaps (object1 object2)) +(defgeneric during (object1 object2)) +(defgeneric starts (object1 object2)) +(defgeneric ends (object1 object2)) + +;;; and extensions thereof ... + +(defgeneric subinterval (object1 object2) + (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2)))) + +(defgeneric disjoint (object1 object2) + (:method (o1 o2) + (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1)))) + +;;; More time-based functions +;; Return the anchored-period representing the intersection of two +;; anchored-period-specifiers. +(defgeneric period-intersection (anchored-period-specifier1 + anchored-period-specifier2)) + +(defgeneric inter-onset-interval (moment-designator1 moment-designator2) + (:method (md1 md2) (time- (moment md2) (moment md1)))) + + +;;; Time Signature + +(defgeneric get-applicable-time-signatures (object1 object2)) + +;;; Tempo + +(defgeneric get-applicable-tempi (object1 object2)) + +;;; Tonality (Key Signature / Mode) + +(defgeneric get-applicable-key-signatures (object1 object2)) + +;;; Dynamics +;;; Voice +;;; Boundary Strength (phrasing) +