@var{music}."
(let ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element)))
- (set! (ly:music-property music 'elements)
- (map (lambda (y) (music-map function y)) es))
+ (if (pair? es)
+ (set! (ly:music-property music 'elements)
+ (map (lambda (y) (music-map function y)) es)))
(if (ly:music? e)
(set! (ly:music-property music 'element)
(music-map function e)))
(define (first-note-duration music)
"Finds the duration of the first NoteEvent by searching depth-first
through MUSIC."
- (if (memq 'note-event (ly:music-property music 'types))
+ ;; NoteEvent or a non-expanded chord-repetition
+ ;; We just take anything that actually sports an announced duration.
+ (if (ly:duration? (ly:music-property music 'duration))
(ly:music-property music 'duration)
(let loop ((elts (if (ly:music? (ly:music-property music 'element))
(list (ly:music-property music 'element))
(set! (ly:music-property r 'repeat-count) (max times 1))
(set! (ly:music-property r 'elements) talts)
(if (and (equal? name "tremolo")
- (or (pair? (ly:music-property main 'elements))
- (ly:music? (ly:music-property main 'element))))
+ (pair? (extract-named-music main '(EventChord NoteEvent))))
;; This works for single-note and multi-note tremolos!
(let* ((children (if (music-is-of-type? main 'sequential-music)
;; \repeat tremolo n { ... }
- (length (extract-named-music main 'EventChord))
+ (length (extract-named-music main '(EventChord
+ NoteEvent)))
;; \repeat tremolo n c4
1))
;; # of dots is equal to the 1 in bitwise representation (minus 1)!
calculate the number of slashes based on the durations. Returns @code{0}
if durations in @var{music} vary, allowing slash beats and double-percent
beats to be distinguished."
- (let* ((durs (map (lambda (elt)
- (duration-of-note elt))
- (extract-named-music music 'EventChord)))
+ (let* ((durs (map duration-of-note
+ (extract-named-music music '(EventChord NoteEvent
+ RestEvent SkipEvent))))
(first-dur (car durs)))
(if (every (lambda (d) (equal? d first-dur)) durs)
(make-sequential-music
(append
(map (lambda (x) (make-grob-property-set x 'direction
- (if (odd? n) -1 1)))
+ (if (odd? n) -1 1)))
direction-polyphonic-grobs)
(list
(make-property-set 'graceSettings
(make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
(make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+(define-safe-public (make-voice-props-override n)
+ (make-sequential-music
+ (append
+ (map (lambda (x) (make-grob-property-override x 'direction
+ (if (odd? n) -1 1)))
+ direction-polyphonic-grobs)
+ (list
+ (make-property-set 'graceSettings
+ ;; TODO: take this from voicedGraceSettings or similar.
+ '((Voice Stem font-size -3)
+ (Voice Flag font-size -3)
+ (Voice NoteHead font-size -3)
+ (Voice TabNoteHead font-size -4)
+ (Voice Dots font-size -3)
+ (Voice Stem length-fraction 0.8)
+ (Voice Stem no-stem-extend #t)
+ (Voice Beam beam-thickness 0.384)
+ (Voice Beam length-fraction 0.8)
+ (Voice Accidental font-size -4)
+ (Voice AccidentalCautionary font-size -4)
+ (Voice Script font-size -3)
+ (Voice Fingering font-size -8)
+ (Voice StringNumber font-size -8)))
+
+ (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))
+ (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+
(define-safe-public (make-voice-props-revert)
(make-sequential-music
(append
(let ((ts (ly:music-property m 'types)))
(memq 'separator ts)))
+;;; expanding repeat chords
+(define-public (copy-repeat-chord original-chord repeat-chord duration
+ event-types)
+ "Copies all events in @var{event-types} (be sure to include
+@code{rhythmic-events}) from @var{original-chord} over to
+@var{repeat-chord} with their articulations filtered as well. Any
+duration is replaced with the specified @var{duration}."
+ ;; First remove everything from event-types that can already be
+ ;; found in the repeated chord. We don't need to look for
+ ;; articulations on individual events since they can't actually get
+ ;; into a repeat chord given its input syntax.
+ (for-each (lambda (e)
+ (for-each (lambda (x)
+ (set! event-types (delq x event-types)))
+ (ly:music-property e 'types)))
+ (ly:music-property repeat-chord 'elements))
+ ;; now treat the elements
+ (set! (ly:music-property repeat-chord 'elements)
+ (append!
+ (filter-map
+ (lambda (m)
+ (and (any (lambda (t) (music-is-of-type? m t)) event-types)
+ (begin
+ (set! m (ly:music-deep-copy m))
+ (if (pair? (ly:music-property m 'articulations))
+ (set! (ly:music-property m 'articulations)
+ (filter
+ (lambda (a)
+ (any (lambda (t) (music-is-of-type? a t))
+ event-types))
+ (ly:music-property m 'articulations))))
+ (if (ly:duration? (ly:music-property m 'duration))
+ (set! (ly:music-property m 'duration) duration))
+ m)))
+ (ly:music-property original-chord 'elements))
+ (ly:music-property repeat-chord 'elements))))
+
+(define-public (expand-repeat-chords! event-types music)
+ "Walks through @var{music} and fills repeated chords (notable by
+having a duration in @code{duration}) with the notes from their
+respective predecessor chord."
+ (let loop ((music music) (last-chord #f))
+ (if (music-is-of-type? music 'event-chord)
+ (let ((chord-repeat (ly:music-property music 'duration)))
+ (cond
+ ((not (ly:duration? chord-repeat))
+ (if (any (lambda (m) (ly:duration?
+ (ly:music-property m 'duration)))
+ (ly:music-property music 'elements))
+ music
+ last-chord))
+ (last-chord
+ (set! (ly:music-property music 'duration) '())
+ (copy-repeat-chord last-chord music chord-repeat event-types)
+ music)
+ (else
+ (ly:music-warning music (_ "Bad chord repetition"))
+ #f)))
+ (let ((elt (ly:music-property music 'element)))
+ (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord)
+ (ly:music-property music 'elements)))))
+ music)
+
;;; splitting chords into voices.
(define (voicify-list lst number)
"Make a list of Musics.
(if (null? clef)
(make-music 'Music)
(make-cue-clef-set clef))
- (context-spec-music (make-voice-props-set cue-voice) 'CueVoice "cue")
+ (context-spec-music (make-voice-props-override cue-voice) 'CueVoice "cue")
quote-music
(context-spec-music (make-voice-props-revert) 'CueVoice "cue")
(if (null? clef)
(set! main-music
(make-sequential-music
(list
- (make-voice-props-set main-voice)
+ (make-voice-props-override main-voice)
main-music
(make-voice-props-revert))))
(set! (ly:music-property quote-music 'element) main-music)))
(define-public toplevel-music-functions
(list
+ (lambda (music parser) (expand-repeat-chords!
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music))
(lambda (music parser) (voicify-music music))
(lambda (x parser) (music-map music-check-error x))
(lambda (x parser) (music-map precompute-music-length x))
`(Staff ,(make-accidental-rule 'same-octave 0))
'()
context))
- ;; accidentals from one voice do NOT get cancelled in other voices
+ ;; accidentals from one voice do NOT get canceled in other voices
((equal? style 'voice)
(set-accidentals-properties #t
`(Voice ,(make-accidental-rule 'same-octave 0))
'()
context))
;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century.
- ;; This includes all the default accidentals, but accidentals also needs cancelling
+ ;; This includes all the default accidentals, but accidentals also needs canceling
;; in other octaves and in the next measure.
((equal? style 'modern)
(set-accidentals-properties #f
context))
;; Multivoice accidentals to be read both by musicians playing one voice
;; and musicians playing all voices.
- ;; Accidentals are typeset for each voice, but they ARE cancelled across voices.
+ ;; Accidentals are typeset for each voice, but they ARE canceled across voices.
((equal? style 'modern-voice)
(set-accidentals-properties #f
`(Voice ,(make-accidental-rule 'same-octave 0)
,(make-accidental-rule 'same-octave 1))
context))
;; stone's suggestions for accidentals on grand staff.
- ;; Accidentals are cancelled across the staves in the same grand staff as well
+ ;; Accidentals are canceled across the staves in the same grand staff as well
((equal? style 'piano)
(set-accidentals-properties #f
`(Staff ,(make-accidental-rule 'same-octave 0)
(ly:music-property (car evs) 'pitch))))
(define-public (duration-of-note event-chord)
- (let ((evs (filter (lambda (x)
- (music-has-type x 'rhythmic-event))
- (ly:music-property event-chord 'elements))))
-
- (and (pair? evs)
- (ly:music-property (car evs) 'duration))))
+ (cond
+ ((pair? event-chord)
+ (or (duration-of-note (car event-chord))
+ (duration-of-note (cdr event-chord))))
+ ((ly:music? event-chord)
+ (let ((dur (ly:music-property event-chord 'duration)))
+ (if (ly:duration? dur)
+ dur
+ (duration-of-note (ly:music-property event-chord 'elements)))))
+ (else #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-public (map-some-music map? music)
+ "Walk through @var{music}, transform all elements calling @var{map?}
+and only recurse if this returns @code{#f}."
+ (let loop ((music music))
+ (or (map? music)
+ (let ((elt (ly:music-property music 'element))
+ (elts (ly:music-property music 'elements))
+ (arts (ly:music-property music 'articulations)))
+ (if (ly:music? elt)
+ (set! (ly:music-property music 'element)
+ (loop elt)))
+ (if (pair? elts)
+ (set! (ly:music-property music 'elements)
+ (map loop elts)))
+ (if (pair? arts)
+ (set! (ly:music-property music 'articulations)
+ (map loop arts)))
+ music))))
+
+(define-public (for-some-music stop? music)
+ "Walk through @var{music}, process all elements calling @var{stop?}
+and only recurse if this returns @code{#f}."
+ (let loop ((music music))
+ (if (not (stop? music))
+ (let ((elt (ly:music-property music 'element)))
+ (if (ly:music? elt)
+ (loop elt))
+ (for-each loop (ly:music-property music 'elements))
+ (for-each loop (ly:music-property music 'articulations))))))
+
+(define-public (fold-some-music pred? proc init music)
+ "This works recursively on music like @code{fold} does on a list,
+calling @samp{(@var{pred?} music)} on every music element. If
+@code{#f} is returned for an element, it is processed recursively
+with the same initial value of @samp{previous}, otherwise
+@samp{(@var{proc} music previous)} replaces @samp{previous}
+and no recursion happens.
+The top @var{music} is processed using @var{init} for @samp{previous}."
+ (let loop ((music music) (previous init))
+ (if (pred? music)
+ (proc music previous)
+ (fold loop
+ (fold loop
+ (let ((elt (ly:music-property music 'element)))
+ (if (null? elt)
+ previous
+ (loop elt previous)))
+ (ly:music-property music 'elements))
+ (ly:music-property music 'articulations)))))
+
+(define-public (extract-music music pred?)
+ "Return a flat list of all music matching @var{pred?} inside of
+@var{music}, not recursing into matches themselves."
+ (reverse! (fold-some-music pred? cons '() music)))
+
(define-public (extract-named-music music music-name)
- "Return a flat list of all music named @var{music-name} from @var{music}."
- (let ((extracted-list
- (if (ly:music? music)
- (if (eq? (ly:music-property music 'name) music-name)
- (list music)
- (let ((elt (ly:music-property music 'element))
- (elts (ly:music-property music 'elements)))
- (if (ly:music? elt)
- (extract-named-music elt music-name)
- (if (null? elts)
- '()
- (map (lambda(x)
- (extract-named-music x music-name ))
- elts)))))
- '())))
- (flatten-list extracted-list)))
+ "Return a flat list of all music named @var{music-name} (either a
+single event symbol or a list of alternatives) inside of @var{music},
+not recursing into matches themselves."
+ (extract-music
+ music
+ (if (cheap-list? music-name)
+ (lambda (m) (memq (ly:music-property m 'name) music-name))
+ (lambda (m) (eq? (ly:music-property m 'name) music-name)))))
+
+(define-public (extract-typed-music music type)
+ "Return a flat list of all music with @var{type} (either a single
+type symbol or a list of alternatives) inside of @var{music}, not
+recursing into matches themselves."
+ (extract-music
+ music
+ (if (cheap-list? type)
+ (lambda (m)
+ (any (lambda (t) (music-is-of-type? m t)) type))
+ (lambda (m) (music-is-of-type? m type)))))
+
+(define*-public (event-chord-wrap! music #:optional parser)
+ "Wrap isolated rhythmic events and non-postevent events in
+@var{music} inside of an @code{EventChord}. If the optional
+@var{parser} argument is given, chord repeats @samp{q} are expanded
+using the default settings. Otherwise, you need to cater for them
+yourself."
+ (map-some-music
+ (lambda (m)
+ (cond ((music-is-of-type? m 'event-chord)
+ (if (pair? (ly:music-property m 'articulations))
+ (begin
+ (set! (ly:music-property m 'elements)
+ (append (ly:music-property m 'elements)
+ (ly:music-property m 'articulations)))
+ (set! (ly:music-property m 'articulations) '())))
+ m)
+ ((music-is-of-type? m 'rhythmic-event)
+ (let ((arts (ly:music-property m 'articulations)))
+ (if (pair? arts)
+ (set! (ly:music-property m 'articulations) '()))
+ (make-event-chord (cons m arts))))
+ (else #f)))
+ (if parser
+ (expand-repeat-chords!
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music)
+ music)))
(define-public (event-chord-notes event-chord)
"Return a list of all notes from @var{event-chord}."
projects / lilypond.git / blobdiff