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 "Add a piece of music to be quoted "
20 (add-quotable parser name music)
21 (make-music 'SequentialMusic 'void #t))
28 #(define-music-function
29 (parser location main grace)
33 ((main-length (ly:music-length main))
34 (fraction (ly:parser-lookup parser 'afterGraceFraction)))
36 (make-simultaneous-music
39 (make-sequential-music
42 (make-music 'SkipMusic
43 'duration (ly:make-duration
45 (* (ly:moment-main-numerator main-length)
47 (* (ly:moment-main-denominator main-length)
49 (make-music 'GraceMusic
53 #(define-music-function (parser location func music) (procedure? ly:music?)
58 #(define-music-function (parser location ctx proc) (symbol? procedure?)
59 (make-music 'ApplyOutputEvent
65 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic)
69 % for regression testing purposes.
71 #(define-music-function (parser location l r) (pair? pair?)
72 (make-grob-property-override 'Beam 'positions
73 (ly:make-simple-closure
74 (ly:make-simple-closure
76 (list chain-grob-member-functions `(,cons 0 0))
77 (check-quant-callbacks l r))))))
79 % for regression testing purposes.
81 #(define-music-function (parser location comp) (procedure?)
82 (make-grob-property-override 'Beam 'positions
83 (ly:make-simple-closure
84 (ly:make-simple-closure
86 (list chain-grob-member-functions `(,cons 0 0))
87 (check-slope-callbacks comp))))))
92 #(define-music-function (parser location music) (ly:music?)
93 (make-autochange-music parser music))
96 #(define-music-function (parser location proc) (procedure?)
97 (make-music 'ApplyContext
103 #(define-music-function (parser location offset text) (number-pair? markup?)
105 (make-music 'AnnotateOutputEvent
106 'X-offset (car offset)
107 'Y-offset (cdr offset)
111 #(define-music-function (parser location grob-name offset text) (symbol? number-pair? markup?)
113 (make-music 'AnnotateOutputEvent
115 'X-offset (car offset)
116 '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"
142 #(define-music-function (parser location) ()
143 (make-music 'EventChord
145 'elements (list (make-music 'BreathingEvent))))
148 #(define-music-function (parser location delta) (integer?)
150 (make-music 'BendAfterEvent
154 #(define-music-function (parser location type)
157 "Set the current clef."
159 (make-clef-set type))
163 #(define-music-function
164 (parser location fraction music) (number-pair? ly:music?)
165 (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))))
169 #(define-music-function
170 (parser location what dir main-music)
171 (string? ly:dir? ly:music?)
172 (make-music 'QuoteMusic
174 'quoted-context-type 'Voice
175 'quoted-context-id "cue"
176 'quoted-music-name what
177 'quoted-voice-direction dir
180 %% The following causes an error with guile 1.6.8 (guile 1.6.7 and 1.8.x are fine)
181 #(use-modules (scm display-lily))
184 #(define-music-function (parser location music) (ly:music?)
186 (display-lily-music music parser)
190 #(define-music-function (parser location music) (ly:music?)
192 (display-scheme-music music)
196 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
198 "Rearrange durations in ARGUMENT so there is an
199 acceleration/deceleration. "
202 ((orig-duration (ly:music-length argument))
203 (multiplier (ly:make-moment 1 1)))
207 (if (and (eq? (ly:music-property mus 'name) 'EventChord)
208 (< 0 (ly:moment-main-denominator (ly:music-length mus))))
210 (ly:music-compress mus multiplier)
211 (set! multiplier (ly:moment-mul factor multiplier)))
218 (ly:moment-div orig-duration (ly:music-length argument)))
223 #(def-grace-function startGraceMusic stopGraceMusic)
226 "instrument-definitions" = #'()
228 addInstrumentDefinition =
229 #(define-music-function
230 (parser location name lst) (string? list?)
232 (set! instrument-definitions (acons name lst instrument-definitions))
234 (make-music 'SequentialMusic 'void #t))
238 #(define-music-function
239 (parser location name) (string?)
241 ((handle (assoc name instrument-definitions))
242 (instrument-def (if handle (cdr handle) '()))
246 (ly:input-message "No such instrument: ~a" name))
248 (make-music 'SimultaneousMusic
259 #(define-music-function
260 (parser location tag music) (symbol? ly:music?)
263 (let* ((tags (ly:music-property m 'tags))
264 (res (memq tag tags)))
273 #(define-music-function
274 (parser location music)
278 (if (string? (ly:music-property mus 'quoted-music-name))
279 (ly:music-property mus 'element)
284 #(define-music-function
285 (parser location arg) (ly:music?)
286 (music-map note-to-cluster arg))
289 #(define-music-function (parser location proc mus) (procedure? ly:music?)
290 (music-map proc mus))
295 #(define-music-function (parser location music lyrics) (ly:music? ly:music?)
297 (make-music 'OldLyricCombineMusic
299 'elements (list music lyrics)))
303 #(define-music-function (parser location name property value)
304 (string? symbol? scheme?)
307 "Set @var{property} to @var{value} in all grobs named @var{name}.
308 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
309 or @code{\"GrobName\"}"
312 ((name-components (string-split name #\.))
313 (context-name 'Bottom)
316 (if (> 2 (length name-components))
317 (set! grob-name (string->symbol (car name-components)))
319 (set! grob-name (string->symbol (list-ref name-components 1)))
320 (set! context-name (string->symbol (list-ref name-components 0)))))
322 (make-music 'ApplyOutputEvent
324 'context-type context-name
326 (lambda (grob orig-context context)
328 (cdr (assoc 'name (ly:grob-property grob 'meta)))
330 (set! (ly:grob-property grob property) value))))))
334 #(define-music-function
335 (parser location tag music) (symbol? ly:music?)
338 (let* ((tags (ly:music-property m 'tags))
339 (res (memq tag tags)))
345 %% define-music-function in a .scm causes crash.
348 #(define-music-function (parser location pitch-note) (ly:music?)
351 (make-music 'RelativeOctaveCheck
353 'pitch (pitch-of-note pitch-note)
356 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
357 (make-part-combine-music parser
362 #(define-music-function
363 (parser location main-note secondary-note)
364 (ly:music? ly:music?)
366 ((get-notes (lambda (ev-chord)
368 (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
369 (ly:music-property ev-chord 'elements))))
370 (sec-note-events (get-notes secondary-note))
371 (trill-events (filter (lambda (m) (memq 'trill-span-event (ly:music-property m 'types)))
372 (ly:music-property main-note 'elements)))
375 (if (pair? sec-note-events)
376 (ly:music-property (car sec-note-events) 'pitch)
379 (if (ly:pitch? trill-pitch)
380 (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
383 (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
384 (display sec-note-events)))
389 #(define-music-function (parser loc arg) (ly:music?)
390 "Tag @var{arg} to be parenthesized."
392 (set! (ly:music-property arg 'parenthesize) #t)
396 #(use-modules (ice-9 optargs))
399 #(define-music-function (parser location voice-ids music) (list? ly:music?)
400 "Define parallel music sequences, separated by '|' (bar check signs),
401 and assign them to the identifiers provided in @var{voice-ids}.
403 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
405 @var{music}: a music sequence, containing BarChecks as limiting expressions.
410 \\parallelMusic #'(A B C) {
420 (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
421 (current-voices voices)
422 (current-sequence (list)))
425 (define (push-music m)
426 "Push the music expression into the current sequence"
427 (set! current-sequence (cons m current-sequence)))
428 (define (change-voice)
429 "Stores the previously built sequence into the current voice and
430 change to the following voice."
431 (list-set! current-voices 0 (cons (make-music 'SequentialMusic
432 'elements (reverse! current-sequence))
433 (car current-voices)))
434 (set! current-sequence (list))
435 (set! current-voices (cdr current-voices)))
436 (define (bar-check? m)
437 "Checks whether m is a bar check."
438 (eq? (ly:music-property m 'name) 'BarCheck))
439 (define (music-origin music)
440 "Recursively search an origin location stored in music."
441 (cond ((null? music) #f)
442 ((not (null? (ly:music-property music 'origin)))
443 (ly:music-property music 'origin))
444 (else (or (music-origin (ly:music-property music 'element))
445 (let ((origins (remove not (map music-origin
446 (ly:music-property music 'elements)))))
447 (and (not (null? origins)) (car origins)))))))
449 ;; first, split the music and fill in voices
450 (map-in-order (lambda (m)
452 (if (bar-check? m) (change-voice)))
453 (ly:music-property music 'elements))
454 (if (not (null? current-sequence)) (change-voice))
455 ;; un-circularize `voices' and reorder the voices
456 (set! voices (map-in-order (lambda (dummy seqs)
460 ;; set origin location of each sequence in each voice
461 ;; for better type error tracking
462 (for-each (lambda (voice)
463 (for-each (lambda (seq)
464 (set! (ly:music-property seq 'origin)
465 (or (music-origin seq) location)))
469 ;; check sequence length
470 (apply for-each (lambda* (#:rest seqs)
471 (let ((moment-reference (ly:music-length (car seqs))))
472 (for-each (lambda (seq moment)
473 (if (not (equal? moment moment-reference))
474 (ly:music-message seq
475 "Bars in parallel music don't have the same length")))
476 seqs (map-in-order ly:music-length seqs))))
479 ;; bind voice identifiers to the voices
480 (map (lambda (voice-id voice)
481 (ly:parser-define! parser voice-id
482 (make-music 'SequentialMusic
486 ;; Return an empty sequence. this function is actually a "void" function.
487 (make-music 'SequentialMusic 'void #t))
492 (define-music-function
493 (parser location what main-music)
495 (make-music 'QuoteMusic
497 'quoted-music-name what
502 resetRelativeOctave =
503 #(define-music-function
504 (parser location reference-note)
506 "Set the octave inside a \\relative section."
509 ((notes (ly:music-property reference-note 'elements))
510 (pitch (ly:music-property (car notes) 'pitch)))
512 (set! (ly:music-property reference-note 'elements) '())
513 (set! (ly:music-property reference-note
514 'to-relative-callback)
515 (lambda (music last-pitch)
523 #(define-music-function (parser location dur dots arg) (integer? integer? ly:music?)
529 (shift-one-duration-log x dur dots)) arg))
532 #(define-music-function (parser location parameters) (list?)
533 "Set the system stretch, by reading the 'system-stretch property of
534 the `parameters' assoc list."
536 \overrideProperty #"Score.NonMusicalPaperColumn"
537 #'line-break-system-details
538 #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters))))
541 %% Parser used to read page-layout file, and then retreive score tweaks.
542 #(define page-layout-parser #f)
544 includePageLayoutFile =
545 #(define-music-function (parser location) ()
546 "If page breaks and tweak dump is not asked, and the file
547 <basename>-page-layout.ly exists, include it."
548 (if (not (ly:get-option 'dump-tweaks))
549 (let ((tweak-filename (format #f "~a-page-layout.ly"
550 (ly:parser-output-name parser))))
551 (if (access? tweak-filename R_OK)
553 (ly:message "Including tweak file ~a" tweak-filename)
554 (set! page-layout-parser (ly:parser-clone parser))
555 (ly:parser-parse-string page-layout-parser
556 (format #f "\\include \"~a\""
558 (make-music 'SequentialMusic 'void #t))
562 #(define-music-function (parser location finger) (number-or-string?)
563 "Define a StrokeFingerEvent"
572 (list 'digit finger)))))
575 #(define-music-function (parser location name) (string?)
576 "Include the score tweak, if exists."
577 (if (and page-layout-parser (not (ly:get-option 'dump-tweaks)))
578 (let ((tweak-music (ly:parser-lookup page-layout-parser
579 (string->symbol name))))
580 (if (ly:music? tweak-music)
582 (make-music 'SequentialMusic)))
583 (make-music 'SequentialMusic)))
585 transposedCueDuring =
586 #(define-music-function
587 (parser location what dir pitch-note main-music)
588 (string? ly:dir? ly:music? ly:music?)
590 "Insert notes from the part @var{what} into a voice called @code{cue},
591 using the transposition defined by @var{pitch-note}. This happens
592 simultaneously with @var{main-music}, which is usually a rest. The
593 argument @var{dir} determines whether the cue notes should be notated
594 as a first or second voice."
596 (make-music 'QuoteMusic
598 'quoted-context-type 'Voice
599 'quoted-context-id "cue"
600 'quoted-music-name what
601 'quoted-voice-direction dir
602 'quoted-transposition (pitch-of-note pitch-note)
608 #(define-music-function (parser location pitch-note) (ly:music?)
609 "Set instrument transposition"
612 (make-property-set 'instrumentTransposition
613 (ly:pitch-negate (pitch-of-note pitch-note)))
616 tweak = #(define-music-function (parser location sym val arg)
617 (symbol? scheme? ly:music?)
619 "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
623 (ly:music-property arg 'tweaks)
625 (ly:music-property arg 'tweaks)))
628 tag = #(define-music-function (parser location tag arg)
631 "Add @var{tag} to the @code{tags} property of @var{arg}."
634 (ly:music-property arg 'tags)
636 (ly:music-property arg 'tags)))
641 #(define-music-function (parser location music) (ly:music?)
642 (unfold-repeats music))
647 #(define-music-function (parser location sym val music) (symbol? scheme? ly:music?)
648 "Set @var{sym} to @var{val} in @var{music}."
650 (set! (ly:music-property music sym) val)