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 grob 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 'symbol grob)
  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 grob gprop)
  94   "Revert the grob property GPROP for GROB."
  95    (let* ((m (ly-make-music  "Music")))
  96      (ly-set-mus-property m 'iterator-ctor Pop_property_iterator::constructor)
  97      (ly-set-mus-property m 'symbol grob)
  98      (ly-set-mus-property m 'grob-property gprop)
  99
 100      m
 101
 102    ))
 103
 104 (define (make-voice-props-set n)
 105   (make-sequential-music
 106    (append
 107       (map (lambda (x) (make-grob-property-set x 'direction
 108                                                (if (odd? n) -1 1)))
 109            '(Tie Slur Stem Dots))
 110       (list (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)))
 111    )
 112   ))
 113
 114 (define (make-voice-props-revert)
 115   (make-sequential-music
 116    (list
 117       (make-grob-property-revert 'Tie 'direction)
 118       (make-grob-property-revert 'Dots 'direction)
 119       (make-grob-property-revert 'Stem 'direction)
 120       (make-grob-property-revert 'Slur 'direction)
 121       (make-grob-property-revert 'NoteColumn 'horizontal-shift)
 122    ))
 123   )
 124
 125 (define (context-spec-music m context . rest)
 126   "Add \context CONTEXT = foo to M. "
 127
 128   (let* ((cm (ly-make-music "Context_specced_music")))
 129     (ly-set-mus-property cm 'element m)
 130     (ly-set-mus-property cm 'context-type context)
 131     (if (and  (pair? rest) (string? (car rest)))
 132         (ly-set-mus-property cm 'context-id (car rest))
 133     )
 134     cm
 135   ))
 136
 137 (define (make-sequential-music elts)
 138   (let*  ((m (ly-make-music "Sequential_music")))
 139     (ly-set-mus-property m 'elements elts)
 140     m
 141   ))
 142 (define (make-simultaneous-music elts)
 143   (let*  ((m (ly-make-music "Simultaneous_music")))
 144     (ly-set-mus-property m 'elements elts)
 145     m
 146     ))
 147 (define (music-separator? m)
 148   "Is M a separator."
 149   (let* ((n (ly-get-mus-property m 'name )))
 150     (and (symbol? n) (equal? 'separator n))
 151   ))
 152
 153 (define (split-one sep?  l acc)
 154   "Split off the first parts before separator and return both parts.
 155
 156 "
 157   (if (null? l)
 158       (cons acc '())
 159       (if (sep? (car l))
 160           (cons acc (cdr l))
 161           (split-one sep? (cdr l) (cons (car l) acc))
 162           )
 163       ))
 164
 165 (define (split-list l sep?)
 166   (if (null? l)
 167       '()
 168       (let* ((c (split-one sep? l '())))
 169         (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
 170         )
 171       )
 172   )
 173
 174 ;; test code
 175 ; (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
 176
 177
 178 ;;; splitting chords into voices.
 179
 180 (define (voicify-list lst number)
 181    "Make a list of Musics.
 182
 183    voicify-list :: [ [Music ] ] -> number -> [Music]
 184    LST is a list music-lists.
 185 "
 186
 187    (if (null? lst) '()
 188        (cons (context-spec-music
 189               (make-sequential-music
 190                (list
 191                 (make-voice-props-set number)
 192                 (make-simultaneous-music (car lst))))
 193
 194               "Voice"  (number->string number))
 195               (voicify-list (cdr lst) (+ number 1))
 196        ))
 197    )
 198
 199 (define (voicify-chord ch)
 200   "Split the parts of a chord into different Voices using separator"
 201    (let* ((es (ly-get-mus-property ch 'elements)))
 202
 203
 204      (ly-set-mus-property  ch 'elements
 205        (voicify-list (split-list es music-separator?) 0))
 206      ch
 207    ))
 208
 209 (define (voicify-music m)
 210    "Recursively split chords that are separated with \\ "
 211
 212    (if (not (music? m))
 213        (begin (display m)
 214        (error "not music!"))
 215        )
 216    (let*
 217        ((es (ly-get-mus-property m 'elements))
 218         (e (ly-get-mus-property m 'element))
 219         )
 220
 221      (if
 222       (and (equal? (ly-music-name m) "Simultaneous_music")
 223            (reduce (lambda (x y ) (or x y))     (map music-separator? es)))
 224       (voicify-chord m)
 225       (begin
 226         (if (pair? es)
 227             (ly-set-mus-property m 'elements (map voicify-music es)))
 228         (if (music? e)
 229             (ly-set-mus-property m 'element  (voicify-music e)))
 230
 231         m)
 232
 233       )
 234      ))
 235
 236 ;;;