1 %------------------------------------------------------------------%
2 % Opéra Libre -- functions.ly %
4 % (c) Valentin Villenave, 2008 %
6 %------------------------------------------------------------------%
8 % Various additional functions.
10 %%%%%%%%%%%%%%%%%%%%%%%%% Music Shortcuts %%%%%%%%%%%%%%%%%%%%%%%%%%
12 %% Rhythm shortcuts -----------------------------------------------%
15 #(define-music-function
(parser location music
) (ly
:music?
)
16 #{ \times 2/3 $music
#})
19 #(define-music-function
(parser location music
) (ly
:music?
)
20 #{ \times 4/5 $music
#})
23 #(define-music-function
(parser location music
) (ly
:music?
)
24 #{ \times 4/6 $music
#})
27 #(define-music-function
(parser location music
) (ly
:music?
)
28 #{ \times 4/7 $music
#})
31 %% Polyphony shortcuts --------------------------------------------%
33 %%% Functions (Issue #442 workaround)
35 #(define
(remove music
) ; throw everything into the Big Void
...
36 (context-spec-music music
'Devnull
))
38 #(define
(unpitch music
)
39 ; in addition to the PitchSquash thing
, we need to make
40 ; accidentals disappear
(since these are engraved at
a
41 ; Staff level
, and since we don
't want to affect the
43 (let
* ((es (ly
:music-property music
'elements
))
44 (e (ly
:music-property music
'element
))
45 (p
(ly
:music-property music
'pitch
)))
47 (ly
:music-set-property
!
49 (map
(lambda
(x
) (unpitch x
)) es)))
51 (ly
:music-set-property
!
55 (ly
:music-set-property
! music
'pitch
0)))
58 #(define
(event-filter event
)
59 (let
((n
(ly
:music-property event
'name
)))
61 (eq? n
'ContextSpeccedMusic
) ; to avoid clefs and ottavas
62 (eq? n
'ContextChange
) ; cross-staff voices are supported
63 (eq? n
'ArpeggioEvent
)) ; arpeggios need to go too
64 (music-map remove event
))
65 (if
(eq? n
'SimultaneousMusic
) ; we don
't want
a new Voice to be created
66 (ly
:music-set-property
! event
'name
'NoteEvent
))))
69 #(define-music-function
(parser location music
) (ly
:music?
)
70 (context-spec-music
(music-filter event-filter
(unpitch music
)) 'PseudoVoice
))
73 #(define-music-function
(parser location one two
) (ly
:music? ly
:music?
)
74 #{ << { \voiceTwo $one
} \\ { \voiceOne $two
} >> #})
76 %%% Piano implementation
78 showAnyway
= %not needed
79 #(define-music-function
(parser location music
) (ly
:music?
)
81 \unset Score
.keepAliveInterfaces
83 \set Score
.keepAliveInterfaces
= #'(rhythmic-grob-interface
84 lyric-interface percent-repeat-item-interface
85 percent-repeat-interface stanza-number-interface
)
89 #(define-music-function
(parser location droite gauche
) (ly
:music? ly
:music?
)
94 \new Voice
{ \clef treble $droite
}
95 \new Voice
{ \makeGhost $gauche
}
99 \new Voice
{ \clef bass $gauche
}
100 \new Voice
{ \makeGhost $droite
}
105 md
= { \change Staff
= "md" }
107 mg
= { \change Staff
= "mg" }
109 %%% The same, for percussions.
112 #(define-music-function
(parser location droite gauche
) (ly
:music? ly
:music?
)
115 \new Staff
= "percuDroite"
117 \new Voice
{ \clef treble $droite
}
118 \new Voice
{ \makeGhost $gauche
}
120 \new Staff
= "percuGauche"
122 \new Voice
{ \clef bass $gauche
}
123 \new Voice
{ \makeGhost $droite
}
128 droite
= { \change Staff
= "percuDroite" }
130 gauche
= { \change Staff
= "percuGauche" }
133 #(define-music-function
(parser location one two
) (ly
:music? ly
:music?
)
134 #{ << { \stemDown $one
\stemNeutral } \new DrumVoice
{ \stemUp $two
} >> #})
137 %% Music formatting -----------------------------------------------%
140 #(define-music-function
(parser location notes
) (ly
:music?
)
141 #{ \tiny $notes
\normalsize #})
144 #(define-music-function
(parser location notes
) (ly
:music?
)
145 #{ \override NoteHead
#'style
= #'cross
147 \revert NoteHead
#'style
#})
150 #(define-music-function
(parser location music
) (ly
:music?
)
151 #{ \override Hairpin
#'to-barline
= ##f
152 $music
\revert Hairpin
#'to-barline
#})
155 #(define-music-function
(parser location music
) (ly
:music?
)
156 #{\override NoteHead
#'stencil
= #ly
:text-interface
::print
157 \override NoteHead
#'text
= \markup \musicglyph #"scripts.sforzato"
158 \override NoteHead
#'extra-offset
= #'(0.1 . 0.0 )
160 \revert NoteHead
#'stencil
161 \revert NoteHead
#'text
162 \revert NoteHead
#'extra-offset
#})
165 \once \override NoteHead
#'transparent
= ##t
166 \once \override NoteHead
#'no-ledgers
= ##t
167 \once \override Stem
#'transparent
= ##t
168 \once \override Beam
#'transparent
= ##t
169 \once \override Accidental
#'transparent
= ##t
173 \once \override TupletBracket
#'transparent
= ##t
174 \once \override TupletNumber
#'transparent
= ##t
178 \once \override Stem
#'direction
= #DOWN
182 \once \override Stem
#'direction
= #UP
185 %% Music shortcuts ------------------------------------------------%
187 sk
= \set Score
.skipTypesetting
= ##t
189 unsk
= \set Score
.skipTypesetting
= ##f
191 % This might not be needed
192 #(define
(octave-up noteevent
)
193 (let
* ((pitch
(ly
:music-property noteevent
'pitch
))
194 (octave
(ly
:pitch-octave pitch
))
195 (note
(ly
:pitch-notename pitch
))
196 (alteration
(ly
:pitch-alteration pitch
))
197 (duration
(ly
:music-property noteevent
'duration
))
199 (make-music
'NoteEvent
201 'pitch
(ly
:make-pitch
(1- octave
) note alteration
))))
204 #(define
(octavize-chord elements
)
205 (cond
((null? elements
) elements
)
206 ((eq?
(ly
:music-property
(car elements
) 'name
) 'NoteEvent
)
208 (cons
(octave-up
(car elements
))
209 (octavize-chord
(cdr elements
)))))
210 (else
(cons
(car elements
) (octavize-chord
(cdr elements
))))))
212 #(define
(octavize music
)
213 (let
* ((es (ly
:music-property music
'elements
))
214 (e (ly
:music-property music
'element
))
215 (name
(ly
:music-property music
'name
)))
216 (cond
((eq? name
'EventChord
)
217 (ly
:music-set-property
! music
'elements
(octavize-chord
es)))
219 (for-each
(lambda
(x
) (octavize x
)) es))
224 oct
= #(define-music-function
(parser location mus
) (ly
:music?
)
228 %%%%%%%%%%%%%%%%%%%%%%%%% Music Decoration %%%%%%%%%%%%%%%%%%%%%%%%%
230 %% Articulation marks ---------------------------------------------%
232 #(define
(make-script x
)
233 (make-music
'ArticulationEvent
234 'articulation-type x
))
236 #(define
(add-script m x
)
237 (let
( (eventname
(ly
:music-property m
'name
)))
238 (if
(equal? eventname
'EventChord
)
239 (let
( (elements
(ly
:music-property m
'elements
)) )
240 (if
(not
(equal?
(ly
:music-property
(car elements
)
242 (set
! (ly
:music-property m
'elements
)
243 (append elements
(list
244 (make-script x
)))))))
247 #(define
(double-script m t tt
)
248 (add-script
(add-script m t
) tt
))
251 #(define-music-function
(parser location music
)
253 (define
(make-script-music m
)
254 (add-script m
"staccato"))
255 (music-map make-script-music music
))
258 #(define-music-function
(parser location music
)
260 (define
(make-script-music m
)
261 (add-script m
"accent"))
262 (music-map make-script-music music
))
264 det
= % I call these "det" as in "détaché".
265 #(define-music-function
(parser location music
)
267 (define
(make-script-music m
)
268 (add-script m
"tenuto"))
269 (music-map make-script-music music
))
272 #(define-music-function
(parser location music
)
274 (define
(make-script-music m
)
275 (add-script m
"portato"))
276 (music-map make-script-music music
))
279 #(define-music-function
(parser location music
)
281 (define
(make-script-music m
)
282 (double-script m
"tenuto" "accent"))
283 (music-map make-script-music music
))
286 #(define-music-function
(parser location music
)
288 (define
(make-script-music m
)
289 (double-script m
"accent" "staccato"))
290 (music-map make-script-music music
))
293 #(define-music-function
(parser location music
)
295 (define
(make-script-music m
)
296 (add-script m
"downbow"))
297 (music-map make-script-music music
))
300 #(let
((m
(make-music
'ArticulationEvent
301 'articulation-type
"flageolet")))
302 (set
! (ly
:music-property m
'tweaks
)
304 (ly
:music-property m
'tweaks
)))
307 #(define-music-function
(parser location chord result
) (ly
:music? ly
:music?
)
308 #{ << \oneStemDown $chord
\\ { \stemUp %FIXME: ties could look better.
309 \override NoteHead
#'stencil
= #ly
:text-interface
::print
310 \override NoteHead
#'text
= \markup { \null \musicglyph #"noteheads.s2"}
311 \once \override NoteHead
#'text
= \markup {\null \override #'(direction
. 1)
312 \dir-column
{\musicglyph #"noteheads.s2" \teeny \musicglyph #"eight"}}
313 \override Stem
#'stencil
= ##f $result
314 \revert Stem
#'stencil
\revert NoteHead
#'stencil
\stemNeutral } >> #})
317 #(define-music-function
(parser location music
) (ly
:music?
)
319 \override Dots
#'transparent
= ##t
320 \override Stem
#'transparent
= ##t
321 \override Beam
#'transparent
= ##t
322 \override NoteHead
#'style
= #'harmonic
324 \revert NoteHead
#'style
325 \revert Beam
#'transparent
326 \revert Stem
#'transparent
327 \revert Dots
#'transparent
#})
330 #(let
* ((m
(make-music
'ArticulationEvent
331 'articulation-type
"stopped"
333 (ly
:music-set-property
! m
'tweaks
338 #:musicglyph
"scripts.stopped")
339 (acons
'stencil ly
:text-interface
::print
340 (ly
:music-property m
'tweaks
)))))
344 #(let
* ((m
(make-music
'ArticulationEvent
345 'articulation-type
"stopped"
347 (ly
:music-set-property
! m
'tweaks
349 (ly
:music-property m
'tweaks
)))
353 #(let
* ((m
(make-music
'ArpeggioEvent
)))
354 (ly
:music-set-property
! m
'tweaks
355 (acons
'arpeggio-direction
1
356 (ly
:music-property m
'tweaks
)))
360 #(let
* ((m
(make-music
'ArpeggioEvent
)))
361 (ly
:music-set-property
! m
'tweaks
362 (acons
'arpeggio-direction -
1
363 (ly
:music-property m
'tweaks
)))
367 #(let
* ((m
(make-music
'ArpeggioEvent
)))
368 (ly
:music-set-property
! m
'tweaks
369 (acons
'stencil ly
:arpeggio
::brew-chord-bracket
370 (ly
:music-property m
'tweaks
)))
373 %%% TODO: custom scripts priority.
374 #(define modern-scripts default-script-alist
)
376 %%%%%%%%%%%%%%%%%%%%%%%% Layout Functions %%%%%%%%%%%%%%%%%%%%%%%%%%
378 %% Music layout ---------------------------------------------------%
380 #(define modern-auto-beam-settings
381 (append default-auto-beam-settings
383 ((end
* * 3 4) . ,(ly
:make-moment
1 4))
384 ((end
* * 3 4) . ,(ly
:make-moment
1 2))
385 ((end
* * 4 4) . ,(ly
:make-moment
1 4))
386 ((end
* * 4 4) . ,(ly
:make-moment
3 4))
387 ((end
* * 2 2) . ,(ly
:make-moment
1 4))
388 ((end
* * 2 2) . ,(ly
:make-moment
1 2))
389 ((end
* * 2 2) . ,(ly
:make-moment
3 4))
390 ((end
* * 2 8) . ,(ly
:make-moment
1 4))
391 ((be
* * 5 8) . ,(ly
:make-moment
1 8))
392 ((end
* * 5 8) . ,(ly
:make-moment
5 8))
395 #(define modern-accidentals-style
396 `
(Staff
,(make-accidental-rule
'same-octave
0)
397 ,(make-accidental-rule
'any-octave
0)
398 ,(make-accidental-rule
'same-octave
1)
399 ,neo-modern-accidental-rule
))
400 #(define modern-cautionaries-style
401 `
(Staff
,(make-accidental-rule
'same-octave
1)
402 ,(make-accidental-rule
'any-octave
1)))
404 %%%%%%%%%%%%%%%%%%%%%%%%%%%% Editorial %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
406 %% Individual parts -----------------------------------------------%
409 #(define-music-function
(parser location part ref
)
410 (ly
:music? ly
:music?
)
411 #{\context Staff
<< $part
\new GhostVoice $ref
>> #})
413 makeSection
= % two parts
414 #(define-music-function
(parser location part-one part-two ref
)
415 (ly
:music? ly
:music? ly
:music?
)
417 \new Staff
<< $part-one
\new GhostVoice $ref
>>
421 makeExtraSection
= % three parts, e.g. for violins
422 #(define-music-function
(parser location part-one part-two part-three ref
)
423 (ly
:music? ly
:music? ly
:music? ly
:music?
)
425 \new Staff
<< $part-one
\new GhostVoice $ref
>>
427 \new Staff $part-three
431 #(define-music-function
(parser location part-one ref
)
432 (ly
:music? ly
:music?
)
433 #{<< $part-one
\new GhostVoice $ref
>> #})
435 %%-----------------------------------------------------------------%
438 #(define
(naturalize-pitch p
)
439 (let
* ((o
(ly
:pitch-octave p
))
440 (a (* 4 (ly
:pitch-alteration p
)))
441 ; alteration
, a, in quarter tone steps
, for historical reasons
442 (n
(ly
:pitch-notename p
)))
444 ((and
(> a 1) (or
(eq? n
6) (eq? n
2)))
447 ((and
(< a -
1) (or
(eq? n
0) (eq? n
3)))
451 ((> a 2) (set
! a (-
a 4)) (set
! n
(+ n
1)))
452 ((< a -
2) (set
! a (+
a 4)) (set
! n
(- n
1))))
453 (if
(< n
0) (begin
(set
! o
(- o
1)) (set
! n
(+ n
7))))
454 (if
(> n
6) (begin
(set
! o
(+ o
1)) (set
! n
(- n
7))))
455 (ly
:make-pitch o n
(/ a 4))))
457 #(define
(naturalize music
)
458 (let
* ((es (ly
:music-property music
'elements
))
459 (e (ly
:music-property music
'element
))
460 (p
(ly
:music-property music
'pitch
)))
462 (ly
:music-set-property
!
464 (map
(lambda
(x
) (naturalize x
)) es)))
466 (ly
:music-set-property
!
471 (set
! p
(naturalize-pitch p
))
472 (ly
:music-set-property
! music
'pitch p
)))
477 #(define-music-function
(parser location m
)