X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=3eedbcc577bd74e96fea03a9941d1ef932ed7b9b;hb=33dd448c34f9f667c3d1c4722f5bc7c229251b6b;hp=afcdb843e72545e3f20a1922a737a58a08044577;hpb=ef5c8e061ba49682c06cdfbd3816c971d6accba4;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index afcdb843e7..3eedbcc577 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -728,7 +728,8 @@ duration is replaced with the specified @var{duration}." (set! (ly:music-property repeat-chord 'articulations) (append! (set-origin! (ly:music-deep-copy arts)) - (ly:music-property repeat-chord 'articulations)))))) + (ly:music-property repeat-chord 'articulations))))) + repeat-chord) (define-public (expand-repeat-chords! event-types music) @@ -747,8 +748,7 @@ respective predecessor chord." last-chord)) (last-chord (set! (ly:music-property music 'duration) '()) - (copy-repeat-chord last-chord music chord-repeat event-types) - music) + (copy-repeat-chord last-chord music chord-repeat event-types)) (else (ly:music-warning music (_ "Bad chord repetition")) #f))) @@ -757,6 +757,73 @@ respective predecessor chord." (ly:music-property music 'elements))))) music) +;;; This does _not_ copy any articulations. Rationale: one main +;;; incentive for pitch-repeating durations is after ties, such that +;;; 4~2~8. can stand in for a 15/16 note in \partial 4 position. In +;;; this use case, any repeated articulations will be a nuisance. +;;; +;;; String assignments in TabStaff might seem like a worthwhile +;;; exception, but they would be better tackled by the respective +;;; engravers themselves (see issue 3662). +;;; +;;; Repeating chords as well seems problematic for things like +;;; \score { +;;; << +;;; \new Staff { c4 c c } +;;; \new RhythmicStaff { 4 4 4 4 } +;;; >> +;;; } +;;; +;;; However, because of MIDI it is not advisable to use RhythmicStaff +;;; without any initial pitch/drum-type. For music functions taking +;;; pure rhythms as an argument, the running of expand-repeat-notes! +;;; at scorification time is irrelevant: at that point of time, the +;;; music function has already run. + +(define-public (expand-repeat-notes! music) + "Walks through @var{music} and gives pitchless notes (not having a +pitch in code{pitch} or a drum type in @code{drum-type}) the pitch(es) +from the predecessor note/chord if available." + (let ((last-pitch #f)) + (map-some-music + (lambda (m) + (define (set-and-ret last) + (set! last-pitch last) + m) + (cond + ((music-is-of-type? m 'event-chord) + (set-and-ret m)) + ((music-is-of-type? m 'note-event) + (cond + ((or (ly:music-property m 'pitch #f) + (ly:music-property m 'drum-type #f)) + => set-and-ret) + ;; ok, naked rhythm. Go through the various cases of + ;; last-pitch + ;; nothing available: just keep as-is + ((not last-pitch) m) + ((ly:pitch? last-pitch) + (set! (ly:music-property m 'pitch) last-pitch) + m) + ((symbol? last-pitch) + (set! (ly:music-property m 'drum-type) last-pitch) + m) + ;; Ok, this is the big bad one: the reference is a chord. + ;; For now, we use the repeat chord logic. That's not + ;; really efficient as cleaning out all articulations is + ;; quite simpler than what copy-repeat-chord does. + (else + (copy-repeat-chord last-pitch + (make-music 'EventChord + 'elements + (ly:music-property m 'articulations) + 'origin + (ly:music-property m 'origin)) + (ly:music-property m 'duration) + '(rhythmic-event))))) + (else #f))) + music))) + ;;; splitting chords into voices. (define (voicify-list lst number) "Make a list of Musics. @@ -1261,6 +1328,7 @@ then revert skipTypesetting." (cons 'rhythmic-event (ly:parser-lookup parser '$chord-repeat-events)) music)) + (lambda (music parser) (expand-repeat-notes! 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)) @@ -2081,3 +2149,96 @@ Broken measures are numbered in parentheses." (cdr break-alignment-L-ext)))) X))) num)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following are used by the \offset function + +(define (find-value-to-offset prop self alist) + "Return the first value of the property @var{prop} in the property +alist @var{alist} -- after having found @var{self}. If @var{self} is +not found, return the first value of @var{prop}." + (let ((segment (member (cons prop self) alist))) + (if (not segment) + (assoc-get prop alist) + (assoc-get prop (cdr segment))))) + +(define (offset-multiple-types arg offsets) + "Displace @var{arg} by @var{offsets} if @var{arg} is a number, a +number pair, or a list of number pairs. If @var{offsets} is an empty +list or if there is a type-mismatch, @var{arg} will be returned." + (cond + ((and (number? arg) (number? offsets)) + (+ arg offsets)) + ((and (number-pair? arg) + (or (number? offsets) + (number-pair? offsets))) + (coord-translate arg offsets)) + ((and (number-pair-list? arg) (number-pair-list? offsets)) + (map + (lambda (x y) (coord-translate x y)) + arg offsets)) + (else arg))) + +(define-public (offsetter property offsets) + "Apply @var{offsets} to the default values of @var{property} of @var{grob}. +Offsets are restricted to immutable properties and values of type @code{number}, +@code{number-pair}, or @code{number-pair-list}." + (define (self grob) + (let* ((immutable (ly:grob-basic-properties grob)) + ; We need to search the basic-properties alist for our property to + ; obtain values to offset. Our search is complicated by the fact that + ; calling the music function `offset' as an override conses a pair to + ; the head of the alist. This pair must be discounted. The closure it + ; contains is named `self' so it can be easily recognized. If `offset' + ; is called as a tweak, the basic-property alist is unaffected. + (target (find-value-to-offset property self immutable)) + ; if target is a procedure, we need to apply it to our grob to calculate + ; values to offset. + (vals + (if (procedure? target) + (target grob) + target)) + (can-type-be-offset? + (or (number? vals) + (number-pair? vals) + (number-pair-list? vals)))) + + (if can-type-be-offset? + ; '(+inf.0 . -inf.0) would offset to itself. This will be confusing to a + ; user unaware of the default value of the property, so issue a warning. + (if (equal? empty-interval vals) + (ly:warning "default '~a of ~a is ~a and can't be offset" + property grob vals) + (let* ((orig (ly:grob-original grob)) + (siblings + (if (ly:spanner? grob) + (ly:spanner-broken-into orig) + '())) + (total-found (length siblings)) + ; Since there is some flexibility in input syntax, + ; structure of `offsets' is normalized. + (offsets + (if (or (not (pair? offsets)) + (number-pair? offsets) + (and (number-pair-list? offsets) + (number-pair-list? vals))) + (list offsets) + offsets))) + + (define (helper sibs offs) + ; apply offsets to the siblings of broken spanners + (if (pair? offs) + (if (eq? (car sibs) grob) + (offset-multiple-types vals (car offs)) + (helper (cdr sibs) (cdr offs))) + vals)) + + (if (>= total-found 2) + (helper siblings offsets) + (offset-multiple-types vals (car offsets))))) + + (begin + (ly:warning "the property '~a of ~a cannot be offset" property grob) + vals)))) + ; return the closure named `self' + self)