1 %------------------------------------------------------------------%
2 % Opéra Libre -- music-functions.ly %
4 % (c) Valentin Villenave, 2008, 2009 %
5 %------------------------------------------------------------------%
7 % Functions used for music notation.
9 %%%%%%%%%%%%%%%%%%%%%%%%% Music Shortcuts %%%%%%%%%%%%%%%%%%%%%%%%%%
11 %% Rhythm shortcuts -----------------------------------------------%
14 #(define-music-function
(parser location music
) (ly
:music?
)
15 #{ \times 2/3 $music
#})
18 #(define-music-function
(parser location music
) (ly
:music?
)
19 #{ \times 4/5 $music
#})
22 #(define-music-function
(parser location music
) (ly
:music?
)
23 #{ \times 4/6 $music
#})
26 #(define-music-function
(parser location music
) (ly
:music?
)
27 #{ \times 4/7 $music
#})
30 %% Polyphony shortcuts --------------------------------------------%
32 %%% Functions (Issue #442 workaround)
34 #(define
(remove music
) ; throw everything into the Big Void
...
35 (context-spec-music music
'Devnull
))
37 #(define
(unpitch music
)
38 ; in addition to the PitchSquash thing
, we need to make
39 ; accidentals disappear
(since these are engraved at
a
40 ; Staff level
, and since we don
't want to affect the
42 (let
* ((es (ly
:music-property music
'elements
))
43 (e (ly
:music-property music
'element
))
44 (p
(ly
:music-property music
'pitch
)))
46 (ly
:music-set-property
!
48 (map
(lambda
(x
) (unpitch x
)) es)))
50 (ly
:music-set-property
!
54 (ly
:music-set-property
! music
'pitch
0)))
57 #(define
(event-filter event
)
58 (let
((n
(ly
:music-property event
'name
)))
60 (eq? n
'ContextSpeccedMusic
) ; to avoid clefs and ottavas
61 (eq? n
'ContextChange
) ; cross-staff voices are supported
62 (eq? n
'ArpeggioEvent
)) ; arpeggios need to go too
63 (music-map remove event
))
64 (if
(eq? n
'SimultaneousMusic
) ; we don
't want
a new Voice to be created
65 (ly
:music-set-property
! event
'name
'NoteEvent
))))
68 #(define-music-function
(parser location music
) (ly
:music?
)
69 (context-spec-music
(music-filter event-filter
(unpitch music
)) 'PseudoVoice
))
72 #(define-music-function
(parser location one two
) (ly
:music? ly
:music?
)
73 #{ << { \voiceTwo $one
} \\ { \voiceOne $two
} >> #})
75 %%% Piano implementation
77 showAnyway
= %not needed
78 #(define-music-function
(parser location music
) (ly
:music?
)
80 \unset Score
.keepAliveInterfaces
82 \set Score
.keepAliveInterfaces
= #'(rhythmic-grob-interface
83 lyric-interface percent-repeat-item-interface
84 percent-repeat-interface stanza-number-interface
)
88 #(define-music-function
(parser location droite gauche
) (ly
:music? ly
:music?
)
93 \new Voice
{ \clef treble $droite
}
94 %\new Voice { \makeGhost $gauche }
98 \new Voice
{ \clef bass $gauche
}
99 %\new Voice { \makeGhost $droite }
104 md
= { \change Staff
= "md" }
106 mg
= { \change Staff
= "mg" }
108 %%% The same, for percussions.
111 #(define-music-function
(parser location droite gauche
) (ly
:music? ly
:music?
)
114 \new Staff
= "percuDroite"
116 \new Voice
{ \clef treble $droite
}
117 %\new Voice { \makeGhost $gauche }
119 \new Staff
= "percuGauche"
121 \new Voice
{ \clef bass $gauche
}
122 %\new Voice { \makeGhost $droite }
127 droite
= { \change Staff
= "percuDroite" }
129 gauche
= { \change Staff
= "percuGauche" }
132 #(define-music-function
(parser location one two
) (ly
:music? ly
:music?
)
133 #{ << { \stemDown $one
\stemNeutral } \new DrumVoice
{ \stemUp $two
} >> #})
136 %% Music formatting -----------------------------------------------%
139 #(define-music-function
(parser location notes
) (ly
:music?
)
140 #{ \tiny $notes
\normalsize #})
143 #(define-music-function
(parser location notes
) (ly
:music?
)
144 #{ \override NoteHead
#'style
= #'cross
146 \revert NoteHead
#'style
#})
149 #(define-music-function
(parser location music
) (ly
:music?
)
150 #{ \override Hairpin
#'to-barline
= ##f
151 $music
\revert Hairpin
#'to-barline
#})
154 #(define-music-function
(parser location music
) (ly
:music?
)
155 #{\override NoteHead
#'stencil
= #ly
:text-interface
::print
156 \override NoteHead
#'text
= \markup \musicglyph #"scripts.sforzato"
157 \override NoteHead
#'extra-offset
= #'(0.1 . 0.0 )
159 \revert NoteHead
#'stencil
160 \revert NoteHead
#'text
161 \revert NoteHead
#'extra-offset
#})
164 \once \override NoteHead
#'transparent
= ##t
165 \once \override NoteHead
#'no-ledgers
= ##t
166 \once \override Stem
#'transparent
= ##t
167 \once \override Beam
#'transparent
= ##t
168 \once \override Accidental
#'transparent
= ##t
172 \once \override TupletBracket
#'transparent
= ##t
173 \once \override TupletNumber
#'transparent
= ##t
177 \once \override Stem
#'direction
= #DOWN
181 \once \override Stem
#'direction
= #UP
184 %% Music shortcuts ------------------------------------------------%
186 sk
= \set Score
.skipTypesetting
= ##t
188 unsk
= \set Score
.skipTypesetting
= ##f
190 % This might not be needed
191 #(define
(octave-up noteevent
)
192 (let
* ((pitch
(ly
:music-property noteevent
'pitch
))
193 (octave
(ly
:pitch-octave pitch
))
194 (note
(ly
:pitch-notename pitch
))
195 (alteration
(ly
:pitch-alteration pitch
))
196 (duration
(ly
:music-property noteevent
'duration
))
198 (make-music
'NoteEvent
200 'pitch
(ly
:make-pitch
(1- octave
) note alteration
))))
203 #(define
(octavize-chord elements
)
204 (cond
((null? elements
) elements
)
205 ((eq?
(ly
:music-property
(car elements
) 'name
) 'NoteEvent
)
207 (cons
(octave-up
(car elements
))
208 (octavize-chord
(cdr elements
)))))
209 (else
(cons
(car elements
) (octavize-chord
(cdr elements
))))))
211 #(define
(octavize music
)
212 (let
* ((es (ly
:music-property music
'elements
))
213 (e (ly
:music-property music
'element
))
214 (name
(ly
:music-property music
'name
)))
215 (cond
((eq? name
'EventChord
)
216 (ly
:music-set-property
! music
'elements
(octavize-chord
es)))
218 (for-each
(lambda
(x
) (octavize x
)) es))
223 oct
= #(define-music-function
(parser location mus
) (ly
:music?
)
227 %%%%%%%%%%%%%%%%%%%%%%%%% Music Decoration %%%%%%%%%%%%%%%%%%%%%%%%%
229 %% Articulation marks ---------------------------------------------%
231 #(define
(make-script x
)
232 (make-music
'ArticulationEvent
233 'articulation-type x
))
235 #(define
(add-script m x
)
236 (let
( (eventname
(ly
:music-property m
'name
)))
237 (if
(equal? eventname
'EventChord
)
238 (let
( (elements
(ly
:music-property m
'elements
)) )
239 (if
(not
(equal?
(ly
:music-property
(car elements
)
241 (set
! (ly
:music-property m
'elements
)
242 (append elements
(list
243 (make-script x
)))))))
246 #(define
(double-script m t tt
)
247 (add-script
(add-script m t
) tt
))
250 #(define-music-function
(parser location music
)
252 (define
(make-script-music m
)
253 (add-script m
"staccato"))
254 (music-map make-script-music music
))
257 #(define-music-function
(parser location music
)
259 (define
(make-script-music m
)
260 (add-script m
"accent"))
261 (music-map make-script-music music
))
263 det
= % I call these "det" as in "détaché".
264 #(define-music-function
(parser location music
)
266 (define
(make-script-music m
)
267 (add-script m
"tenuto"))
268 (music-map make-script-music music
))
271 #(define-music-function
(parser location music
)
273 (define
(make-script-music m
)
274 (add-script m
"portato"))
275 (music-map make-script-music music
))
278 #(define-music-function
(parser location music
)
280 (define
(make-script-music m
)
281 (double-script m
"tenuto" "accent"))
282 (music-map make-script-music music
))
285 #(define-music-function
(parser location music
)
287 (define
(make-script-music m
)
288 (double-script m
"accent" "staccato"))
289 (music-map make-script-music music
))
292 #(define-music-function
(parser location music
)
294 (define
(make-script-music m
)
295 (add-script m
"downbow"))
296 (music-map make-script-music music
))
299 #(let
((m
(make-music
'ArticulationEvent
300 'articulation-type
"flageolet")))
301 (set
! (ly
:music-property m
'tweaks
)
303 (ly
:music-property m
'tweaks
)))
306 #(define-music-function
(parser location chord result
) (ly
:music? ly
:music?
)
307 #{ << \oneStemDown $chord
\\ { \stemUp %FIXME: ties could look better.
308 \override NoteHead
#'stencil
= #ly
:text-interface
::print
309 \override NoteHead
#'text
= \markup { \null \musicglyph #"noteheads.s2"}
310 \once \override NoteHead
#'text
= \markup {\null \override #'(direction
. 1)
311 \dir-column
{\musicglyph #"noteheads.s2" \teeny \musicglyph #"eight"}}
312 \override Stem
#'stencil
= ##f $result
313 \revert Stem
#'stencil
\revert NoteHead
#'stencil
\stemNeutral } >> #})
316 #(define-music-function
(parser location music
) (ly
:music?
)
318 \override Dots
#'transparent
= ##t
319 \override Stem
#'transparent
= ##t
320 \override Beam
#'transparent
= ##t
321 \override NoteHead
#'style
= #'harmonic
323 \revert NoteHead
#'style
324 \revert Beam
#'transparent
325 \revert Stem
#'transparent
326 \revert Dots
#'transparent
#})
329 #(let
* ((m
(make-music
'ArticulationEvent
330 'articulation-type
"stopped"
332 (ly
:music-set-property
! m
'tweaks
337 #:musicglyph
"scripts.stopped")
338 (acons
'stencil ly
:text-interface
::print
339 (ly
:music-property m
'tweaks
)))))
343 #(let
* ((m
(make-music
'ArticulationEvent
344 'articulation-type
"stopped"
346 (ly
:music-set-property
! m
'tweaks
348 (ly
:music-property m
'tweaks
)))
352 #(let
* ((m
(make-music
'ArpeggioEvent
)))
353 (ly
:music-set-property
! m
'tweaks
354 (acons
'arpeggio-direction
1
355 (ly
:music-property m
'tweaks
)))
359 #(let
* ((m
(make-music
'ArpeggioEvent
)))
360 (ly
:music-set-property
! m
'tweaks
361 (acons
'arpeggio-direction -
1
362 (ly
:music-property m
'tweaks
)))
366 #(let
* ((m
(make-music
'ArpeggioEvent
)))
367 (ly
:music-set-property
! m
'tweaks
368 (acons
'stencil ly
:arpeggio
::brew-chord-bracket
369 (ly
:music-property m
'tweaks
)))
372 %%% TODO: custom scripts priority.
373 #(define modern-scripts default-script-alist
)
375 %%%%%%%%%%%%%%%%%%%%%%%% Layout Functions %%%%%%%%%%%%%%%%%%%%%%%%%%
377 %% Music layout ---------------------------------------------------%
379 #(define modern-auto-beam-settings
380 (append default-beam-settings
382 ((end
* * 3 4) . ,(ly
:make-moment
1 4))
383 ((end
* * 3 4) . ,(ly
:make-moment
1 2))
384 ((end
* * 4 4) . ,(ly
:make-moment
1 4))
385 ((end
* * 4 4) . ,(ly
:make-moment
3 4))
386 ((end
* * 2 2) . ,(ly
:make-moment
1 4))
387 ((end
* * 2 2) . ,(ly
:make-moment
1 2))
388 ((end
* * 2 2) . ,(ly
:make-moment
3 4))
389 ((end
* * 2 8) . ,(ly
:make-moment
1 4))
390 ((be
* * 5 8) . ,(ly
:make-moment
1 8))
391 ((end
* * 5 8) . ,(ly
:make-moment
5 8))
394 #(define modern-accidentals-style
395 `
(Staff
,(make-accidental-rule
'same-octave
0)
396 ,(make-accidental-rule
'any-octave
0)
397 ,(make-accidental-rule
'same-octave
1)
398 ,neo-modern-accidental-rule
))
399 #(define modern-cautionaries-style
400 `
(Staff
,(make-accidental-rule
'same-octave
1)
401 ,(make-accidental-rule
'any-octave
1)))
403 %%%%%%%%%%%%%%%%%%%%%%%%%%%% Editorial %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
405 %% Individual parts -----------------------------------------------%
408 #(define-music-function
(parser location part ref
)
409 (ly
:music? ly
:music?
)
410 #{\context Staff
<< $part
\new GhostVoice $ref
>> #})
412 makeSection
= % two parts
413 #(define-music-function
(parser location part-one part-two ref
)
414 (ly
:music? ly
:music? ly
:music?
)
416 \new Staff
<< $part-one
\new GhostVoice $ref
>>
420 makeExtraSection
= % three parts, e.g. for violins
421 #(define-music-function
(parser location part-one part-two part-three ref
)
422 (ly
:music? ly
:music? ly
:music? ly
:music?
)
424 \new Staff
<< $part-one
\new GhostVoice $ref
>>
426 \new Staff $part-three
430 #(define-music-function
(parser location part-one ref
)
431 (ly
:music? ly
:music?
)
432 #{<< $part-one
\new GhostVoice $ref
>> #})
434 %%-----------------------------------------------------------------%
437 #(define
(naturalize-pitch p
)
438 (let
* ((o
(ly
:pitch-octave p
))
439 (a (* 4 (ly
:pitch-alteration p
)))
440 ; alteration
, a, in quarter tone steps
, for historical reasons
441 (n
(ly
:pitch-notename p
)))
443 ((and
(> a 1) (or
(eq? n
6) (eq? n
2)))
446 ((and
(< a -
1) (or
(eq? n
0) (eq? n
3)))
450 ((> a 2) (set
! a (-
a 4)) (set
! n
(+ n
1)))
451 ((< a -
2) (set
! a (+
a 4)) (set
! n
(- n
1))))
452 (if
(< n
0) (begin
(set
! o
(- o
1)) (set
! n
(+ n
7))))
453 (if
(> n
6) (begin
(set
! o
(+ o
1)) (set
! n
(- n
7))))
454 (ly
:make-pitch o n
(/ a 4))))
456 #(define
(naturalize music
)
457 (let
* ((es (ly
:music-property music
'elements
))
458 (e (ly
:music-property music
'element
))
459 (p
(ly
:music-property music
'pitch
)))
461 (ly
:music-set-property
!
463 (map
(lambda
(x
) (naturalize x
)) es)))
465 (ly
:music-set-property
!
470 (set
! p
(naturalize-pitch p
))
471 (ly
:music-set-property
! music
'pitch p
)))
476 #(define-music-function
(parser location m
)