Mercurial > hg > amuse
changeset 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 | c6c803903417 |
| children | bc893627f92d |
| files | base/charm/classes.lisp base/charm/constructors.lisp base/charm/package.lisp |
| diffstat | 3 files changed, 38 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- 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."))
--- 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)
--- 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