|
j@318
|
1 (cl:in-package #:amuse-charm)
|
|
j@318
|
2
|
|
j@318
|
3 (defun make-charm-property-list (properties)
|
|
j@318
|
4 (make-instance 'charm-property-list
|
|
j@318
|
5 :%data properties))
|
|
j@318
|
6
|
|
j@318
|
7 (defun make-charm-constituent-identifier (id)
|
|
j@318
|
8 (make-instance 'charm-constituent-identifier
|
|
j@318
|
9 :constituent-id id))
|
|
j@318
|
10
|
|
j@318
|
11 (defun make-standard-charm-constituent (particles parent
|
|
j@318
|
12 extrinsic-properties
|
|
j@318
|
13 intrinsic-properties &key
|
|
j@318
|
14 start duration
|
|
j@318
|
15 constituent-identifier owner
|
|
j@318
|
16 version creation-timestamp
|
|
j@318
|
17 deletion-timestamp)
|
|
j@318
|
18 "Properties should be charm-property-lists. FIXME: enforce this?
|
|
j@318
|
19 What about time? Should we be using implementation time data-types?
|
|
j@318
|
20 Particles by definition are identifiers - BUT this seemed to cause
|
|
j@318
|
21 unnecessary pain, so particales are now either events or
|
|
j@318
|
22 constituents. This could be make to call an backend specific
|
|
j@318
|
23 constructor specialised on the parent-identifier."
|
|
j@318
|
24 (make-instance 'standard-charm-constituent
|
|
j@318
|
25 :identifier constituent-identifier
|
|
j@318
|
26 :parent parent
|
|
j@318
|
27 :time start ; FIXME: naming conventions?
|
|
j@318
|
28 :interval duration
|
|
j@318
|
29 :extrinsic-properties extrinsic-properties
|
|
j@318
|
30 :intrinsic-properties intrinsic-properties
|
|
j@318
|
31 :%data particles
|
|
j@318
|
32 :owner owner
|
|
j@318
|
33 :version version
|
|
j@318
|
34 :creation-timestamp creation-timestamp
|
|
j@318
|
35 :deletion-timestamp deletion-timestamp))
|
|
j@318
|
36
|
|
j@318
|
37 (defun make-standard-charm-event-constituent (particles parent
|
|
j@318
|
38 extrinsic-properties
|
|
j@318
|
39 intrinsic-properties
|
|
j@318
|
40 &key start duration
|
|
j@318
|
41 constituent-identifier
|
|
j@318
|
42 owner version
|
|
j@318
|
43 creation-timestamp
|
|
j@318
|
44 deletion-timestamp)
|
|
j@318
|
45 "Properties should be charm-property-lists. FIXME: enforce this?
|
|
j@318
|
46 What about time? Should we be using implementation time data-types?
|
|
j@318
|
47 Particles by definition are identifiers - BUT this seemed to cause
|
|
j@318
|
48 unnecessary pain, so particales are now either events or
|
|
j@318
|
49 constituents. This could be make to call an backend specific
|
|
j@318
|
50 constructor specialised on the parent-identifier."
|
|
j@318
|
51 (make-instance 'standard-charm-event-constituent
|
|
j@318
|
52 :identifier constituent-identifier
|
|
j@318
|
53 :parent parent
|
|
j@318
|
54 :time start ; FIXME: naming conventions?
|
|
j@318
|
55 :interval duration
|
|
j@318
|
56 :extrinsic-properties extrinsic-properties
|
|
j@318
|
57 :intrinsic-properties intrinsic-properties
|
|
j@318
|
58 :%data (copy-list particles)
|
|
j@318
|
59 :owner owner
|
|
j@318
|
60 :version version
|
|
j@318
|
61 :creation-timestamp creation-timestamp
|
|
j@318
|
62 :deletion-timestamp deletion-timestamp))
|
|
j@318
|
63
|
|
j@318
|
64 (defun composition->charm-constituent (composition
|
|
j@318
|
65 extrinsic-properties
|
|
j@318
|
66 intrinsic-properties)
|
|
j@318
|
67 "This is currently the bridge that takes us from AMuSE compositions
|
|
j@318
|
68 to Charm constituents."
|
|
j@318
|
69 (make-standard-charm-event-constituent (%list-slot-sequence-data
|
|
j@318
|
70 composition)
|
|
j@318
|
71 composition
|
|
j@318
|
72 extrinsic-properties
|
|
j@318
|
73 intrinsic-properties
|
|
j@318
|
74 :start (timepoint
|
|
j@318
|
75 composition)
|
|
j@318
|
76 :duration (duration
|
|
j@318
|
77 composition)))
|
|
j@318
|
78
|
|
j@318
|
79 (defun make-onset-segment-constituent (composition)
|
|
j@318
|
80 (let ((grouped-events (group-by-onset composition))
|
|
j@318
|
81 (parent-constituent
|
|
j@318
|
82 (make-standard-charm-constituent nil composition
|
|
j@318
|
83 (make-charm-property-list
|
|
j@318
|
84 '("sequence-class"))
|
|
j@318
|
85 (make-charm-property-list
|
|
j@318
|
86 '("sequence-class"))
|
|
j@318
|
87 :start (timepoint
|
|
j@318
|
88 composition)
|
|
j@318
|
89 :duration (duration
|
|
j@318
|
90 composition))))
|
|
j@318
|
91 (loop for beat-events in grouped-events
|
|
j@318
|
92 collect (make-standard-charm-event-constituent
|
|
j@318
|
93 beat-events
|
|
j@318
|
94 parent-constituent
|
|
j@318
|
95 (make-charm-property-list '("segment"))
|
|
j@318
|
96 (make-charm-property-list '("onset-segment")))
|
|
j@318
|
97 into constituents
|
|
j@318
|
98 finally (progn
|
|
j@318
|
99 (setf (%list-slot-sequence-data parent-constituent)
|
|
j@318
|
100 constituents)
|
|
j@318
|
101 (return parent-constituent)))))
|
|
j@318
|
102
|
|
j@318
|
103 (defun group-by-onset (composition)
|
|
j@318
|
104 (loop for event in (reverse (%list-slot-sequence-data composition))
|
|
j@318
|
105 with grouped-events
|
|
j@318
|
106 do (if (and grouped-events
|
|
j@318
|
107 (time= (onset event) (onset (car (car grouped-events)))))
|
|
j@318
|
108 (push event (car grouped-events))
|
|
j@318
|
109 (push (list event) grouped-events))
|
|
j@318
|
110 finally (return grouped-events)))
|
