changeset 17:930e9880ed3f

Pitch methods and added constructors.lisp file

darcs-hash:20061212144422-f76cc-194cd746d5d7eaf40f24ca5788093b25066de77c.gz

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/constructors.lisp	Tue Dec 12 14:44:22 2006 +0000
@@ -0,0 +1,32 @@
+(cl:in-package #:amuse)
+
+;; Time classes
+
+(defun make-moment (time)
+  (make-instance 'moment :time time))
+
+;; N.B. period should never be constructed directly - it's either
+;; floating or anchored or some other subclass.
+
+(defun make-floating-period (interval)
+  (make-instance 'floating-period :interval interval))
+
+(defun make-anchored-period (onset interval)
+  (make-instance 'anchored-period
+		 :time onset
+		 :interval interval))
+
+;; Pitch classes (no, not that sort of pitch class)
+
+(defun make-chromatic-pitch (pitch-number)
+  (make-instance 'chromatic-pitch :number pitch-number))
+
+(defun make-diatonic-pitch (name accidental octave)
+  (make-instance 'diatonic-pitch
+		 :name name
+		 :accidental accidental
+		 :octave octave))
+
+(defun make-pitch-interval (span)
+  (make-instance 'pitch-interval :span span))
+

--- a/generics.lisp	Tue Dec 12 12:34:52 2006 +0000
+++ b/generics.lisp	Tue Dec 12 14:44:22 2006 +0000
@@ -11,6 +11,7 @@
 (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these
 (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed?
 (defgeneric frequency (object)) ;?
+(defgeneric span (pitch-interval-designator))
 
 (defgeneric duration (period-designator))
 (defgeneric (setf duration) (value period-designator))
@@ -84,15 +85,15 @@
 
 ;;; Pitch protocol 
 
-;; pitch+: <pitch>    <pitch>     -> <pitch> 
+;; 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> (or a distinct interval-? 
-;;         <interval> <pitch>     -> ERROR? 
+;;         <interval> <interval>  -> <interval>
+;;         <interval> <pitch>     -> ERROR 
 
 (defgeneric pitch+ (object1 object2))
 (defgeneric pitch- (object1 object2))

--- a/methods.lisp	Tue Dec 12 12:34:52 2006 +0000
+++ b/methods.lisp	Tue Dec 12 14:44:22 2006 +0000
@@ -6,6 +6,9 @@
 (defmethod timepoint ((moment-designator moment))
   (%moment-time moment-designator))
 
+(defmethod span ((pitch-interval-designator pitch-interval))
+  (%pitch-interval-span pitch-interval-designator))
+
 ;; Time protocol
 
 (defmethod time+ ((object1 moment) (object2 period))
@@ -19,7 +22,7 @@
 			   (duration object2))))
 
 (defmethod time+ ((object1 moment) (object2 moment))
-  (error 'undefined-action :operation 'time+ :datatype (list 'moment 'moment)))
+  (error 'undefined-action :operation 'time+ :datatype (list (class-of object1) (class-of object2))))
 
 (defmethod time- ((object1 moment) (object2 moment))
   (make-anchored-period object1
@@ -32,7 +35,7 @@
 (defmethod time- ((object1 period) (object2 moment)) ;?
   (error 'undefined-action
 	 :operation 'time-
-	 :datatype (list 'period 'moment)))
+	 :datatype (list (class-of object1) (class-of object2))))
 
 (defmethod time- ((object1 period) (object2 period))
   (make-floating-period (- (duration object2)
@@ -62,7 +65,67 @@
 
 ;; Pitch protocol
 
-; How do we do this?
+(defmethod pitch+ ((object1 pitch-designator)
+		   (object2 pitch-designator))
+  (error 'undefined-action :operation 'pitch+
+	 :datatype (list (class-of object1) (class-of object2))))
+
+(defmethod pitch+ ((object1 pitch-designator)
+		   (object2 pitch-interval)) ; or should I check the
+					     ; pitch/interval types?
+  (make-chromatic-pitch (+ (chromatic-pitch object1)
+			   (span object2))))
+
+(defmethod pitch+  ((object1 pitch-interval)
+		    (object2 pitch-designator)) ;?
+  (pitch+ object2 object1))
+
+(defmethod pitch+ ((object1 pitch-interval)
+		   (object2 pitch-interval))
+  (make-pitch-interval (+ (span object1)
+			  (span object2))))
+
+(defmethod pitch- ((object1 pitch-designator)
+		   (object2 pitch-designator))
+  (make-pitch-interval (- (chromatic-pitch object1)
+			  (chromatic-pitch object2))))
+
+(defmethod pitch- ((object1 pitch-designator)
+		   (object2 pitch-interval))
+  (make-chromatic-pitch (- (chromatic-pitch object1)
+			   (span object2))))
+
+(defmethod pitch- ((object1 pitch-interval)
+		   (object2 pitch-interval))
+  (make-pitch-interval (- (span object1)
+			  (span object2))))
+
+(defmethod pitch- ((object1 pitch-interval)
+		   (object2 pitch-designator))
+  (error 'undefined-action :operation 'pitch-
+	 :datatype (list (class-of object1) (class-of object2))))
+
+(defmethod pitch> ((object1 pitch-designator)
+		   (object2 pitch-designator))
+  (> (chromatic-pitch object1)
+     (chromatic-pitch object2)))
+
+(defmethod pitch= ((object1 pitch-designator)
+		   (object2 pitch-designator))
+  (= (chromatic-pitch object1)
+     (chromatic-pitch object2)))
+
+(defmethod interval> ((object1 pitch-interval)
+		   (object2 pitch-interval))
+  (> (span object1)
+     (span object2)))
+
+(defmethod interval= ((object1 pitch-interval)
+		   (object2 pitch-interval))
+  (= (span object1)
+     (span object2)))
+
+
 
 ;; Allen