Well, I worked a bit with the stencil drawing procedure earlier, so I
adapted it for what you describe. It is not working well with line
breaks... I'll have to figure out why later, but for normal hairpins it
should do what you describe.
Hope that helps.
By the way I'm also curious about their meaning.
2018-02-20 23:44 GMT-03:00 Shane Brandes <[email protected]>:
> Just out of curiosity what does it signify?
>
> Shane
>
>
>
> On Tue, Feb 20, 2018 at 9:25 PM, Andrew Bernard
> <[email protected]> wrote:
> > Is there any example of how to make a hairpin with normal solid lines,
> but
> > dashed at the end, say the last quarter or so? [Yep, some new complexity
> > notation again.]
> >
> > Andrew
> >
> >
> > _______________________________________________
> > lilypond-user mailing list
> > [email protected]
> > https://lists.gnu.org/mailman/listinfo/lilypond-user
> >
>
> _______________________________________________
> lilypond-user mailing list
> [email protected]
> https://lists.gnu.org/mailman/listinfo/lilypond-user
>
\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")
(style-break-point ,number? "From 0 to 1")
(styled-direction ,number? "-1 for LEFT and 1 for RIGHT")
))
#(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)))
(shorten (ly:grob-property grob 'shorten-pair '(0 . 0))))
(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)))
(begin
(interval-dir-set x-points
(+ (interval-center e)
(* dir (- rad (/ thick 2.0))))
dir)
(interval-dir-set shorten 0.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))))))))
(interval-dir-set x-points
(- (interval-bound x-points dir)
(* (interval-bound shorten dir) dir))
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))))))
(let* ((styled-dir (ly:grob-property grob 'styled-direction RIGHT))
(break-point (ly:grob-property grob 'style-break-point 0.5))
(bp-x (* width break-point))
(ang (ly:angle
width
(abs (- endh starth))))
(bp-h (* (tan (degrees->radians ang))
(if (= grow-dir RIGHT)
bp-x
(- width bp-x))))
(styled-sx (if (= styled-dir LEFT)
x
bp-x))
(styled-sh (if (= styled-dir LEFT)
starth
bp-h))
(styled-ex (if (= styled-dir LEFT)
bp-x
width))
(styled-eh (if (= styled-dir LEFT)
bp-h
endh))
(normal-sx (if (= styled-dir RIGHT)
x
bp-x))
(normal-sh (if (= styled-dir RIGHT)
starth
bp-h))
(normal-ex (if (= styled-dir RIGHT)
bp-x
width))
(normal-eh (if (= styled-dir RIGHT)
bp-h
endh)))
(set! mol (ly:line-interface::line grob styled-sx styled-sh styled-ex styled-eh))
(set! mol
(ly:stencil-add
mol
(ly:line-interface::line grob styled-sx (- styled-sh) styled-ex (- styled-eh))))
(set! mol
(ly:stencil-add
mol
(make-line-stencil thick normal-sx normal-sh normal-ex normal-eh)))
(set! mol
(ly:stencil-add
mol
(make-line-stencil thick normal-sx (- normal-sh) normal-ex (- normal-eh))))
(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)))))))
music =
{
c'1\<
\break
c'1
\break
c'2 c'2\!
<<
f''1
{ s4 s4\< s4\> s4\! }
>>
\once \override Hairpin.to-barline = ##f %\once \override Hairpin.shorten-pair = #'(1 . -1)
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.style = #'dashed-line
%\music
}
\markup \huge \bold "PARTIAL STYLE"
{
\override Hairpin.style = #'dashed-line
\override Hairpin.dash-fraction = 0.3
\override Hairpin.dash-period = 0.35
\override Hairpin.stencil = #hairpin::print-scheme
\music
\override Hairpin.styled-direction = #LEFT
\override Hairpin.style-break-point = 0.75
\music
}
\layout {
ragged-right = ##t
}_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
