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 'iterator-ctor Unfolded_repeat_iterator::constructor)))
  25
  26     (if (pair? es)
  27         (ly-set-mus-property
  28          music 'elements
  29          (map unfold-repeats es)))
  30
  31     (if (music? e)
  32         (ly-set-mus-property
  33          music 'element
  34          (unfold-repeats e)))
  35
  36
  37     music))
  38
  39 (define  (pitchify-scripts music)
  40   "Copy the pitch fields of the Note_requests into  Text_script_requests, to aid
  41 Fingering_engraver."
  42   (define (find-note musics)
  43     (filter-list (lambda (m) (equal? (ly-music-name m) "Note_req")) musics)
  44     )
  45   (define (find-scripts musics)
  46     (filter-list (lambda (m) (equal? (ly-music-name m) "Text_script_req")) musics))
  47
  48   (let* (
  49          (e (ly-get-mus-property music 'element))
  50          (es (ly-get-mus-property music 'elements))
  51          (notes (find-note es))
  52          (pitch (if (pair? notes) (ly-get-mus-property (car  notes) 'pitch) #f))
  53          )
  54
  55     (if pitch
  56         (map (lambda (x) (ly-set-mus-property x 'pitch pitch)) (find-scripts es))
  57         )
  58
  59     (if (pair? es)
  60         (ly-set-mus-property
  61          music 'elements
  62          (map pitchify-scripts es)))
  63
  64     (if (music? e)
  65         (ly-set-mus-property
  66          music 'element
  67          (pitchify-scripts e)))
  68
  69     music))
  70
  71
  72 ;;;;;;;;;;;;;;;;;
  73 ;;;;;;;;;;;;;;;;
  74 ;;;;;;;;;;;;;;;;
  75
  76
  77 (define (make-grob-property-set grobs gprop val)
  78   "Make a M-exp that sets GPROP to VAL in GROBS. Does a pop first, i.e.
  79 this is not an override
  80 "
  81
  82    (let* ((m (ly-make-music  "Music")))
  83      (ly-set-mus-property m 'iterator-ctor Push_property_iterator::constructor)
  84      (ly-set-mus-property m 'symbols grobs)
  85      (ly-set-mus-property m 'grob-property gprop)
  86      (ly-set-mus-property m 'grob-value val)
  87      (ly-set-mus-property m 'pop-first #t)
  88
  89      m
  90
  91    ))
  92
  93 (define (make-grob-property-revert grobs gprop)
  94    (let* ((m (ly-make-music  "Music")))
  95      (ly-set-mus-property m 'iterator-ctor Pop_property_iterator::constructor)
  96      (ly-set-mus-property m 'symbols grobs)
  97      (ly-set-mus-property m 'grob-property gprop)
  98
  99      m
 100
 101    ))
 102
 103 (define (make-voice-props-set n)
 104   (make-sequential-music
 105    (list
 106       (make-grob-property-set '(Tie Slur Stem Dots) 'direction
 107                          (if (odd? n) -1 1))
 108       (make-grob-property-set '(NoteColumn) 'horizontal-shift (quotient n 2))
 109    )
 110   ))
 111
 112 (define (make-voice-props-revert)
 113   (make-sequential-music
 114    (list
 115       (make-grob-property-revert '(Tie Slur Stem Dots) 'direction)
 116       (make-grob-property-revert '(NoteColumn) 'horizontal-shift)
 117    ))
 118   )
 119
 120 (define (context-spec-music m context . rest)
 121   "Add \context CONTEXT = foo to M. "
 122
 123   (let* ((cm (ly-make-music "Context_specced_music")))
 124     (ly-set-mus-property cm 'element m)
 125     (ly-set-mus-property cm 'context-type context)
 126     (if (and  (pair? rest) (string? (car rest)))
 127         (ly-set-mus-property cm 'context-id (car rest))
 128     )
 129     cm
 130   ))
 131
 132 (define (make-sequential-music elts)
 133   (let*  ((m (ly-make-music "Sequential_music")))
 134     (ly-set-mus-property m 'elements elts)
 135     m
 136   ))
 137 (define (make-simultaneous-music elts)
 138   (let*  ((m (ly-make-music "Simultaneous_music")))
 139     (ly-set-mus-property m 'elements elts)
 140     m
 141     ))
 142 (define (music-separator? m)
 143   "Is M a separator."
 144   (let* ((n (ly-get-mus-property m 'name )))
 145     (and (symbol? n) (equal? 'separator n))
 146   ))
 147
 148 (define (split-one sep?  l acc)
 149   "Split off the first parts before separator and return both parts.
 150
 151 "
 152   (if (null? l)
 153       (cons acc '())
 154       (if (sep? (car l))
 155           (cons acc (cdr l))
 156           (split-one sep? (cdr l) (cons (car l) acc))
 157           )
 158       ))
 159
 160 (define (split-list l sep?)
 161   (if (null? l)
 162       '()
 163       (let* ((c (split-one sep? l '())))
 164         (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
 165         )
 166       )
 167   )
 168
 169 ;; test code
 170 ; (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
 171
 172
 173 ;;; splitting chords into voices.
 174
 175 (define (voicify-list lst number)
 176    "Make a list of Musics.
 177
 178    voicify-list :: [ [Music ] ] -> number -> [Music]
 179    LST is a list music-lists.
 180 "
 181
 182    (if (null? lst) '()
 183        (cons (context-spec-music
 184               (make-sequential-music
 185                (list
 186                 (make-voice-props-set number)
 187                 (make-simultaneous-music (car lst))))
 188
 189               "Voice"  (number->string number))
 190               (voicify-list (cdr lst) (+ number 1))
 191        ))
 192    )
 193
 194 (define (voicify-chord ch)
 195   "Split the parts of a chord into different Voices using separator"
 196    (let* ((es (ly-get-mus-property ch 'elements)))
 197
 198
 199      (ly-set-mus-property  ch 'elements
 200        (voicify-list (split-list es music-separator?) 0))
 201      ch
 202    ))
 203
 204 (define (voicify-music m)
 205    "Recursively split chords that are separated with \\ "
 206
 207    (if (not (music? m))
 208        (begin (display m)
 209        (error "not music!"))
 210        )
 211    (let*
 212        ((es (ly-get-mus-property m 'elements))
 213         (e (ly-get-mus-property m 'element))
 214         )
 215
 216      (if
 217       (and (equal? (ly-music-name m) "Simultaneous_music")
 218            (reduce (lambda (x y ) (or x y))     (map music-separator? es)))
 219       (voicify-chord m)
 220       (begin
 221         (if (pair? es)
 222             (ly-set-mus-property m 'elements (map voicify-music es)))
 223         (if (music? e)
 224             (ly-set-mus-property m 'element  (voicify-music e)))
 225
 226         m)
 227
 228       )
 229      ))
 230
 231 ;;;