3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
8 #(use-modules (srfi srfi-1))
9 #(define* (has-some-member? list1 list2 #:key (test eqv?))
10 "Return a true value iif there exists an element of list1 that also
11 belongs to list2 under test."
14 (or (member (car list1) list2 test)
15 (has-some-member? (cdr list1) list2 #:test test))))
17 #(define (symbol-or-symbols? x)
21 (and (list? x) (every symbol? x))))
24 #(define-music-function (parser location tags music)
25 (symbol-or-symbols? ly:music?)
29 (let ((m.tags (ly:music-property m 'tags)))
31 (or (null? m.tags) (memq tags m.tags)))
35 (or (null? m.tags) (has-some-member? tags m.tags)))
41 #(define-music-function (parser location tags arg)
42 (symbol-or-symbols? ly:music?)
43 "Add @var{tags} (a single tag or a list of tags) to the @code{tags}
44 property of @var{arg}."
45 (set! (ly:music-property arg 'tags)
47 (cons tags (ly:music-property arg 'tags))
48 (append tags (ly:music-property arg 'tags))))
51 %%% Music binding construct
54 #(define-music-function (parser location sym music) (symbol? ly:music?)
55 (ly:parser-define! parser sym music)
56 (make-music 'Music 'void #t))
58 %% Force clef printing, with full size
60 \set Staff.forceClef = ##t
61 \override Staff.Clef #'full-size-change = ##t
64 %% Print clef in full size
65 fullClef = \override Staff.Clef #'full-size-change = ##t
67 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
69 %%% Repeat with alternatives
72 forceCloseVoltaBracket = {
73 \once \override Score.VoltaBracket #'stencil =
75 (let* ((volta (ly:volta-bracket-interface::print grob))
76 (edge-heights (ly:grob-property grob 'edge-height))
77 (height (if (pair? edge-heights)
80 (thickness (* (ly:grob-property grob 'thickness 1.6)
81 (ly:staff-symbol-line-thickness grob))))
82 (ly:stencil-combine-at-edge
84 (make-line-stencil thickness 0 0 0 (- height))
86 \once \override Score.VoltaBracket #'edge-height = #'(1.5 . 1.5)
90 #(define-music-function (parser location first second) (ly:music? ly:music?)
91 (if (eqv? #t (ly:get-option 'baroque-repeats))
92 (let ((repeat-bar (if (string? (ly:get-option 'baroque-repeat-bar))
93 (ly:get-option 'baroque-repeat-bar)
95 #{ \forceCloseVoltaBracket
96 \set Score.repeatCommands = #'((volta " "))
97 $first \bar $repeat-bar \noBreak
98 << $second >> <<{ s4*0 \set Score.repeatCommands = #'((volta #f)) } >> #})
99 #{ \set Score.repeatCommands = #'((volta "1."))
101 \set Score.repeatCommands = #'((volta #f) (volta "2.") end-repeat)
103 \set Score.repeatCommands = #'((volta #f)) #}))
106 #(define-music-function (parser location first second) (ly:music? ly:music?)
107 (let ((repeat-bar (if (string? (ly:get-option 'baroque-repeat-bar))
108 (ly:get-option 'baroque-repeat-bar)
110 #{ \forceCloseVoltaBracket
111 \set Score.repeatCommands = #'((volta " "))
112 $first \bar $repeat-bar \noBreak
113 << $second >> <<{ s4*0 \set Score.repeatCommands = #'((volta #f)) } >> #}))
116 #(define-music-function (parser location first second) (ly:music? ly:music?)
117 #{ \set Score.repeatCommands = #'((volta "1."))
120 \set Score.repeatCommands = #'((volta #f) (volta "2."))
122 \set Score.repeatCommands = #'((volta #f)) #})
124 %% Alternatives only on one staff
127 \new Voice \with { \alternativeLayout } {
128 re'2.*1/2\startGroup fad'4*1/2 \fakeBar
132 alternativeLayout = \with {
133 \consists "Horizontal_bracket_engraver"
134 \override HorizontalBracket #'bracket-flare = #'(0 . 0)
135 \override HorizontalBracket #'direction = #UP
138 \once\override BreathingSign #'text = \markup \draw-line #'(0 . 4)
139 \once\override BreathingSign #'Y-offset = #-2
143 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
146 \override Script #'transparent = ##t
147 \override TextScript #'transparent = ##t
148 \override Tie #'transparent = ##t
149 \override Slur #'transparent = ##t
150 \override MultiMeasureRest #'transparent = ##t
151 \override AccidentalCautionary #'transparent = ##t
152 \override AccidentalSuggestion #'transparent = ##t
157 \revert Script #'transparent
158 \revert TextScript #'transparent
159 \revert Tie #'transparent
160 \revert Slur #'transparent
161 \revert MultiMeasureRest #'transparent
162 \revert AccidentalCautionary #'transparent
163 \revert AccidentalSuggestion #'transparent
171 #(define-music-function (parser location music) (ly:music?)
172 (let ((first-note #f)
175 ;; count the notes, and get first and last ones.
178 (if (eqv? (ly:music-property event 'name) 'NoteEvent)
181 (set! last-note event)
182 (set! first-note event))
183 (set! note-count (1+ note-count))))
186 ;; Add [ and ] beaming directive to the first and last note
189 (set! (ly:music-property first-note 'articulations)
190 (cons (make-music 'BeamEvent 'span-direction -1)
191 (ly:music-property first-note 'articulations)))
192 (set! (ly:music-property last-note 'articulations)
193 (cons (make-music 'BeamEvent 'span-direction 1)
194 (ly:music-property last-note 'articulations)))))
195 ;; If there are 3 notes, add a *2/3 duration factor
199 (if (eqv? (ly:music-property event 'name) 'NoteEvent)
200 (let* ((duration (ly:music-property event 'duration))
201 (dot-count (ly:duration-dot-count duration))
202 (log (ly:duration-log duration)))
203 (set! (ly:music-property event 'duration)
204 (ly:make-duration log dot-count 2 3))))
208 \override Voice.NoteHead.font-size = #-3
209 \override Voice.Flag.font-size = #-3
210 \override Voice.Dots.font-size = #-3
211 \override Voice.Stem.font-size = #-3
212 \override Voice.Stem.length-fraction = #0.8
213 \override Voice.Beam.beam-thickness = #0.384
214 \override Voice.Beam.length-fraction = #0.8
215 \override Voice.Accidental.font-size = #-4
216 \override Voice.AccidentalCautionary.font-size = #-4
218 \revert Voice.NoteHead.font-size
219 \revert Voice.Flag.font-size
220 \revert Voice.Dots.font-size
221 \revert Voice.Stem.font-size
222 \revert Voice.Stem.length-fraction
223 \revert Voice.Beam.beam-thickness
224 \revert Voice.Beam.length-fraction
225 \revert Voice.Accidental.font-size
226 \revert Voice.AccidentalCautionary.font-size
229 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
231 %%% Custos note heads
235 #(define-music-function (parser location note) (ly:music?)
236 (make-music 'SequentialMusic
238 \once \override Voice.NoteHead #'stencil = #ly:text-interface::print
239 \once \override Voice.NoteHead #'text =
240 #(markup #:null #:raise 0.0 #:musicglyph "custodes.mensural.u0")
241 \once \override Voice.Flag #'stencil = ##f
242 \once \override Voice.Stem #'stencil = ##f #}
246 %%% Note formatting tweaks
250 #(define-music-function (parser location length music) (number? ly:music?)
252 \override Voice.Stem #'details = #`((lengths . (,length))
253 (beamed-lengths . (,(- length 1.0)))
254 (beamed-minimum-free-lengths . (,(- length 1.0)))
255 (beamed-extreme-minimum-free-lengths . (,(- length 1.0)))
256 (stem-shorten . (1.0 0.5)))
258 \revert Voice.Stem #'details
261 shiftOnce = { \once \override NoteColumn #'horizontal-shift = #1 }
264 #(define-music-function (parser location amount) (number?)
265 #{ \once \override NoteHead #'X-offset = #amount
266 \once \override Stem #'X-offset = #amount
267 \once \override Beam #'X-offset = #amount #})
270 #(define-music-function (parser location amount) (number?)
271 #{ \once \override Rest #'X-offset = #amount #})
278 #(define-music-function (parser location fractions) (list?)
279 (define (make-time-sig-markup num den . rest)
281 (make-center-column-markup
282 (list (number->string num)
283 (number->string den)))
284 (make-raise-markup -1 (number->string num))))
286 (let ((time1 (apply make-time-sig-markup fractions))
287 (time2 (apply make-time-sig-markup (cddr fractions))))
289 \once \override Staff.TimeSignature #'stencil = #ly:text-interface::print
290 \once \override Staff.TimeSignature #'text =
291 \markup \override #'(baseline-skip . 0)
292 \number \line { $time1 $time2 }
295 fractionTime = \once \override Staff.TimeSignature #'style = #'numbered
296 cTime = \once \override Staff.TimeSignature #'style = #'C
297 digitTime = \once \override Staff.TimeSignature #'style = #'single-digit
300 #(define-music-function (parser location name) (markup?)
301 #{ \set Staff.instrumentName = \markup \large $name #})
304 #(define-music-function (parser location name) (markup?)
305 #{ \set Staff . instrumentName = \markup \large \smallCaps $name #})
308 #(define-music-function (parser location quater-nb-par-min) (number?)
309 #{ \set Score . tempoWholesPerMinute =
310 #(ly:make-moment (/ quater-nb-par-min 4) 1 0 1) #})
313 figExtOn = \bassFigureExtendersOn
314 figExtOff = \bassFigureExtendersOff
317 \bassFigureExtendersOn
318 \override BassFigureContinuation #'stencil = ##f
319 \override Staff.BassFigureContinuation #'stencil = ##f
322 \bassFigureExtendersOff
323 \revert BassFigureContinuation #'stencil
324 \revert Staff.BassFigureContinuation #'stencil
329 #(define-markup-command (triangle-up layout props a b c) (markup? markup? markup?)
330 (let ((base (interpret-markup layout props (markup #:tiny #:line (#:number b #:number c))))
331 (top (interpret-markup layout props (markup #:tiny #:number a))))
332 (let* ((base-width (interval-length (ly:stencil-extent base X)))
333 (top-width (interval-length (ly:stencil-extent top X)))
334 (top-left-padding (/ (- base-width top-width) 2.0)))
335 (stack-lines DOWN 0.0 2
337 (stack-stencil-line 0 (list (ly:make-stencil "" `(0 . ,top-left-padding) '(0 . 0))
341 #(define-markup-command (triangle-down layout props a b c) (markup? markup? markup?)
342 (let ((base (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
343 (bottom (interpret-markup layout props (markup #:tiny #:number c))))
344 (let* ((base-width (interval-length (ly:stencil-extent base X)))
345 (bottom-width (interval-length (ly:stencil-extent bottom X)))
346 (bottom-left-padding (/ (- base-width bottom-width) 2.0)))
347 (stack-lines DOWN 0.0 2
351 0 (list (ly:make-stencil ""
352 `(0 . ,bottom-left-padding)
356 #(define-markup-command (triangle-down-down layout props a b c d) (markup? markup? markup? markup?)
357 (let ((base (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
358 (bottom (interpret-markup layout props (markup #:tiny #:number c)))
359 (bottom2 (interpret-markup layout props (markup #:tiny #:number d))))
360 (let* ((base-width (interval-length (ly:stencil-extent base X)))
361 (bottom-width (interval-length (ly:stencil-extent bottom X)))
362 (bottom-left-padding (/ (- base-width bottom-width) 2.0))
363 (bottom2-width (interval-length (ly:stencil-extent bottom2 X)))
364 (bottom2-left-padding (/ (- base-width bottom2-width) 2.0)))
365 (stack-lines DOWN 0.0 2
369 0 (list (ly:make-stencil ""
370 `(0 . ,bottom-left-padding)
374 0 (list (ly:make-stencil ""
375 `(0 . ,bottom2-left-padding)
379 #(define-markup-command (parallelogram-up-left layout props a b c d) (markup? markup? markup? markup?)
383 (let ((top (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
384 (bottom (interpret-markup layout props (markup #:tiny #:line (#:number c #:number d)))))
385 (let* ((top-width (interval-length (ly:stencil-extent top X)))
386 (bottom-left-padding (/ (- top-width
389 (interpret-markup layout props (markup #:tiny #:number c)) X)))
391 (stack-lines DOWN 0.0 2
396 (list (ly:make-stencil ""
397 `(0 . ,bottom-left-padding)
401 #(define-markup-command (square layout props a b c d) (markup? markup? markup? markup?)
405 (let ((top (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
406 (bottom (interpret-markup layout props (markup #:tiny #:line (#:number c #:number d)))))
407 (stack-lines DOWN 0.0 2 (list top bottom))))
409 #(define-markup-command (fig-five layout props a b c d e)
410 (markup? markup? markup? markup? markup?)
415 (let ((top (interpret-markup layout props
416 (markup #:tiny #:line (#:number a #:number b))))
417 (center (interpret-markup layout props
418 (markup #:tiny #:number c)))
419 (bottom (interpret-markup layout props
420 (markup #:tiny #:line (#:number d #:number e)))))
421 (let* ((top-width (interval-length (ly:stencil-extent top X)))
422 (center-width (interval-length (ly:stencil-extent center X)))
423 (center-left-padding (/ (- top-width center-width) 2.0)))
424 (stack-lines DOWN 0.0 2
428 0 (list (ly:make-stencil ""
429 `(0 . ,center-left-padding)
434 #(define-markup-command (figure-sharp layout props) ()
437 (markup #:tiny #:concat (#:null #:raise 0.7 #:fontsize -2 #:sharp))))
439 #(define-markup-command (figure-flat layout props) ()
442 (markup #:tiny #:concat (#:null #:raise 0.7 #:fontsize -2 #:flat))))
444 #(define-markup-command (figure-natural layout props) ()
447 (markup #:tiny #:concat (#:null #:raise 0.7 #:fontsize -2 #:natural))))
449 #(define-markup-command (paren-sharp layout props num) (markup?)
452 (markup #:tiny #:concat (#:null #:raise 0.2 #:line ("(" #:figure-sharp ")")
455 #(define-markup-command (paren-flat layout props num) (markup?)
458 (markup #:tiny #:concat (#:null #:raise 0.2 #:line ("(" #:figure-flat ")")
462 %%% On-demand hara-kiri
464 startHaraKiri = \set Staff.keepAliveInterfaces = #'()
465 stopHaraKiri = \unset Staff.keepAliveInterfaces
467 noHaraKiri = \set Staff.keepAliveInterfaces =
468 #'(multi-measure-interface
469 rhythmic-grob-interface
471 percent-repeat-item-interface
472 percent-repeat-interface
473 stanza-number-interface)
474 revertNoHaraKiri = \unset Staff.keepAliveInterfaces
478 #(define-music-function (parser location music) (ly:music?)
479 (if (eqv? #t (ly:get-option 'letter))
481 (make-music 'Music 'void #t)))
483 #(define-music-function (parser location music) (ly:music?)
484 (if (not (eqv? #t (ly:get-option 'letter)))
486 (make-music 'Music 'void #t)))
490 #(define-music-function (parser location pattern music) (ly:music? ly:music?)
491 "\\applyDurations { c'16. c32 } { c d e f }
493 { c16. d32 e16. f32 }"
494 (let ((durations (apply circular-list
495 (let ((result (list)))
496 (music-map (lambda (event)
497 (if (eqv? (ly:music-property event 'name) 'NoteEvent)
498 (set! result (cons (ly:music-property event 'duration) result)))
501 (reverse! result)))))
502 (music-map (lambda (event)
503 (cond ((eqv? (ly:music-property event 'name) 'NoteEvent)
504 (set! (ly:music-property event 'duration) (car durations))
505 (set! durations (cdr durations))))
510 %% double pointée triple x2
512 #(define-music-function (parser location chords) (ly:music?)
513 (define (make-16.-32-16.-32 chord)
515 (music-map (lambda (m)
516 (if (eqv? (ly:music-property m 'name) 'NoteEvent)
517 (set! pitches (cons (ly:music-property m 'pitch) pitches))))
519 (let ((chord16. (make-music 'EventChord
520 'elements (map (lambda (pitch)
521 (make-music 'NoteEvent
522 'duration (ly:make-duration 4 1 1 1)
525 (chord32 (make-music 'EventChord
526 'elements (map (lambda (pitch)
527 (make-music 'NoteEvent
528 'duration (ly:make-duration 5 0 1 1)
531 (make-music 'SequentialMusic 'elements (list chord16. chord32 chord16. chord32)))))
532 (make-music 'SequentialMusic 'elements (map make-16.-32-16.-32 (ly:music-property chords 'elements))))
536 updown = { \change Staff = "down" \voiceOne }
537 upup = { \change Staff = "up" \oneVoice }
538 downup = { \change Staff = "up" \voiceTwo }
539 downdown = { \change Staff = "down" \oneVoice }
544 #(define-music-function (parser location times music) (number? ly:music?)
545 (if (eqv? #t (ly:get-option 'use-tremolo-repeat))
546 (make-repeat "tremolo" times music '())
547 (make-repeat "unfold" times music '())))
549 #(define-music-function (parser location times music) (number? ly:music?)
550 (make-repeat "tremolo" times music '()))
553 #(define-music-function (parser location times music) (number? ly:music?)
554 (if (eqv? #t (ly:get-option 'use-tremolo-repeat))
555 (make-repeat "percent" times music '())
556 (make-repeat "unfold" times music '())))
558 %% Tweak on articulations
561 #(define-music-function (parser location property value music)
562 (symbol? scheme? ly:music?)
563 "Like \\tweak, but apply the tweak to articulation event found
564 found inside @var{music}."
565 (if (equal? (object-property property 'backend-type?) #f)
567 (ly:warning (_ "cannot find property type-check for ~a") property)
568 (ly:warning (_ "doing assignment anyway"))))
569 (for-each (lambda (event)
570 (set! (ly:music-property event 'tweaks)
571 (acons property value (ly:music-property event 'tweaks))))
572 (ly:music-property music 'articulations))
575 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
576 %%% Selection of version: urtext or modified
578 #(define-music-function (parser location music) (ly:music?)
579 (if (eqv? #t (ly:get-option 'ancient-style))
581 (let ((type (ly:music-property music 'name)))
582 (if (memq type '(TextScriptEvent ArticulationEvent TieEvent SlurEvent))
583 (make-music 'TextScriptEvent 'text "")
584 (make-music 'Music 'void #t)))))
587 #(define-music-function (parser location music) (ly:music?)
588 (if (not (eqv? #t (ly:get-option 'ancient-style)))
590 (let ((type (ly:music-property music 'name)))
591 (if (memq type '(TextScriptEvent ArticulationEvent TieEvent SlurEvent))
592 (make-music 'TextScriptEvent 'text "")
593 (make-music 'Music 'void #t)))))
595 #(define-markup-command (orig-version layout props markp) (markup?)
596 (if (eqv? #t (ly:get-option 'ancient-style))
597 (interpret-markup layout props markp)
600 #(define-markup-command (mod-version layout props markp) (markup?)
601 (if (not (eqv? #t (ly:get-option 'ancient-style)))
602 (interpret-markup layout props markp)
606 #(define-music-function (parser location music) (ly:music?)
607 (if (eqv? #t (ly:get-option 'original-layout))
609 (make-music 'Music)))
614 \override NonMusicalPaperColumn #'line-break-permission =
615 #(if (eqv? #t (ly:get-option 'original-layout))
618 \override NonMusicalPaperColumn #'page-break-permission =
619 #(if (eqv? #t (ly:get-option 'original-layout))
625 #(define-markup-command (annotation layout props markp) (markup?)
626 (if (eqv? #t (ly:get-option 'ancient-style))
627 (interpret-markup layout props (markup #:with-color red markp))
631 #(define-music-function (parser location tweak) (list?)
632 "Specify hard coded vertical spacing. setting lilypond option
633 `apply-vertical-tweaks' to #f get rid off these tweaks."
634 (if (eqv? #t (ly:get-option 'apply-vertical-tweaks))
636 Score.NonMusicalPaperColumn.line-break-system-details #tweak #}
637 (make-music 'Music 'void #t)))
641 %%% conditional music
643 #(define-music-function (parser location condition music) (boolean? ly:music?)
646 (make-music 'Music 'void #t)))
649 #(define-music-function (parser location condition music) (boolean? ly:music?)
651 (make-music 'Music 'void #t)
654 %%% dessine une croix à l'emplacement de la note
655 #(define (make-erased-note-print print-procedure)
657 (let ((note-head (print-procedure grob))
659 (y-offset (if (number? (ly:grob-property grob 'staff-position))
660 (/ (ly:grob-property grob
670 `(draw-line ,thickness
672 ,(- 0 radius y-offset)
674 ,(- radius y-offset))
678 `(draw-line ,thickness
682 ,(- 0 radius y-offset))
687 \once\override NoteHead #'stencil =
688 #(make-erased-note-print ly:note-head::print)
689 \once\override Rest #'stencil =
690 #(make-erased-note-print ly:rest::print)
693 #(define (make-erased-mmrest-print print-procedure)
695 (let ((note-head (print-procedure grob))
697 (y-offset (if (number? (ly:grob-property grob 'staff-position))
698 (/ (ly:grob-property grob
706 (ly:stencil-translate
709 `(draw-line ,thickness
711 ,(- 0 radius y-offset)
713 ,(- radius y-offset))
717 `(draw-line ,thickness
721 ,(- 0 radius y-offset))
724 ;; translate the X so that it is on the bar center,
726 (cons (car (ly:stencil-extent note-head X)) 0)
730 \once\override MultiMeasureRest #'stencil =
731 #(make-erased-mmrest-print ly:multi-measure-rest::print)