Re: Flat flared hairpins

[Thomas Morley]

Am Mi., 2. Jan. 2019 um 01:26 Uhr schrieb Andrew Bernard
<address@hidden>:
>
> Hi Thomas,
>
> The correction works and all is good. Thanks so much.
>
> An interesting point I discovered. If you use \< for the hairpins, the LEFT, 
> RIGHT settings are correct. but if you use /< they are reversed - but still 
> work fine. A fascinating side effect of the code.

Well, it's coming from 'elbowed-hairpin'. There it's a feature, here
we have to fight against.
Below a code which drops 'elbowed-hairpin',

> [It did have me a bit confused for a while. And of course, in this usage, 
> there is no need for a distinction between \< and \<.]

The code will read whether cresc or decresc is used and place the
flares accordingly. Only in the case you want both flares, you need to
do
\override Hairpin.details.flare-position = #CENTER

Also, see Change-log, doc-string and exmples.

\version "2.19.82"

#(define flat-flared-hairpin
  (lambda (grob)
;; Change-log:
;; (1) Correct scaling of flare-height (for use with 'elbowed-hairpin')
;; (2) - Dropped usage of 'elbowed-hairpin', use 'make-connected-line' directly
;;       No scaling is needed any more
;;     - Look at 'grow-direction to choose flares for start or end
;;       Only for getting both flares 'details.flare-position' must be set.

"Is supposed to take a maybe broken Hairpin.
Looking at 'grow-direction, a crescendo gets an opening flare at the end, a
decrescendo gets a closing flare at start.
If details.flare-position is set 0 or CENTER flares are printed at
start and end.
Otherwise a flat line is printed.
The behaviour is determined looking at some sub-properties of 'details:
  - details.flare-position: default is #f
      Remark: can't look at 'grow-direction, because setting it zero causes an
              assertion failure.
  - details.flare-height: height of the flare, numerical value
      default is 1
      TODO: replace with Hairpin.height?
  - details.flare-width: width of the flare, numerical value
      default is 1"
    (let* ((orig (ly:grob-original grob))
           (broken-siblings (ly:spanner-broken-into orig))
           (siblings
             (if (pair? broken-siblings)
                 broken-siblings
                 (list grob)))
           (decresc? (eqv? (ly:grob-property grob 'grow-direction) LEFT))
           (details (ly:grob-property grob 'details))
           (flare-position
             (assoc-get 'flare-position details #f))
           (flare-height
             (assoc-get 'flare-height details 1))
           (flare-width
             (assoc-get 'flare-width details 1))
           (flare-left
             (lambda (g)
               (let* ((stil (ly:hairpin::print g))
                      (stil-x-ext (ly:stencil-extent stil X))
                      (x-start (car stil-x-ext))
                      (stil-y-ext (ly:stencil-extent stil Y))
                      (stil-x-length (interval-length stil-x-ext))
                      (stil-y-length (interval-length stil-y-ext)))
                 (if (and (or (eqv? flare-position 0) decresc?)
                          (equal? g (car siblings)))
                     (list
                       (cons x-start flare-height)
                       (cons (+ x-start flare-width) 0))
                     (list (cons x-start 0))))))
           (flare-right
             (lambda (g)
               (let* ((stil (ly:hairpin::print g))
                      (stil-x-ext (ly:stencil-extent stil X))
                      (x-start (car stil-x-ext))
                      (stil-y-ext (ly:stencil-extent stil Y))
                      (stil-x-length (interval-length stil-x-ext))
                      (stil-y-length (interval-length stil-y-ext)))
                 (if (and (or (eqv? flare-position 0) (not decresc?))
                          (equal? g (last siblings)))
                     (list
                       (cons (+ x-start (- stil-x-length flare-width)) 0)
                       (cons (+ x-start stil-x-length) flare-height))
                     (list (cons (+ x-start stil-x-length) 0))))))
           (points-list `(,@(flare-left grob) ,@(flare-right grob))))
      (ly:stencil-add
        (make-connected-line points-list grob)
        ;; TODO:
        ;;   Overlapping stencils, a problem?
        ;;   Would it be less expensive to draw the missing lines separately?
        (ly:stencil-scale (make-connected-line points-list grob) 1 -1)))))


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\paper {
  ragged-right = ##f
  indent = 25
}

mus = { c'1\> \break cis' \break d' dis'\! }

musII = { c'1\< cis' d' dis'\! }

musIII = { c'1\< \break cis' \break d'\! }

\layout {
  \override Hairpin.stencil = #flat-flared-hairpin
  \override Hairpin.details.flare-height = 2 %% default is 1
  \override Hairpin.details.flare-width = 2 %% default is 1
  \override Hairpin.thickness = 2
  \override Hairpin.stencil =
    #(lambda (grob) (box-stencil (flat-flared-hairpin grob) 0 0))
}

{
  \set Staff.instrumentName = "TEST 1: decresc "
  c'1\> \break cis' \break d' dis'\!
}

{
  \set Staff.instrumentName = "TEST 2: both "
  \override Hairpin.details.flare-position = #CENTER
  c'1\> \break cis' \break d' dis'\!
}

{
  \set Staff.instrumentName = "TEST 3 cresc "
  c'1\< \break cis' \break d' dis'\!
}


{
  \set Staff.instrumentName = "TEST 4: both "
  \override Hairpin.details.flare-position = #CENTER
  c'1\> cis' d' dis'\!
}

{
  \set Staff.instrumentName = "TEST 5"
  \override Hairpin.to-barline = ##f
  \override Hairpin.after-line-breaking = ##t
  c'1\< \break cis' \break d'\!
}

{
  \override DynamicLineSpanner.staff-padding = 4
  \grace { c''32\< d'\! }
  d'1\> f'1 g' a'\!
}




Cheers,
  Harm