Re: Editorial ties in scheme

[Mike]

Here is my solution for marking ties as editorial.

It seems that the size of tie is not known when the
stencil is called, so I used a function from sencil.scm
to calculate its extent.  I thought scheme was not too
bad until I saw this - I have no idea how it works, but
the answers seem plausible.

Posted for comments and in case others may find it
useful.


\version "2.15"
editorialTieStencil=#(lambda(grob)
  (define (pairs-to-lists p) (list(car p) (cdr p)))
  
  ; this routine taken from stencil.scm
  ; trace the course of a bezier and return
  ; its extent.  We use the max Y extent
  (define (path-min-max origin pointlist)
    (define (line-part-min-max x1 x2)
    (list (min x1 x2) (max x1 x2)))

   (define (bezier-part-min-max x1 x2 x3 x4)
    ((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
      (map
        (lambda (x)
          (+ (* x1 (expt (- 1 x) 3))
             (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
                (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
                   (* x4 (expt x 3))))))
        (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
               (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
            (list 0.0 1.0)
            (filter
              (lambda (x) (and (>= x 0) (<= x 1)))
              (append
                (list 0.0 1.0)
                (map (lambda (op)
                       (if (not (eqv? 0.0
                                      (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2)))))
                           ;; Zeros of the bezier curve
                           (/ (+ (- x1 (* 2 x2))
                                 (op x3
                                     (sqrt (- (+ (expt x2 2)
                                                 (+ (expt x3 2) (* x1 x4)))
                                              (+ (* x1 x3)
                                                 (+ (* x2 x4) (* x2 x3)))))))
                              (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
                           ;; Apply L'hopital's rule to get the zeros if 0/0
                           (* (op 0 1)
                              (/ (/ (- x4 x3) 2)
                                 (sqrt (- (+ (* x2 x2)
                                             (+ (* x3 x3) (* x1 x4)))
                                          (+ (* x1 x3)
                                             (+ (* x2 x4) (* x2 x3)))))))))
                     (list + -))))))))

  (define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
    (map (lambda (x)
           (apply bezier-part-min-max x))
         `((,x1 ,x2 ,x3 ,x4) (,y1 ,y2 ,y3 ,y4))))

  (define (line-min-max x1 y1 x2 y2)
    (map (lambda (x)
           (apply line-part-min-max x))
         `((,x1 ,x2) (,y1 ,y2))))

  ((lambda (x)
  
     (list
       (reduce min +inf.0 (map caar x))
       (reduce max -inf.0 (map cadar x))
       (reduce min +inf.0 (map caadr x))
       (reduce max -inf.0 (map cadadr x))))
    (map (lambda (x)
        
           (if (eq? (length x) 8)
               (apply bezier-min-max x)
               (apply line-min-max x)))
         (map (lambda (x y)
                (append (list (cadr (reverse x)) (car (reverse x))) y))
              (append (list origin)
                      (reverse (cdr (reverse pointlist)))) pointlist))))
   ;-----------------------------------------------------------------
   ;  the stencil
  (let* (
         (tie-stencil (ly:tie::print grob))
         (cpoints (ly:grob-property grob 'control-points))
         ;  bezier routine wants a list of lists, not pairs
         (lpoints (map pairs-to-lists cpoints))
         (dir(ly:grob-property grob 'direction))
         (offset -0.2) ; vertical fudge factor 
         (max-tie (if (= dir -1) 
                (list-ref  (path-min-max '(0 0) lpoints) 2) 
                (list-ref  (path-min-max '(0 0) lpoints) 3)
                ))
         
         ; (cpoint3-cpoint0) / 2 + cpoint0
         (mid-tie
           (+(car(list-ref cpoints 0))
             ( / (- (car(list-ref cpoints 3))
                    (car( list-ref cpoints 0))) 2)))
         (ps (format #f "gsave
                     /mid-tie ~s def
                     /max-tie ~s def
                     /offset ~s def
                     /tick-len 0.5 def
                     currentpoint translate
                     0 offset translate
                     newpath
                     0.15 setlinewidth
                     1 setlinecap
                     mid-tie max-tie moveto
                     gsave
                     0 tick-len rlineto
                     stroke
                     grestore
                     0 -1 tick-len mul rlineto
                     stroke
                     grestore" mid-tie  max-tie (* offset dir)))

                     (tick-stencil(ly:make-stencil(list 'embedded-ps ps )
                                    (cons 0 1)(cons -1 -1)))
                     )
    (ly:stencil-add tie-stencil  tick-stencil )
    )
 )
         

ed={\once \override Tie #'stencil =\editorialTieStencil}
{
 
 
 << 
         {              
        \ed g''2~g''~
         g''8 a'' b'' c'' g'' a'' b'' c''
}\\{ 

        \override Tie #'stencil =\editorialTieStencil
        g'8 a' b'~ b' g' a' b' c'
        g'2~ \revert Tie #'stencil  g'4~g'}
   >>
}