I managed to fix it. The problem was not with the calculation of the angle,
it was with the translation of the angle to the offset that the function
applies to the vertical placement of the end-points of the hairpins. It is
correct now.
I also got rid of the rotation of the stencil for the case where the
straight end-points are not needed, the coordinates of the end-points for
the different cases are all calculated now.
As far as I can tell this is done. Finally!
I got the alists working now. I can't reproduce the problems I had earlier,
and the error message was weird and I don't remember it. But I guess that's
not important anymore.
I'm not sure I understood the following:
> But the spanner is cloned for each broken segment, so you aren't
> actually comparing
> with the initial bit. Each new segment is simply drawn with a stencil
> reflecting its
> position within the whole.
>
By reading the code that creates the hairpin stencils I got the idea that
after line breaks are calculated, hairpins get broken into smaller hairpins
that are related to each other. And when drawing the stencils, if these
relationships are found, then they are drawn differently (they can start
and end in 1/3rd or 2/3rds of the height depending on the situation). If
what I'm saying is redundant with what you are saying, as I think it is,
then I probably did a poor job of explaining myself in my last message.
English is not my native language and I struggle to be clear and concise
with technical topics such as these. I apologize for the difficulties in
communication that surely arise because of this.
But why rotate it in the first place?
>
The case where one of the hairpin lines follows the staff lines would have
been much more easier to manage like you propose, that's without question.
However, I wanted to implement the whole rotation thing as an interface so
that in the future I can create functions that find the correct angle for
use cases that arise. The "follow the staff line" case was a way to test
this approach, and it made me find errors in the math, so it payed off in
the end.
I can now very comfortably get the hairpins I wanted, and I learned a lot
of useful things in the process. I know I said it many times already but
I'm truly grateful for your help! I never would have been able to reach a
satisfying solution without it.
2018-02-10 15:02 GMT-03:00 David Nalesnik <david.nales...@gmail.com>:
> Hi Stefano,
>
> On Sat, Feb 10, 2018 at 11:14 AM, Stefano Troncaro
> <stefanotronc...@gmail.com> wrote:
> > Hi David, thank you for your suggestions, this is almost done!
> >
> > I decided to pass an alist to the function instead of changing the
> amount of
> > arguments based on the procedure name, mainly because if I write more
> angle
> > functions in the future I want to be able to do so without having to
> temper
> > with the stencil definition. That is however a useful idea that I would
> have
> > never thought about, and I may find it useful in the future.
> >
> > I have a few doubts if you don't mind.
> >
> > 1) At first I couldn't make the alist approach work because for some
> reason
> > I can't define one in a let or let* block. Do you know why? I googled
> and I
> > couldn't find an explanation.
> >
> > 2) Is there a way to define an alist different than a succession of
> acons? I
> > thought I would be able to create it with a syntax like '((k1 . v1) (k2 .
> > v2) ... etc) but in the end I had to settle for (acons k1 v1 (acons k2 v2
> > ... (acons kn vn '()))).
>
> Not sure what you could have been doing wrong, but there are two ways you
> could
> define the alist
>
> (list (cons 'grob grob) (cons 'width width) (cons 'starth starth)
> (cons 'endh endh))
>
> or through quasi-quoting:
>
> `((grob . ,grob) (width . ,width) (starth . ,starth) (endh . ,endh))
>
>
> > 3) I made the following function to make it so that the upper line of the
> > hairpin runs parallel with the staff lines. It does so by finding the
> angle
> > that is formed between the "zero-point" of the hairpin (the point where
> it
> > begins to open) and the ending point of the higher hairpin line, that is
> in
> > (width, height). The function takes into account that the lines of
> hairpins
> > that go through a system break have different starting and ending
> heights,
> > this is called "adjusted height" here.
>
> But the spanner is cloned for each broken segment, so you aren't
> actually comparing
> with the initial bit. Each new segment is simply drawn with a stencil
> reflecting its
> position within the whole.
>
> With all this in mind, the function
> > finds the angle of the upper line of the hairpin, and returns the
> negative
> > of that angle, which ideally would result in that angle being 0 degrees,
> > making it so that the upper line is parallel to the staff. But the end
> > result is slightly off (see image). I don't know if the math is wrong or
> if
> > this problem arises from rounding differences. If it is the later I may
> need
> > to formulate another approach entirely. Any insight on this?
>
> I noticed this. I'm not great with trig, so I'm not seeing right away
> how to approach this
> by rotating the hairpin. But why rotate it in the first place? You
> simply want the top or
> bottom line--you also need to consider if the hairpin is above the
> staff--to be horizontal. So
> create a property 'follow-staff or something and, when set, draw a
> straight line for one of the two lines
> which are joined to create the hairpin, instead of two lines which
> split the opening width.
>
> >
> > Thank you for all the help!!
>
> You're very welcome!
>
> David
>
\version "2.19.80"
#(define (proc-number-or-false? obj)
(or (procedure? obj)
(number? obj)
(eq? obj #f)))
#(define (define-grob-property symbol type? description)
(if (not (equal? (object-property symbol 'backend-doc) #f))
(ly:error (_ "symbol ~S redefined") symbol))
(set-object-property! symbol 'backend-type? type?)
(set-object-property! symbol 'backend-doc description)
symbol)
#(map
(lambda (x)
(apply define-grob-property x))
`(
(circled-tip-radius ,number? "Radius for hairpin circled tip")
(rotate ,proc-number-or-false? "Custom rotation: a number specifies angle in degrees, a procedure will receive the grob and return an angle, #f deactivates rotation")
(straight-end ,boolean? "Straighten the end of the hairpin when it's rotated?")
))
#(define broken-neighbor
(lambda (grob)
(let* ((pieces (ly:spanner-broken-into (ly:grob-original grob)))
(me-list (member grob pieces)))
(if (> (length me-list) 1)
(cadr me-list)
'()))))
#(define (interval-dir-set i val dir)
(cond ((= dir LEFT) (set-car! i val))
((= dir RIGHT) (set-cdr! i val))
(else (ly:error "dir must be LEFT or RIGHT"))))
#(define (other-dir dir) (- dir))
#(define hairpin::print-scheme
(lambda (grob)
(let ((grow-dir (ly:grob-property grob 'grow-direction)))
(if (not (ly:dir? grow-dir))
(begin
(ly:grob-suicide! grob)
'()))
(let* ((padding (ly:grob-property grob 'bound-padding 0.5))
(bounds (cons (ly:spanner-bound grob LEFT)
(ly:spanner-bound grob RIGHT)))
(broken (cons
(not (= (ly:item-break-dir (car bounds)) CENTER))
(not (= (ly:item-break-dir (cdr bounds)) CENTER)))))
(if (cdr broken)
(let ((next (broken-neighbor grob)))
(if (ly:spanner? next)
(begin
(ly:grob-property next 'after-line-breaking)
(set-cdr! broken (grob::is-live? next)))
(set-cdr! broken #f))))
(let* ((common
(ly:grob-common-refpoint (car bounds) (cdr bounds) X))
(x-points (cons 0 0))
(circled-tip (ly:grob-property grob 'circled-tip))
(height (* (ly:grob-property grob 'height 0.2)
(ly:staff-symbol-staff-space grob)))
(rad (ly:grob-property grob 'circled-tip-radius (* 0.525 height)))
(thick (* (ly:grob-property grob 'thickness 1.0)
(ly:staff-symbol-line-thickness grob))))
(define (inner dir)
(let* ((b (interval-bound bounds dir))
(e (ly:generic-bound-extent b common)))
(interval-dir-set
x-points (ly:grob-relative-coordinate b common X) dir)
(if (interval-bound broken dir)
(if (= dir LEFT)
(interval-dir-set
x-points (interval-bound e (other-dir dir)) dir)
(let* ((broken-bound-padding
(ly:grob-property grob 'broken-bound-padding 0.0))
(chp (ly:grob-object grob 'concurrent-hairpins)))
(let loop ((i 0))
(if (and (ly:grob-array? chp)
(< i (ly:grob-array-length chp)))
(let ((span-elt (ly:grob-array-ref chp i)))
(if (= (ly:item-break-dir (ly:spanner-bound span-elt RIGHT))
LEFT)
(set! broken-bound-padding
(max broken-bound-padding
(ly:grob-property span-elt 'broken-bound-padding 0.0))))
(loop (1+ i)))))
(interval-dir-set
x-points
(- (interval-bound x-points dir)
(* dir broken-bound-padding))
dir)))
(if (grob::has-interface b 'text-interface)
(if (not (interval-empty? e))
(interval-dir-set x-points
(- (interval-bound e (other-dir dir))
(* dir padding))
dir))
(let* ((neighbor-found #f)
(adjacent '())
(neighbors (ly:grob-object grob 'adjacent-spanners))
(neighbors-len (if (ly:grob-array? neighbors)
(ly:grob-array-length neighbors)
0)))
(let inner-two ((i 0))
(if (and (< i neighbors-len)
(not neighbor-found))
(begin
(set! adjacent (ly:grob-array-ref neighbors i))
(if (and (ly:spanner? adjacent)
(eq? (ly:item-get-column (ly:spanner-bound adjacent (other-dir dir)))
(ly:item-get-column b)))
(set! neighbor-found #t))
(inner-two (1+ i)))))
(if neighbor-found
(if (grob::has-interface adjacent 'hairpin-interface)
(if (and circled-tip (not (eq? grow-dir dir)))
(interval-dir-set x-points
(+ (interval-center e)
(* dir
(- rad (/ thick 2.0))))
dir)
(interval-dir-set x-points
(- (interval-center e)
(/ (* dir padding) 3.0))
dir))
(if (= dir RIGHT)
(interval-dir-set x-points
(- (interval-bound e (other-dir dir))
(* dir padding))
dir)))
(begin
(if (and (= dir RIGHT)
(grob::has-interface b 'note-column-interface)
(ly:grob-array? (ly:grob-object b 'rest)))
(interval-dir-set x-points
(interval-bound e (other-dir dir))
dir)
(interval-dir-set x-points
(interval-bound e dir)
dir))
(if (eq? (ly:grob-property b 'non-musical) #t)
(interval-dir-set x-points
(- (interval-bound x-points dir)
(* dir padding))
dir)))))))))
(inner LEFT)
(inner RIGHT)
(let* ((width (- (interval-bound x-points RIGHT)
(interval-bound x-points LEFT)))
(width (if (< width 0)
(begin
(ly:warning
(if (< grow-dir 0)
"decrescendo too small"
"crescendo too small"))
0)
width))
(continued (interval-bound broken (other-dir grow-dir)))
(continuing (interval-bound broken grow-dir))
(starth (if (< grow-dir 0)
(if continuing
(* 2 (/ height 3))
height)
(if continued
(/ height 3)
0.0)))
(endh (if (< grow-dir 0)
(if continued
(/ height 3)
0.0)
(if continuing
(* 2 (/ height 3))
height)))
(mol empty-stencil)
(x 0.0)
(tip-dir (other-dir grow-dir)))
(if (and circled-tip
(not (interval-bound broken tip-dir)))
(if (> grow-dir 0)
(set! x (* rad 2.0))
(if (< grow-dir 0)
(set! width (- width (* rad 2.0))))))
;add support for rotation and straightened end-points
(let* ((rotate (ly:grob-property-data grob 'rotate))
(straighten (ly:grob-property grob 'straight-end #f))
(ang (cond
((number? rotate) (degrees->radians rotate))
((procedure? rotate)
(let ((prop-alist (list (cons 'grob grob)
(cons 'width width)
(cons 'starth starth)
(cons 'endh endh))))
(rotate prop-alist)))
(else 0)))
(y-offset (* width (tan ang)))
(x-offset-mod (cond
((> ang 0) (- 1))
((< ang 0) 1)
(else 0)))
(x-offset (if (and (not straighten) (not (= ang 0)))
(- (sqrt (- (expt width 2) (* y-offset (+ y-offset (* 2 (- endh starth)))))) width )
0))
(upper-height (+ endh y-offset))
(lower-height (- y-offset endh))
(upper-width (if (and (not straighten) (> ang 0) (= grow-dir RIGHT))
;#f
(+ width x-offset)
width))
(lower-width (if (and (not straighten) (< ang 0) (= grow-dir RIGHT))
;#f
(+ width x-offset)
width))
(upper-x (if (and (not straighten) (< ang 0) (= grow-dir LEFT))
(- x x-offset)
x))
(lower-x (if (and (not straighten) (> ang 0) (= grow-dir LEFT))
(- x x-offset)
x)))
(set! mol (make-line-stencil thick upper-x starth upper-width upper-height))
(set! mol
(ly:stencil-add
mol
(make-line-stencil thick lower-x (- starth) lower-width lower-height)))
;TODO: circle on the right end of the object should be placed with the offset. How?
(if circled-tip
(let ((circle (make-circle-stencil rad thick #f)))
(if (not (interval-bound broken tip-dir))
(set! mol
(ly:stencil-combine-at-edge mol X tip-dir circle 0)))))
(set! mol
(ly:stencil-translate-axis mol
(- (interval-bound x-points LEFT)
(ly:grob-relative-coordinate (interval-bound bounds LEFT) common X))
X))
mol)))))))
#(define hairpin-follow-beam
(lambda (prop-alist)
(let* ((grob (assq-ref prop-alist 'grob))
(lb (ly:spanner-bound grob LEFT))
(rb (ly:spanner-bound grob RIGHT))
(bound
(find (lambda (b)
(grob::has-interface b 'note-column-interface))
(list lb rb)))
(beam
(if bound
(ly:grob-object (ly:grob-object bound 'stem) 'beam)
(let* ((col (ly:item-get-column lb))
(elts (ly:grob-array->list
(ly:grob-object col 'bounded-by-me))))
(find (lambda (e) (grob::has-interface e 'beam-interface))
elts)))))
(if (ly:grob? beam)
(let* ((X-pos (ly:grob-property beam 'X-positions))
(Y-pos (ly:grob-property beam 'positions))
(ang (ly:angle (- (cdr X-pos) (car X-pos))
(- (cdr Y-pos) (car Y-pos)))))
(degrees->radians ang))
0))))
#(define hairpin-upper-with-staff
(lambda (prop-alist)
(let* ((starth (assq-ref prop-alist 'starth))
(endh (assq-ref prop-alist 'endh))
(width (assq-ref prop-alist 'width))
(adj-hgt (- endh starth))
(def-ang (ly:angle width adj-hgt)) )
(degrees->radians (- def-ang)))))
#(define hairpin-lower-with-staff
(lambda (prop-alist)
(let* ((starth (assq-ref prop-alist 'starth))
(endh (assq-ref prop-alist 'endh))
(width (assq-ref prop-alist 'width))
(adj-hgt (- endh starth))
(def-ang (ly:angle width adj-hgt)) )
(degrees->radians def-ang))))
music =
{
c'1\<
\break
c'1
\break
c'2 c'2\!
<<
f''1
{ s4 s4\< s4\> s4\! }
>>
\once \override Hairpin.to-barline = ##f
c''1\<
c''1\!
c'8\< e' g' b'\! d''\> b' g' e'\!
<< f''1 { s4 s\< s\> s\! } >>
\override Hairpin.minimum-length = #5
<< f''1 { s4 s\< s\> s\! } >>
\revert Hairpin.minimum-length
\break
}
\markup \huge \bold "DEFAULT"
{
\music
%\override Hairpin.circled-tip = ##t
%\music
}
\markup \huge \bold "ANGLE REWRITE"
{
\override Hairpin.stencil = #hairpin::print-scheme
\music
\override Hairpin.rotate = 10
\override Hairpin.straight-end = ##f
\music
\override Hairpin.rotate = -15
\override Hairpin.straight-end = ##t
\music
%\override Hairpin.circled-tip = ##t %can't properly position circled-tip
\override Hairpin.rotate = #hairpin-follow-beam
\override Hairpin.straight-end = ##t
\music
\override Hairpin.rotate = #hairpin-upper-with-staff
\override Hairpin.straight-end = ##t
\music
\override Hairpin.rotate = #hairpin-lower-with-staff
\override Hairpin.straight-end = ##f
\music
}
\layout {
ragged-right = ##t
}_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
