# HG changeset patch
# User David Lewis <d.lewis@gold.ac.uk>
# Date 1166010049 0
# Node ID 70e76c1c87b7987441a921cc94a3135dbfbe20d1
# Parent  930e9880ed3f0eaf6d6daeee147deabe65cdf126
Bug fixes and exports in package.lisp

darcs-hash:20061213114049-f76cc-4c4175a1ad8b24e1c5df82c9fb67445ac32977d9.gz

diff -r 930e9880ed3f -r 70e76c1c87b7 classes.lisp
--- a/classes.lisp	Tue Dec 12 14:44:22 2006 +0000
+++ b/classes.lisp	Wed Dec 13 11:40:49 2006 +0000
@@ -44,4 +44,5 @@
 
 (defclass event (anchored-period) ())
 (defclass pitched-event (event pitch-designator) ())
+(defclass midi-pitched-event (pitched-event chromatic-pitch) ()) 
 (defclass percussive-event (event) ())
diff -r 930e9880ed3f -r 70e76c1c87b7 constructors.lisp
--- a/constructors.lisp	Tue Dec 12 14:44:22 2006 +0000
+++ b/constructors.lisp	Wed Dec 13 11:40:49 2006 +0000
@@ -30,3 +30,10 @@
 (defun make-pitch-interval (span)
   (make-instance 'pitch-interval :span span))
 
+;; Events
+
+(defun make-midi-pitched-event (pitch-number onset duration)
+  (make-instance 'midi-pitched-event
+		 :number pitch-number
+		 :time onset
+		 :interval duration))
\ No newline at end of file
diff -r 930e9880ed3f -r 70e76c1c87b7 generics.lisp
--- a/generics.lisp	Tue Dec 12 14:44:22 2006 +0000
+++ b/generics.lisp	Wed Dec 13 11:40:49 2006 +0000
@@ -11,6 +11,12 @@
 (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these
 (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed?
 (defgeneric frequency (object)) ;?
+(defgeneric chromatic-pitch-number (pitch-designator))
+(defgeneric meredith-chromatic-pitch-number (pitch-designator)
+  ;; David Meredith's PhD and ps13 code
+  (:method (p) (- (midi-chromatic-pitch-number p) 21)))
+(defgeneric pitch-class (pitch-designator)
+  (:method (p) (mod (chromatic-pitch-number p) 12)))
 (defgeneric span (pitch-interval-designator))
 
 (defgeneric duration (period-designator))
@@ -21,7 +27,7 @@
   (:method (apd) (timepoint apd)))
 (defgeneric (setf onset) (value anchored-period-designator))
 (defgeneric cut-off (anchored-period-designator) ; name?
-  (:method (apd) (time+ (onset apd) (duration apd))))
+  (:method (apd) (time+ (moment apd) (floating-period apd))))
 
 ;;; Coerce-type accessors
 
@@ -51,6 +57,7 @@
 ;;        <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))
@@ -143,13 +150,14 @@
   (:method (o1 o2) 
     (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1))))
 
-;; Another time-based function, returning the anchored-period
-;; representing the intersection of two
+;;; 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 
diff -r 930e9880ed3f -r 70e76c1c87b7 methods.lisp
--- a/methods.lisp	Tue Dec 12 14:44:22 2006 +0000
+++ b/methods.lisp	Wed Dec 13 11:40:49 2006 +0000
@@ -9,6 +9,15 @@
 (defmethod span ((pitch-interval-designator pitch-interval))
   (%pitch-interval-span pitch-interval-designator))
 
+(defmethod chromatic-pitch ((pitch-designator chromatic-pitch))
+  pitch-designator)
+
+(defmethod chromatic-pitch-number ((pitch-designator chromatic-pitch))
+  (%chromatic-pitch-number pitch-designator))
+
+(defmethod chromatic-pitch-number ((pitch-designator pitch))
+  (%chromatic-pitch-number (chromatic-pitch pitch-designator)))
+
 ;; Time protocol
 
 (defmethod time+ ((object1 moment) (object2 period))
@@ -25,9 +34,9 @@
   (error 'undefined-action :operation 'time+ :datatype (list (class-of object1) (class-of object2))))
 
 (defmethod time- ((object1 moment) (object2 moment))
-  (make-anchored-period object1
-			(- (duration object2)
-			   (duration object1))))
+  (make-anchored-period (timepoint object2)
+			(- (timepoint object1)
+			   (timepoint object2))))
 
 (defmethod time- ((object1 moment) (object2 period))
   (make-moment (- (timepoint object1) (duration object2))))
@@ -41,6 +50,19 @@
   (make-floating-period (- (duration object2)
 			   (duration object1))))
 
+;; these ones are less certain. I've just put them in, but think I
+;; should remove them and force the user to specify what they mean
+;; when they give objects that are both moments *and* periods to these
+;; functions.
+
+(defmethod time- ((object1 anchored-period) (object2 anchored-period)) ;? 
+  (time- (moment object1) (moment object2)))
+
+(defmethod time- (object1 (object2 anchored-period)) ;?
+  (time- object1 (moment object2)))
+
+(defmethod time- ((object1 anchored-period) object2) ;?
+  (time- (moment object1) object2))
 
 (defmethod time> ((object1 moment) (object2 moment))
   (> (timepoint object1) (timepoint object2)))
@@ -55,13 +77,13 @@
   (= (duration object1) (duration object2)))
 
 (defmethod duration* ((object1 period) (object2 number))
-  (* (duration object1) object2))
+  (make-floating-period (* (duration object1) object2)))
 
 (defmethod duration* ((object1 number) (object2 period))
   (duration* object2 object1))
 
 (defmethod duration/ ((object1 period) (object2 number))
-  (/ (duration object1) object2))
+  (make-floating-period (/ (duration object1) object2)))
 
 ;; Pitch protocol
 
diff -r 930e9880ed3f -r 70e76c1c87b7 package.lisp
--- a/package.lisp	Tue Dec 12 14:44:22 2006 +0000
+++ b/package.lisp	Wed Dec 13 11:40:49 2006 +0000
@@ -1,5 +1,83 @@
 (cl:defpackage #:amuse
   (:use #:common-lisp)
-  (:export))
-
-
+  (:export #:constituent
+	   #:composition
+	   #:monody
+	   #:moment-designator
+	   #:period-designator
+	   #:anchored-period-designator
+	   #:pitch-designator
+	   #:pitch-interval-designator
+	   #:moment
+	   #:period
+	   #:floating-period
+	   #:anchored-period
+	   #:frequency
+	   #:pitch
+	   #:chromatic-pitch 
+	   #:diatonic-pitch   
+	   #:pitch-interval
+	   #:pitched-event
+	   #:midi-pitched-event
+	   #:percussive-event
+	   #:get-composition
+	   #:chromatic-pitch
+	   #:diatonic-pitch
+	   #:chromatic-pitch-number
+	   #:meredith-chromatic-pitch-number
+	   #:pitch-class
+	   #:span
+	   #:duration
+	   #:timepoint
+	   #:onset
+	   #:cut-off
+	   #:anchored-period
+	   #:floating-period
+	   #:moment
+	   #:time+
+	   #:time-
+	   #:time>
+	   #:time<
+	   #:time=
+	   #:time>=
+	   #:time<=
+	   #:time/=
+	   #:duration>
+	   #:duration<
+	   #:duration=
+	   #:duration>=
+	   #:duration<=
+	   #:duration/=
+	   #:duration*
+	   #:duration/
+	   #:pitch+
+	   #:pitch-
+	   #:pitch>
+	   #:pitch<
+	   #:pitch=
+	   #:pitch>=
+	   #:pitch<=
+	   #:pitch/=
+	   #:interval>
+	   #:interval<
+	   #:interval=
+	   #:interval>=
+	   #:interval<=
+	   #:interval/=
+	   #:meets
+	   #:before
+	   #:overlaps
+	   #:during
+	   #:starts
+	   #:ends
+	   #:subinterval
+	   #:disjoint
+	   #:period-intersection
+	   #:inter-onset-interval
+	   #:make-moment
+	   #:make-floating-period
+	   #:make-anchored-period
+	   #:make-chromatic-pitch
+	   #:make-diatonic-pitch
+	   #:make-pitch-interval
+	   #:make-midi-pitched-event))
\ No newline at end of file