;;;; changed eval to primitive-eval for guile 1.4/1.4.1 compatibility --jcn
+
+(define drum-pitch-names `(
+ (acousticbassdrum bda ,(make-pitch -3 6 0 ))
+ (bassdrum bd ,(make-pitch -2 0 0 ))
+ (hisidestick ssh ,(make-pitch -3 6 2))
+ (sidestick ss ,(make-pitch -2 0 1))
+ (losidestick ssl ,(make-pitch -2 1 -1))
+ (acousticsnare sna ,(make-pitch -2 1 0))
+ (snare sn ,(make-pitch -2 2 -2))
+ (handclap hc ,(make-pitch -2 1 1))
+ (electricsnare sne ,(make-pitch -2 2 0))
+ (lowfloortom tomfl ,(make-pitch -2 3 0))
+ (closedhihat hhc ,(make-pitch -2 3 1))
+ (hihat hh ,(make-pitch -2 4 -1))
+ (highfloortom tomfh ,(make-pitch -2 4 0))
+ (pedalhihat hhp ,(make-pitch -2 4 1))
+ (lowtom toml ,(make-pitch -2 5 0))
+ (openhihat hho ,(make-pitch -2 5 1))
+ (halfopenhihat hhho ,(make-pitch -2 5 1))
+ (lowmidtom tomml ,(make-pitch -2 6 0))
+ (himidtom tommh ,(make-pitch -1 0 0))
+ (crashcymbala cymca ,(make-pitch -1 0 1))
+ (crashcymbal cymc ,(make-pitch -1 1 -1))
+ (hightom tomh ,(make-pitch -1 1 0))
+ (ridecymbala cymra ,(make-pitch -1 1 1))
+ (ridecymbal cymr ,(make-pitch -1 2 -1))
+ (chinesecymbal cymch ,(make-pitch -1 2 0))
+ (ridebell rb ,(make-pitch -1 3 0))
+ (tambourine tamb ,(make-pitch -1 3 1))
+ (splashcymbal cyms ,(make-pitch -1 4 0))
+ (cowbell cb ,(make-pitch -1 4 1))
+ (crashcymbalb cymcb ,(make-pitch -1 5 0))
+ (vibraslap vibs ,(make-pitch -1 5 1))
+ (ridecymbalb cymrb ,(make-pitch -1 6 0))
+ (mutehibongo bohm ,(make-pitch -1 6 1))
+ (hibongo boh ,(make-pitch 0 0 0))
+ (openhibongo boho ,(make-pitch 0 1 -2))
+ (mutelobongo bolm ,(make-pitch -1 6 2))
+ (lobongo bol ,(make-pitch 0 0 1))
+ (openlobongo bolo ,(make-pitch 0 1 -1))
+ (mutehiconga cghm ,(make-pitch 0 1 0))
+ (muteloconga cglm ,(make-pitch 0 2 -2))
+ (openhiconga cgho ,(make-pitch 0 1 1))
+ (hiconga cgh ,(make-pitch 0 2 -1))
+ (openloconga cglo ,(make-pitch 0 1 2))
+ (loconga cgl ,(make-pitch 0 2 0))
+ (hitimbale timh ,(make-pitch 0 3 0))
+ (lotimbale timl ,(make-pitch 0 3 1))
+ (hiagogo agh ,(make-pitch 0 4 0))
+ (loagogo agl ,(make-pitch 0 4 1))
+ (cabasa cab ,(make-pitch 0 5 0))
+ (maracas mar ,(make-pitch 0 5 1))
+ (shortwhistle whs ,(make-pitch 0 6 0))
+ (longwhistle whl ,(make-pitch 1 0 0))
+ (shortguiro guis ,(make-pitch 1 0 1))
+ (longguiro guil ,(make-pitch 1 1 0))
+ (guiro gui ,(make-pitch 1 0 2))
+ (claves cl ,(make-pitch 1 1 1))
+ (hiwoodblock wbh ,(make-pitch 1 2 0))
+ (lowoodblock wbl ,(make-pitch 1 3 0))
+ (mutecuica cuim ,(make-pitch 1 3 1))
+ (opencuica cuio ,(make-pitch 1 4 0))
+ (mutetriangle trim ,(make-pitch 1 4 1))
+ (triangle tri ,(make-pitch 1 4 2))
+ (opentriangle trio ,(make-pitch 1 5 0))
+ ;; "transposing" pitches:
+ (oneup ua ,(make-pitch 0 1 0))
+ (twoup ub ,(make-pitch 0 2 0))
+ (threeup uc ,(make-pitch 0 3 0))
+ (fourup ud ,(make-pitch 0 4 0))
+ (fiveup ue ,(make-pitch 0 5 0))
+ (onedown da ,(make-pitch -1 6 0))
+ (twodown db ,(make-pitch -1 5 0))
+ (threedown dc ,(make-pitch -1 4 0))
+ (fourdown dd ,(make-pitch -1 3 0))
+ (fivedown de ,(make-pitch -1 2 0))
+))
+
+(define drums `(
+ (acousticbassdrum default #f ,(make-pitch -1 4 0))
+ (bassdrum default #f ,(make-pitch -1 4 0))
+ (sidestick cross #f ,(make-pitch 0 1 0))
+ (acousticsnare default #f ,(make-pitch 0 1 0))
+ (snare default #f ,(make-pitch 0 1 0))
+ (handclap triangle #f ,(make-pitch 0 1 0))
+ (electricsnare default #f ,(make-pitch 0 1 0))
+ (lowfloortom default #f ,(make-pitch -1 3 0))
+ (closedhihat cross "stopped" ,(make-pitch 0 3 0))
+ (hihat cross #f ,(make-pitch 0 3 0))
+ (highfloortom default #f ,(make-pitch -1 5 0))
+ (pedalhihat cross #f ,(make-pitch -1 2 0))
+ (lowtom default #f ,(make-pitch -1 6 0))
+ (openhihat cross "open" ,(make-pitch 0 3 0))
+ (halfopenhihat xcircle #f ,(make-pitch 0 3 0))
+ (lowmidtom default #f ,(make-pitch 0 0 0))
+ (himidtom default #f ,(make-pitch 0 2 0))
+ (crashcymbala xcircle #f ,(make-pitch 0 5 0))
+ (crashcymbal xcircle #f ,(make-pitch 0 5 0))
+ (hightom default #f ,(make-pitch 0 4 0))
+ (ridecymbala cross #f ,(make-pitch 0 5 0))
+ (ridecymbal cross #f ,(make-pitch 0 5 0))
+ (chinesecymbal mensural #f ,(make-pitch 0 5 0))
+ (ridebell default #f ,(make-pitch 0 5 0))
+ (splashcymbal diamond #f ,(make-pitch 0 5 0))
+ (cowbell triangle #f ,(make-pitch 0 5 0))
+ (crashcymbalb cross #f ,(make-pitch 0 5 0))
+ (vibraslap diamond #f ,(make-pitch 0 4 0))
+ (ridecymbalb cross #f ,(make-pitch 0 5 0))
+ ))
+
+(define timbales `(
+ (losidestick cross #f ,(make-pitch -1 6 0))
+ (lotimbale default #f ,(make-pitch -1 6 0))
+ (cowbell triangle #f ,(make-pitch 0 2 0))
+ (hisidestick cross #f ,(make-pitch 0 1 0))
+ (hitimbale default #f ,(make-pitch 0 1 0))
+ ))
+
+(define congas `(
+ (losidestick cross #f ,(make-pitch -1 6 0))
+ (loconga default #f ,(make-pitch -1 6 0))
+ (openloconga default "open" ,(make-pitch -1 6 0))
+ (muteloconga default "stopped" ,(make-pitch -1 6 0))
+ (hisidestick cross #f ,(make-pitch 0 1 0))
+ (hiconga default #f ,(make-pitch 0 1 0))
+ (openhiconga default "open" ,(make-pitch 0 1 0))
+ (mutehiconga default "stopped" ,(make-pitch 0 1 0))
+
+ ))
+
+(define bongos `(
+ (losidestick cross #f ,(make-pitch -1 6 0))
+ (lobongo default #f ,(make-pitch -1 6 0))
+ (openlobongo default "open" ,(make-pitch -1 6 0))
+ (mutelobongo default "stopped" ,(make-pitch -1 6 0))
+ (hisidestick cross #f ,(make-pitch 0 1 0))
+ (hibongo default #f ,(make-pitch 0 1 0))
+ (openhibongo default "open" ,(make-pitch 0 1 0))
+ (mutehibongo default "stopped" ,(make-pitch 0 1 0))
+ ))
+
+
+(define percussion `(
+ (opentriangle cross "open" ,(make-pitch 0 0 0))
+ (mutetriangle cross "stopped" ,(make-pitch 0 0 0))
+ (triangle cross #f ,(make-pitch 0 0 0))
+ (shortguiro default "staccato",(make-pitch 0 0 0))
+ (longguiro default "tenuto" ,(make-pitch 0 0 0))
+ (guiro default #f ,(make-pitch 0 0 0))
+ (cowbell triangle #f ,(make-pitch 0 0 0))
+ (claves default #f ,(make-pitch 0 0 0))
+ (tambourine default #f ,(make-pitch 0 0 0))
+ (cabasa cross #f ,(make-pitch 0 0 0))
+ (maracas default #f ,(make-pitch 0 0 0))
+ (handclap default #f ,(make-pitch 0 0 0))
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;
+
(define (make-articulation-script x)
(let* ( (m (ly-make-music "Articulation_req"))
)
- (ly-set-mus-property m 'articulation-type x)
+ (ly-set-mus-property! m 'articulation-type x)
m
)
)
(define (add-articulation-script m x)
(if x
(if (and x (equal? (ly-music-name m) "Request_chord"))
- (ly-set-mus-property m 'elements
+ (ly-set-mus-property! m 'elements
(cons (make-articulation-script x) (ly-get-mus-property m 'elements))
)
(let* ( (es (ly-get-mus-property m 'elements))
(define (make-head-type-elem t)
(let* ( (m (ly-make-music "Music"))
)
- (ly-set-mus-property m 'iterator-ctor Push_property_iterator::constructor)
- (ly-set-mus-property m 'symbol 'NoteHead)
- (ly-set-mus-property m 'grob-property 'style)
- (ly-set-mus-property m 'grob-value t)
+ (ly-set-mus-property! m 'iterator-ctor Push_property_iterator::constructor)
+ (ly-set-mus-property! m 'symbol 'NoteHead)
+ (ly-set-mus-property! m 'grob-property 'style)
+ (ly-set-mus-property! m 'grob-value t)
+ (ly-set-mus-property! m 'pop-first #t)
m
)
)
(let* ( (m (ly-make-music "Context_specced_music"))
(e (make-head-type-elem t))
)
- (ly-set-mus-property m 'element e)
- (ly-set-mus-property m 'context-type "Thread")
+ (ly-set-mus-property! m 'element e)
+ (ly-set-mus-property! m 'context-type "Thread")
m
)
)
(define (make-thread-context thread-name element)
(let* ( (m (ly-make-music "Context_specced_music")))
- (ly-set-mus-property m 'element element)
- (ly-set-mus-property m 'context-type "Thread")
- (ly-set-mus-property m 'context-id (symbol->string thread-name))
+ (ly-set-mus-property! m 'element element)
+ (ly-set-mus-property! m 'context-type "Thread")
+ (ly-set-mus-property! m 'context-id (symbol->string thread-name))
m
)
)
(seq (make-sequential-music (list ht req-ch)))
)
(add-articulation-script req-ch script)
- (ly-set-mus-property fe 'pitch pitch)
+ (ly-set-mus-property! fe 'pitch pitch)
(set! req-ch (make-thread-context style seq))
req-ch
)
(alts (ly-get-mus-property music 'alternatives)))
(if (pair? es)
- (ly-set-mus-property music 'elements (map (drums->paper kit) es) )
+ (ly-set-mus-property! music 'elements (map (drums->paper kit) es) )
)
(if (music? alts)
- (ly-set-mus-property
+ (ly-set-mus-property!
music 'alternatives
((drums->paper kit) alts)))
(if (music? body)
- (ly-set-mus-property
+ (ly-set-mus-property!
music 'body
((drums->paper kit) body)))
(if (music? e)
(begin
- (ly-set-mus-property
+ (ly-set-mus-property!
music 'element
((drums->paper kit) e))
)
projects / lilypond.git / blobdiff