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