# HG changeset patch
# User Jamie Forth <j.forth@gold.ac.uk>
# Date 1298546599 0
# Node ID f1e6d10fdb119b81c27098d6bd5d617bbe80c51a
# Parent  c6c8039034179c19dfa67177dc353384c055bfa1
pitched and unpitched Charm event constituent classes

diff -r c6c803903417 -r f1e6d10fdb11 base/charm/classes.lisp
--- a/base/charm/classes.lisp	Thu Feb 24 11:23:18 2011 +0000
+++ b/base/charm/classes.lisp	Thu Feb 24 11:23:19 2011 +0000
@@ -115,3 +115,14 @@
   ()
   (:documentation "Base class for constituents using standard time
    representation."))
+
+(defclass standard-charm-pitched-event-constituent
+    (standard-charm-event-constituent)
+  ()
+  (:documentation "Base class for constituents using standard time
+  representation containing only pitched events."))
+
+(defclass standard-charm-unpitched-event-constituent (standard-charm-event-constituent)
+  ()
+  (:documentation "Base class for constituents using standard time
+   representation containing only unpitched events."))
diff -r c6c803903417 -r f1e6d10fdb11 base/charm/constructors.lisp
--- a/base/charm/constructors.lisp	Thu Feb 24 11:23:18 2011 +0000
+++ b/base/charm/constructors.lisp	Thu Feb 24 11:23:19 2011 +0000
@@ -42,18 +42,24 @@
 					      owner version
 					      creation-timestamp
 					      deletion-timestamp)
-  (make-instance 'standard-charm-event-constituent
-		 :identifier constituent-identifier
-		 :parent parent
-		 :time start		; FIXME: naming conventions?
-		 :interval duration
-		 :extrinsic-properties extrinsic-properties
-		 :intrinsic-properties intrinsic-properties
-		 :%data particles
-		 :owner owner
-		 :version version
-		 :creation-timestamp creation-timestamp
-		 :deletion-timestamp deletion-timestamp))
+  (let ((constituent-class (cond
+			     ((every #'amuse-utils:pitchedp particles)
+			      'standard-charm-pitched-event-constituent)
+			     ((every #'amuse-utils:unpitchedp particles)
+			      'standard-charm-unpitched-event-constituent)
+			     (t 'standard-charm-event-constituent))))
+    (make-instance constituent-class
+		   :identifier constituent-identifier
+		   :parent parent
+		   :time start		; FIXME: naming conventions?
+		   :interval duration
+		   :extrinsic-properties extrinsic-properties
+		   :intrinsic-properties intrinsic-properties
+		   :%data particles
+		   :owner owner
+		   :version version
+		   :creation-timestamp creation-timestamp
+		   :deletion-timestamp deletion-timestamp)))
 
 (defun composition->charm-constituent (composition
 				       extrinsic-properties
@@ -109,7 +115,8 @@
 
 (defun segment-at-bar (composition)
   "Returns a list of bar-constituents."
-  (loop with current-bar = (current-bar (elt composition 0) composition) and current-events
+  (loop with current-bar = (current-bar (elt composition 0) composition)
+     and current-events
      for event in (%list-slot-sequence-data composition)
      if (time= current-bar (current-bar event composition))
      do (push event current-events)
diff -r c6c803903417 -r f1e6d10fdb11 base/charm/package.lisp
--- a/base/charm/package.lisp	Thu Feb 24 11:23:18 2011 +0000
+++ b/base/charm/package.lisp	Thu Feb 24 11:23:19 2011 +0000
@@ -1,8 +1,14 @@
 (cl:defpackage #:amuse-charm
   (:use #:common-lisp #:amuse #:amuse-database-admin)
-  (:export #:make-standard-charm-constituent
+  (:export #:charm-constituent
+	   #:standard-charm-constituent
+	   #:standard-charm-event-constituent
+	   #:standard-charm-pitched-event-constituent
+	   #:standard-charm-unpitched-event-constituent
+	   #:make-standard-charm-constituent
 	   #:make-charm-constituent-identifier
 	   #:make-charm-property-list
+	   #:parent
 	   #:composition->charm-constituent
 	   #:make-onset-segment-constituent
 	   #:segment-at-bar