6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7 %% this file is alphabetically sorted.
8 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
12 #(use-modules
(srfi srfi-
1))
15 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic
16 (_i
"Create an acciaccatura from the following music expression"))
19 #(define-music-function
(parser location name music
) (string? ly
:music?
)
20 (_i
"Define @var{music} as a quotable music expression named
22 (add-quotable parser name music
)
23 (make-music
'SequentialMusic
'void
#t
))
29 #(define-music-function
30 (parser location main grace
)
32 (_i
"Create @var{grace} note(s) after a @var{main} music expression.")
34 ((main-length
(ly
:music-length main
))
35 (fraction
(ly
:parser-lookup parser
'afterGraceFraction
)))
37 (make-simultaneous-music
40 (make-sequential-music
43 (make-music
'SkipMusic
44 'duration
(ly
:make-duration
46 (* (ly
:moment-main-numerator main-length
)
48 (* (ly
:moment-main-denominator main-length
)
50 (make-music
'GraceMusic
54 #(define-music-function
(parser location func music
) (procedure? ly
:music?
)
55 (_i
"Apply procedure @var{func} to @var{music}.")
60 #(define-music-function
(parser location ctx proc
) (symbol? procedure?
)
61 (_i
"Apply function @code{proc} to every layout object in context @code{ctx}")
62 (make-music
'ApplyOutputEvent
68 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
69 (_i
"Create an appoggiatura from @var{music}"))
72 % for regression testing purposes.
74 #(define-music-function
(parser location l r
) (pair? pair?
)
75 (_i
"Testing function: check whether the beam quants @var{l} and @var{r} are correct")
76 (make-grob-property-override
'Beam
'positions
77 (ly
:make-simple-closure
78 (ly
:make-simple-closure
80 (list chain-grob-member-functions `
(,cons
0 0))
81 (check-quant-callbacks l r
))))))
83 % for regression testing purposes.
85 #(define-music-function
(parser location comp
) (procedure?
)
86 (_i
"Testing function: check whether the slope of the beam is the same as @code{comp}")
87 (make-grob-property-override
'Beam
'positions
88 (ly
:make-simple-closure
89 (ly
:make-simple-closure
91 (list chain-grob-member-functions `
(,cons
0 0))
92 (check-slope-callbacks comp
))))))
97 #(define-music-function
(parser location music
) (ly
:music?
)
98 (_i
"Make voices that switch between staves automatically")
99 (make-autochange-music parser music
))
102 #(define-music-function
(parser location proc
) (procedure?
)
103 (_i
"Modify context properties with Scheme procedure @var{proc}.")
104 (make-music
'ApplyContext
110 #(define-music-function
(parser location grob-name offset text
)
111 (symbol? number-pair? markup?
)
112 (_i
"Attach @var{text} to @var{grob-name} at offset @var{offset}
113 (use like @code{\\once})")
114 (make-music
'AnnotateOutputEvent
116 'X-offset
(car offset
)
117 'Y-offset
(cdr offset
)
121 #(define-music-function
(parser location offset text
) (number-pair? markup?
)
122 (_i
"Attach @var{text} at @var{offset} (use like @code{\\tweak})")
123 (make-music
'AnnotateOutputEvent
124 'X-offset
(car offset
)
125 'Y-offset
(cdr offset
)
130 #(define-music-function
(parser location type
) (string?
)
131 (_i
"Insert a bar line of type @var{type}")
133 (make-property-set
'whichBar type
)
138 #(define-music-function
(parser location n
) (integer?
)
139 (_i
"Print a warning if the current bar number is not @var{n}.")
140 (make-music
'ApplyContext
145 ((cbn
(ly
:context-property
c 'currentBarNumber
)))
146 (if
(and
(number? cbn
) (not
(= cbn n
)))
147 (ly
:input-message location
"Barcheck failed got ~a expect ~a"
152 #(define-music-function
(parser location delta
) (real?
)
153 (_i
"Create a fall or doit of pitch interval @var{delta}.")
154 (make-music
'BendAfterEvent
159 #(define-music-function
(parser location
) ()
160 (_i
"Insert a breath mark.")
161 (make-music
'EventChord
163 'elements
(list
(make-music
'BreathingEvent
))))
167 #(define-music-function
(parser location type
) (string?
)
168 (_i
"Set the current clef to @var{type}.")
169 (make-clef-set type
))
173 #(define-music-function
174 (parser location what dir main-music
) (string? ly
:dir? ly
:music?
)
175 (_i
"Insert contents of quote @var{what} corresponding to @var{main-music},
176 in a CueVoice oriented by @var{dir}.")
177 (make-music
'QuoteMusic
179 'quoted-context-type
'Voice
180 'quoted-context-id
"cue"
181 'quoted-music-name what
182 'quoted-voice-direction dir
186 #(define-music-function
(parser location music
) (ly
:music?
)
187 (_i
"Display the LilyPond input representation of @var{music}
190 (display-lily-music music parser
)
194 #(define-music-function
(parser location music
) (ly
:music?
)
195 (_i
"Display the internal representation of @var{music} to the console.")
197 (display-scheme-music music
)
202 #(define-music-function
(parser location music
) (ly
:music?
)
203 (_i
"Terminate the next spanner prematurely after exactly one note without the need of a specific end spanner.")
204 (if
(eq?
(ly
:music-property music
'name
) 'EventChord
)
206 ((elts
(ly
:music-property music
'elements
))
207 (start-span-evs
(filter
(lambda
(ev
)
208 (and
(music-has-type ev
'span-event
)
209 (equal?
(ly
:music-property ev
'span-direction
)
214 (let
* ((c (music-clone m
)))
215 (set
! (ly
:music-property
c 'span-direction
) STOP
)
218 (end-ev-chord
(make-music
'EventChord
219 'elements stop-span-evs
))
220 (total
(make-music
'SequentialMusic
221 'elements
(list music
225 (ly
:input-message location
(_ "argument endSpanners is not an EventChord: ~a" music
))))
228 #(define-music-function
(parser location factor argument
) (ly
:moment? ly
:music?
)
229 (_i
"Adjust durations of music in @var{argument} by rational @var{factor}. ")
231 ((orig-duration
(ly
:music-length argument
))
232 (multiplier
(ly
:make-moment
1 1)))
236 (if
(and
(eq?
(ly
:music-property mus
'name
) 'EventChord
)
237 (< 0 (ly
:moment-main-denominator
(ly
:music-length mus
))))
239 (ly
:music-compress mus multiplier
)
240 (set
! multiplier
(ly
:moment-mul factor multiplier
)))
247 (ly
:moment-div orig-duration
(ly
:music-length argument
)))
252 #(def-grace-function startGraceMusic stopGraceMusic
253 (_i
"Insert @var{music} as grace notes."))
255 "instrument-definitions" = #'()
257 addInstrumentDefinition
=
258 #(define-music-function
259 (parser location name lst
) (string? list?
)
260 (_i
"Create instrument @var{name} with properties @var{list}.")
261 (set
! instrument-definitions
(acons name lst instrument-definitions
))
263 (make-music
'SequentialMusic
'void
#t
))
267 #(define-music-function
268 (parser location name
) (string?
)
269 (_i
"Switch instrument to @var{name}, which must be predefined with
270 @var{\addInstrumentDefinition}.")
272 ((handle
(assoc name instrument-definitions
))
273 (instrument-def
(if handle
(cdr handle
) '()))
277 (ly
:input-message
"No such instrument: ~a" name
))
279 (make-music
'SimultaneousMusic
289 %% Parser used to read page-layout file, and then retreive score tweaks.
290 #(define page-layout-parser
#f)
292 includePageLayoutFile
=
293 #(define-music-function
(parser location
) ()
294 (_i
"Include the file @var{<basename>-page-layout.ly}. Deprecated as
295 part of two-pass spacing.")
296 (if
(not
(ly
:get-option
'dump-tweaks
))
297 (let
((tweak-filename
(format
#f "~a-page-layout.ly"
298 (ly
:parser-output-name parser
))))
299 (if
(access? tweak-filename R
_OK
)
301 (ly
:message
"Including tweak file ~a" tweak-filename
)
302 (set
! page-layout-parser
(ly
:parser-clone parser
))
303 (ly
:parser-parse-string page-layout-parser
304 (format
#f "\\include \"~a\""
306 (make-music
'SequentialMusic
'void
#t
))
309 #(define-music-function
310 (parser location tag music
) (symbol? ly
:music?
)
311 (_i
"Include only elements of @var{music} that are tagged with @var{tag}.")
314 (let
* ((tags
(ly
:music-property m
'tags
))
315 (res
(memq tag tags
)))
322 #(define-music-function
323 (parser location tag music
) (symbol? ly
:music?
)
324 (_i
"Remove elements of @var{music} that are tagged with @var{tag}.")
327 (let
* ((tags
(ly
:music-property m
'tags
))
328 (res
(memq tag tags
)))
333 #(define-music-function
334 (parser location music
)
336 (_i
"Remove cue notes from @var{music}.")
339 (if
(string?
(ly
:music-property mus
'quoted-music-name
))
340 (ly
:music-property mus
'element
)
344 #(define-music-function
(parser location label
) (symbol?
)
345 (_i
"Create @var{label} as a bookmarking label")
346 (make-music
'EventChord
349 'elements
(list
(make-music
'LabelEvent
350 'page-label label
))))
353 #(define-music-function
354 (parser location arg
) (ly
:music?
)
355 (_i
"Display chords in @var{arg} as clusters")
356 (music-map note-to-cluster arg
))
359 #(define-music-function
(parser location proc mus
) (procedure? ly
:music?
)
360 (music-map proc mus
))
364 #(define-music-function
(parser location name property value
)
365 (string? symbol? scheme?
)
367 (_i
"Set @var{property} to @var{value} in all grobs named @var{name}.
368 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
369 or @code{\"GrobName\"}")
372 ((name-components
(string-split name
#\
.))
373 (context-name
'Bottom
)
376 (if
(> 2 (length name-components
))
377 (set
! grob-name
(string-
>symbol
(car name-components
)))
379 (set
! grob-name
(string-
>symbol
(list-ref name-components
1)))
380 (set
! context-name
(string-
>symbol
(list-ref name-components
0)))))
382 (make-music
'ApplyOutputEvent
384 'context-type context-name
386 (lambda
(grob orig-context context
)
388 (cdr
(assoc
'name
(ly
:grob-property grob
'meta
)))
390 (set
! (ly
:grob-property grob property
) value
))))))
392 %% These are music functions (iso music indentifiers), because music identifiers
393 %% are not allowed at top-level.
395 #(define-music-function
(location parser
) ()
396 (_i
"Force a page break. May be used at toplevel (ie between scores or
397 markups), or inside a score.")
398 (make-music
'EventChord
400 'line-break-permission
'force
401 'page-break-permission
'force
402 'elements
(list
(make-music
'LineBreakEvent
403 'break-permission
'force
)
404 (make-music
'PageBreakEvent
405 'break-permission
'force
))))
408 #(define-music-function
(location parser
) ()
409 (_i
"Forbid a page break. May be used at toplevel (ie between scores or
410 markups), or inside a score.")
411 (make-music
'EventChord
413 'page-break-permission
'forbid
414 'elements
(list
(make-music
'PageBreakEvent
415 'break-permission
'()))))
418 #(define-music-function
(location parser
) ()
419 (_i
"Force a page turn between two scores or top-level markups.")
420 (make-music
'EventChord
422 'line-break-permission
'force
423 'page-break-permission
'force
424 'page-turn-permission
'force
425 'elements
(list
(make-music
'LineBreakEvent
426 'break-permission
'force
)
427 (make-music
'PageBreakEvent
428 'break-permission
'force
)
429 (make-music
'PageTurnEvent
430 'break-permission
'force
))))
433 #(define-music-function
(location parser
) ()
434 (_i
"Forbid a page turn. May be used at toplevel (ie between scores or
435 markups), or inside a score.")
436 (make-music
'EventChord
438 'page-turn-permission
'forbid
439 'elements
(list
(make-music
'PageTurnEvent
440 'break-permission
'()))))
443 #(define-music-function
(location parser
) ()
444 (_i
"Allow a page turn. May be used at toplevel (ie between scores or
445 markups), or inside a score.")
446 (make-music
'EventChord
448 'page-turn-permission
'allow
449 'elements
(list
(make-music
'PageTurnEvent
450 'break-permission
'allow
))))
454 %% define-music-function in a .scm causes crash.
457 #(define-music-function
(parser location pitch-note
) (ly
:music?
)
460 (make-music
'RelativeOctaveCheck
462 'pitch
(pitch-of-note pitch-note
)
465 ottava
= #(define-music-function
(parser location octave
) (number?
)
466 (_i
"set the octavation ")
467 (make-ottava-set octave
))
470 #(define-music-function
(parser location part
1 part
2) (ly
:music? ly
:music?
)
471 (make-part-combine-music parser
476 #(define-music-function
477 (parser location main-note secondary-note
)
478 (ly
:music? ly
:music?
)
480 ((get-notes
(lambda
(ev-chord
)
482 (lambda
(m
) (eq?
'NoteEvent
(ly
:music-property m
'name
)))
483 (ly
:music-property ev-chord
'elements
))))
484 (sec-note-events
(get-notes secondary-note
))
485 (trill-events
(filter
(lambda
(m
) (music-has-type m
'trill-span-event
))
486 (ly
:music-property main-note
'elements
))))
488 (if
(pair? sec-note-events
)
491 ((trill-pitch
(ly
:music-property
(car sec-note-events
) 'pitch
))
492 (forced
(ly
:music-property
(car sec-note-events
) 'force-accidental
)))
494 (if
(ly
:pitch? trill-pitch
)
495 (for-each
(lambda
(m
) (ly
:music-set-property
! m
'pitch trill-pitch
))
498 (ly
:warning
(_ "Second argument of \\pitchedTrill should be single note: "))
499 (display sec-note-events
)))
502 (for-each
(lambda
(m
) (ly
:music-set-property
! m
'force-accidental forced
))
509 #(use-modules
(ice-
9 optargs
))
512 #(define-music-function
(parser location voice-ids music
) (list? ly
:music?
)
513 (_i
"Define parallel music sequences, separated by '|' (bar check signs),
514 and assign them to the identifiers provided in @var{voice-ids}.
516 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
518 @var{music}: a music sequence, containing BarChecks as limiting expressions.
523 \\parallelMusic #'(A B C) {
533 (let
* ((voices
(apply circular-list
(make-list
(length voice-ids
) (list
))))
534 (current-voices voices
)
535 (current-sequence
(list
)))
538 (define
(push-music m
)
539 "Push the music expression into the current sequence"
540 (set
! current-sequence
(cons m current-sequence
)))
541 (define
(change-voice
)
542 "Stores the previously built sequence into the current voice and
543 change to the following voice."
544 (list-set
! current-voices
0 (cons
(make-music
'SequentialMusic
545 'elements
(reverse
! current-sequence
))
546 (car current-voices
)))
547 (set
! current-sequence
(list
))
548 (set
! current-voices
(cdr current-voices
)))
549 (define
(bar-check? m
)
550 "Checks whether m is a bar check."
551 (eq?
(ly
:music-property m
'name
) 'BarCheck
))
552 (define
(music-origin music
)
553 "Recursively search an origin location stored in music."
554 (cond
((null? music
) #f)
555 ((not
(null?
(ly
:music-property music
'origin
)))
556 (ly
:music-property music
'origin
))
557 (else
(or
(music-origin
(ly
:music-property music
'element
))
558 (let
((origins
(remove not
(map music-origin
559 (ly
:music-property music
'elements
)))))
560 (and
(not
(null? origins
)) (car origins
)))))))
562 ;; first
, split the music and fill in voices
563 (map-in-order
(lambda
(m
)
565 (if
(bar-check? m
) (change-voice
)))
566 (ly
:music-property music
'elements
))
567 (if
(not
(null? current-sequence
)) (change-voice
))
568 ;; un-circularize `voices
' and reorder the voices
569 (set
! voices
(map-in-order
(lambda
(dummy seqs
)
573 ;; set origin location of each sequence in each voice
574 ;; for better type error tracking
575 (for-each
(lambda
(voice
)
576 (for-each
(lambda
(seq
)
577 (set
! (ly
:music-property seq
'origin
)
578 (or
(music-origin seq
) location
)))
582 ;; check sequence length
583 (apply for-each
(lambda
* (#:rest seqs
)
584 (let
((moment-reference
(ly
:music-length
(car seqs
))))
585 (for-each
(lambda
(seq moment
)
586 (if
(not
(equal? moment moment-reference
))
587 (ly
:music-message seq
588 "Bars in parallel music don't have the same length")))
589 seqs
(map-in-order ly
:music-length seqs
))))
592 ;; bind voice identifiers to the voices
593 (map
(lambda
(voice-id voice
)
594 (ly
:parser-define
! parser voice-id
595 (make-music
'SequentialMusic
599 ;; Return an empty sequence
. this function is actually
a "void" function
.
600 (make-music
'SequentialMusic
'void
#t
))
605 #(define-music-function
(parser loc arg
) (ly
:music?
)
606 (_i
"Tag @var{arg} to be parenthesized.")
608 (if
(memq
'event-chord
(ly
:music-property arg
'types
))
609 ; arg is an EventChord -
> set the parenthesize property on all child notes and rests
612 (if
(or
(memq
'note-event
(ly
:music-property ev
'types
))
613 (memq
'rest-event
(ly
:music-property ev
'types
)))
614 (set
! (ly
:music-property ev
'parenthesize
) #t
)))
615 (ly
:music-property arg
'elements
))
616 ; No chord
, simply set property for this expression
:
617 (set
! (ly
:music-property arg
'parenthesize
) #t
))
622 (define-music-function
623 (parser location what main-music
)
625 (make-music
'QuoteMusic
627 'quoted-music-name what
632 resetRelativeOctave
=
633 #(define-music-function
634 (parser location reference-note
)
636 (_i
"Set the octave inside a \\relative section.")
639 ((notes
(ly
:music-property reference-note
'elements
))
640 (pitch
(ly
:music-property
(car notes
) 'pitch
)))
642 (set
! (ly
:music-property reference-note
'elements
) '())
643 (set
! (ly
:music-property reference-note
644 'to-relative-callback
)
645 (lambda
(music last-pitch
)
652 #(define-music-function
(parser location fraction music
) (number-pair? ly
:music?
)
653 (_i
"Multiply the duration of events in @var{music} by @var{fraction}.")
654 (ly
:music-compress music
655 (ly
:make-moment
(car fraction
) (cdr fraction
))))
660 #(define-music-function
(parser location dur dots arg
) (integer? integer? ly
:music?
)
661 (_i
"Scale @var{arg} up by a factor of @var{2^dur*(2-(1/2)^dots)}.")
665 (shift-one-duration-log x dur dots
)) arg
))
668 #(define-music-function
(parser location parameters
) (list?
)
669 (_i
"Set the system stretch, by reading the 'system-stretch property of
670 the `parameters' assoc list.")
672 \overrideProperty #"Score.NonMusicalPaperColumn"
673 #'line-break-system-details
674 #$
(list
(cons
'alignment-extra-space
(cdr
(assoc
'system-stretch parameters
)))
675 (cons
'system-Y-extent
(cdr
(assoc
'system-Y-extent parameters
))))
680 #(define-music-function
(parser location finger
) (number-or-string?
)
681 (_i
"Apply @var{finger} as a fingering indication.")
690 (list
'digit finger
)))))
693 #(define-music-function
(parser location name
) (string?
)
694 (_i
"Include the score tweak, if exists.")
695 (if
(and page-layout-parser
(not
(ly
:get-option
'dump-tweaks
)))
696 (let
((tweak-music
(ly
:parser-lookup page-layout-parser
697 (string-
>symbol name
))))
698 (if
(ly
:music? tweak-music
)
700 (make-music
'SequentialMusic
)))
701 (make-music
'SequentialMusic
)))
705 #(define-music-function
(parser location tag arg
)
708 (_i
"Add @var{tag} to the @code{tags} property of @var{arg}.")
711 (ly
:music-property arg
'tags
)
713 (ly
:music-property arg
'tags
)))
718 transposedCueDuring
=
719 #(define-music-function
720 (parser location what dir pitch-note main-music
)
721 (string? ly
:dir? ly
:music? ly
:music?
)
723 (_i
"Insert notes from the part @var{what} into a voice called @code{cue},
724 using the transposition defined by @var{pitch-note}. This happens
725 simultaneously with @var{main-music}, which is usually a rest. The
726 argument @var{dir} determines whether the cue notes should be notated
727 as a first or second voice.")
729 (make-music
'QuoteMusic
731 'quoted-context-type
'Voice
732 'quoted-context-id
"cue"
733 'quoted-music-name what
734 'quoted-voice-direction dir
735 'quoted-transposition
(pitch-of-note pitch-note
)
741 #(define-music-function
(parser location pitch-note
) (ly
:music?
)
742 (_i
"Set instrument transposition")
745 (make-property-set
'instrumentTransposition
746 (ly
:pitch-negate
(pitch-of-note pitch-note
)))
750 #(define-music-function
(parser location sym val arg
)
751 (symbol? scheme? ly
:music?
)
752 (_i
"Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
754 (if
(equal?
(object-property sym
'backend-type?
) #f)
756 (ly
:warning
(_ "cannot find property type-check for ~a") sym
)
757 (ly
:warning
(_ "doing assignment anyway"))))
759 (ly
:music-property arg
'tweaks
)
761 (ly
:music-property arg
'tweaks
)))
767 #(define-music-function
(parser location music
) (ly
:music?
)
768 (unfold-repeats music
))
773 #(define-music-function
(parser location sym val music
) (symbol? scheme? ly
:music?
)
774 (_i
"Set @var{sym} to @var{val} in @var{music}.")
776 (set
! (ly
:music-property music sym
) val
)