X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=559eae3c3ff300e04e2a0eed635ea678e32d37ff;hb=9b95b5452f689f330178ff142fc3847193ef19a5;hp=c6ac33a54734f2a4c93e39f7e27f65bc481cb821;hpb=9ff4029627f34267fc9f040c703d568b1dfd10b1;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index c6ac33a547..559eae3c3f 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -62,8 +62,9 @@ First it recurses over the children, then the function is applied to @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))) @@ -311,9 +312,9 @@ through MUSIC." 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 NoteEvent)))) + (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) @@ -426,7 +427,7 @@ in @var{grob}." (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 @@ -449,6 +450,33 @@ in @var{grob}." (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 @@ -625,7 +653,11 @@ respective predecessor chord." (let ((chord-repeat (ly:music-property music 'duration))) (cond ((not (ly:duration? chord-repeat)) - music) + (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) @@ -953,7 +985,7 @@ set to the @code{location} parameter." (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) @@ -962,7 +994,7 @@ set to the @code{location} parameter." (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))) @@ -1373,14 +1405,14 @@ as a context." `(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 @@ -1445,7 +1477,7 @@ as a context." 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) @@ -1468,7 +1500,7 @@ as a context." ,(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) @@ -1580,45 +1612,123 @@ Entries that conform with the current key signature are not invalidated." (ly:music-property (car evs) 'pitch)))) (define-public (duration-of-note event-chord) - (let ((evs (filter (lambda (x) - (music-has-type x 'rhythmic-event)) - (cons event-chord - (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}." - (if (not (list? music-name)) - (set! music-name (list music-name))) - (if (ly:music? music) - (if (memq (ly:music-property music 'name) music-name) - (list music) - (let ((arts (ly:music-property music 'articulations))) - (append-map! - (lambda (x) (extract-named-music x music-name)) - (if (pair? arts) - arts - (cons (ly:music-property music 'element) - (ly:music-property music 'elements)))))) - '())) + "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} from @var{music}." - (if (ly:music? music) - (if (music-is-of-type? music type) - (list music) - (let ((arts (ly:music-property music 'articulations))) - (append-map! - (lambda (x) (extract-typed-music x type)) - (if (pair? arts) - arts - (cons (ly:music-property music 'element) - (ly:music-property music 'elements)))))) - '())) + "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}."