ly/music-functions-init.ly

   1 % -*-Scheme-*-
   2
   3 \version "2.9.12"
   4
   5
   6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   7 %% this file is alphabetically sorted.
   8 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   9
  10 %% need SRFI-1 filter
  11
  12 #(use-modules (srfi srfi-1))
  13 %% FIXME: guile-1.7 required?
  14 %#(use-modules (scm display-lily))invalid module name for use-syntax ((srfi srfi-39))
  15
  16 #(use-modules (scm display-lily))
  17 #(display-lily-init parser)
  18
  19
  20 acciaccatura =
  21 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic)
  22
  23 addquote =
  24 #(define-music-function (parser location name music) (string? ly:music?)
  25    "Add a piece of music to be quoted "
  26    (add-quotable name music)
  27    (make-music 'SequentialMusic 'void #t))
  28
  29
  30 afterGraceFraction =
  31 #(cons 6 8)
  32
  33 afterGrace =
  34 #(define-music-function
  35   (parser location main grace)
  36   (ly:music? ly:music?)
  37
  38   (let*
  39       ((main-length (ly:music-length main))
  40        (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
  41
  42     (make-simultaneous-music
  43      (list
  44       main
  45       (make-sequential-music
  46        (list
  47
  48         (make-music 'SkipMusic
  49                     'duration (ly:make-duration
  50                                0 0
  51                                (* (ly:moment-main-numerator main-length)
  52                                   (car fraction))
  53                                (* (ly:moment-main-denominator main-length)
  54                                   (cdr fraction)) ))
  55         (make-music 'GraceMusic
  56                     'element grace)))))))
  57
  58 applyMusic =
  59 #(define-music-function (parser location func music) (procedure? ly:music?)
  60                (func music))
  61
  62
  63 applyOutput =
  64 #(define-music-function (parser location ctx proc) (symbol? procedure?)
  65                 (make-music 'ApplyOutputEvent
  66                   'origin location
  67                   'procedure proc
  68                   'context-type ctx))
  69
  70 appoggiatura =
  71 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic)
  72
  73
  74
  75 % for regression testing purposes.
  76 assertBeamQuant =
  77 #(define-music-function (parser location l r) (pair? pair?)
  78   (make-grob-property-override 'Beam 'positions
  79    (ly:make-simple-closure
  80     (ly:make-simple-closure
  81      (append
  82       (list chain-grob-member-functions `(,cons 0 0))
  83       (check-quant-callbacks l r))))))
  84
  85 % for regression testing purposes.
  86 assertBeamSlope =
  87 #(define-music-function (parser location comp) (procedure?)
  88   (make-grob-property-override 'Beam 'positions
  89    (ly:make-simple-closure
  90     (ly:make-simple-closure
  91      (append
  92       (list chain-grob-member-functions `(,cons 0 0))
  93       (check-slope-callbacks comp))))))
  94
  95
  96
  97 autochange =
  98 #(define-music-function (parser location music) (ly:music?)
  99                (make-autochange-music music))
 100
 101 applyContext =
 102 #(define-music-function (parser location proc) (procedure?)
 103                  (make-music 'ApplyContext
 104                    'origin location
 105                    'procedure proc))
 106
 107 bar =
 108 #(define-music-function (parser location type)
 109    (string?)
 110    (context-spec-music
 111     (make-property-set 'whichBar type)
 112     'Timing))
 113
 114
 115 barNumberCheck =
 116 #(define-music-function (parser location n) (integer?)
 117    (make-music 'ApplyContext
 118                'origin location
 119                'procedure
 120                (lambda (c)
 121                  (let*
 122                      ((cbn (ly:context-property c 'currentBarNumber)))
 123                    (if (and  (number? cbn) (not (= cbn n)))
 124                        (ly:input-message location "Barcheck failed got ~a expect ~a"
 125                                          cbn n))))))
 126
 127
 128 %% why a function?
 129 breathe =
 130 #(define-music-function (parser location) ()
 131             (make-music 'EventChord
 132               'origin location
 133               'elements (list (make-music 'BreathingEvent))))
 134
 135 bendAfter =
 136 #(define-music-function (parser location delta) (integer?)
 137
 138   (make-music 'BendAfterEvent
 139    'delta-step delta))
 140
 141 clef =
 142 #(define-music-function (parser location type)
 143    (string?)
 144
 145    "Set the current clef."
 146
 147    (make-clef-set type))
 148
 149
 150 compressMusic =
 151 #(define-music-function
 152                   (parser location fraction music) (number-pair? ly:music?)
 153                   (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))))
 154
 155
 156 cueDuring =
 157 #(define-music-function
 158   (parser location what dir main-music)
 159   (string? ly:dir? ly:music?)
 160   (make-music 'QuoteMusic
 161               'element main-music
 162               'quoted-context-type 'Voice
 163               'quoted-context-id "cue"
 164               'quoted-music-name what
 165               'quoted-voice-direction dir
 166               'origin location))
 167
 168
 169 displayLilyMusic =
 170 #(define-music-function (parser location music) (ly:music?)
 171    (display-lily-music music)
 172    music)
 173
 174 displayMusic =
 175 #(define-music-function (parser location music) (ly:music?)
 176                  (display-scheme-music music)
 177                  music)
 178
 179 featherDurations=
 180 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
 181
 182    "Rearrange durations in ARGUMENT so there is an
 183 acceleration/deceleration. "
 184
 185    (let*
 186        ((orig-duration (ly:music-length argument))
 187         (multiplier (ly:make-moment 1 1)))
 188
 189      (music-map
 190       (lambda (mus)
 191         (if (and (eq? (ly:music-property mus 'name) 'EventChord)
 192                  (< 0 (ly:moment-main-denominator (ly:music-length mus))))
 193             (begin
 194               (ly:music-compress mus multiplier)
 195               (set! multiplier (ly:moment-mul factor multiplier)))
 196             )
 197         mus)
 198       argument)
 199
 200      (ly:music-compress
 201       argument
 202       (ly:moment-div orig-duration (ly:music-length argument)))
 203
 204      argument))
 205
 206 grace =
 207 #(def-grace-function startGraceMusic stopGraceMusic)
 208
 209
 210 "instrument-definitions" = #'()
 211
 212 addInstrumentDefinition =
 213 #(define-music-function
 214    (parser location name lst) (string? list?)
 215
 216    (set! instrument-definitions (acons name lst instrument-definitions))
 217
 218    (make-music 'SequentialMusic 'void #t))
 219
 220
 221 instrumentSwitch =
 222 #(define-music-function
 223    (parser location name) (string?)
 224    (let*
 225        ((handle  (assoc name instrument-definitions))
 226         (instrument-def (if handle (cdr handle) '()))
 227         )
 228
 229      (if (not handle)
 230          (ly:input-message "No such instrument: ~a" name))
 231      (context-spec-music
 232       (make-music 'SimultaneousMusic
 233                   'elements
 234                   (map (lambda (kv)
 235                          (make-property-set
 236                           (car kv)
 237                           (cdr kv)))
 238                        instrument-def))
 239       'Staff)))
 240
 241
 242 keepWithTag =
 243 #(define-music-function
 244   (parser location tag music) (symbol? ly:music?)
 245   (music-filter
 246    (lambda (m)
 247     (let* ((tags (ly:music-property m 'tags))
 248            (res (memq tag tags)))
 249      (or
 250       (eq? tags '())
 251       res)))
 252    music))
 253
 254
 255
 256 killCues =
 257 #(define-music-function
 258    (parser location music)
 259    (ly:music?)
 260    (music-map
 261     (lambda (mus)
 262       (if (string? (ly:music-property mus 'quoted-music-name))
 263           (ly:music-property mus 'element)
 264           mus)) music))
 265
 266
 267 makeClusters =
 268 #(define-music-function
 269                 (parser location arg) (ly:music?)
 270                 (music-map note-to-cluster arg))
 271
 272 musicMap =
 273 #(define-music-function (parser location proc mus) (procedure? ly:music?)
 274              (music-map proc mus))
 275
 276
 277
 278 oldaddlyrics =
 279 #(define-music-function (parser location music lyrics) (ly:music? ly:music?)
 280
 281               (make-music 'OldLyricCombineMusic
 282                           'origin location
 283                           'elements (list music lyrics)))
 284
 285
 286 overrideProperty =
 287 #(define-music-function (parser location name property value)
 288    (string? symbol? scheme?)
 289
 290
 291    "Set @var{property} to @var{value} in all grobs named @var{name}.
 292 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
 293 or @code{\"GrobName\"}"
 294
 295    (let*
 296        ((name-components (string-split name #\.))
 297         (context-name 'Bottom)
 298         (grob-name #f))
 299
 300      (if (> 2 (length name-components))
 301          (set! grob-name (string->symbol (car name-components)))
 302          (begin
 303            (set! grob-name (string->symbol (list-ref name-components 1)))
 304            (set! context-name (string->symbol (list-ref name-components 0)))))
 305
 306      (make-music 'ApplyOutputEvent
 307                  'origin location
 308                  'context-type context-name
 309                  'procedure
 310                  (lambda (grob orig-context context)
 311                    (if (equal?
 312                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
 313                         grob-name)
 314                        (set! (ly:grob-property grob property) value))))))
 315
 316
 317 removeWithTag =
 318 #(define-music-function
 319   (parser location tag music) (symbol? ly:music?)
 320   (music-filter
 321    (lambda (m)
 322     (let* ((tags (ly:music-property m 'tags))
 323            (res (memq tag tags)))
 324      (not res)))
 325  music))
 326
 327 %% Todo:
 328 %% doing
 329 %% define-music-function in a .scm causes crash.
 330
 331 octave =
 332 #(define-music-function (parser location pitch-note) (ly:music?)
 333    "octave check"
 334
 335    (make-music 'RelativeOctaveCheck
 336                'origin location
 337                'pitch (pitch-of-note pitch-note)
 338                ))
 339 partcombine =
 340 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 341                 (make-part-combine-music (list part1 part2)))
 342
 343
 344 pitchedTrill =
 345 #(define-music-function
 346    (parser location main-note secondary-note)
 347    (ly:music? ly:music?)
 348    (let*
 349        ((get-notes (lambda (ev-chord)
 350                      (filter
 351                       (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
 352                       (ly:music-property ev-chord 'elements))))
 353         (sec-note-events (get-notes secondary-note))
 354         (trill-events (filter (lambda (m) (memq 'trill-span-event (ly:music-property m 'types)))
 355                               (ly:music-property main-note 'elements)))
 356
 357         (trill-pitch
 358          (if (pair? sec-note-events)
 359              (ly:music-property (car sec-note-events) 'pitch)
 360              )))
 361
 362      (if (ly:pitch? trill-pitch)
 363          (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
 364                    trill-events)
 365          (begin
 366            (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
 367            (display sec-note-events)))
 368
 369      main-note))
 370
 371 parenthesize =
 372 #(define-music-function (parser loc arg) (ly:music?)
 373    "Tag @var{arg} to be parenthesized."
 374
 375    (set! (ly:music-property arg 'parenthesize) #t)
 376    arg)
 377
 378 %% for lambda*
 379 #(use-modules (ice-9 optargs))
 380
 381 parallelMusic =
 382 #(define-music-function (parser location voice-ids music) (list? ly:music?)
 383   "Define parallel music sequences, separated by '|' (bar check signs),
 384 and assign them to the identifiers provided in @var{voice-ids}.
 385
 386 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
 387
 388 @var{music}: a music sequence, containing BarChecks as limiting expressions.
 389
 390 Example:
 391   \\parallelMusic #'(A B C) {
 392     c c | d d | e e |
 393     d d | e e | f f |
 394   }
 395 <==>
 396   A = { c c | d d | }
 397   B = { d d | e e | }
 398   C = { e e | f f | }
 399 "
 400   (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
 401          (current-voices voices)
 402          (current-sequence (list)))
 403     ;;
 404     ;; utilities
 405     (define (push-music m)
 406       "Push the music expression into the current sequence"
 407       (set! current-sequence (cons m current-sequence)))
 408     (define (change-voice)
 409       "Stores the previously built sequence into the current voice and
 410        change to the following voice."
 411       (list-set! current-voices 0 (cons (make-music 'SequentialMusic
 412                                          'elements (reverse! current-sequence))
 413                                         (car current-voices)))
 414       (set! current-sequence (list))
 415       (set! current-voices (cdr current-voices)))
 416     (define (bar-check? m)
 417       "Checks whether m is a bar check."
 418       (eq? (ly:music-property m 'name) 'BarCheck))
 419     (define (music-origin music)
 420       "Recursively search an origin location stored in music."
 421       (cond ((null? music) #f)
 422             ((not (null? (ly:music-property music 'origin)))
 423              (ly:music-property music 'origin))
 424             (else (or (music-origin (ly:music-property music 'element))
 425                       (let ((origins (remove not (map music-origin
 426                                                       (ly:music-property music 'elements)))))
 427                         (and (not (null? origins)) (car origins)))))))
 428     ;;
 429     ;; first, split the music and fill in voices
 430     (map-in-order (lambda (m)
 431                     (push-music m)
 432                     (if (bar-check? m) (change-voice)))
 433                   (ly:music-property music 'elements))
 434     (if (not (null? current-sequence)) (change-voice))
 435     ;; un-circularize `voices' and reorder the voices
 436     (set! voices (map-in-order (lambda (dummy seqs)
 437                                  (reverse! seqs))
 438                                voice-ids voices))
 439     ;;
 440     ;; set origin location of each sequence in each voice
 441     ;; for better type error tracking
 442     (for-each (lambda (voice)
 443                 (for-each (lambda (seq)
 444                             (set! (ly:music-property seq 'origin)
 445                                   (or (music-origin seq) location)))
 446                           voice))
 447               voices)
 448     ;;
 449     ;; check sequence length
 450     (apply for-each (lambda* (#:rest seqs)
 451                       (let ((moment-reference (ly:music-length (car seqs))))
 452                         (for-each (lambda (seq moment)
 453                                     (if (not (equal? moment moment-reference))
 454                                         (ly:music-message seq
 455                                          "Bars in parallel music don't have the same length")))
 456                           seqs (map-in-order ly:music-length seqs))))
 457            voices)
 458    ;;
 459    ;; bind voice identifiers to the voices
 460    (map (lambda (voice-id voice)
 461           (ly:parser-define! parser voice-id
 462                              (make-music 'SequentialMusic
 463                                'origin location
 464                                'elements voice)))
 465         voice-ids voices))
 466  ;; Return an empty sequence. this function is actually a "void" function.
 467  (make-music 'SequentialMusic 'void #t))
 468
 469
 470
 471 quoteDuring = #
 472 (define-music-function
 473   (parser location what main-music)
 474   (string? ly:music?)
 475   (make-music 'QuoteMusic
 476               'element main-music
 477               'quoted-music-name what
 478               'origin location))
 479
 480
 481
 482 resetRelativeOctave  =
 483 #(define-music-function
 484     (parser location reference-note)
 485     (ly:music?)
 486     "Set the octave inside a \\relative section."
 487
 488    (let*
 489     ((notes (ly:music-property reference-note 'elements))
 490      (pitch (ly:music-property (car notes) 'pitch)))
 491
 492     (set! (ly:music-property reference-note 'elements) '())
 493     (set! (ly:music-property reference-note
 494        'to-relative-callback)
 495        (lambda (music last-pitch)
 496         pitch))
 497
 498     reference-note))
 499
 500
 501
 502 shiftDurations =
 503 #(define-music-function (parser location dur dots arg) (integer? integer? ly:music?)
 504    ""
 505
 506
 507    (music-map
 508     (lambda (x)
 509       (shift-one-duration-log x dur dots)) arg))
 510
 511 spacingTweaks =
 512 #(define-music-function (parser location parameters) (list?)
 513    "Set the system stretch, by reading the 'system-stretch property of
 514    the `parameters' assoc list."
 515    #{
 516       \overrideProperty #"Score.NonMusicalPaperColumn"
 517         #'line-break-system-details
 518         #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters))))
 519    #})
 520
 521 %% Parser used to read page-layout file, and then retreive score tweaks.
 522 #(define page-layout-parser #f)
 523
 524 includePageLayoutFile =
 525 #(define-music-function (parser location) ()
 526    "If page breaks and tweak dump is not asked, and the file
 527    <basename>-page-layout.ly exists, include it."
 528    (if (not (ly:get-option 'dump-tweaks))
 529        (let ((tweak-filename (format #f "~a-page-layout.ly"
 530                                      (ly:parser-output-name parser))))
 531          (if (access? tweak-filename R_OK)
 532              (begin
 533                (ly:message "Including tweak file ~a" tweak-filename)
 534                (set! page-layout-parser (ly:clone-parser parser))
 535                (ly:parser-parse-string page-layout-parser
 536                                        (format #f "\\include \"~a\""
 537                                                tweak-filename))))))
 538    (make-music 'SequentialMusic 'void #t))
 539
 540
 541 rightHandFinger =
 542 #(define-music-function (parser location finger) (number-or-string?)
 543    "Define a StrokeFingerEvent"
 544
 545    (apply make-music
 546           (append
 547            (list
 548             'StrokeFingerEvent
 549             'origin location)
 550            (if  (string? finger)
 551                 (list 'text finger)
 552                 (list 'digit finger)))))
 553
 554 scoreTweak =
 555 #(define-music-function (parser location name) (string?)
 556    "Include the score tweak, if exists."
 557    (if (and page-layout-parser (not (ly:get-option 'dump-tweaks)))
 558        (let ((tweak-music (ly:parser-lookup page-layout-parser
 559                                             (string->symbol name))))
 560          (if (ly:music? tweak-music)
 561              tweak-music
 562              (make-music 'SequentialMusic)))
 563        (make-music 'SequentialMusic)))
 564
 565 transposedCueDuring =
 566 #(define-music-function
 567   (parser location what dir pitch-note main-music)
 568   (string? ly:dir? ly:music? ly:music?)
 569
 570   "Insert notes from the part @var{what} into a voice called @code{cue},
 571 using the transposition defined by @var{pitch-note}.  This happens
 572 simultaneously with @var{main-music}, which is usually a rest.  The
 573 argument @var{dir} determines whether the cue notes should be notated
 574 as a first or second voice."
 575
 576   (make-music 'QuoteMusic
 577               'element main-music
 578               'quoted-context-type 'Voice
 579               'quoted-context-id "cue"
 580               'quoted-music-name what
 581               'quoted-voice-direction dir
 582               'quoted-transposition (pitch-of-note pitch-note)
 583               'origin location))
 584
 585
 586
 587 transposition =
 588 #(define-music-function (parser location pitch-note) (ly:music?)
 589    "Set instrument transposition"
 590
 591    (context-spec-music
 592     (make-property-set 'instrumentTransposition
 593                        (ly:pitch-diff (ly:make-pitch 0 0 0) (pitch-of-note pitch-note)))
 594         'Staff
 595 ))
 596
 597 tweak = #(define-music-function (parser location sym val arg)
 598            (symbol? scheme? ly:music?)
 599
 600            "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
 601
 602
 603            (set!
 604             (ly:music-property arg 'tweaks)
 605             (acons sym val
 606                    (ly:music-property arg 'tweaks)))
 607            arg)
 608
 609 tag = #(define-music-function (parser location tag arg)
 610    (symbol? ly:music?)
 611
 612    "Add @var{tag} to the @code{tags} property of @var{arg}."
 613
 614    (set!
 615     (ly:music-property arg 'tags)
 616     (cons tag
 617           (ly:music-property arg 'tags)))
 618    arg)
 619
 620
 621 unfoldRepeats =
 622 #(define-music-function (parser location music) (ly:music?)
 623                   (unfold-repeats music))
 624
 625
 626
 627 withMusicProperty =
 628 #(define-music-function (parser location sym val music) (symbol? scheme? ly:music?)
 629    "Set @var{sym} to @var{val} in @var{music}."
 630
 631    (set! (ly:music-property music sym) val)
 632    music)
 633
 634