Hi James,
On Mon, Jun 16, 2014 at 2:06 AM, James Harkins <[email protected]> wrote:
> TL;DR version of the question: How could I define an accidental style that
> behaves mostly like neo-modern, but also avoids repeating accidentals
> within a beamed group?
>
> [...]
>
> A nice middle ground between "remember accidentals for the whole cadenza"
> and "remember accidentals only from the immediately preceding note" would
> be to remember accidentals within a beamed group. Is there any way to hack
> this up in scheme, say?
>
> Thanks,
> hjh
>
>
I don't know if this will give you what you want with the Frescobaldi
cadenza, but maybe it's helpful...
The attached should do accidentals purely by beamed group. For it to work
properly, you need to set accidental-style to dodecaphonic.
Issues:
--You can't force an accidental with "!". Perhaps a property
'force-accidental might be created?
--You'll get repeated accidentals with immediate repetition and no beams
(i.e., a succession of quarter notes). Strict application of
accidentals-by-beamed-group...
Hope you find a use for this!
--David
\version "2.19.5"
\language "english"
#(define (get-pitch grob)
(ly:event-property (ly:grob-property grob 'cause) 'pitch))
#(define (has-accidental? grob)
(ly:grob? (ly:grob-object grob 'accidental-grob)))
#(define (first-in-beamed-group? me heads)
(let loop ((x heads))
(cond
((eq? (car x) me) #t)
((equal? (get-pitch (car x)) (get-pitch me)) #f)
(else (loop (cdr x))))))
#(define (preceded-by-chromatic-variant? me heads)
;; Within a beamed group, compare a pitch with the preceding pitches. Find the closest
;; pitch sharing octave and note-name with our pitch. If it has a different alteration
;; from our pitch, return #t. Our pitch will then need an accidental.
(let* ((me-pitch (get-pitch me))
(preceding
(take-while
(lambda (x) (not (eq? x me)))
heads))
(preceding
(map
(lambda (x) (get-pitch x))
preceding))
(preceding
(filter
(lambda (x)
(and (equal? (ly:pitch-octave x) (ly:pitch-octave me-pitch))
(equal? (ly:pitch-notename x) (ly:pitch-notename me-pitch))))
preceding)))
(and (pair? preceding)
(not (equal? (ly:pitch-alteration (last preceding))
(ly:pitch-alteration me-pitch))))))
#(define (redundant-natural? me heads)
;; Will remove any natural which isn't cancelling anything within a beamed group.
(let* ((acc (ly:grob-object me 'accidental-grob))
(glyph-name (ly:grob-property acc 'glyph-name)))
(and (string=? glyph-name "accidentals.natural")
(not (preceded-by-chromatic-variant? me heads)))))
#(define (unnecessary-acc? me heads)
(cond
((redundant-natural? me heads) #t)
((first-in-beamed-group? me heads) #f)
((preceded-by-chromatic-variant? me heads) #f)
(else #t)))
#(define (accidentals-by-beam-group grob)
(let* ((stems (ly:grob-array->list (ly:grob-object grob 'stems)))
(heads (map (lambda (x)
(ly:grob-array->list
(ly:grob-object x 'note-heads))) stems))
(heads (flatten-list heads)))
(let loop ((candidates heads))
(if (pair? candidates)
(begin
(if (and
(has-accidental? (car candidates))
(unnecessary-acc? (car candidates) heads))
(ly:grob-suicide! (ly:grob-object (car candidates) 'accidental-grob)))
(loop (cdr candidates)))))))
\score {
\new Staff {
\accidentalStyle dodecaphonic
\override Beam.before-line-breaking = #accidentals-by-beam-group
\time 2/4
\relative c'' { e8 [ cs ] \tuplet 5/4 { e16 [ cs! e cs e ] } }
\bar "||"
\transpose a c' \relative c'' { e8 [ cs ] \tuplet 5/4 { e16 [ cs e cs e ] } }
}
}
notesA = \relative c'' { e8 [ cs ] \tuplet 5/4 { e16 [ cs! e cs e ] } }
\score {
\new Staff \relative c'' {
\time 2/4
\accidentalStyle dodecaphonic
\override Beam.before-line-breaking = #accidentals-by-beam-group
\notesA
\bar "||"
\transpose a c' \notesA
}
}
\score {
\new Staff {
\relative c' {
\accidentalStyle dodecaphonic
\override Beam.before-line-breaking = #accidentals-by-beam-group
cs8 cs cs cs cs cs cs cs
cs ds ds cs cs ds ds cs
<cs ds> <fs gs> q <cs ds> <fs gs> q <cs ds> <fs gs>
<cs ds> <c d> <c d> <cs ds> <c d> <cs ds> q <c d>
cs4 cs cs cs
}
}
}
_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
