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) 
+