changeset 1:cbb5b478307e

Initial import of classes.lisp and default-methods.lisp from David. darcs-hash:20061016144427-aa3d6-93919f5153445ade41eb753434da6f3c838c155a.gz
author m.pearce <m.pearce@gold.ac.uk>
date Mon, 16 Oct 2006 15:44:27 +0100
parents 92b28dfc3938
children 8fbbb0f14f3c
files classes.lisp default-methods.lisp
diffstat 2 files changed, 121 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/classes.lisp	Mon Oct 16 15:44:27 2006 +0100
@@ -0,0 +1,68 @@
+;; basic musical object classes
+
+(defclass composition ()
+  ())
+
+(defclass event ()
+  ())
+
+(defclass pitched-event (event)
+  ())
+
+;; pitch-related classes
+
+(defclass pitch ()
+  ())
+
+(defclass chromatic-pitch (pitch)
+  ())
+
+(defclass diatonic-pitch (pitch)
+  ())
+
+(defclass frequency (pitch)
+  ())
+
+(defclass interval ()
+  ())
+
+;; time-related classes
+
+(defclass moment ()
+  ())
+
+(defclass duration ()
+  ())
+
+;; Some conditions we might want to be able to signal
+
+(define-condition undefined-action (condition)
+  ;; This condition would apply to an attempt to perform a meaningless
+  ;; operation on an object. This may, initially, include things that
+  ;; are a pain to implement but should really be used when it's
+  ;; genuinely unclear what an operation means in the given
+  ;; context. In such cases, a condition handler might be the best
+  ;; approach anyway.
+  ((operation :initarg :operation
+	      :reader undefined-action-operation)
+   (datatype :initarg :datatype
+	     :reader undefined-action-datatype))
+  (:report (lambda (condition stream)
+	     (format stream "The consequence of performing ~A on and object of type ~A is undefined"
+		     (undefined-action-operation condition)
+		     (undefined-action-datatype condition)))
+
+(define-condition insufficient-information (condition)
+  ;; It should be possible to construct genuinely minimal musical
+  ;; structures. When the information in these is insufficient to
+  ;; answer a query, this condition should be raised.
+  ((operation :initarg :operation
+	      :reader insufficient-information-operation)
+   (datatype :initarg :datatype
+	     :reader insufficient-information-datatype))
+  (:report (lambda (condition stream)
+	     (format stream "The ~A object does not contain enough information to perform ~A"
+		     (insufficient-information-datatype condition)
+		     (insufficient-information-operation condition)))
+
+	   
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/default-methods.lisp	Mon Oct 16 15:44:27 2006 +0100
@@ -0,0 +1,53 @@
+;; Some methods that can be defined in terms of others:
+
+;; Time
+
+(defmethod time>= ((object1 moment) (object2 moment))
+  (or (time> object1 object2)
+      (time= object1 object2)))
+
+(defmethod time<= ((object1 moment) (object2 moment))
+  (or (time< object1 object2)
+      (time= object1 object2)))
+
+(defmethod time/= ((object1 moment) (object2 moment))
+  (not (time= object1 object2)))
+
+;; Duration
+
+(defmethod duration>= ((object1 duration) (object2 duration))
+  (or (duration> object1 object2)
+      (duration= object1 object2)))
+
+(defmethod duration<= ((object1 duration) (object2 duration))
+  (or (duration< object1 object2)
+      (duration= object1 object2)))
+
+(defmethod duration/= ((object1 duration) (object2 duration))
+  (not (duration= object1 object2)))
+
+;; Pitch
+
+(defmethod pitch>= ((object1 pitch) (object2 pitch))
+  (or (pitch> object1 object2)
+      (pitch= object1 object2)))
+
+(defmethod pitch<= ((object1 pitch) (object2 pitch))
+  (or (pitch< object1 object2)
+      (pitch= object1 object2)))
+
+(defmethod pitch/= ((object1 pitch) (object2 pitch))
+  (not (pitch= object1 object2)))
+
+;; Interval
+
+(defmethod interval>= ((object1 interval) (object2 interval))
+  (or (interval> object1 object2)
+      (interval= object1 object2)))
+
+(defmethod interval<= ((object1 interval) (object2 interval))
+  (or (interval< object1 object2)
+      (interval= object1 object2)))
+
+(defmethod interval/= ((object1 interval) (object2 interval))
+  (not (interval= object1 object2)))