1 ;;;; drum-"hack". See input/regression/drums.ly and ly/drumpitch-init.ly
2 ;;;; 2001/03/25 Rune Zedeler <rune@zedeler.dk>
4 ;;;; changed eval to primitive-eval for guile 1.4/1.4.1 compatibility --jcn
7 ;; ugh. Should make separate module?
8 (define-public drum-pitch-names `(
9 (acousticbassdrum bda ,(ly:make-pitch -3 6 0 ))
10 (bassdrum bd ,(ly:make-pitch -2 0 0 ))
11 (hisidestick ssh ,(ly:make-pitch -3 6 2))
12 (sidestick ss ,(ly:make-pitch -2 0 1))
13 (losidestick ssl ,(ly:make-pitch -2 1 -1))
14 (acousticsnare sna ,(ly:make-pitch -2 1 0))
15 (snare sn ,(ly:make-pitch -2 2 -2))
16 (handclap hc ,(ly:make-pitch -2 1 1))
17 (electricsnare sne ,(ly:make-pitch -2 2 0))
18 (lowfloortom tomfl ,(ly:make-pitch -2 3 0))
19 (closedhihat hhc ,(ly:make-pitch -2 3 1))
20 (hihat hh ,(ly:make-pitch -2 4 -1))
21 (highfloortom tomfh ,(ly:make-pitch -2 4 0))
22 (pedalhihat hhp ,(ly:make-pitch -2 4 1))
23 (lowtom toml ,(ly:make-pitch -2 5 0))
24 (openhihat hho ,(ly:make-pitch -2 5 1))
25 (halfopenhihat hhho ,(ly:make-pitch -2 5 1))
26 (lowmidtom tomml ,(ly:make-pitch -2 6 0))
27 (himidtom tommh ,(ly:make-pitch -1 0 0))
28 (crashcymbala cymca ,(ly:make-pitch -1 0 1))
29 (crashcymbal cymc ,(ly:make-pitch -1 1 -1))
30 (hightom tomh ,(ly:make-pitch -1 1 0))
31 (ridecymbala cymra ,(ly:make-pitch -1 1 1))
32 (ridecymbal cymr ,(ly:make-pitch -1 2 -1))
33 (chinesecymbal cymch ,(ly:make-pitch -1 2 0))
34 (ridebell rb ,(ly:make-pitch -1 3 0))
35 (tambourine tamb ,(ly:make-pitch -1 3 1))
36 (splashcymbal cyms ,(ly:make-pitch -1 4 0))
37 (cowbell cb ,(ly:make-pitch -1 4 1))
38 (crashcymbalb cymcb ,(ly:make-pitch -1 5 0))
39 (vibraslap vibs ,(ly:make-pitch -1 5 1))
40 (ridecymbalb cymrb ,(ly:make-pitch -1 6 0))
41 (mutehibongo bohm ,(ly:make-pitch -1 6 1))
42 (hibongo boh ,(ly:make-pitch 0 0 0))
43 (openhibongo boho ,(ly:make-pitch 0 1 -2))
44 (mutelobongo bolm ,(ly:make-pitch -1 6 2))
45 (lobongo bol ,(ly:make-pitch 0 0 1))
46 (openlobongo bolo ,(ly:make-pitch 0 1 -1))
47 (mutehiconga cghm ,(ly:make-pitch 0 1 0))
48 (muteloconga cglm ,(ly:make-pitch 0 2 -2))
49 (openhiconga cgho ,(ly:make-pitch 0 1 1))
50 (hiconga cgh ,(ly:make-pitch 0 2 -1))
51 (openloconga cglo ,(ly:make-pitch 0 1 2))
52 (loconga cgl ,(ly:make-pitch 0 2 0))
53 (hitimbale timh ,(ly:make-pitch 0 3 0))
54 (lotimbale timl ,(ly:make-pitch 0 3 1))
55 (hiagogo agh ,(ly:make-pitch 0 4 0))
56 (loagogo agl ,(ly:make-pitch 0 4 1))
57 (cabasa cab ,(ly:make-pitch 0 5 0))
58 (maracas mar ,(ly:make-pitch 0 5 1))
59 (shortwhistle whs ,(ly:make-pitch 0 6 0))
60 (longwhistle whl ,(ly:make-pitch 1 0 0))
61 (shortguiro guis ,(ly:make-pitch 1 0 1))
62 (longguiro guil ,(ly:make-pitch 1 1 0))
63 (guiro gui ,(ly:make-pitch 1 0 2))
64 (claves cl ,(ly:make-pitch 1 1 1))
65 (hiwoodblock wbh ,(ly:make-pitch 1 2 0))
66 (lowoodblock wbl ,(ly:make-pitch 1 3 0))
67 (mutecuica cuim ,(ly:make-pitch 1 3 1))
68 (opencuica cuio ,(ly:make-pitch 1 4 0))
69 (mutetriangle trim ,(ly:make-pitch 1 4 1))
70 (triangle tri ,(ly:make-pitch 1 4 2))
71 (opentriangle trio ,(ly:make-pitch 1 5 0))
72 ;; "transposing" pitches:
73 (oneup ua ,(ly:make-pitch 0 1 0))
74 (twoup ub ,(ly:make-pitch 0 2 0))
75 (threeup uc ,(ly:make-pitch 0 3 0))
76 (fourup ud ,(ly:make-pitch 0 4 0))
77 (fiveup ue ,(ly:make-pitch 0 5 0))
78 (onedown da ,(ly:make-pitch -1 6 0))
79 (twodown db ,(ly:make-pitch -1 5 0))
80 (threedown dc ,(ly:make-pitch -1 4 0))
81 (fourdown dd ,(ly:make-pitch -1 3 0))
82 (fivedown de ,(ly:make-pitch -1 2 0))
85 (define-public drums `(
86 (acousticbassdrum default #f ,(ly:make-pitch -1 4 0))
87 (bassdrum default #f ,(ly:make-pitch -1 4 0))
88 (sidestick cross #f ,(ly:make-pitch 0 1 0))
89 (acousticsnare default #f ,(ly:make-pitch 0 1 0))
90 (snare default #f ,(ly:make-pitch 0 1 0))
91 (handclap triangle #f ,(ly:make-pitch 0 1 0))
92 (electricsnare default #f ,(ly:make-pitch 0 1 0))
93 (lowfloortom default #f ,(ly:make-pitch -1 3 0))
94 (closedhihat cross "stopped" ,(ly:make-pitch 0 3 0))
95 (hihat cross #f ,(ly:make-pitch 0 3 0))
96 (highfloortom default #f ,(ly:make-pitch -1 5 0))
97 (pedalhihat cross #f ,(ly:make-pitch -1 2 0))
98 (lowtom default #f ,(ly:make-pitch -1 6 0))
99 (openhihat cross "open" ,(ly:make-pitch 0 3 0))
100 (halfopenhihat xcircle #f ,(ly:make-pitch 0 3 0))
101 (lowmidtom default #f ,(ly:make-pitch 0 0 0))
102 (himidtom default #f ,(ly:make-pitch 0 2 0))
103 (crashcymbala xcircle #f ,(ly:make-pitch 0 5 0))
104 (crashcymbal xcircle #f ,(ly:make-pitch 0 5 0))
105 (hightom default #f ,(ly:make-pitch 0 4 0))
106 (ridecymbala cross #f ,(ly:make-pitch 0 5 0))
107 (ridecymbal cross #f ,(ly:make-pitch 0 5 0))
108 (chinesecymbal mensural #f ,(ly:make-pitch 0 5 0))
109 (ridebell default #f ,(ly:make-pitch 0 5 0))
110 (splashcymbal diamond #f ,(ly:make-pitch 0 5 0))
111 (cowbell triangle #f ,(ly:make-pitch 0 5 0))
112 (crashcymbalb cross #f ,(ly:make-pitch 0 5 0))
113 (vibraslap diamond #f ,(ly:make-pitch 0 4 0))
114 (ridecymbalb cross #f ,(ly:make-pitch 0 5 0))
117 (define-public timbales `(
118 (losidestick cross #f ,(ly:make-pitch -1 6 0))
119 (lotimbale default #f ,(ly:make-pitch -1 6 0))
120 (cowbell triangle #f ,(ly:make-pitch 0 2 0))
121 (hisidestick cross #f ,(ly:make-pitch 0 1 0))
122 (hitimbale default #f ,(ly:make-pitch 0 1 0))
125 (define-public congas `(
126 (losidestick cross #f ,(ly:make-pitch -1 6 0))
127 (loconga default #f ,(ly:make-pitch -1 6 0))
128 (openloconga default "open" ,(ly:make-pitch -1 6 0))
129 (muteloconga default "stopped" ,(ly:make-pitch -1 6 0))
130 (hisidestick cross #f ,(ly:make-pitch 0 1 0))
131 (hiconga default #f ,(ly:make-pitch 0 1 0))
132 (openhiconga default "open" ,(ly:make-pitch 0 1 0))
133 (mutehiconga default "stopped" ,(ly:make-pitch 0 1 0))
137 (define-public bongos `(
138 (losidestick cross #f ,(ly:make-pitch -1 6 0))
139 (lobongo default #f ,(ly:make-pitch -1 6 0))
140 (openlobongo default "open" ,(ly:make-pitch -1 6 0))
141 (mutelobongo default "stopped" ,(ly:make-pitch -1 6 0))
142 (hisidestick cross #f ,(ly:make-pitch 0 1 0))
143 (hibongo default #f ,(ly:make-pitch 0 1 0))
144 (openhibongo default "open" ,(ly:make-pitch 0 1 0))
145 (mutehibongo default "stopped" ,(ly:make-pitch 0 1 0))
149 (define-public percussion `(
150 (opentriangle cross "open" ,(ly:make-pitch 0 0 0))
151 (mutetriangle cross "stopped" ,(ly:make-pitch 0 0 0))
152 (triangle cross #f ,(ly:make-pitch 0 0 0))
153 (shortguiro default "staccato",(ly:make-pitch 0 0 0))
154 (longguiro default "tenuto" ,(ly:make-pitch 0 0 0))
155 (guiro default #f ,(ly:make-pitch 0 0 0))
156 (cowbell triangle #f ,(ly:make-pitch 0 0 0))
157 (claves default #f ,(ly:make-pitch 0 0 0))
158 (tambourine default #f ,(ly:make-pitch 0 0 0))
159 (cabasa cross #f ,(ly:make-pitch 0 0 0))
160 (maracas default #f ,(ly:make-pitch 0 0 0))
161 (handclap default #f ,(ly:make-pitch 0 0 0))
164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
167 (define (make-articulation-script x)
168 (let* ((m (make-music-by-name 'ArticulationEvent)))
169 (ly:set-mus-property! m 'articulation-type x)
172 ;; adds the articulation script x to m if x is not #f.
173 (define (add-articulation-script m x)
175 (if (and x (equal? (ly:get-mus-property m 'name) 'EventChord))
176 (ly:set-mus-property! m 'elements
177 (cons (make-articulation-script x) (ly:get-mus-property m 'elements))
179 (let* ( (es (ly:get-mus-property m 'elements))
180 (e (ly:get-mus-property m 'element)) )
181 (map (lambda (y) (add-articulation-script y x)) es)
183 (add-articulation-script e x))
190 (define (make-head-type-elem t)
191 (let* ( (m (make-music-by-name 'OverrideProperty)))
194 `((symbol . NoteHead)
195 (grob-property . style)
203 (define (make-head-type t)
204 (context-spec-music (make-head-type-elem t) "Thread"))
206 (define (make-thread-context thread-name element)
207 (context-spec-music element "Thread" thread-name))
209 ;; makes a sequential-music of thread-context, head-change and note
210 (define (make-drum-head kit req-ch )
211 (let ((es (ly:get-mus-property req-ch 'elements)))
215 (oldp (ly:get-mus-property fe 'pitch))
217 (if (not (ly:pitch? oldp))
219 (let* ((pap ((pitch->paper kit) oldp ))
223 (ht (make-head-type style))
224 (seq (make-sequential-music (list ht req-ch)))
226 (add-articulation-script req-ch script)
227 (ly:set-mus-property! fe 'pitch pitch)
228 (set! req-ch (make-thread-context style seq))
237 ;; whoa, hadn't head of "assoc" when I made this :)
238 (define ((pitch->paper kit) p)
239 (let p2p ((pitches drum-pitch-names))
240 (cond ((eq? pitches '())
242 (display p) ;; UGH. FIXME. pitch->string ???
243 (ly:warn " unknown drumpitch.")
244 (cdar (primitive-eval kit))
246 ((eq? p (caddr (car pitches))) ((name->paper kit) (caar pitches)) )
247 (else (p2p (cdr pitches) ) )
251 (define ((name->paper kit) n)
252 (let n2p ((pitches (primitive-eval kit)))
253 (cond ((eq? pitches '())
255 (ly:warn (string-append "Kit `" (symbol->string kit) "' doesn't contain drum `" n
256 "'\nSee ly/drumpitch-init.ly for supported drums."))
257 (cdar (primitive-eval kit))
259 ((eq? n (caar pitches)) (cdar pitches) )
260 (else (n2p (cdr pitches) ) )
266 ;; converts a midi-pitched (ly/drumpitch.ly) file to paper output.
267 (define-public ((drums->paper kit) music)
269 (if (equal? (ly:get-mus-property music 'name) 'EventChord)
270 (set! music (make-drum-head kit music))
271 (let* ((es (ly:get-mus-property music 'elements))
272 (e (ly:get-mus-property music 'element))
273 (p (ly:get-mus-property music 'pitch))
274 (body (ly:get-mus-property music 'body))
275 (alts (ly:get-mus-property music 'alternatives)))
278 (ly:set-mus-property! music 'elements (map (drums->paper kit) es) )
282 (ly:set-mus-property!
284 ((drums->paper kit) alts)))
287 (ly:set-mus-property!
289 ((drums->paper kit) body)))
293 (ly:set-mus-property!
295 ((drums->paper kit) e))