\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
}