|
j@215
|
1 (cl:in-package #:amuse-meredith)
|
|
j@215
|
2
|
|
j@239
|
3 ;;;=====================================================================
|
|
j@215
|
4 ;;; Specialised constructors
|
|
j@239
|
5 ;;;=====================================================================
|
|
j@239
|
6
|
|
j@215
|
7 (defmethod make-composition-identifier ((package (eql *package*))
|
|
j@215
|
8 composition-id)
|
|
j@215
|
9 (make-meredith-composition-identifier composition-id))
|
|
j@215
|
10
|
|
j@239
|
11
|
|
j@239
|
12 ;;;=====================================================================
|
|
j@239
|
13 ;;; Specialized composition methods
|
|
j@239
|
14 ;;;=====================================================================
|
|
j@215
|
15
|
|
j@215
|
16 (defvar *event-attributes*
|
|
j@215
|
17 #.(clsql:locally-enable-sql-reader-syntax)
|
|
j@215
|
18 (list [event-id] [tatum-on] [tatum-dur] [tactus-on] [tactus-dur]
|
|
j@215
|
19 [crot-on] [crot-dur] [tatum-on-ms] [tatum-dur-ms] [beat-on-ms]
|
|
j@215
|
20 [beat-dur-ms] [crot-on-ms] [crot-dur-ms] [pitch-name]
|
|
j@215
|
21 [midi-note-number] [chrom-pitch] [morph-pitch] [voice])
|
|
j@215
|
22 #.(clsql:locally-disable-sql-reader-syntax))
|
|
j@215
|
23
|
|
j@215
|
24 (defmethod get-composition ((identifier meredith-composition-identifier))
|
|
j@215
|
25 #.(clsql:locally-enable-sql-reader-syntax)
|
|
j@215
|
26 (let* ((composition-id (composition-id identifier))
|
|
j@215
|
27 (where-clause [= [composition-id] composition-id])
|
|
j@215
|
28 (description
|
|
j@225
|
29 (car (clsql:select [description]
|
|
j@225
|
30 :from [|meredith-compositions|]
|
|
j@225
|
31 :where where-clause
|
|
j@225
|
32 :flatp t
|
|
j@225
|
33 :field-names nil
|
|
j@225
|
34 :database *amuse-database*)))
|
|
j@225
|
35 (composition (make-meredith-composition
|
|
j@225
|
36 :identifier identifier
|
|
j@225
|
37 :description description))
|
|
j@215
|
38 (db-events (apply #'clsql:select
|
|
j@215
|
39 (append *event-attributes*
|
|
j@215
|
40 (list :from [|meredith-events|]
|
|
j@215
|
41 :order-by '(([event-id] :asc))
|
|
j@225
|
42 :where where-clause
|
|
j@225
|
43 :database *amuse-database*))))
|
|
j@225
|
44 (events (loop for e in db-events
|
|
j@225
|
45 collect (db-event->meredith-event e composition))))
|
|
j@225
|
46 (sequence:adjust-sequence composition (length events)
|
|
j@225
|
47 :initial-contents events))
|
|
j@215
|
48 #.(clsql:locally-disable-sql-reader-syntax))
|
|
j@215
|
49
|
|
j@215
|
50 (defmethod copy-event (event)
|
|
j@215
|
51 (with-slots (identifier tatum-on tatum-dur tactus-on tactus-dur
|
|
j@215
|
52 (time amuse::time)
|
|
j@215
|
53 (interval amuse::interval) tatum-on-ms
|
|
j@215
|
54 tatum-dur-ms beat-on-ms beat-dur-ms
|
|
j@215
|
55 crot-on-ms crot-dur-ms pitch-name
|
|
j@215
|
56 (midi-note-number amuse::number)
|
|
j@215
|
57 (cp amuse::cp) (mp amuse::mp) voice) event
|
|
j@215
|
58 (make-meredith-event :identifier identifier
|
|
j@215
|
59 :tatum-on tatum-on
|
|
j@215
|
60 :tatum-dur tatum-dur
|
|
j@215
|
61 :tactus-on tactus-on
|
|
j@215
|
62 :tactus-dur tactus-dur
|
|
j@215
|
63 :time time
|
|
j@215
|
64 :interval interval
|
|
j@215
|
65 :tatum-on-ms tatum-on-ms
|
|
j@215
|
66 :tatum-dur-ms tatum-dur-ms
|
|
j@215
|
67 :beat-on-ms beat-on-ms
|
|
j@215
|
68 :beat-dur-ms beat-dur-ms
|
|
j@215
|
69 :crot-on-ms crot-on-ms
|
|
j@215
|
70 :crot-dur-ms crot-dur-ms
|
|
j@215
|
71 :pitch-name pitch-name
|
|
j@215
|
72 :number midi-note-number
|
|
j@215
|
73 :cp cp
|
|
j@215
|
74 :mp mp
|
|
j@215
|
75 :voice voice)))
|
|
j@215
|
76
|
|
j@215
|
77 (defmethod get-applicable-key-signatures ((event meredith-event)
|
|
j@215
|
78 (composition
|
|
j@215
|
79 meredith-composition))
|
|
j@215
|
80 nil)
|
|
j@215
|
81
|
|
j@215
|
82 (defmethod get-applicable-key-signatures ((event meredith-composition)
|
|
j@215
|
83 o)
|
|
j@215
|
84 nil)
|
|
j@215
|
85
|
|
j@215
|
86 (defmethod get-applicable-time-signatures ((event meredith-event)
|
|
j@215
|
87 (composition
|
|
j@215
|
88 meredith-composition))
|
|
j@215
|
89 (make-standard-time-signature-period 4 4 0 (duration composition)))
|
|
j@215
|
90
|
|
j@215
|
91 (defmethod time-signatures ((composition meredith-composition))
|
|
j@215
|
92 (list (make-standard-time-signature-period 4 4 0 (duration composition))))
|
|
j@215
|
93
|
|
j@215
|
94 (defmethod crotchet ((event meredith-composition))
|
|
j@215
|
95 (amuse:make-standard-period 1))
|
|
j@215
|
96
|
|
j@215
|
97 (defmethod crotchet ((event meredith-event))
|
|
j@215
|
98 (amuse:make-standard-period 1))
|
|
j@215
|
99
|
|
j@215
|
100 (defmethod tempi ((composition meredith-composition))
|
|
j@215
|
101 (list (make-standard-tempo-period 120 0 88)))
|
