On Mon, Jun 16, 2014 at 7:09 PM, David Nalesnik <[email protected]>
wrote:
> Hi,
>
>
> On Mon, Jun 16, 2014 at 6:00 PM, David Nalesnik <[email protected]>
> wrote:
>
> Issues:
>> --You can't force an accidental with "!". Perhaps a property
>> 'force-accidental might be created?
>>
>
> Of course, there's 'forced...
>
>
Here's a variation which incorporates my little discovery :)
In the second example, the ! forces the natural. I don't see that there's
any logic in allowing the function to ignore an explicit directive like
this. (Though I'm guessing it's there as an artifact from the "this is how
I'd like it to look" example?)
--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))
(not (forced? me)))))
#(define (forced? grob)
(and (has-accidental? grob)
(eq? #t (ly:grob-property (ly:grob-object grob 'accidental-grob) 'forced))))
#(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)
((forced? me))
(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
