|
d@116
|
1 (in-package #:amuse-viewpointing-implementation)
|
|
d@116
|
2
|
|
d@116
|
3 ;; A set of classes and methods such that, if the amuse-form methods
|
|
d@116
|
4 ;; are implemented, a viewpointable-composition can be made and have
|
|
d@116
|
5 ;; viewpoint operations carried out without loss of context.
|
|
d@116
|
6
|
|
d@117
|
7 (defclass viewpointable-event (amuse::event)
|
|
d@116
|
8 ((source-event :initarg :source-event
|
|
d@116
|
9 :accessor %viewpointable-event-source-event)
|
|
d@116
|
10 (source-composition :initarg :source-composition
|
|
d@116
|
11 :accessor %viewpointable-event-source-composition)))
|
|
d@116
|
12
|
|
d@117
|
13 (defclass viewpointable-composition (monody) ())
|
|
d@116
|
14
|
|
d@116
|
15 (defmethod timepoint ((event viewpointable-event))
|
|
d@116
|
16 (timepoint (%viewpointable-event-source-event event)))
|
|
d@116
|
17
|
|
d@116
|
18 (defmethod duration ((event viewpointable-event))
|
|
d@116
|
19 (duration (%viewpointable-event-source-event event)))
|
|
d@116
|
20
|
|
d@116
|
21 (defmethod midi-pitch-number ((event viewpointable-event))
|
|
d@116
|
22 (midi-pitch-number (%viewpointable-event-source-event event)))
|
|
d@116
|
23
|
|
d@116
|
24 (defmethod get-applicable-key-signatures ((event viewpointable-event) foo)
|
|
d@116
|
25 (declare (ignore foo))
|
|
d@116
|
26 (get-applicable-key-signatures (%viewpointable-event-source-event event)
|
|
d@116
|
27 (%viewpointable-event-source-composition event)))
|
|
d@116
|
28
|
|
d@116
|
29 (defmethod get-applicable-time-signatures ((event viewpointable-event) foo)
|
|
d@116
|
30 (declare (ignore foo))
|
|
d@116
|
31 (get-applicable-time-signatures (%viewpointable-event-source-event event)
|
|
d@116
|
32 (%viewpointable-event-source-composition event)))
|
|
d@116
|
33
|
|
d@116
|
34
|
|
d@116
|
35 (defmethod get-applicable-tempi ((event viewpointable-event) foo)
|
|
d@116
|
36 (declare (ignore foo))
|
|
d@116
|
37 (get-applicable-tempi (%viewpointable-event-source-event event)
|
|
d@116
|
38 (%viewpointable-event-source-composition event)))
|
|
d@116
|
39
|
|
d@116
|
40 (defmethod crotchet ((event viewpointable-event))
|
|
d@116
|
41 (crotchet (%viewpointable-event-source-event event)))
|
|
d@116
|
42
|
|
d@116
|
43 (defmethod diatonic-pitch ((event viewpointable-event))
|
|
d@116
|
44 (diatonic-pitch (%viewpointable-event-source-event event)))
|
|
d@116
|
45
|
|
d@116
|
46 (defmethod amuse-segmentation:ground-truth-segmenter-after ((composition viewpointable-composition))
|
|
d@116
|
47 (amuse-segmentation:ground-truth-segmenter-after composition))
|
|
d@116
|
48
|
|
d@116
|
49 (defmethod amuse-segmentation:ground-truth-segmenter-before ((composition viewpointable-composition))
|
|
d@116
|
50 (amuse-segmentation:ground-truth-segmenter-before composition))
|
|
d@116
|
51
|
|
d@116
|
52 (defmethod amuse-segmentation:boundary-strength (segmenter (event viewpointable-event) (composition viewpointable-composition))
|
|
d@116
|
53 (declare (ignore composition))
|
|
d@116
|
54 (amuse-segmentation:boundary-strength segmenter
|
|
d@116
|
55 (%viewpointable-event-source-event event)
|
|
d@116
|
56 (%viewpointable-event-source-composition event)))
|
|
d@116
|
57
|
|
d@116
|
58 (defun make-viewpointable-composition (composition)
|
|
d@116
|
59 (let ((new-comp (make-instance 'viewpointable-composition
|
|
d@116
|
60 :time (timepoint composition)
|
|
d@116
|
61 :interval (duration composition)))
|
|
d@116
|
62 (event-list) (i 0))
|
|
d@116
|
63 (sequence:dosequence (event composition)
|
|
d@116
|
64 (push (make-instance 'viewpointable-event :source-event event
|
|
d@116
|
65 :source-composition composition)
|
|
d@116
|
66 event-list)
|
|
d@116
|
67 (incf i))
|
|
d@116
|
68 (sequence:adjust-sequence new-comp i :initial-contents (reverse event-list))
|
|
d@116
|
69 new-comp))
|
