annotate base/generics.lisp @ 81:4e1538df0d10

base/: add an implementation of diatonic pitch.

darcs-hash:20070717120206-c0ce4-b18278ab07116658e58839c4fd18972508da6658.gz

(cl:in-package #:amuse) 

;;; Pulling compositions from the database 

(defgeneric get-composition (identifier))

;;; Getting constituents from compositions
;; IS this the mechanism we want to use
(defgeneric time-signatures (composition)
  (:documentation "Returns all time-signatures in a composition
  Probably shouldn't be exported - can be replaced
  by (get-applicable-time-signature commposition composition)"))
(defgeneric (setf time-signatures) (sequence composition)
  (:documentation "Sets all time-signatures in a composition.
  Is this wanted here?"))
(defgeneric tempi (composition)
  (:documentation "Returns all tempi in a composition Probably
  shouldn't be exported - can be replaced
  by (get-applicable-tempi commposition composition)"))
(defgeneric (setf tempi) (sequence composition)
  (:documentation "Sets all tempi in a composition.
  Is this wanted here?"))
(defgeneric key-signatures (composition)
  (:documentation "Returns all key-signatures in a composition
  Probably shouldn't be exported - can be replaced
  by (get-applicable-key-signature commposition composition)"))
(defgeneric (setf key-signatures) (sequence composition)
  (:documentation "Sets all key sigs in a composition.
  Is this wanted here?"))

;;; 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 mips-pitch (pitch-designator))
(defgeneric frequency (object)) ;?

(defgeneric middle-c (pitch-designator) 
  (:documentation "Returns the value of middle C in the particular
representation of pitch used by PITCH-DESIGNATOR."))
(defgeneric midi-pitch-number (pitch-designator)
  (:documentation "Takes a pitch-designator (usually a pitched
  event) and returns an integer between 0 and 127 representing
  the chromatic pitch designated (60=middle C, 48 the C below
  that, etc.)"))
(defgeneric meredith-chromatic-pitch-number (pitch-designator)
  (:documentation "Takes a pitch-designator (usually a pitched
  event) and returns an integer representing the chromatic pitch
  designated (39=middle C, 27 the C below that, etc.)")
  ;; David Meredith's PhD and ps13 code. FIXME: What is the legal
  ;; range of this?
  (:method (p) (- (midi-pitch-number p) 21)))
(defgeneric meredith-morphetic-pitch-number (pitch-designator)
  (:documentation "Returns an integer representing the morphetic pitch
(7 per octave, An0 = 0, An1 = 7, middle c = 23) designated."))
(defgeneric asa-pitch-string (pitch-designator)
  (:documentation "Returns a string representing the designated ASA
pitch name which has three parts: a letter name in the set
{A,B,C,D,E,F,G}, an inflection in the set {n,f,s,ff,ss,fff,sss,...}
and an octave number. E.g., Cn4 = Middle C."))
(defgeneric diatonic-pitch-name (pitch-designator)
  (:documentation "Returns a char in the set
{#\A,#\B,#\C,#\D,#\E,#\F,#\G}, representing the pitch name of
PITCH-DESIGNATOR."))
(defgeneric pitch-class (pitch-designator)
  (:documentation "Takes a pitch-designator (usually a pitched
  event) and returns an integer between 0 and 12 representing
  the octave-independant pitch, with c=0, c#=1, etc.")
  (: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?
  (:documentation "Returns a <moment> representing the point at
  which the anchored period has ended.")
  (: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 tactus-duration (time-signature)
  ;; basic, but should do?
  (:method (ts)
    (cond
      ((and (not (= (beat-units-per-bar ts) 3))
	    (= (rem (beat-units-per-bar ts) 3) 0))
       ;; compound time
       (* (/ 4 (beat-units ts))
	  3))
      (t (/ 4 (beat-units ts))))))

(defgeneric key-signature-sharps (key-signature))
(defgeneric key-signature-mode (ks))

(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

(defgeneric period= (object1 object2)
  (:method (x y) nil))

(defgeneric find-overlapping (anchored-period sequence)
  ;; Returns all members of a sequence of period signifiers that overlap
  ;; with the supplied period
  (:method (ap s) (remove-if #'(lambda (x) (amuse:disjoint ap x)) s)))

;; 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 (anchored-period composition)
  (:method (ap c) (find-overlapping ap (time-signatures c))))

(defgeneric time-signature-equal (ts1 ts2))

;;; Tempo 

(defgeneric get-applicable-tempi  (anchored-period composition)
  (:method (ap c) (find-overlapping ap (tempi c))))

(defgeneric tempo-equal (t1 t2))

;;; Tonality (Key Signature / Mode) 

(defgeneric get-applicable-key-signatures (object1 object2))

(defgeneric key-signature-equal (ks1 ks2))

;;; Dynamics 
;;; Voice 
;;; Boundary Strength (phrasing)