Hi,
On Sat, Jun 18, 2016 at 11:11 AM, David Nalesnik
<david.nales...@gmail.com> wrote:
> Hi Simon,
>
> On Sat, Jun 18, 2016 at 10:37 AM, Simon Albrecht <simon.albre...@mail.de>
> wrote:
>> On 18.06.2016 17:27, David Nalesnik wrote:
>>>
>>> (I would propose that bound-padding be redefined as a pair in the code
>>> base. Broken-bound-padding, too. The latter is not replaced with a
>>> broken-bound-padding-pair in this code experiment, but that should be easily
>>> done.)
>>
>>
>> Well, it should be pretty easy to use number-or-pair?, shouldn’t it? That
>> way you can use both as a matter of convenience.
>>
>
> That should be workable.
>
> Also, I see now that the situation with broken hairpins is a bit more
> complex (bound-padding still does have an impact). Will see what I
> can do about that, and your suggestion, Simon.
>
> David
OK, I think I took the wrong tack with bound-padding. Evidently,
bound-padding is designed to change hairpin endpoints when dynamics
are present.
The attached code introduces the idea of 'shorten-pair with hairpins.
My first idea, should've stuck with that.
Positive values shorten the hairpin, negative values lengthen it.
Hope this proves useful.
David
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\version "2.19.30"
#(define broken-right-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))))
(broken (if (cdr broken)
(let ((next (broken-right-neighbor grob)))
(if (ly:spanner? next)
(begin
(ly:grob-property next 'after-line-breaking) ; call for side-effect
(cons (car broken) (grob::is-live? next)))
(cons (car broken) #f)))
broken))
(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 (* 0.525 height))
(thick (* (ly:grob-property grob 'thickness 1.0)
(ly:staff-symbol-line-thickness grob)))
(shorten-pair (ly:grob-property grob 'shorten-pair '(0.0 . 0.0)))) ; enhancement
(define (set-x-points dir)
(let* ((b (interval-bound bounds dir))
(e (ly:generic-bound-extent b common))) ; X-AXIS assumed
(interval-dir-set
x-points (ly:grob-relative-coordinate b common X) dir)
(if (interval-bound broken dir)
;; If broken ...
;; starting a line
(if (= dir LEFT)
(interval-dir-set
;x-points (interval-bound e (other-dir dir)) dir)
x-points (interval-bound e RIGHT) LEFT)
;; ending a line
(let* ((broken-bound-padding
(ly:grob-property grob 'broken-bound-padding 0.0))
(chp (ly:grob-object grob 'concurrent-hairpins)))
; make sure that concurrent broken hairpins end at the same time at line break
(let loop ((i 0))
(if (and (ly:grob-array? chp) ; hmm...why no test in C++ needed?
(< 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)))
;; Not broken ...
;; If a dynamic is present at bound
(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))
;; If no dynamic, we consider adjacent spanners
(let* ((neighbor-found #f)
(adjacent '()) ; spanner
(neighbors (ly:grob-object grob 'adjacent-spanners))
(neighbors-len (if (ly:grob-array? neighbors)
(ly:grob-array-length neighbors)
0))) ; this shouldn't be necessary -- see comment above
;; is there a spanner sharing bound?
(let find-neighbor ((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))
(find-neighbor (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)))))))
(interval-dir-set x-points
(- (interval-bound x-points dir) (* dir (interval-bound shorten-pair dir)))
dir)))
(set-x-points LEFT)
(set-x-points 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))))))
;(set! mol (make-line-stencil thick x starth width endh))
(set! mol (ly:line-interface::line grob x starth width endh))
(set! mol
(ly:stencil-add
mol
;(make-line-stencil thick x (- starth) width (- endh))))
(ly:line-interface::line grob x (- starth) width (- endh))))
;; Support al/del niente notation by putting a circle at the
;; tip of the (de)crescendo.
(if circled-tip
(let ((circle (make-circle-stencil rad thick #f)))
;; don't add another circle if the hairpin is broken
(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))))))
hairpin = {
c'1~\<
c'1~
%\break
c'2~ c'2\!
}
\markup \bold "DEFAULT"
{
\hairpin
\break
}
\markup \bold "Shorten right"
{
\override Hairpin.shorten-pair = #'(0 . 4)
\hairpin
\break
}
\markup \bold "Lengthen right"
{
\override Hairpin.shorten-pair = #'(0 . -4)
\hairpin
\break
}
\markup \bold "Shorten left"
{
\override Hairpin.shorten-pair = #'(4 . 0)
\hairpin
\break
}
\markup \bold "Lengthen left"
{
\override Hairpin.shorten-pair = #'(-4 . 0)
\hairpin
\break
}
\markup \bold "Shorten both ends"
{
\override Hairpin.shorten-pair = #'(4 . 4)
\hairpin
\break
}
\markup \bold "Lengthen both ends"
{
\override Hairpin.shorten-pair = #'(-4 . -4)
\hairpin
\break
}
\layout {
\override Hairpin.stencil = #hairpin::print-scheme
%\override Hairpin.to-barline = ##f
%\override Hairpin.circled-tip = ##t
%\override Hairpin.style = #'zigzag
}
\paper {
indent = 0
ragged-right = ##f
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
