common/music-commands.ily

   1 \version "2.11.57"
   2
   3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   4 %%%
   5 %%% Tagging commands
   6 %%%
   7
   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."
  12    (if (null? list1)
  13        #f
  14        (or (member (car list1) list2 test)
  15            (has-some-member? (cdr list1) list2 #:test test))))
  16
  17 #(define (symbol-or-symbols? x)
  18    (or (null? x)
  19        (not x)
  20        (symbol? x)
  21        (and (list? x) (every symbol? x))))
  22
  23 keepWithTag =
  24 #(define-music-function (parser location tags music)
  25                         (symbol-or-symbols? ly:music?)
  26    (if tags
  27        (music-filter
  28         (lambda (m)
  29           (let ((m.tags (ly:music-property m 'tags)))
  30             (cond ((symbol? tags)
  31                    (or (null? m.tags) (memq tags m.tags)))
  32                   ((null? tags)
  33                    (null? m.tags))
  34                   ((list? tags)
  35                    (or (null? m.tags) (has-some-member? tags m.tags)))
  36                   (else #t))))
  37         music)
  38        music))
  39
  40 tag =
  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)
  46          (if (symbol? tags)
  47              (cons tags (ly:music-property arg 'tags))
  48              (append tags (ly:music-property arg 'tags))))
  49    arg)
  50
  51 %%% Music binding construct
  52
  53 setMusic =
  54 #(define-music-function (parser location sym music) (symbol? ly:music?)
  55    (ly:parser-define! parser sym music)
  56    (make-music 'Music 'void #t))
  57
  58 %%% Two voices construct
  59 twoVoices =
  60 #(define-music-function (parser location tags music)
  61      (list? ly:music?)
  62    "Example:
  63   \\twoVoices #'(flauto1 flauto2 flauti) <<
  64     { music-voice1 }
  65     { music-voice2 }
  66     { optional-common-music }
  67   >>
  68 =>
  69   <<
  70     \\tag #'(flauto1 flauti) \\new Voice {
  71       \\tag #'flauti \\voiceOne
  72       music-voice1
  73     }
  74     \\tag #'(flauto2 flauti) \\new Voice {
  75       \\tag #'flauti \\voiceTwo
  76       music-voice2
  77     }
  78     { optional-common-music }
  79   >>
  80
  81 Then, use:
  82    \\keepWithTag #'flauto1 <this-music>   for flauto1 alone
  83    \\keepWithTag #'flauto2 <this-music>   for flauto2 alone
  84    \\keepWithTag #'flauti  <this-music>   for flauto1 & flauto2
  85 "
  86    (let ((tag1 (car tags))
  87          (tag2 (cadr tags))
  88          (tag-all (caddr tags))
  89          (music1 (car (ly:music-property music 'elements)))
  90          (music2 (cadr (ly:music-property music 'elements)))
  91          (rest-music (make-music
  92                       'SimultaneousMusic
  93                       'elements (cddr (ly:music-property music 'elements)))))
  94      #{ <<
  95   \tag #(list tag1 tag-all) \new Voice {
  96     \tag #tag-all \voiceOne $music1
  97   }
  98   \tag #(list tag2 tag-all) \new Voice {
  99     \tag #tag-all \voiceTwo $music2
 100   }
 101   \tag #(list tag1 tag2 tag-all) $rest-music
 102 >> #}))
 103
 104 %% Force clef printing, with full size
 105 forceFullClef = {
 106   \set Staff.forceClef = ##t
 107   \override Staff.Clef #'full-size-change = ##t
 108 }
 109
 110 %% Print clef in full size
 111 fullClef = \override Staff.Clef #'full-size-change = ##t
 112
 113 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 114 %%%
 115 %%% Repeat with alternatives
 116 %%%
 117
 118 forceCloseVoltaBracket = {
 119   \once \override Score.VoltaBracket #'stencil =
 120   #(lambda (grob)
 121      (let* ((volta (ly:volta-bracket-interface::print grob))
 122             (edge-heights (ly:grob-property grob 'edge-height))
 123             (height (if (pair? edge-heights)
 124                         (car edge-heights)
 125                         1.5))
 126             (thickness (* (ly:grob-property grob 'thickness 1.6)
 127                           (ly:staff-symbol-line-thickness grob))))
 128        (ly:stencil-combine-at-edge
 129         volta X RIGHT
 130         (make-line-stencil thickness 0 0 0 (- height))
 131         0)))
 132   \once \override Score.VoltaBracket #'edge-height = #'(1.5 . 1.5)
 133 }
 134
 135 alternatives =
 136 #(define-music-function (parser location first second) (ly:music? ly:music?)
 137    (if (eqv? #t (ly:get-option 'baroque-repeats))
 138        (let ((repeat-bar (if (string? (ly:get-option 'baroque-repeat-bar))
 139                              (ly:get-option 'baroque-repeat-bar)
 140                              "|;|")))
 141          #{ \forceCloseVoltaBracket
 142             \set Score.repeatCommands = #'((volta " "))
 143             $first \bar $repeat-bar \noBreak
 144             << $second >> <<{ s4*0 \set Score.repeatCommands = #'((volta #f)) } >> #})
 145        #{ \set Score.repeatCommands = #'((volta "1."))
 146           $first
 147           \set Score.repeatCommands = #'((volta #f) (volta "2.") end-repeat)
 148           $second
 149           \set Score.repeatCommands = #'((volta #f)) #}))
 150
 151 origAlternatives =
 152 #(define-music-function (parser location first second) (ly:music? ly:music?)
 153    (let ((repeat-bar (if (string? (ly:get-option 'baroque-repeat-bar))
 154                          (ly:get-option 'baroque-repeat-bar)
 155                          "|;|")))
 156      #{ \forceCloseVoltaBracket
 157         \set Score.repeatCommands = #'((volta " "))
 158         $first \bar $repeat-bar \noBreak
 159         << $second >> <<{ s4*0 \set Score.repeatCommands = #'((volta #f)) } >> #}))
 160
 161 modAlternatives =
 162 #(define-music-function (parser location first second) (ly:music? ly:music?)
 163    #{ \set Score.repeatCommands = #'((volta "1."))
 164       $first
 165       \bar ":|."
 166       \set Score.repeatCommands = #'((volta #f) (volta "2."))
 167       $second
 168       \set Score.repeatCommands = #'((volta #f)) #})
 169
 170 %% Alternatives only on one staff
 171 %% Example:
 172 %{
 173 \new Voice \with { \alternativeLayout } {
 174   re'2.*1/2\startGroup fad'4*1/2 \fakeBar
 175   re'1*1/2\stopGroup |
 176 }
 177 %}
 178 alternativeLayout = \with {
 179   \consists "Horizontal_bracket_engraver"
 180   \override HorizontalBracket #'bracket-flare = #'(0 . 0)
 181   \override HorizontalBracket #'direction = #UP
 182 }
 183 fakeBar = {
 184   \once\override BreathingSign #'text = \markup \draw-line #'(0 . 4)
 185   \once\override BreathingSign #'Y-offset = #-2
 186   \breathe
 187 }
 188
 189 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 190 hideVoice = {
 191   \hideNotes
 192   \override Script #'transparent = ##t
 193   \override TextScript #'transparent = ##t
 194   \override Tie #'transparent = ##t
 195   \override Slur #'transparent = ##t
 196   \override MultiMeasureRest #'transparent = ##t
 197   \override AccidentalCautionary #'transparent = ##t
 198   \override AccidentalSuggestion #'transparent = ##t
 199 }
 200
 201 unHideVoice = {
 202   \unHideNotes
 203   \revert Script #'transparent
 204   \revert TextScript #'transparent
 205   \revert Tie #'transparent
 206   \revert Slur #'transparent
 207   \revert MultiMeasureRest #'transparent
 208   \revert AccidentalCautionary #'transparent
 209   \revert AccidentalSuggestion #'transparent
 210 }
 211
 212 %%%
 213 %%% smaller notes
 214 %%%
 215
 216 smallNotes =
 217 #(define-music-function (parser location music) (ly:music?)
 218   (let ((first-note #f)
 219         (last-note #f)
 220         (note-count 0))
 221     ;; count the notes, and get first and last ones.
 222     (music-map
 223      (lambda (event)
 224        (if (eqv? (ly:music-property event 'name) 'NoteEvent)
 225            (begin
 226              (if first-note
 227                  (set! last-note event)
 228                  (set! first-note event))
 229              (set! note-count (1+ note-count))))
 230        event)
 231      music)
 232     ;; Add [ and ] beaming directive to the first and last note
 233     (if (> note-count 1)
 234         (begin
 235           (set! (ly:music-property first-note 'articulations)
 236                 (cons (make-music 'BeamEvent 'span-direction -1)
 237                       (ly:music-property first-note 'articulations)))
 238           (set! (ly:music-property last-note 'articulations)
 239                 (cons (make-music 'BeamEvent 'span-direction 1)
 240                       (ly:music-property last-note 'articulations)))))
 241     ;; If there are 3 notes, add a *2/3 duration factor
 242     (if (= note-count 3)
 243         (music-map
 244          (lambda (event)
 245            (if (eqv? (ly:music-property event 'name) 'NoteEvent)
 246                (let* ((duration (ly:music-property event 'duration))
 247                       (dot-count (ly:duration-dot-count duration))
 248                       (log (ly:duration-log duration)))
 249                  (set! (ly:music-property event 'duration)
 250                        (ly:make-duration log dot-count 2 3))))
 251            event)
 252          music)))
 253   #{
 254   \override Voice.NoteHead.font-size = #-3
 255   \override Voice.Flag.font-size = #-3
 256   \override Voice.Dots.font-size = #-3
 257   \override Voice.Stem.font-size = #-3
 258   \override Voice.Stem.length-fraction = #0.8
 259   \override Voice.Beam.beam-thickness = #0.384
 260   \override Voice.Beam.length-fraction = #0.8
 261   \override Voice.Accidental.font-size = #-4
 262   \override Voice.AccidentalCautionary.font-size = #-4
 263   $music
 264   \revert Voice.NoteHead.font-size
 265   \revert Voice.Flag.font-size
 266   \revert Voice.Dots.font-size
 267   \revert Voice.Stem.font-size
 268   \revert Voice.Stem.length-fraction
 269   \revert Voice.Beam.beam-thickness
 270   \revert Voice.Beam.length-fraction
 271   \revert Voice.Accidental.font-size
 272   \revert Voice.AccidentalCautionary.font-size
 273   #})
 274
 275 sugNotes =
 276 #(define-music-function (parser location music) (ly:music?)
 277   #{
 278   \override Rest.font-size = #-3
 279   \override NoteHead.font-size = #-3
 280   \override Flag.font-size = #-3
 281   \override Dots.font-size = #-3
 282   \override Stem.font-size = #-3
 283   \override Stem.length-fraction = #0.8
 284   \override Beam.beam-thickness = #0.384
 285   \override Beam.length-fraction = #0.8
 286   \override Accidental.font-size = #-4
 287   \override AccidentalCautionary.font-size = #-4
 288   $music
 289   \revert Rest.font-size
 290   \revert NoteHead.font-size
 291   \revert Flag.font-size
 292   \revert Dots.font-size
 293   \revert Stem.font-size
 294   \revert Stem.length-fraction
 295   \revert Beam.beam-thickness
 296   \revert Beam.length-fraction
 297   \revert Accidental.font-size
 298   \revert AccidentalCautionary.font-size
 299   #})
 300
 301 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 302 %%%
 303 %%% Custos note heads
 304 %%%
 305
 306 custosNote =
 307 #(define-music-function (parser location note) (ly:music?)
 308   (make-music 'SequentialMusic
 309    'elements (list #{
 310               \once \override Voice.NoteHead #'stencil = #ly:text-interface::print
 311               \once \override Voice.NoteHead #'text =
 312               #(markup #:null #:raise 0.0 #:musicglyph "custodes.mensural.u0")
 313               \once \override Voice.Flag #'stencil = ##f
 314               \once \override Voice.Stem #'stencil = ##f #}
 315               note)))
 316
 317 %%%
 318 %%% Note formatting tweaks
 319 %%%
 320
 321 forceStemLength =
 322 #(define-music-function (parser location length music) (number? ly:music?)
 323   #{
 324   \override Voice.Stem #'details = #`((lengths . (,length))
 325                                       (beamed-lengths . (,(- length 1.0)))
 326                                       (beamed-minimum-free-lengths . (,(- length 1.0)))
 327                                       (beamed-extreme-minimum-free-lengths . (,(- length 1.0)))
 328                                       (stem-shorten . (1.0 0.5)))
 329   $music
 330   \revert Voice.Stem #'details
 331   #})
 332
 333 shiftOnce = { \once \override NoteColumn #'horizontal-shift = #1 }
 334
 335 shiftNote =
 336 #(define-music-function (parser location amount) (number?)
 337    #{ \once \override NoteHead #'X-offset = #amount
 338       \once \override Stem #'X-offset = #amount
 339       \once \override Beam #'X-offset = #amount #})
 340
 341 shiftRest =
 342 #(define-music-function (parser location amount) (number?)
 343    #{ \once \override Rest #'X-offset = #amount #})
 344
 345 %%%
 346 %%% Misc utilities
 347 %%%
 348
 349 altKeys =
 350 #(define-music-function (parser location fractions) (list?)
 351    (define (make-time-sig-markup num den . rest)
 352      (if den
 353          (make-center-column-markup
 354           (list (number->string num)
 355                 (number->string den)))
 356          (make-raise-markup -1 (number->string num))))
 357
 358    (let ((time1 (apply make-time-sig-markup fractions))
 359          (time2 (apply make-time-sig-markup (cddr fractions))))
 360      #{
 361        \once \override Staff.TimeSignature #'stencil = #ly:text-interface::print
 362        \once \override Staff.TimeSignature #'text =
 363        \markup \override #'(baseline-skip . 0)
 364        \number \line { $time1 $time2 }
 365      #}))
 366
 367 fractionTime = \once \override Staff.TimeSignature #'style = #'numbered
 368 cTime = \once \override Staff.TimeSignature #'style = #'C
 369 digitTime = \once \override Staff.TimeSignature #'style = #'single-digit
 370
 371 instrumentName =
 372 #(define-music-function (parser location name) (markup?)
 373    #{ \set Staff.instrumentName = \markup \large $name #})
 374
 375 characterName =
 376 #(define-music-function (parser location name) (markup?)
 377   #{ \set Staff . instrumentName = \markup \large \smallCaps $name #})
 378
 379 midiTempo =
 380 #(define-music-function (parser location quater-nb-par-min) (number?)
 381    #{ \set Score . tempoWholesPerMinute =
 382       #(ly:make-moment (/ quater-nb-par-min 4) 1 0 1) #})
 383
 384 %% figure extenders
 385 figExtOn = \bassFigureExtendersOn
 386 figExtOff = \bassFigureExtendersOff
 387
 388 figPosOn = {
 389   \bassFigureExtendersOn
 390   \override BassFigureContinuation #'stencil = ##f
 391   \override Staff.BassFigureContinuation #'stencil = ##f
 392 }
 393 figPosOff = {
 394   \bassFigureExtendersOff
 395   \revert BassFigureContinuation #'stencil
 396   \revert Staff.BassFigureContinuation #'stencil
 397 }
 398
 399 %% geometric figures
 400
 401 #(define-markup-command (triangle-up layout props a b c) (markup? markup? markup?)
 402    (let ((base (interpret-markup layout props (markup #:tiny #:line (#:number b #:number c))))
 403          (top (interpret-markup layout props (markup #:tiny #:number a))))
 404      (let* ((base-width (interval-length (ly:stencil-extent base X)))
 405             (top-width (interval-length (ly:stencil-extent top X)))
 406             (top-left-padding (/ (- base-width top-width) 2.0)))
 407        (stack-lines DOWN 0.0 2
 408                     (list
 409                      (stack-stencil-line 0 (list (ly:make-stencil "" `(0 . ,top-left-padding) '(0 . 0))
 410                                                  top))
 411                      base)))))
 412
 413 #(define-markup-command (triangle-down layout props a b c) (markup? markup? markup?)
 414    (let ((base (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
 415          (bottom (interpret-markup layout props (markup #:tiny #:number c))))
 416      (let* ((base-width (interval-length (ly:stencil-extent base X)))
 417             (bottom-width (interval-length (ly:stencil-extent bottom X)))
 418             (bottom-left-padding (/ (- base-width bottom-width) 2.0)))
 419        (stack-lines DOWN 0.0 2
 420                     (list
 421                      base
 422                      (stack-stencil-line
 423                       0 (list (ly:make-stencil ""
 424                                                `(0 . ,bottom-left-padding)
 425                                                '(0 . 0))
 426                               bottom)))))))
 427
 428 #(define-markup-command (triangle-down-down layout props a b c d) (markup? markup? markup? markup?)
 429    (let ((base (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
 430          (bottom (interpret-markup layout props (markup #:tiny #:number c)))
 431          (bottom2 (interpret-markup layout props (markup #:tiny #:number d))))
 432      (let* ((base-width (interval-length (ly:stencil-extent base X)))
 433             (bottom-width (interval-length (ly:stencil-extent bottom X)))
 434             (bottom-left-padding (/ (- base-width bottom-width) 2.0))
 435             (bottom2-width (interval-length (ly:stencil-extent bottom2 X)))
 436             (bottom2-left-padding (/ (- base-width bottom2-width) 2.0)))
 437        (stack-lines DOWN 0.0 2
 438                     (list
 439                      base
 440                      (stack-stencil-line
 441                       0 (list (ly:make-stencil ""
 442                                                `(0 . ,bottom-left-padding)
 443                                                '(0 . 0))
 444                               bottom))
 445                      (stack-stencil-line
 446                       0 (list (ly:make-stencil ""
 447                                                `(0 . ,bottom2-left-padding)
 448                                                '(0 . 0))
 449                               bottom2)))))))
 450
 451 #(define-markup-command (parallelogram-up-left layout props a b c d) (markup? markup? markup? markup?)
 452    "figure:
 453 a b
 454  c d"
 455    (let ((top (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
 456          (bottom (interpret-markup layout props (markup #:tiny #:line (#:number c #:number d)))))
 457      (let* ((top-width (interval-length (ly:stencil-extent top X)))
 458             (bottom-left-padding (/ (- top-width
 459                                        (interval-length
 460                                         (ly:stencil-extent
 461                                          (interpret-markup layout props (markup #:tiny #:number c)) X)))
 462                                     2.0)))
 463        (stack-lines DOWN 0.0 2
 464                     (list
 465                      top
 466                      (stack-stencil-line
 467                       0
 468                       (list (ly:make-stencil ""
 469                                              `(0 . ,bottom-left-padding)
 470                                              '(0 . 0))))
 471                      bottom)))))
 472
 473 #(define-markup-command (square layout props a b c d) (markup? markup? markup? markup?)
 474    "figure:
 475 a b
 476 c d"
 477    (let ((top (interpret-markup layout props (markup #:tiny #:line (#:number a #:number b))))
 478          (bottom (interpret-markup layout props (markup #:tiny #:line (#:number c #:number d)))))
 479      (stack-lines DOWN 0.0 2 (list top bottom))))
 480
 481 #(define-markup-command (fig-five layout props a b c d e)
 482      (markup? markup? markup? markup? markup?)
 483    "figure:
 484 a b
 485  c
 486 d e"
 487    (let ((top (interpret-markup layout props
 488                                 (markup #:tiny #:line (#:number a #:number b))))
 489          (center (interpret-markup layout props
 490                                    (markup #:tiny #:number c)))
 491          (bottom (interpret-markup layout props
 492                                    (markup #:tiny #:line (#:number d #:number e)))))
 493      (let* ((top-width (interval-length (ly:stencil-extent top X)))
 494             (center-width (interval-length (ly:stencil-extent center X)))
 495             (center-left-padding (/ (- top-width center-width) 2.0)))
 496        (stack-lines DOWN 0.0 2
 497                     (list
 498                      top
 499                      (stack-stencil-line
 500                       0 (list (ly:make-stencil ""
 501                                                `(0 . ,center-left-padding)
 502                                                '(0 . 0))
 503                               center))
 504                      bottom)))))
 505
 506 #(define-markup-command (figure-sharp layout props) ()
 507    (interpret-markup
 508     layout props
 509     (markup #:tiny #:concat (#:null #:raise 0.7 #:fontsize -2 #:sharp))))
 510
 511 #(define-markup-command (figure-flat layout props) ()
 512    (interpret-markup
 513     layout props
 514     (markup #:tiny #:concat (#:null #:raise 0.7 #:fontsize -2 #:flat))))
 515
 516 #(define-markup-command (figure-natural layout props) ()
 517    (interpret-markup
 518     layout props
 519     (markup #:tiny #:concat (#:null #:raise 0.7 #:fontsize -2 #:natural))))
 520
 521 #(define-markup-command (paren-sharp layout props num) (markup?)
 522    (interpret-markup
 523     layout props
 524     (markup #:tiny #:concat (#:null #:raise 0.2 #:line ("(" #:figure-sharp ")")
 525                                     #:number num ))))
 526
 527 #(define-markup-command (paren-flat layout props num) (markup?)
 528    (interpret-markup
 529     layout props
 530     (markup #:tiny #:concat (#:null #:raise 0.2 #:line ("(" #:figure-flat ")")
 531                                     #:number num ))))
 532
 533 %%%
 534 %%% On-demand hara-kiri
 535 %%%
 536 startHaraKiri = \set Staff.keepAliveInterfaces = #'()
 537 stopHaraKiri = \unset Staff.keepAliveInterfaces
 538
 539 noHaraKiri = \set Staff.keepAliveInterfaces =
 540 #'(multi-measure-interface
 541    rhythmic-grob-interface
 542    lyric-interface
 543    percent-repeat-item-interface
 544    percent-repeat-interface
 545    stanza-number-interface)
 546 revertNoHaraKiri = \unset Staff.keepAliveInterfaces
 547
 548 %%%
 549 ifLetter =
 550 #(define-music-function (parser location music) (ly:music?)
 551    (if (eqv? #t (ly:get-option 'letter))
 552        music
 553        (make-music 'Music 'void #t)))
 554 unlessLetter =
 555 #(define-music-function (parser location music) (ly:music?)
 556    (if (not (eqv? #t (ly:get-option 'letter)))
 557        music
 558        (make-music 'Music 'void #t)))
 559
 560 %%%
 561 applyDurations =
 562 #(define-music-function (parser location pattern music) (ly:music? ly:music?)
 563   "\\applyDurations { c'16. c32 } { c d e f }
 564 ==>
 565 { c16. d32 e16. f32 }"
 566    (let ((durations (apply circular-list
 567                       (let ((result (list)))
 568                         (music-map (lambda (event)
 569                                      (if (eqv? (ly:music-property event 'name) 'NoteEvent)
 570                                          (set! result (cons (ly:music-property event 'duration) result)))
 571                                      event)
 572                                   pattern)
 573                         (reverse! result)))))
 574     (music-map (lambda (event)
 575                  (cond ((eqv? (ly:music-property event 'name) 'NoteEvent)
 576                         (set! (ly:music-property event 'duration) (car durations))
 577                         (set! durations (cdr durations))))
 578                  event)
 579                music)))
 580
 581 %%%
 582 %% double pointée triple x2
 583 dpts =
 584 #(define-music-function (parser location chords) (ly:music?)
 585    (define (make-16.-32-16.-32 chord)
 586      (let ((pitches '()))
 587        (music-map (lambda (m)
 588                     (if (eqv? (ly:music-property m 'name) 'NoteEvent)
 589                         (set! pitches (cons (ly:music-property m 'pitch) pitches))))
 590                   chord)
 591        (let ((chord16. (make-music 'EventChord
 592                          'elements (map (lambda (pitch)
 593                                           (make-music 'NoteEvent
 594                                            'duration (ly:make-duration 4 1 1 1)
 595                                            'pitch pitch))
 596                                         pitches)))
 597              (chord32  (make-music 'EventChord
 598                          'elements (map (lambda (pitch)
 599                                           (make-music 'NoteEvent
 600                                            'duration (ly:make-duration 5 0 1 1)
 601                                            'pitch pitch))
 602                                         pitches))))
 603          (make-music 'SequentialMusic 'elements (list chord16. chord32 chord16. chord32)))))
 604    (make-music 'SequentialMusic 'elements (map make-16.-32-16.-32 (ly:music-property chords 'elements))))
 605
 606 %% Staff change
 607
 608 updown = { \change Staff = "down" \voiceOne }
 609 upup = { \change Staff = "up" \oneVoice }
 610 downup = { \change Staff = "up" \voiceTwo }
 611 downdown = { \change Staff = "down" \oneVoice }
 612
 613 %% repeats
 614
 615 ru =
 616 #(define-music-function (parser location times music) (number? ly:music?)
 617    (if (eqv? #t (ly:get-option 'use-tremolo-repeat))
 618        (make-repeat "tremolo" times music '())
 619        (make-repeat "unfold" times music '())))
 620 rt =
 621 #(define-music-function (parser location times music) (number? ly:music?)
 622    (make-repeat "tremolo" times music '()))
 623
 624 rp =
 625 #(define-music-function (parser location times music) (number? ly:music?)
 626    (make-repeat "percent" times music '()))
 627
 628 %% Tweak on articulations
 629
 630 tweakArticulation =
 631 #(define-music-function (parser location property value music)
 632      (symbol? scheme? ly:music?)
 633    "Like \\tweak, but apply the tweak to articulation event found
 634 found inside @var{music}."
 635    (if (equal? (object-property property 'backend-type?) #f)
 636        (begin
 637          (ly:warning (_ "cannot find property type-check for ~a") property)
 638          (ly:warning (_ "doing assignment anyway"))))
 639    (for-each (lambda (event)
 640                (set! (ly:music-property event 'tweaks)
 641                      (acons property value (ly:music-property event 'tweaks))))
 642              (ly:music-property music 'articulations))
 643    music)
 644
 645 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 646 %%% Selection of version: urtext or modified
 647 origVersion =
 648 #(define-music-function (parser location music) (ly:music?)
 649    (if (eqv? #t (ly:get-option 'ancient-style))
 650        music
 651        (let ((type (ly:music-property music 'name)))
 652          (if (memq type '(TextScriptEvent ArticulationEvent TieEvent SlurEvent))
 653              (make-music 'TextScriptEvent 'text "")
 654              (make-music 'Music 'void #t)))))
 655
 656 modVersion =
 657 #(define-music-function (parser location music) (ly:music?)
 658    (if (not (eqv? #t (ly:get-option 'ancient-style)))
 659        music
 660        (let ((type (ly:music-property music 'name)))
 661          (if (memq type '(TextScriptEvent ArticulationEvent TieEvent SlurEvent))
 662              (make-music 'TextScriptEvent 'text "")
 663              (make-music 'Music 'void #t)))))
 664
 665 #(define-markup-command (orig-version layout props markp) (markup?)
 666    (if (eqv? #t (ly:get-option 'ancient-style))
 667        (interpret-markup layout props markp)
 668        empty-stencil))
 669
 670 #(define-markup-command (mod-version layout props markp) (markup?)
 671    (if (not (eqv? #t (ly:get-option 'ancient-style)))
 672        (interpret-markup layout props markp)
 673        empty-stencil))
 674
 675 origLayout =
 676 #(define-music-function (parser location music) (ly:music?)
 677    (if (eqv? #t (ly:get-option 'original-layout))
 678        music
 679        (make-music 'Music)))
 680
 681 \layout {
 682   \context {
 683     \Score
 684     \override NonMusicalPaperColumn #'line-break-permission =
 685     #(if (eqv? #t (ly:get-option 'original-layout))
 686          #f
 687          'allow)
 688     \override NonMusicalPaperColumn #'page-break-permission =
 689     #(if (eqv? #t (ly:get-option 'original-layout))
 690          #f
 691          'allow)
 692   }
 693 }
 694
 695 #(define-markup-command (annotation layout props markp) (markup?)
 696    (if (eqv? #t (ly:get-option 'ancient-style))
 697        (interpret-markup layout props (markup #:with-color red markp))
 698        empty-stencil))
 699
 700 verticalTweak =
 701 #(define-music-function (parser location tweak) (list?)
 702    "Specify hard coded vertical spacing.  setting lilypond option
 703 `apply-vertical-tweaks' to #f get rid off these tweaks."
 704    (if (eqv? #t (ly:get-option 'apply-vertical-tweaks))
 705        #{ \overrideProperty
 706 Score.NonMusicalPaperColumn.line-break-system-details #tweak #}
 707        (make-music 'Music 'void #t)))
 708
 709
 710
 711 %%% conditional music
 712 whenCondition =
 713 #(define-music-function (parser location condition music) (boolean? ly:music?)
 714    (if condition
 715        music
 716        (make-music 'Music 'void #t)))
 717
 718 unlessCondition =
 719 #(define-music-function (parser location condition music) (boolean? ly:music?)
 720    (if condition
 721        (make-music 'Music 'void #t)
 722        music))
 723
 724 %%% dessine une croix à l'emplacement de la note
 725 #(define (make-erased-note-print print-procedure)
 726    (lambda (grob)
 727      (let ((note-head (print-procedure grob))
 728            (x-offset 1)
 729            (y-offset (if (number? (ly:grob-property grob 'staff-position))
 730                          (/ (ly:grob-property grob
 731                                               'staff-position)
 732                             2)
 733                          0))
 734            (thickness 0.4)
 735            (radius 2))
 736        (ly:stencil-add
 737         note-head
 738         (ly:stencil-add
 739          (ly:make-stencil
 740           `(draw-line ,thickness
 741                       ,(+ radius x-offset)
 742                       ,(- 0 radius y-offset)
 743                       ,(- x-offset radius)
 744                       ,(- radius y-offset))
 745           '(0 . 0)
 746           '(0 . 0))
 747          (ly:make-stencil
 748           `(draw-line ,thickness
 749                       ,(+ radius x-offset)
 750                       ,(- radius y-offset)
 751                       ,(- x-offset radius)
 752                       ,(- 0 radius y-offset))
 753           '(0 . 0)
 754           '(0 . 0)))))))
 755
 756 ratureNote = {
 757   \once\override NoteHead #'stencil =
 758   #(make-erased-note-print ly:note-head::print)
 759   \once\override Rest #'stencil =
 760   #(make-erased-note-print ly:rest::print)
 761 }
 762
 763 #(define (make-erased-mmrest-print print-procedure)
 764    (lambda (grob)
 765      (let ((note-head (print-procedure grob))
 766            (x-offset 1)
 767            (y-offset (if (number? (ly:grob-property grob 'staff-position))
 768                          (/ (ly:grob-property grob
 769                                               'staff-position)
 770                             2)
 771                          0))
 772            (thickness 0.4)
 773            (radius 2))
 774        (ly:stencil-add
 775         note-head
 776         (ly:stencil-translate
 777          (ly:stencil-add
 778           (ly:make-stencil
 779            `(draw-line ,thickness
 780                        ,(+ radius x-offset)
 781                        ,(- 0 radius y-offset)
 782                        ,(- x-offset radius)
 783                        ,(- radius y-offset))
 784            '(0 . 0)
 785            '(0 . 0))
 786           (ly:make-stencil
 787            `(draw-line ,thickness
 788                        ,(+ radius x-offset)
 789                        ,(- radius y-offset)
 790                        ,(- x-offset radius)
 791                        ,(- 0 radius y-offset))
 792            '(0 . 0)
 793            '(0 . 0)))
 794          ;; translate the X so that it is on the bar center,
 795          ;; like the mm rest.
 796          (cons (car (ly:stencil-extent note-head X)) 0)
 797          )))))
 798
 799 ratureMmRest = {
 800   \once\override MultiMeasureRest #'stencil =
 801   #(make-erased-mmrest-print ly:multi-measure-rest::print)
 802 }
 803
 804 %%% Suggested dynamics
 805
 806 sug =
 807 #(define-music-function (parser loc arg) (ly:music?)
 808    (cond ((eqv? (ly:music-property arg 'name) 'AbsoluteDynamicEvent)
 809           (set! (ly:music-property arg 'text)
 810                 #{ \markup\smaller\smaller
 811                    #(ly:music-property arg 'text) #}))
 812           ((eqv? (ly:music-property arg 'name) 'CrescendoEvent)
 813            (set! (ly:music-property arg 'span-text)
 814                  #{ \markup\smaller\smaller
 815                    #(ly:music-property arg 'span-text) #})))
 816    arg)
 817
 818 rinf = #(make-dynamic-script #{\markup\normal-text\italic rinf #})
 819
 820 \defineBarLine "|.|:" #'("|." ".|:" "|.| ")