ly/music-functions-init.ly

   1 % -*-Scheme-*-
   2
   3 \version "2.6.0"
   4
   5 %% need SRFI-1 filter
   6
   7 #(use-modules (srfi srfi-1))
   8
   9
  10 tweak = #(def-music-function (parser location sym val arg)
  11            (symbol? scheme? ly:music?)
  12
  13            "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
  14
  15
  16            (set!
  17             (ly:music-property arg 'tweaks)
  18             (acons sym val
  19                    (ly:music-property arg 'tweaks)))
  20            arg)
  21
  22
  23
  24 tag = #(def-music-function (parser location tag arg)
  25    (symbol? ly:music?)
  26
  27    "Add @var{tag} to the @code{tags} property of @var{arg}."
  28
  29    (set!
  30     (ly:music-property arg 'tags)
  31     (cons tag
  32           (ly:music-property arg 'tags)))
  33    arg)
  34
  35 tag = #(def-music-function (parser location tag arg)
  36    (symbol? ly:music?)
  37
  38    "Add @var{tag} to the @code{tags} property of @var{arg}."
  39
  40    (set!
  41     (ly:music-property arg 'tags)
  42     (cons tag
  43           (ly:music-property arg 'tags)))
  44    arg)
  45
  46 clef =
  47 #(def-music-function (parser location type)
  48    (string?)
  49
  50    "Set the current clef."
  51
  52    (make-clef-set type))
  53
  54 bar =
  55 #(def-music-function (parser location type)
  56    (string?)
  57    (context-spec-music
  58     (make-property-set 'whichBar type)
  59     'Timing))
  60
  61 applyMusic =
  62 #(def-music-function (parser location func music) (procedure? ly:music?)
  63                (func music))
  64
  65 oldaddlyrics =
  66 #(def-music-function (parser location music lyrics) (ly:music? ly:music?)
  67
  68               (make-music 'OldLyricCombineMusic
  69                           'origin location
  70                           'elements (list music lyrics)))
  71
  72 grace =
  73 #(def-grace-function startGraceMusic stopGraceMusic)
  74
  75 acciaccatura =
  76 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic)
  77 appoggiatura =
  78 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic)
  79
  80 partcombine =
  81 #(def-music-function (parser location part1 part2) (ly:music? ly:music?)
  82                 (make-part-combine-music (list part1 part2)))
  83
  84 autochange =
  85 #(def-music-function (parser location music) (ly:music?)
  86                (make-autochange-music music))
  87
  88 applyContext =
  89 #(def-music-function (parser location proc) (procedure?)
  90                  (make-music 'ApplyContext
  91                    'origin location
  92                    'procedure proc))
  93
  94 musicMap =
  95 #(def-music-function (parser location proc mus) (procedure? ly:music?)
  96              (music-map proc mus))
  97
  98 displayMusic =
  99 #(def-music-function (parser location music) (ly:music?)
 100                  (display-scheme-music music)
 101                  music)
 102
 103 %% FIXME: guile-1.7 required?
 104 %#(use-modules (scm display-lily))invalid module name for use-syntax ((srfi srfi-39))
 105
 106 #(use-modules (scm display-lily))
 107 #(display-lily-init parser)
 108 displayLilyMusic =
 109 #(def-music-function (parser location music) (ly:music?)
 110    (display-lily-music music)
 111    music)
 112
 113 applyOutput =
 114 #(def-music-function (parser location proc) (procedure?)
 115                 (make-music 'ApplyOutputEvent
 116                   'origin location
 117                   'procedure proc))
 118
 119 overrideProperty =
 120 #(def-music-function (parser location name property value)
 121    (string? symbol? scheme?)
 122
 123
 124    "Set @var{property} to @var{value} in all grobs named @var{name}.
 125 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
 126 or @code{\"GrobName\"}"
 127
 128    (let*
 129        ((name-components (string-split name #\.))
 130         (context-name 'Bottom)
 131         (grob-name #f))
 132
 133      (if (> 2 (length name-components))
 134          (set! grob-name (string->symbol (car name-components)))
 135          (begin
 136            (set! grob-name (string->symbol (list-ref name-components 1)))
 137            (set! context-name (string->symbol (list-ref name-components 0)))))
 138
 139      (context-spec-music
 140       (make-music 'ApplyOutputEvent
 141                   'origin location
 142                   'procedure
 143                   (lambda (grob orig-context context)
 144                     (if (equal?
 145                          (cdr (assoc 'name (ly:grob-property grob 'meta)))
 146                          grob-name)
 147                         (set! (ly:grob-property grob property) value)
 148                         )))
 149
 150       context-name)))
 151
 152 breathe =
 153 #(def-music-function (parser location) ()
 154             (make-music 'EventChord
 155               'origin location
 156               'elements (list (make-music 'BreathingSignEvent))))
 157
 158
 159 unfoldRepeats =
 160 #(def-music-function (parser location music) (ly:music?)
 161                   (unfold-repeats music))
 162
 163 compressMusic =
 164 #(def-music-function
 165                   (parser location fraction music) (number-pair? ly:music?)
 166                   (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))))
 167
 168 makeClusters =
 169 #(def-music-function
 170                 (parser location arg) (ly:music?)
 171                 (music-map note-to-cluster arg))
 172
 173
 174 removeWithTag =
 175 #(def-music-function
 176   (parser location tag music) (symbol? ly:music?)
 177   (music-filter
 178    (lambda (m)
 179     (let* ((tags (ly:music-property m 'tags))
 180            (res (memq tag tags)))
 181      (not res)))
 182  music))
 183
 184 keepWithTag =
 185 #(def-music-function
 186   (parser location tag music) (symbol? ly:music?)
 187   (music-filter
 188    (lambda (m)
 189     (let* ((tags (ly:music-property m 'tags))
 190            (res (memq tag tags)))
 191      (or
 192       (eq? tags '())
 193       res)))
 194    music))
 195
 196
 197 %% Todo:
 198 %% doing
 199 %% def-music-function in a .scm causes crash.
 200
 201 cueDuring =
 202 #(def-music-function
 203   (parser location what dir main-music)
 204   (string? ly:dir? ly:music?)
 205   (make-music 'QuoteMusic
 206               'element main-music
 207               'quoted-context-type 'Voice
 208               'quoted-context-id "cue"
 209               'quoted-music-name what
 210               'quoted-voice-direction dir
 211               'origin location))
 212
 213
 214 quoteDuring = #
 215 (def-music-function
 216   (parser location what main-music)
 217   (string? ly:music?)
 218   (make-music 'QuoteMusic
 219               'element main-music
 220               'quoted-music-name what
 221               'origin location))
 222
 223
 224
 225 pitchedTrill =
 226 #(def-music-function
 227    (parser location main-note secondary-note)
 228    (ly:music? ly:music?)
 229    (let*
 230        ((get-notes (lambda (ev-chord)
 231                      (filter
 232                       (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
 233                       (ly:music-property ev-chord 'elements))))
 234         (sec-note-events (get-notes secondary-note))
 235         (trill-events (filter (lambda (m) (memq 'trill-span-event (ly:music-property m 'types)))
 236                               (ly:music-property main-note 'elements)))
 237
 238         (trill-pitch
 239          (if (pair? sec-note-events)
 240              (ly:music-property (car sec-note-events) 'pitch)
 241              )))
 242
 243      (if (ly:pitch? trill-pitch)
 244          (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
 245                    trill-events)
 246          (begin
 247            (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
 248            (display sec-note-events)))
 249
 250      main-note))
 251
 252 killCues =
 253 #(def-music-function
 254    (parser location music)
 255    (ly:music?)
 256    (music-map
 257     (lambda (mus)
 258       (if (string? (ly:music-property mus 'quoted-music-name))
 259           (ly:music-property mus 'element)
 260           mus)) music))
 261
 262
 263 afterGraceFraction =
 264 #(cons 6 8)
 265
 266 afterGrace =
 267 #(def-music-function
 268   (parser location main grace)
 269   (ly:music? ly:music?)
 270
 271   (let*
 272       ((main-length (ly:music-length main))
 273        (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
 274
 275     (make-simultaneous-music
 276      (list
 277       main
 278       (make-sequential-music
 279        (list
 280
 281         (make-music 'SkipMusic
 282                     'duration (ly:make-duration
 283                                0 0
 284                                (* (ly:moment-main-numerator main-length)
 285                                   (car fraction))
 286                                (* (ly:moment-main-denominator main-length)
 287                                   (cdr fraction)) ))
 288         (make-music 'GraceMusic
 289                     'element grace)))))))
 290
 291
 292 barNumberCheck =
 293 #(def-music-function (parser location n) (integer?)
 294    (make-music 'ApplyContext
 295                'origin location
 296                'procedure
 297                (lambda (c)
 298                  (let*
 299                      ((cbn (ly:context-property c 'currentBarNumber)))
 300                    (if (not (= cbn n))
 301                        (ly:input-message location "Barcheck failed got ~a expect ~a"
 302                                          cbn n))))))
 303
 304
 305
 306 % for regression testing purposes.
 307 assertBeamQuant =
 308 #(def-music-function (parser location l r) (pair? pair?)
 309   (make-grob-property-override 'Beam 'positions
 310    (ly:make-simple-closure
 311     (ly:make-simple-closure
 312      (append
 313       (list chain-grob-member-functions `(,cons 0 0))
 314       (check-quant-callbacks l r))))))
 315
 316 % for regression testing purposes.
 317 assertBeamSlope =
 318 #(def-music-function (parser location comp) (procedure?)
 319   (make-grob-property-override 'Beam 'positions
 320    (ly:make-simple-closure
 321     (ly:make-simple-closure
 322      (append
 323       (list chain-grob-member-functions `(,cons 0 0))
 324       (check-slope-callbacks comp))))))
 325
 326
 327
 328