Mercurial > hg > amuse
diff base/charm/constructors.lisp @ 255:f1e6d10fdb11
pitched and unpitched Charm event constituent classes
| author | Jamie Forth <j.forth@gold.ac.uk> |
|---|---|
| date | Thu, 24 Feb 2011 11:23:19 +0000 |
| parents | b5ffec94ae6d |
| children |
line wrap: on
line diff
--- 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)