1 ;;;; drum-"hack". See input/tricks/drums.ly and ly/drumpitch.ly
2 ;;;; 2001/03/25 Rune Zedeler <rune@zedeler.dk>
4 ;;;; changed eval to ly-eval for guile 1.4/1.4.1 compatibility --jcn
6 (define (seq-music-list elts)
7 (let* ( (ml (ly-make-music "Sequential_music")) )
8 (ly-set-mus-property ml 'elements elts)
12 (define (make-art-script x)
13 (let* ( (m (ly-make-music "Articulation_req"))
15 (ly-set-mus-property m 'articulation-type x)
20 ;; adds the articulation script x to m if x is not #f.
21 (define (add-art-script m x)
23 (if (and x (equal? (ly-music-name m) "Request_chord"))
24 (ly-set-mus-property m 'elements
25 (cons (make-art-script x) (ly-get-mus-property m 'elements))
27 (let* ( (es (ly-get-mus-property m 'elements))
28 (e (ly-get-mus-property m 'element)) )
29 (map (lambda (y) (add-art-script y x)) es)
38 (define (make-head-type-elem t)
39 (let* ( (m (ly-make-music "Music"))
41 (ly-set-mus-property m 'iterator-ctor Push_property_iterator::constructor)
42 (ly-set-mus-property m 'symbols 'NoteHead)
43 (ly-set-mus-property m 'grob-property 'style)
44 (ly-set-mus-property m 'grob-value t)
49 (define (make-head-type t)
50 (let* ( (m (ly-make-music "Context_specced_music"))
51 (e (make-head-type-elem t))
53 (ly-set-mus-property m 'element e)
54 (ly-set-mus-property m 'context-type "Thread")
59 (define (make-thread-context thread-name element)
60 (let* ( (m (ly-make-music "Context_specced_music")))
61 (ly-set-mus-property m 'element element)
62 (ly-set-mus-property m 'context-type "Thread")
63 (ly-set-mus-property m 'context-id (symbol->string thread-name))
68 ;; makes a sequential-music of thread-context, head-change and note
69 (define (make-drum-head kit req-ch )
70 (let ((es (ly-get-mus-property req-ch 'elements)))
74 (oldp (ly-get-mus-property fe 'pitch))
76 (if (not (pitch? oldp))
78 (let* ((pap ((pitch->paper kit) oldp ))
82 (ht (make-head-type style))
83 (seq (seq-music-list (list ht req-ch)))
85 (add-art-script req-ch script)
86 (ly-set-mus-property fe 'pitch pitch)
87 (set! req-ch (make-thread-context style seq))
96 ;; whoa, hadn't head of "assoc" when I made this :)
97 (define ((pitch->paper kit) p)
98 (let p2p ((pitches drum-pitch-names))
99 (cond ((eq? pitches '())
101 (display p) ;; UGH. FIXME. pitch->string ???
102 (ly-warn " unknown drumpitch.")
105 ((eq? p (caddr (car pitches))) ((name->paper kit) (caar pitches)) )
106 (else (p2p (cdr pitches) ) )
110 (define ((name->paper kit) n)
111 (let n2p ((pitches (ly-eval kit)))
112 (cond ((eq? pitches '())
114 (ly-warn (string-append "Kit `" (symbol->string kit) "' doesn't contain drum `" n
115 "'\nSee lily/drumpitch.ly for supported drums."))
118 ((eq? n (caar pitches)) (cdar pitches) )
119 (else (n2p (cdr pitches) ) )
125 ;; converts a midi-pitched (ly/drumpitch.ly) file to paper output.
126 (define ((drums->paper kit) music)
128 (if (equal? (ly-music-name music) "Request_chord")
129 (set! music (make-drum-head kit music))
130 (let* ((es (ly-get-mus-property music 'elements))
131 (e (ly-get-mus-property music 'element))
132 (p (ly-get-mus-property music 'pitch))
133 (body (ly-get-mus-property music 'body))
134 (alts (ly-get-mus-property music 'alternatives)))
137 (ly-set-mus-property music 'elements (map (drums->paper kit) es) )
143 ((drums->paper kit) alts)))
148 ((drums->paper kit) body)))
154 ((drums->paper kit) e))