Hello again!
I managed to modify David's translation of ly:hairpin::print to have it use
two properties, Hairpin.rotate and Hairpin.straight-end, to achieve almost
all the results I wanted.
The idea is that Hairpin.rotate can be either a numerical value,
representing the angle of rotation, or a procedure that returns the angle
of rotation. In one of the examples I used the function discussed earlier
in this thread to have it automatically detect the angle of a beam.
However, I can't manage to make this idea work when the procedure given to
Hairpin.rotate requires more than one variable. This is very inconvenient
because for some cases the procedure would need to calculate again a lot of
things that are already calculated in the process of making the stencil.
Besides that, I have yet to figure out how to make a rotated Hairpin with
the circled-tip placed in the right spot (when it's a decrescendo,
crescendos pose no problem that I've found).
I think everything else is working as intended, but I could be wrong. I
attached it in case anyone wants to look at it or test it out.
Of course, suggestions on how to improve it / optimize it are welcome!
2018-02-06 19:38 GMT-03:00 Thomas Morley <thomasmorle...@gmail.com>:
> 2018-02-06 16:10 GMT+01:00 Werner LEMBERG <w...@gnu.org>:
> >
> >> Sure, I attached a few from here
> >> <https://imslp.org/wiki/Special:ReverseLookup/23160>
> >
> > Thanks, but in this score there is not a single heavily rotated
> > hairpin; I would say that the differences are not of any importance.
> >
> >> <https://imslp.org/wiki/Special:ReverseLookup/23074>.
> >
> > Oh, and an orchestral score doesn't contain heavily rotated hairpins
> > by its very nature. What I see here is very irregular.
> >
> >> Of course there are many more, in these and other scores.
> >
> > Hmm. Here's a counterexample that contains `steep' hairpins
> > (cf. page 6 bottom, page 23 bottom, page 24 top, etc., etc.) – and the
> > ends are not vertically aligned.
> >
> > https://imslp.org/wiki/Special:ReverseLookup/246876
> >
> > The exception, however, is a broken hairpin, page 30 – here I agree
> > that the continuation part should start (or end) vertically aligned.
> > Or may only `could' instead of `should', as for example page 38
> > demonstrates.
> >
> > On the other hand, it probably solely depends on the typesetter:
> > page 40 contains steep hairpins that are all aligned...
> >
> > My conclusion: It could be a useful feature to have the ends of
> > rotated hairpins vertically aligned. However, I wouldn't like to have
> > this as the default.
> >
> > I'm CCing this e-mail to `bug-lilypond' so that this feature request
> > can be added to our issue database.
> >
> >
> > Werner
>
> I'm a little late to the party this evening...
>
> Though, vertically aligned Hairpins were already discussed (a little)
> during code review of Ferneyhough hairpins
> https://codereview.appspot.com/7615043
> but postponed.
> For an image see comment #2
> I'm pretty sure they could still be implemented. `elbowed-hairpin' has
> it's own limitations, though
>
> Cheers,
> Harm
>
\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 grob 'rotate #f))
(straighten (ly:grob-property grob 'straight-end #f))
(ang (cond ((number? rotate) rotate)
((procedure? rotate) (rotate grob))
;why is this not working???
;((procedure? rotate) (rotate grob width starth end))
(else 0)))
(offset (if (or (= ang 0) (not straighten))
0
(let* ((adj-hgt (- starth endh))
(def-ang (atan (/ adj-hgt width)))
(and-rad (degrees->radians ang))
(tot-ang (+ def-ang and-rad)))
(- (* width (tan tot-ang)) adj-hgt)))))
(set! mol (make-line-stencil thick x starth width (+ endh offset)))
(set! mol
(ly:stencil-add
mol
(make-line-stencil thick x (- starth) width (- offset endh))))
;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)))))
;if straight end-points are not needed, just rotate the stencil
(if (and (not straighten) (not (= ang 0)))
(set! mol (ly:stencil-rotate mol ang CENTER CENTER)))
(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 (grob)
(let* ((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)))))
ang)))))
% The following doesn't work because of the following error when Hairpin.rotate has a lambda that requires more than one variable.
% 226:29: Wrong number of arguments to #<procedure hairpin-upper-with-staff (grob width starth endh)>
#(define hairpin-upper-with-staff
(lambda (grob width starth endh)
(let* ((adj-hgt (- endh starth))
(def-ang (atan (/ adj-hgt width)))
(def-ang-degrees (* def-ang (/ 180 PI))))
(- def-ang-degrees))))
music =
{
c'1\<
c'2\! c'2~\>
c'2~ c'2\!
c'2\> c'2\< c'1
c''1\<
c''4 a' c''\< a'
c''4 a' c''\! a'\<
c''4 a' c'' a'\!
c''1~\<
c''1~
\break
c''1\!
c'1\!\<
\break
c'1
\break
c'2 c'2\!
c''1\<
c''4 a' c''\mf a'
c''1\<
c''4 a' c''\ffff a'
c''4\< c''\! d''\> e''\!
<<
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
}
\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
%{ %currently not working
\override Hairpin.rotate = #hairpin-upper-with-staff
\override Hairpin.straight-end = ##t
\music
%}
}
\layout {
ragged-right = ##t
}_______________________________________________
bug-lilypond mailing list
bug-lilypond@gnu.org
https://lists.gnu.org/mailman/listinfo/bug-lilypond
