|
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
|
|
j@293
|
15 (defclass standard-viewpointable-composition (standard-monody) ())
|
|
j@293
|
16
|
|
d@116
|
17 (defmethod timepoint ((event viewpointable-event))
|
|
d@116
|
18 (timepoint (%viewpointable-event-source-event event)))
|
|
d@116
|
19
|
|
d@116
|
20 (defmethod duration ((event viewpointable-event))
|
|
d@116
|
21 (duration (%viewpointable-event-source-event event)))
|
|
d@116
|
22
|
|
d@116
|
23 (defmethod midi-pitch-number ((event viewpointable-event))
|
|
d@116
|
24 (midi-pitch-number (%viewpointable-event-source-event event)))
|
|
d@116
|
25
|
|
d@116
|
26 (defmethod get-applicable-key-signatures ((event viewpointable-event) foo)
|
|
d@116
|
27 (declare (ignore foo))
|
|
d@116
|
28 (get-applicable-key-signatures (%viewpointable-event-source-event event)
|
|
d@116
|
29 (%viewpointable-event-source-composition event)))
|
|
d@116
|
30
|
|
d@116
|
31 (defmethod get-applicable-time-signatures ((event viewpointable-event) foo)
|
|
d@116
|
32 (declare (ignore foo))
|
|
d@116
|
33 (get-applicable-time-signatures (%viewpointable-event-source-event event)
|
|
d@116
|
34 (%viewpointable-event-source-composition event)))
|
|
d@116
|
35
|
|
d@116
|
36
|
|
d@116
|
37 (defmethod get-applicable-tempi ((event viewpointable-event) foo)
|
|
d@116
|
38 (declare (ignore foo))
|
|
d@116
|
39 (get-applicable-tempi (%viewpointable-event-source-event event)
|
|
d@116
|
40 (%viewpointable-event-source-composition event)))
|
|
d@116
|
41
|
|
d@116
|
42 (defmethod crotchet ((event viewpointable-event))
|
|
d@116
|
43 (crotchet (%viewpointable-event-source-event event)))
|
|
d@116
|
44
|
|
d@116
|
45 (defmethod diatonic-pitch ((event viewpointable-event))
|
|
d@116
|
46 (diatonic-pitch (%viewpointable-event-source-event event)))
|
|
d@116
|
47
|
|
d@116
|
48 (defmethod amuse-segmentation:ground-truth-segmenter-after ((composition viewpointable-composition))
|
|
d@116
|
49 (amuse-segmentation:ground-truth-segmenter-after composition))
|
|
d@116
|
50
|
|
d@116
|
51 (defmethod amuse-segmentation:ground-truth-segmenter-before ((composition viewpointable-composition))
|
|
d@116
|
52 (amuse-segmentation:ground-truth-segmenter-before composition))
|
|
d@116
|
53
|
|
d@116
|
54 (defmethod amuse-segmentation:boundary-strength (segmenter (event viewpointable-event) (composition viewpointable-composition))
|
|
d@116
|
55 (declare (ignore composition))
|
|
d@116
|
56 (amuse-segmentation:boundary-strength segmenter
|
|
d@116
|
57 (%viewpointable-event-source-event event)
|
|
d@116
|
58 (%viewpointable-event-source-composition event)))
|
|
d@116
|
59
|
|
j@293
|
60 (defun make-standard-viewpointable-composition (composition)
|
|
j@293
|
61 (let ((new-comp (make-instance 'standard-viewpointable-composition
|
|
d@116
|
62 :time (timepoint composition)
|
|
d@116
|
63 :interval (duration composition)))
|
|
d@116
|
64 (event-list) (i 0))
|
|
d@116
|
65 (sequence:dosequence (event composition)
|
|
d@116
|
66 (push (make-instance 'viewpointable-event :source-event event
|
|
d@116
|
67 :source-composition composition)
|
|
d@116
|
68 event-list)
|
|
d@116
|
69 (incf i))
|
|
d@116
|
70 (sequence:adjust-sequence new-comp i :initial-contents (reverse event-list))
|
|
d@116
|
71 new-comp))
|
