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
102 #(define-music-function (parser location type)
105 (make-property-set 'whichBar type)
110 #(define-music-function (parser location n) (integer?)
111 (make-music 'ApplyContext
116 ((cbn (ly:context-property c 'currentBarNumber)))
117 (if (and (number? cbn) (not (= cbn n)))
118 (ly:input-message location "Barcheck failed got ~a expect ~a"
124 #(define-music-function (parser location) ()
125 (make-music 'EventChord
127 'elements (list (make-music 'BreathingEvent))))
130 #(define-music-function (parser location delta) (integer?)
132 (make-music 'BendAfterEvent
136 #(define-music-function (parser location type)
139 "Set the current clef."
141 (make-clef-set type))
145 #(define-music-function
146 (parser location fraction music) (number-pair? ly:music?)
147 (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))))
151 #(define-music-function
152 (parser location what dir main-music)
153 (string? ly:dir? ly:music?)
154 (make-music 'QuoteMusic
156 'quoted-context-type 'Voice
157 'quoted-context-id "cue"
158 'quoted-music-name what
159 'quoted-voice-direction dir
162 %% The following causes an error with guile 1.6.8 (guile 1.6.7 and 1.8.x are fine)
163 #(use-modules (scm display-lily))
166 #(define-music-function (parser location music) (ly:music?)
168 (display-lily-music music parser)
172 #(define-music-function (parser location music) (ly:music?)
174 (display-scheme-music music)
178 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
180 "Rearrange durations in ARGUMENT so there is an
181 acceleration/deceleration. "
184 ((orig-duration (ly:music-length argument))
185 (multiplier (ly:make-moment 1 1)))
189 (if (and (eq? (ly:music-property mus 'name) 'EventChord)
190 (< 0 (ly:moment-main-denominator (ly:music-length mus))))
192 (ly:music-compress mus multiplier)
193 (set! multiplier (ly:moment-mul factor multiplier)))
200 (ly:moment-div orig-duration (ly:music-length argument)))
205 #(def-grace-function startGraceMusic stopGraceMusic)
208 "instrument-definitions" = #'()
210 addInstrumentDefinition =
211 #(define-music-function
212 (parser location name lst) (string? list?)
214 (set! instrument-definitions (acons name lst instrument-definitions))
216 (make-music 'SequentialMusic 'void #t))
220 #(define-music-function
221 (parser location name) (string?)
223 ((handle (assoc name instrument-definitions))
224 (instrument-def (if handle (cdr handle) '()))
228 (ly:input-message "No such instrument: ~a" name))
230 (make-music 'SimultaneousMusic
241 #(define-music-function
242 (parser location tag music) (symbol? ly:music?)
245 (let* ((tags (ly:music-property m 'tags))
246 (res (memq tag tags)))
255 #(define-music-function
256 (parser location music)
260 (if (string? (ly:music-property mus 'quoted-music-name))
261 (ly:music-property mus 'element)
266 #(define-music-function
267 (parser location arg) (ly:music?)
268 (music-map note-to-cluster arg))
271 #(define-music-function (parser location proc mus) (procedure? ly:music?)
272 (music-map proc mus))
277 #(define-music-function (parser location music lyrics) (ly:music? ly:music?)
279 (make-music 'OldLyricCombineMusic
281 'elements (list music lyrics)))
285 #(define-music-function (parser location name property value)
286 (string? symbol? scheme?)
289 "Set @var{property} to @var{value} in all grobs named @var{name}.
290 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
291 or @code{\"GrobName\"}"
294 ((name-components (string-split name #\.))
295 (context-name 'Bottom)
298 (if (> 2 (length name-components))
299 (set! grob-name (string->symbol (car name-components)))
301 (set! grob-name (string->symbol (list-ref name-components 1)))
302 (set! context-name (string->symbol (list-ref name-components 0)))))
304 (make-music 'ApplyOutputEvent
306 'context-type context-name
308 (lambda (grob orig-context context)
310 (cdr (assoc 'name (ly:grob-property grob 'meta)))
312 (set! (ly:grob-property grob property) value))))))
316 #(define-music-function
317 (parser location tag music) (symbol? ly:music?)
320 (let* ((tags (ly:music-property m 'tags))
321 (res (memq tag tags)))
327 %% define-music-function in a .scm causes crash.
330 #(define-music-function (parser location pitch-note) (ly:music?)
333 (make-music 'RelativeOctaveCheck
335 'pitch (pitch-of-note pitch-note)
338 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
339 (make-part-combine-music parser
344 #(define-music-function
345 (parser location main-note secondary-note)
346 (ly:music? ly:music?)
348 ((get-notes (lambda (ev-chord)
350 (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
351 (ly:music-property ev-chord 'elements))))
352 (sec-note-events (get-notes secondary-note))
353 (trill-events (filter (lambda (m) (memq 'trill-span-event (ly:music-property m 'types)))
354 (ly:music-property main-note 'elements)))
357 (if (pair? sec-note-events)
358 (ly:music-property (car sec-note-events) 'pitch)
361 (if (ly:pitch? trill-pitch)
362 (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
365 (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
366 (display sec-note-events)))
371 #(define-music-function (parser loc arg) (ly:music?)
372 "Tag @var{arg} to be parenthesized."
374 (set! (ly:music-property arg 'parenthesize) #t)
378 #(use-modules (ice-9 optargs))
381 #(define-music-function (parser location voice-ids music) (list? ly:music?)
382 "Define parallel music sequences, separated by '|' (bar check signs),
383 and assign them to the identifiers provided in @var{voice-ids}.
385 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
387 @var{music}: a music sequence, containing BarChecks as limiting expressions.
390 \\parallelMusic #'(A B C) {
399 (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
400 (current-voices voices)
401 (current-sequence (list)))
404 (define (push-music m)
405 "Push the music expression into the current sequence"
406 (set! current-sequence (cons m current-sequence)))
407 (define (change-voice)
408 "Stores the previously built sequence into the current voice and
409 change to the following voice."
410 (list-set! current-voices 0 (cons (make-music 'SequentialMusic
411 'elements (reverse! current-sequence))
412 (car current-voices)))
413 (set! current-sequence (list))
414 (set! current-voices (cdr current-voices)))
415 (define (bar-check? m)
416 "Checks whether m is a bar check."
417 (eq? (ly:music-property m 'name) 'BarCheck))
418 (define (music-origin music)
419 "Recursively search an origin location stored in music."
420 (cond ((null? music) #f)
421 ((not (null? (ly:music-property music 'origin)))
422 (ly:music-property music 'origin))
423 (else (or (music-origin (ly:music-property music 'element))
424 (let ((origins (remove not (map music-origin
425 (ly:music-property music 'elements)))))
426 (and (not (null? origins)) (car origins)))))))
428 ;; first, split the music and fill in voices
429 (map-in-order (lambda (m)
431 (if (bar-check? m) (change-voice)))
432 (ly:music-property music 'elements))
433 (if (not (null? current-sequence)) (change-voice))
434 ;; un-circularize `voices' and reorder the voices
435 (set! voices (map-in-order (lambda (dummy seqs)
439 ;; set origin location of each sequence in each voice
440 ;; for better type error tracking
441 (for-each (lambda (voice)
442 (for-each (lambda (seq)
443 (set! (ly:music-property seq 'origin)
444 (or (music-origin seq) location)))
448 ;; check sequence length
449 (apply for-each (lambda* (#:rest seqs)
450 (let ((moment-reference (ly:music-length (car seqs))))
451 (for-each (lambda (seq moment)
452 (if (not (equal? moment moment-reference))
453 (ly:music-message seq
454 "Bars in parallel music don't have the same length")))
455 seqs (map-in-order ly:music-length seqs))))
458 ;; bind voice identifiers to the voices
459 (map (lambda (voice-id voice)
460 (ly:parser-define! parser voice-id
461 (make-music 'SequentialMusic
465 ;; Return an empty sequence. this function is actually a "void" function.
466 (make-music 'SequentialMusic 'void #t))
471 (define-music-function
472 (parser location what main-music)
474 (make-music 'QuoteMusic
476 'quoted-music-name what
481 resetRelativeOctave =
482 #(define-music-function
483 (parser location reference-note)
485 "Set the octave inside a \\relative section."
488 ((notes (ly:music-property reference-note 'elements))
489 (pitch (ly:music-property (car notes) 'pitch)))
491 (set! (ly:music-property reference-note 'elements) '())
492 (set! (ly:music-property reference-note
493 'to-relative-callback)
494 (lambda (music last-pitch)
502 #(define-music-function (parser location dur dots arg) (integer? integer? ly:music?)
508 (shift-one-duration-log x dur dots)) arg))
511 #(define-music-function (parser location parameters) (list?)
512 "Set the system stretch, by reading the 'system-stretch property of
513 the `parameters' assoc list."
515 \overrideProperty #"Score.NonMusicalPaperColumn"
516 #'line-break-system-details
517 #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters))))
520 %% Parser used to read page-layout file, and then retreive score tweaks.
521 #(define page-layout-parser #f)
523 includePageLayoutFile =
524 #(define-music-function (parser location) ()
525 "If page breaks and tweak dump is not asked, and the file
526 <basename>-page-layout.ly exists, include it."
527 (if (not (ly:get-option 'dump-tweaks))
528 (let ((tweak-filename (format #f "~a-page-layout.ly"
529 (ly:parser-output-name parser))))
530 (if (access? tweak-filename R_OK)
532 (ly:message "Including tweak file ~a" tweak-filename)
533 (set! page-layout-parser (ly:clone-parser parser))
534 (ly:parser-parse-string page-layout-parser
535 (format #f "\\include \"~a\""
537 (make-music 'SequentialMusic 'void #t))
541 #(define-music-function (parser location finger) (number-or-string?)
542 "Define a StrokeFingerEvent"
551 (list 'digit finger)))))
554 #(define-music-function (parser location name) (string?)
555 "Include the score tweak, if exists."
556 (if (and page-layout-parser (not (ly:get-option 'dump-tweaks)))
557 (let ((tweak-music (ly:parser-lookup page-layout-parser
558 (string->symbol name))))
559 (if (ly:music? tweak-music)
561 (make-music 'SequentialMusic)))
562 (make-music 'SequentialMusic)))
564 transposedCueDuring =
565 #(define-music-function
566 (parser location what dir pitch-note main-music)
567 (string? ly:dir? ly:music? ly:music?)
569 "Insert notes from the part @var{what} into a voice called @code{cue},
570 using the transposition defined by @var{pitch-note}. This happens
571 simultaneously with @var{main-music}, which is usually a rest. The
572 argument @var{dir} determines whether the cue notes should be notated
573 as a first or second voice."
575 (make-music 'QuoteMusic
577 'quoted-context-type 'Voice
578 'quoted-context-id "cue"
579 'quoted-music-name what
580 'quoted-voice-direction dir
581 'quoted-transposition (pitch-of-note pitch-note)
587 #(define-music-function (parser location pitch-note) (ly:music?)
588 "Set instrument transposition"
591 (make-property-set 'instrumentTransposition
592 (ly:pitch-diff (ly:make-pitch 0 0 0) (pitch-of-note pitch-note)))
596 tweak = #(define-music-function (parser location sym val arg)
597 (symbol? scheme? ly:music?)
599 "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
603 (ly:music-property arg 'tweaks)
605 (ly:music-property arg 'tweaks)))
608 tag = #(define-music-function (parser location tag arg)
611 "Add @var{tag} to the @code{tags} property of @var{arg}."
614 (ly:music-property arg 'tags)
616 (ly:music-property arg 'tags)))
621 #(define-music-function (parser location music) (ly:music?)
622 (unfold-repeats music))
627 #(define-music-function (parser location sym val music) (symbol? scheme? ly:music?)
628 "Set @var{sym} to @var{val} in @var{music}."
630 (set! (ly:music-property music sym) val)