6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7 %% this file is alphabetically sorted.
8 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
12 #(use-modules
(srfi srfi-
1))
15 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic
)
18 #(define-music-function
(parser location name music
) (string? ly
:music?
)
19 (_i
"Add a piece of music to be quoted ")
20 (add-quotable parser name music
)
21 (make-music
'SequentialMusic
'void
#t
))
27 #(define-music-function
28 (parser location main grace
)
32 ((main-length
(ly
:music-length main
))
33 (fraction
(ly
:parser-lookup parser
'afterGraceFraction
)))
35 (make-simultaneous-music
38 (make-sequential-music
41 (make-music
'SkipMusic
42 'duration
(ly
:make-duration
44 (* (ly
:moment-main-numerator main-length
)
46 (* (ly
:moment-main-denominator main-length
)
48 (make-music
'GraceMusic
52 #(define-music-function
(parser location func music
) (procedure? ly
:music?
)
57 #(define-music-function
(parser location ctx proc
) (symbol? procedure?
)
58 (make-music
'ApplyOutputEvent
64 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
)
68 % for regression testing purposes.
70 #(define-music-function
(parser location l r
) (pair? pair?
)
71 (make-grob-property-override
'Beam
'positions
72 (ly
:make-simple-closure
73 (ly
:make-simple-closure
75 (list chain-grob-member-functions `
(,cons
0 0))
76 (check-quant-callbacks l r
))))))
78 % for regression testing purposes.
80 #(define-music-function
(parser location comp
) (procedure?
)
81 (make-grob-property-override
'Beam
'positions
82 (ly
:make-simple-closure
83 (ly
:make-simple-closure
85 (list chain-grob-member-functions `
(,cons
0 0))
86 (check-slope-callbacks comp
))))))
91 #(define-music-function
(parser location music
) (ly
:music?
)
92 (make-autochange-music parser music
))
95 #(define-music-function
(parser location proc
) (procedure?
)
96 (make-music
'ApplyContext
102 #(define-music-function
(parser location grob-name offset text
) (symbol? number-pair? markup?
)
104 (make-music
'AnnotateOutputEvent
106 'X-offset
(car offset
)
107 'Y-offset
(cdr offset
)
111 #(define-music-function
(parser location offset text
) (number-pair? markup?
)
113 (make-music
'AnnotateOutputEvent
114 'X-offset
(car offset
)
115 'Y-offset
(cdr offset
)
120 #(define-music-function
(parser location type
)
123 (make-property-set
'whichBar type
)
128 #(define-music-function
(parser location n
) (integer?
)
129 (make-music
'ApplyContext
134 ((cbn
(ly
:context-property
c 'currentBarNumber
)))
135 (if
(and
(number? cbn
) (not
(= cbn n
)))
136 (ly
:input-message location
"Barcheck failed got ~a expect ~a"
141 #(define-music-function
(parser location delta
) (real?
)
143 (make-music
'BendAfterEvent
148 #(define-music-function
(parser location
) ()
149 (make-music
'EventChord
151 'elements
(list
(make-music
'BreathingEvent
))))
155 #(define-music-function
(parser location type
)
157 (_i
"Set the current clef.")
159 (make-clef-set type
))
163 #(define-music-function
164 (parser location what dir main-music
)
165 (string? ly
:dir? ly
:music?
)
166 (make-music
'QuoteMusic
168 'quoted-context-type
'Voice
169 'quoted-context-id
"cue"
170 'quoted-music-name what
171 'quoted-voice-direction dir
175 #(define-music-function
(parser location music
) (ly
:music?
)
177 (display-lily-music music parser
)
181 #(define-music-function
(parser location music
) (ly
:music?
)
183 (display-scheme-music music
)
188 #(define-music-function
(parser location music
) (ly
:music?
)
189 (if
(eq?
(ly
:music-property music
'name
) 'EventChord
)
191 ((elts
(ly
:music-property music
'elements
))
192 (start-span-evs
(filter
(lambda
(ev
)
193 (and
(music-has-type ev
'span-event
)
194 (equal?
(ly
:music-property ev
'span-direction
)
199 (let
* ((c (music-clone m
)))
200 (set
! (ly
:music-property
c 'span-direction
) STOP
)
203 (end-ev-chord
(make-music
'EventChord
204 'elements stop-span-evs
))
205 (total
(make-music
'SequentialMusic
206 'elements
(list music
210 (ly
:input-message location
(_ "argument endSpanners is not an EventChord: ~a" music
))))
213 #(define-music-function
(parser location factor argument
) (ly
:moment? ly
:music?
)
214 (_i
"Rearrange durations in ARGUMENT so there is an
215 acceleration/deceleration. ")
218 ((orig-duration
(ly
:music-length argument
))
219 (multiplier
(ly
:make-moment
1 1)))
223 (if
(and
(eq?
(ly
:music-property mus
'name
) 'EventChord
)
224 (< 0 (ly
:moment-main-denominator
(ly
:music-length mus
))))
226 (ly
:music-compress mus multiplier
)
227 (set
! multiplier
(ly
:moment-mul factor multiplier
)))
234 (ly
:moment-div orig-duration
(ly
:music-length argument
)))
239 #(def-grace-function startGraceMusic stopGraceMusic
)
242 "instrument-definitions" = #'()
244 addInstrumentDefinition
=
245 #(define-music-function
246 (parser location name lst
) (string? list?
)
248 (set
! instrument-definitions
(acons name lst instrument-definitions
))
250 (make-music
'SequentialMusic
'void
#t
))
254 #(define-music-function
255 (parser location name
) (string?
)
257 ((handle
(assoc name instrument-definitions
))
258 (instrument-def
(if handle
(cdr handle
) '()))
262 (ly
:input-message
"No such instrument: ~a" name
))
264 (make-music
'SimultaneousMusic
274 %% Parser used to read page-layout file, and then retreive score tweaks.
275 #(define page-layout-parser
#f)
277 includePageLayoutFile
=
278 #(define-music-function
(parser location
) ()
279 (_i
"If page breaks and tweak dump is not asked, and the file
280 <basename>-page-layout.ly exists, include it.")
281 (if
(not
(ly
:get-option
'dump-tweaks
))
282 (let
((tweak-filename
(format
#f "~a-page-layout.ly"
283 (ly
:parser-output-name parser
))))
284 (if
(access? tweak-filename R
_OK
)
286 (ly
:message
"Including tweak file ~a" tweak-filename
)
287 (set
! page-layout-parser
(ly
:parser-clone parser
))
288 (ly
:parser-parse-string page-layout-parser
289 (format
#f "\\include \"~a\""
291 (make-music
'SequentialMusic
'void
#t
))
296 #(define-music-function
297 (parser location tag music
) (symbol? ly
:music?
)
300 (let
* ((tags
(ly
:music-property m
'tags
))
301 (res
(memq tag tags
)))
308 #(define-music-function
309 (parser location tag music
) (symbol? ly
:music?
)
312 (let
* ((tags
(ly
:music-property m
'tags
))
313 (res
(memq tag tags
)))
318 #(define-music-function
319 (parser location music
)
323 (if
(string?
(ly
:music-property mus
'quoted-music-name
))
324 (ly
:music-property mus
'element
)
328 #(define-music-function
(parser location label
) (symbol?
)
329 (_i
"Place a bookmarking label, either at top-level or inside music.")
330 (make-music
'EventChord
333 'elements
(list
(make-music
'LabelEvent
334 'page-label label
))))
337 #(define-music-function
338 (parser location arg
) (ly
:music?
)
339 (music-map note-to-cluster arg
))
342 #(define-music-function
(parser location proc mus
) (procedure? ly
:music?
)
343 (music-map proc mus
))
348 #(define-music-function
(parser location music lyrics
) (ly
:music? ly
:music?
)
350 (make-music
'OldLyricCombineMusic
352 'elements
(list music lyrics
)))
356 #(define-music-function
(parser location name property value
)
357 (string? symbol? scheme?
)
360 (_i
"Set @var{property} to @var{value} in all grobs named @var{name}.
361 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
362 or @code{\"GrobName\"}")
365 ((name-components
(string-split name
#\
.))
366 (context-name
'Bottom
)
369 (if
(> 2 (length name-components
))
370 (set
! grob-name
(string-
>symbol
(car name-components
)))
372 (set
! grob-name
(string-
>symbol
(list-ref name-components
1)))
373 (set
! context-name
(string-
>symbol
(list-ref name-components
0)))))
375 (make-music
'ApplyOutputEvent
377 'context-type context-name
379 (lambda
(grob orig-context context
)
381 (cdr
(assoc
'name
(ly
:grob-property grob
'meta
)))
383 (set
! (ly
:grob-property grob property
) value
))))))
385 %% These are music functions (iso music indentifiers), because music identifiers
386 %% are not allowed at top-level.
388 #(define-music-function
(location parser
) ()
389 (_i
"Force a page break. May be used at toplevel (ie between scores or
390 markups), or inside a score.")
391 (make-music
'EventChord
393 'line-break-permission
'force
394 'page-break-permission
'force
395 'elements
(list
(make-music
'LineBreakEvent
396 'break-permission
'force
)
397 (make-music
'PageBreakEvent
398 'break-permission
'force
))))
401 #(define-music-function
(location parser
) ()
402 (_i
"Forbid a page break. May be used at toplevel (ie between scores or
403 markups), or inside a score.")
404 (make-music
'EventChord
406 'page-break-permission
'forbid
407 'elements
(list
(make-music
'PageBreakEvent
408 'break-permission
'()))))
411 #(define-music-function
(location parser
) ()
412 (_i
"Force a page turn between two scores or top-level markups.")
413 (make-music
'EventChord
415 'line-break-permission
'force
416 'page-break-permission
'force
417 'page-turn-permission
'force
418 'elements
(list
(make-music
'LineBreakEvent
419 'break-permission
'force
)
420 (make-music
'PageBreakEvent
421 'break-permission
'force
)
422 (make-music
'PageTurnEvent
423 'break-permission
'force
))))
426 #(define-music-function
(location parser
) ()
427 (_i
"Forbid a page turn. May be used at toplevel (ie between scores or
428 markups), or inside a score.")
429 (make-music
'EventChord
431 'page-turn-permission
'forbid
432 'elements
(list
(make-music
'PageTurnEvent
433 'break-permission
'()))))
436 #(define-music-function
(location parser
) ()
437 (_i
"Allow a page turn. May be used at toplevel (ie between scores or
438 markups), or inside a score.")
439 (make-music
'EventChord
441 'page-turn-permission
'allow
442 'elements
(list
(make-music
'PageTurnEvent
443 'break-permission
'allow
))))
447 %% define-music-function in a .scm causes crash.
450 #(define-music-function
(parser location pitch-note
) (ly
:music?
)
453 (make-music
'RelativeOctaveCheck
455 'pitch
(pitch-of-note pitch-note
)
458 ottava
= #(define-music-function
(parser location octave
) (number?
)
459 (_i
"set the octavation ")
460 (make-ottava-set octave
))
463 #(define-music-function
(parser location part
1 part
2) (ly
:music? ly
:music?
)
464 (make-part-combine-music parser
469 #(define-music-function
470 (parser location main-note secondary-note
)
471 (ly
:music? ly
:music?
)
473 ((get-notes
(lambda
(ev-chord
)
475 (lambda
(m
) (eq?
'NoteEvent
(ly
:music-property m
'name
)))
476 (ly
:music-property ev-chord
'elements
))))
477 (sec-note-events
(get-notes secondary-note
))
478 (trill-events
(filter
(lambda
(m
) (music-has-type m
'trill-span-event
))
479 (ly
:music-property main-note
'elements
))))
481 (if
(pair? sec-note-events
)
484 ((trill-pitch
(ly
:music-property
(car sec-note-events
) 'pitch
))
485 (forced
(ly
:music-property
(car sec-note-events
) 'force-accidental
)))
487 (if
(ly
:pitch? trill-pitch
)
488 (for-each
(lambda
(m
) (ly
:music-set-property
! m
'pitch trill-pitch
))
491 (ly
:warning
(_ "Second argument of \\pitchedTrill should be single note: "))
492 (display sec-note-events
)))
495 (for-each
(lambda
(m
) (ly
:music-set-property
! m
'force-accidental forced
))
502 #(use-modules
(ice-
9 optargs
))
505 #(define-music-function
(parser location voice-ids music
) (list? ly
:music?
)
506 (_i
"Define parallel music sequences, separated by '|' (bar check signs),
507 and assign them to the identifiers provided in @var{voice-ids}.
509 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
511 @var{music}: a music sequence, containing BarChecks as limiting expressions.
516 \\parallelMusic #'(A B C) {
526 (let
* ((voices
(apply circular-list
(make-list
(length voice-ids
) (list
))))
527 (current-voices voices
)
528 (current-sequence
(list
)))
531 (define
(push-music m
)
532 "Push the music expression into the current sequence"
533 (set
! current-sequence
(cons m current-sequence
)))
534 (define
(change-voice
)
535 "Stores the previously built sequence into the current voice and
536 change to the following voice."
537 (list-set
! current-voices
0 (cons
(make-music
'SequentialMusic
538 'elements
(reverse
! current-sequence
))
539 (car current-voices
)))
540 (set
! current-sequence
(list
))
541 (set
! current-voices
(cdr current-voices
)))
542 (define
(bar-check? m
)
543 "Checks whether m is a bar check."
544 (eq?
(ly
:music-property m
'name
) 'BarCheck
))
545 (define
(music-origin music
)
546 "Recursively search an origin location stored in music."
547 (cond
((null? music
) #f)
548 ((not
(null?
(ly
:music-property music
'origin
)))
549 (ly
:music-property music
'origin
))
550 (else
(or
(music-origin
(ly
:music-property music
'element
))
551 (let
((origins
(remove not
(map music-origin
552 (ly
:music-property music
'elements
)))))
553 (and
(not
(null? origins
)) (car origins
)))))))
555 ;; first
, split the music and fill in voices
556 (map-in-order
(lambda
(m
)
558 (if
(bar-check? m
) (change-voice
)))
559 (ly
:music-property music
'elements
))
560 (if
(not
(null? current-sequence
)) (change-voice
))
561 ;; un-circularize `voices
' and reorder the voices
562 (set
! voices
(map-in-order
(lambda
(dummy seqs
)
566 ;; set origin location of each sequence in each voice
567 ;; for better type error tracking
568 (for-each
(lambda
(voice
)
569 (for-each
(lambda
(seq
)
570 (set
! (ly
:music-property seq
'origin
)
571 (or
(music-origin seq
) location
)))
575 ;; check sequence length
576 (apply for-each
(lambda
* (#:rest seqs
)
577 (let
((moment-reference
(ly
:music-length
(car seqs
))))
578 (for-each
(lambda
(seq moment
)
579 (if
(not
(equal? moment moment-reference
))
580 (ly
:music-message seq
581 "Bars in parallel music don't have the same length")))
582 seqs
(map-in-order ly
:music-length seqs
))))
585 ;; bind voice identifiers to the voices
586 (map
(lambda
(voice-id voice
)
587 (ly
:parser-define
! parser voice-id
588 (make-music
'SequentialMusic
592 ;; Return an empty sequence
. this function is actually
a "void" function
.
593 (make-music
'SequentialMusic
'void
#t
))
598 #(define-music-function
(parser loc arg
) (ly
:music?
)
599 (_i
"Tag @var{arg} to be parenthesized.")
601 (if
(memq
'event-chord
(ly
:music-property arg
'types
))
602 ; arg is an EventChord -
> set the parenthesize property on all child notes and rests
605 (if
(or
(memq
'note-event
(ly
:music-property ev
'types
))
606 (memq
'rest-event
(ly
:music-property ev
'types
)))
607 (set
! (ly
:music-property ev
'parenthesize
) #t
)))
608 (ly
:music-property arg
'elements
))
609 ; No chord
, simply set property for this expression
:
610 (set
! (ly
:music-property arg
'parenthesize
) #t
))
615 (define-music-function
616 (parser location what main-music
)
618 (make-music
'QuoteMusic
620 'quoted-music-name what
625 resetRelativeOctave
=
626 #(define-music-function
627 (parser location reference-note
)
629 (_i
"Set the octave inside a \\relative section.")
632 ((notes
(ly
:music-property reference-note
'elements
))
633 (pitch
(ly
:music-property
(car notes
) 'pitch
)))
635 (set
! (ly
:music-property reference-note
'elements
) '())
636 (set
! (ly
:music-property reference-note
637 'to-relative-callback
)
638 (lambda
(music last-pitch
)
645 #(define-music-function
646 (parser location fraction music
) (number-pair? ly
:music?
)
647 (ly
:music-compress music
(ly
:make-moment
(car fraction
) (cdr fraction
))))
652 #(define-music-function
(parser location dur dots arg
) (integer? integer? ly
:music?
)
657 (shift-one-duration-log x dur dots
)) arg
))
660 #(define-music-function
(parser location parameters
) (list?
)
661 (_i
"Set the system stretch, by reading the 'system-stretch property of
662 the `parameters' assoc list.")
664 \overrideProperty #"Score.NonMusicalPaperColumn"
665 #'line-break-system-details
666 #$
(list
(cons
'alignment-extra-space
(cdr
(assoc
'system-stretch parameters
)))
667 (cons
'system-Y-extent
(cdr
(assoc
'system-Y-extent parameters
))))
672 #(define-music-function
(parser location finger
) (number-or-string?
)
673 (_i
"Define a StrokeFingerEvent")
682 (list
'digit finger
)))))
685 #(define-music-function
(parser location name
) (string?
)
686 (_i
"Include the score tweak, if exists.")
687 (if
(and page-layout-parser
(not
(ly
:get-option
'dump-tweaks
)))
688 (let
((tweak-music
(ly
:parser-lookup page-layout-parser
689 (string-
>symbol name
))))
690 (if
(ly
:music? tweak-music
)
692 (make-music
'SequentialMusic
)))
693 (make-music
'SequentialMusic
)))
696 tag
= #(define-music-function
(parser location tag arg
)
699 (_i
"Add @var{tag} to the @code{tags} property of @var{arg}.")
702 (ly
:music-property arg
'tags
)
704 (ly
:music-property arg
'tags
)))
709 transposedCueDuring
=
710 #(define-music-function
711 (parser location what dir pitch-note main-music
)
712 (string? ly
:dir? ly
:music? ly
:music?
)
714 (_i
"Insert notes from the part @var{what} into a voice called @code{cue},
715 using the transposition defined by @var{pitch-note}. This happens
716 simultaneously with @var{main-music}, which is usually a rest. The
717 argument @var{dir} determines whether the cue notes should be notated
718 as a first or second voice.")
720 (make-music
'QuoteMusic
722 'quoted-context-type
'Voice
723 'quoted-context-id
"cue"
724 'quoted-music-name what
725 'quoted-voice-direction dir
726 'quoted-transposition
(pitch-of-note pitch-note
)
732 #(define-music-function
(parser location pitch-note
) (ly
:music?
)
733 (_i
"Set instrument transposition")
736 (make-property-set
'instrumentTransposition
737 (ly
:pitch-negate
(pitch-of-note pitch-note
)))
740 tweak
= #(define-music-function
(parser location sym val arg
)
741 (symbol? scheme? ly
:music?
)
743 (_i
"Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
746 (ly
:music-property arg
'tweaks
)
748 (ly
:music-property arg
'tweaks
)))
754 #(define-music-function
(parser location music
) (ly
:music?
)
755 (unfold-repeats music
))
760 #(define-music-function
(parser location sym val music
) (symbol? scheme? ly
:music?
)
761 (_i
"Set @var{sym} to @var{val} in @var{music}.")
763 (set
! (ly
:music-property music sym
) val
)