scm/music-functions.scm

   1
   2 (define (denominator-tuplet-formatter mus)
   3   (number->string (ly-get-mus-property mus 'denominator)))
   4
   5 (define (fraction-tuplet-formatter mus)
   6   (string-append (number->string (ly-get-mus-property mus 'numerator))
   7                  ":"
   8                  (number->string (ly-get-mus-property mus 'denominator))
   9                  ))
  10
  11 (define (unfold-repeats music)
  12 "
  13 This function replaces all repeats  with unfold repeats. It was
  14 written by Rune Zedeler. "
  15   (let* ((es (ly-get-mus-property music 'elements))
  16          (e (ly-get-mus-property music 'element))
  17          (n  (ly-music-name music)))
  18
  19     (if (equal? n "Repeated_music")
  20         (begin
  21           (ly-set-mus-property
  22            music 'length Repeated_music::unfolded_music_length)
  23           (ly-set-mus-property
  24            music 'start-moment-function Repeated_music::first_start)
  25           (ly-set-mus-property
  26            music 'iterator-ctor Unfolded_repeat_iterator::constructor)))
  27
  28     (if (pair? es)
  29         (ly-set-mus-property
  30          music 'elements
  31          (map unfold-repeats es)))
  32
  33     (if (music? e)
  34         (ly-set-mus-property
  35          music 'element
  36          (unfold-repeats e)))
  37
  38     music))
  39
  40
  41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43
  44 (define  (pitchify-scripts music)
  45   "Copy the pitch fields of the Note_requests into  Text_script_requests, to aid
  46 Fingering_engraver."
  47   (define (find-note musics)
  48     (filter-list (lambda (m) (equal? (ly-music-name m) "Note_req")) musics)
  49     )
  50   (define (find-scripts musics)
  51     (filter-list (lambda (m) (equal? (ly-music-name m) "Text_script_req")) musics))
  52
  53   (let* (
  54          (e (ly-get-mus-property music 'element))
  55          (es (ly-get-mus-property music 'elements))
  56          (notes (find-note es))
  57          (pitch (if (pair? notes) (ly-get-mus-property (car  notes) 'pitch) #f))
  58          )
  59
  60     (if pitch
  61         (map (lambda (x) (ly-set-mus-property x 'pitch pitch)) (find-scripts es))
  62         )
  63
  64     (if (pair? es)
  65         (ly-set-mus-property
  66          music 'elements
  67          (map pitchify-scripts es)))
  68
  69     (if (music? e)
  70         (ly-set-mus-property
  71          music 'element
  72          (pitchify-scripts e)))
  73
  74     music))
  75
  76
  77 ;;;;;;;;;;;;;;;;;
  78 ;;;;;;;;;;;;;;;;
  79 ;;;;;;;;;;;;;;;;
  80
  81
  82 (define (make-grob-property-set grob gprop val)
  83   "Make a M-exp that sets GPROP to VAL in GROBS. Does a pop first, i.e.
  84 this is not an override
  85 "
  86
  87    (let* ((m (ly-make-music  "Music")))
  88      (ly-set-mus-property m 'iterator-ctor Push_property_iterator::constructor)
  89      (ly-set-mus-property m 'symbol grob)
  90      (ly-set-mus-property m 'grob-property gprop)
  91      (ly-set-mus-property m 'grob-value val)
  92      (ly-set-mus-property m 'pop-first #t)
  93
  94      m
  95
  96    ))
  97
  98 (define (make-grob-property-revert grob gprop)
  99   "Revert the grob property GPROP for GROB."
 100    (let* ((m (ly-make-music  "Music")))
 101      (ly-set-mus-property m 'iterator-ctor Pop_property_iterator::constructor)
 102      (ly-set-mus-property m 'symbol grob)
 103      (ly-set-mus-property m 'grob-property gprop)
 104
 105      m
 106
 107    ))
 108
 109 (define (make-voice-props-set n)
 110   (make-sequential-music
 111    (append
 112       (map (lambda (x) (make-grob-property-set x 'direction
 113                                                (if (odd? n) -1 1)))
 114            '(Tie Slur Stem Dots))
 115       (list (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)))
 116    )
 117   ))
 118
 119 (define (make-voice-props-revert)
 120   (make-sequential-music
 121    (list
 122       (make-grob-property-revert 'Tie 'direction)
 123       (make-grob-property-revert 'Dots 'direction)
 124       (make-grob-property-revert 'Stem 'direction)
 125       (make-grob-property-revert 'Slur 'direction)
 126       (make-grob-property-revert 'NoteColumn 'horizontal-shift)
 127    ))
 128   )
 129
 130 (define (context-spec-music m context . rest)
 131   "Add \context CONTEXT = foo to M. "
 132
 133   (let* ((cm (ly-make-music "Context_specced_music")))
 134     (ly-set-mus-property cm 'element m)
 135     (ly-set-mus-property cm 'context-type context)
 136     (if (and  (pair? rest) (string? (car rest)))
 137         (ly-set-mus-property cm 'context-id (car rest))
 138     )
 139     cm
 140   ))
 141
 142 (define (make-sequential-music elts)
 143   (let*  ((m (ly-make-music "Sequential_music")))
 144     (ly-set-mus-property m 'elements elts)
 145     m
 146   ))
 147 (define (make-simultaneous-music elts)
 148   (let*  ((m (ly-make-music "Simultaneous_music")))
 149     (ly-set-mus-property m 'elements elts)
 150     m
 151     ))
 152 (define (music-separator? m)
 153   "Is M a separator."
 154   (let* ((n (ly-get-mus-property m 'name )))
 155     (and (symbol? n) (equal? 'separator n))
 156   ))
 157
 158 (define (split-one sep?  l acc)
 159   "Split off the first parts before separator and return both parts.
 160
 161 "
 162   (if (null? l)
 163       (cons acc '())
 164       (if (sep? (car l))
 165           (cons acc (cdr l))
 166           (split-one sep? (cdr l) (cons (car l) acc))
 167           )
 168       ))
 169
 170 (define (split-list l sep?)
 171   (if (null? l)
 172       '()
 173       (let* ((c (split-one sep? l '())))
 174         (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
 175         )
 176       )
 177   )
 178
 179 ;; test code
 180 ; (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
 181
 182
 183 ;;; splitting chords into voices.
 184
 185 (define (voicify-list lst number)
 186    "Make a list of Musics.
 187
 188    voicify-list :: [ [Music ] ] -> number -> [Music]
 189    LST is a list music-lists.
 190 "
 191
 192    (if (null? lst) '()
 193        (cons (context-spec-music
 194               (make-sequential-music
 195                (list
 196                 (make-voice-props-set number)
 197                 (make-simultaneous-music (car lst))))
 198
 199               "Voice"  (number->string number))
 200               (voicify-list (cdr lst) (+ number 1))
 201        ))
 202    )
 203
 204 (define (voicify-chord ch)
 205   "Split the parts of a chord into different Voices using separator"
 206    (let* ((es (ly-get-mus-property ch 'elements)))
 207
 208
 209      (ly-set-mus-property  ch 'elements
 210        (voicify-list (split-list es music-separator?) 0))
 211      ch
 212    ))
 213
 214 (define (voicify-music m)
 215    "Recursively split chords that are separated with \\ "
 216
 217    (if (not (music? m))
 218        (begin (display m)
 219        (error "not music!"))
 220        )
 221    (let*
 222        ((es (ly-get-mus-property m 'elements))
 223         (e (ly-get-mus-property m 'element))
 224         )
 225      (if (pair? es)
 226          (ly-set-mus-property m 'elements (map voicify-music es)))
 227      (if (music? e)
 228          (ly-set-mus-property m 'element  (voicify-music e)))
 229      (if
 230       (and (equal? (ly-music-name m) "Simultaneous_music")
 231            (reduce (lambda (x y ) (or x y))     (map music-separator? es)))
 232       (voicify-chord m)
 233       )
 234
 235      m
 236      ))
 237
 238 ;;;
 239
 240 ;;;;;;;;;;;;;;;;
 241 ;;;;;;;;;;;;;;;;
 242
 243 (define (has-request-chord elts)
 244   (reduce (lambda (x y) (or x y)) (map (lambda (x) (equal? (ly-music-name x)
 245                                                            "Request_chord")) elts)
 246   ))
 247
 248 (define (ly-music-message music msg)
 249   (let* (
 250       (ip (ly-get-mus-property music 'origin))
 251       )
 252
 253     (if (ly-input-location? ip)
 254         (ly-input-message ip msg)
 255         (ly-warn msg))
 256   ))
 257
 258 (define (check-start-chords music)
 259   "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), without context specification. Called  from parser."
 260
 261      (let*
 262        ((es (ly-get-mus-property music 'elements))
 263         (e (ly-get-mus-property music 'element))
 264         (name (ly-music-name music))
 265         )
 266
 267        (cond
 268          ((equal? name "Context_specced_music") #t)
 269          ((equal? name "Simultaneous_music")
 270
 271           (if (has-request-chord es)
 272               (ly-music-message music "Starting score with a chord.\nPlease insert an explicit \\context before chord")
 273               (map check-start-chords es)))
 274
 275          ((equal? name "Sequential_music")
 276            (if (pair? es)
 277                (check-start-chords (car es))))
 278           (else (if (music? e) (check-start-chords e )))
 279
 280        ))
 281      music
 282      )
 283
 284
 285 (define toplevel-music-functions (list check-start-chords voicify-music))