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 applyMusic =
  10 #(def-music-function (parser location func music) (procedure? ly:music?)
  11                (func music))
  12
  13 oldaddlyrics =
  14 #(def-music-function (parser location music lyrics) (ly:music? ly:music?)
  15
  16               (make-music 'OldLyricCombineMusic
  17                           'origin location
  18                           'elements (list music lyrics)))
  19
  20 grace =
  21 #(def-grace-function startGraceMusic stopGraceMusic)
  22
  23 acciaccatura =
  24 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic)
  25 appoggiatura =
  26 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic)
  27
  28 partcombine =
  29 #(def-music-function (parser location part1 part2) (ly:music? ly:music?)
  30                 (make-part-combine-music (list part1 part2)))
  31
  32 autochange =
  33 #(def-music-function (parser location music) (ly:music?)
  34                (make-autochange-music music))
  35
  36 applyContext =
  37 #(def-music-function (parser location proc) (procedure?)
  38                  (make-music 'ApplyContext
  39                    'origin location
  40                    'procedure proc))
  41
  42 musicMap =
  43 #(def-music-function (parser location proc mus) (procedure? ly:music?)
  44              (music-map proc mus))
  45
  46 displayMusic =
  47 #(def-music-function (parser location music) (ly:music?)
  48                  (display-scheme-music music)
  49                  music)
  50
  51 %% FIXME: guile-1.7 required?
  52 %#(use-modules (scm display-lily))invalid module name for use-syntax ((srfi srfi-39))
  53
  54 #(use-modules (scm display-lily))
  55 #(display-lily-init parser)
  56 displayLilyMusic =
  57 #(def-music-function (parser location music) (ly:music?)
  58    (display-lily-music music)
  59    music)
  60
  61 applyOutput =
  62 #(def-music-function (parser location proc) (procedure?)
  63                 (make-music 'ApplyOutputEvent
  64                   'origin location
  65                   'procedure proc))
  66
  67 outputProperty =
  68 #(def-music-function (parser location name property value)
  69    (string? symbol? scheme?)
  70
  71
  72    "Set @var{property} to @var{value} in all grobs named @var{name}.
  73 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
  74 or @code{\"GrobName\"}"
  75
  76    (let*
  77        ((name-components (string-split name #\.))
  78         (context-name 'Bottom)
  79         (grob-name #f))
  80
  81      (if (> 2 (length name-components))
  82          (set! grob-name (string->symbol (car name-components)))
  83          (begin
  84            (set! grob-name (string->symbol (list-ref name-components 1)))
  85            (set! context-name (string->symbol (list-ref name-components 0)))))
  86
  87      (context-spec-music
  88       (make-music 'ApplyOutputEvent
  89                   'origin location
  90                   'procedure
  91                   (lambda (grob orig-context context)
  92                     (if (equal?
  93                          (cdr (assoc 'name (ly:grob-property grob 'meta)))
  94                          grob-name)
  95                         (set! (ly:grob-property grob property) value)
  96                         )))
  97
  98       context-name)))
  99
 100 breathe =
 101 #(def-music-function (parser location) ()
 102             (make-music 'EventChord
 103               'origin location
 104               'elements (list (make-music 'BreathingSignEvent))))
 105
 106
 107 unfoldRepeats =
 108 #(def-music-function (parser location music) (ly:music?)
 109                   (unfold-repeats music))
 110
 111 compressMusic =
 112 #(def-music-function
 113                   (parser location fraction music) (number-pair? ly:music?)
 114                   (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))))
 115
 116 makeClusters =
 117 #(def-music-function
 118                 (parser location arg) (ly:music?)
 119                 (music-map note-to-cluster arg))
 120
 121
 122 removeWithTag =
 123 #(def-music-function
 124   (parser location tag music) (symbol? ly:music?)
 125   (music-filter
 126    (lambda (m)
 127     (let* ((tags (ly:music-property m 'tags))
 128            (res (memq tag tags)))
 129      (not res)))
 130  music))
 131
 132 keepWithTag =
 133 #(def-music-function
 134   (parser location tag music) (symbol? ly:music?)
 135   (music-filter
 136    (lambda (m)
 137     (let* ((tags (ly:music-property m 'tags))
 138            (res (memq tag tags)))
 139      (or
 140       (eq? tags '())
 141       res)))
 142    music))
 143
 144
 145 %% Todo:
 146 %% doing
 147 %% def-music-function in a .scm causes crash.
 148
 149 cueDuring =
 150 #(def-music-function
 151   (parser location what dir main-music)
 152   (string? ly:dir? ly:music?)
 153   (make-music 'QuoteMusic
 154               'element main-music
 155               'quoted-context-type 'Voice
 156               'quoted-context-id "cue"
 157               'quoted-music-name what
 158               'quoted-voice-direction dir
 159               'origin location))
 160
 161
 162 quoteDuring = #
 163 (def-music-function
 164   (parser location what main-music)
 165   (string? ly:music?)
 166   (make-music 'QuoteMusic
 167               'element main-music
 168               'quoted-music-name what
 169               'origin location))
 170
 171
 172
 173 pitchedTrill =
 174 #(def-music-function
 175    (parser location main-note secondary-note)
 176    (ly:music? ly:music?)
 177    (let*
 178        ((get-notes (lambda (ev-chord)
 179                      (filter
 180                       (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
 181                       (ly:music-property ev-chord 'elements))))
 182         (sec-note-events (get-notes secondary-note))
 183         (trill-events (filter (lambda (m) (memq 'trill-span-event (ly:music-property m 'types)))
 184                               (ly:music-property main-note 'elements)))
 185
 186         (trill-pitch
 187          (if (pair? sec-note-events)
 188              (ly:music-property (car sec-note-events) 'pitch)
 189              )))
 190
 191      (if (ly:pitch? trill-pitch)
 192          (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
 193                    trill-events)
 194          (begin
 195            (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
 196            (display sec-note-events)))
 197
 198      main-note))
 199
 200 killCues =
 201 #(def-music-function
 202    (parser location music)
 203    (ly:music?)
 204    (music-map
 205     (lambda (mus)
 206       (if (string? (ly:music-property mus 'quoted-music-name))
 207           (ly:music-property mus 'element)
 208           mus)) music))
 209
 210
 211 afterGraceFraction =
 212 #(cons 6 8)
 213
 214 afterGrace =
 215 #(def-music-function
 216   (parser location main grace)
 217   (ly:music? ly:music?)
 218
 219   (let*
 220       ((main-length (ly:music-length main))
 221        (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
 222
 223     (make-simultaneous-music
 224      (list
 225       main
 226       (make-sequential-music
 227        (list
 228
 229         (make-music 'SkipMusic
 230                     'duration (ly:make-duration
 231                                0 0
 232                                (* (ly:moment-main-numerator main-length)
 233                                   (car fraction))
 234                                (* (ly:moment-main-denominator main-length)
 235                                   (cdr fraction)) ))
 236         (make-music 'GraceMusic
 237                     'element grace)))))))
 238
 239
 240 barNumberCheck =
 241 #(def-music-function (parser location n) (integer?)
 242    (make-music 'ApplyContext
 243                'origin location
 244                'procedure
 245                (lambda (c)
 246                  (let*
 247                      ((cbn (ly:context-property c 'currentBarNumber)))
 248                    (if (not (= cbn n))
 249                        (ly:input-message location "Barcheck failed got ~a expect ~a"
 250                                          cbn n))))))
 251
 252
 253 %{
 254
 255 TODO:
 256
 257 remove these from the parser, and softcode here:
 258
 259  * \tag
 260
 261 with small syntax changes, we could also do
 262
 263  * \bar
 264  *  ?
 265
 266 %}
 267