LSR-snippet 878: Customizing individual staff lines

[Thomas Morley]

To the author of LSR-snippet 878: Customizing individual staff lines
(currently not approved)
http://lsr.dsi.unimi.it/LSR/Item?id=878
Hope you're on this list.

I had a look at your file and noticed a small gap when the normal
staff is restored. Visible with high zoom.

What do you think about the modified code below.
(In the example I've set 'layer and 'color to gain better visibility.)

\version "2.14.2"

#(define-public ((custom-staff-lines . rest) grob)

   (define (index-cell cell dir)
     (if (equal? dir RIGHT)
         (cdr cell)
         (car cell)))

   (define (index-set-cell! x dir val)
     (case dir
       ((-1) (set-car! x val))
       ((1) (set-cdr! x val))))

   (let* ((common (ly:grob-system grob))
          (span-points '(0 . 0))
          (thickness (* (ly:grob-property grob 'thickness 1.0)
                        (ly:output-def-lookup (ly:grob-layout grob)
'line-thickness)))
          (width (ly:grob-property grob 'width))
          (line-positions (ly:grob-property grob 'line-positions))
          (staff-space (ly:grob-property grob 'staff-space 1))
          (line-stencil #f)
          (total-lines empty-stencil)
          ;; use a local copy of list, since stencil creation mutates list
          (functions rest))

     (for-each
      (lambda (dir)
        (if (and (= dir RIGHT)
                 (number? width))
            (set-cdr! span-points width)
            (let* ((bound (ly:spanner-bound grob dir))
                   (bound-ext (ly:grob-extent bound bound X)))

              (index-set-cell! span-points dir
                               (ly:grob-relative-coordinate bound common X))
              (if (and (not (ly:item-break-dir bound))
                       (not (interval-empty? bound-ext)))
                  (index-set-cell! span-points dir
                                   (+ (index-cell span-points dir)
                                      (index-cell bound-ext dir))))))
        (index-set-cell! span-points dir (- (index-cell span-points dir)
                                            (* dir thickness 0.5))))
      (list LEFT RIGHT))

     (set! span-points
           (coord-translate span-points
;;;; CHANGED
                          ;;(- (ly:grob-relative-coordinate grob common X))))
                            (- thickness (ly:grob-relative-coordinate
grob common X)) ))
     (set! line-stencil
           (make-line-stencil thickness (car span-points) 0 (cdr
span-points) 0))

     (if (pair? line-positions)
         (for-each (lambda (position)
                     (let ((func (if (pair? functions)
                                      (car functions)
                                      #f)))
                       (set! total-lines
                             (ly:stencil-add
                              total-lines
                              (ly:stencil-translate-axis
                               (if (procedure? func)
                                  (func grob thickness (car
span-points) (cdr span-points))
                                  line-stencil)
                               (* position staff-space 0.5) Y)))
                       (and (pair? funcs)
                            (set! funcs (cdr funcs)))))
                   line-positions)
         (let* ((line-count (ly:grob-property grob 'line-count 5))
                (height (* (1- line-count) (/ staff-space 2))))
           (do ((i 0 (1+ i)))
               ((= i line-count))
             (let ((func (if (and (pair? functions)
                                   (> (length functions) i))
                              (list-ref functions i)
                              #f)))
               (set! total-lines (ly:stencil-add
                                  total-lines
                                  (ly:stencil-translate-axis
                                     (if (procedure? func)
                                        (func grob thickness (car
span-points) (cdr span-points))
                                        line-stencil)
                                   (- height (* i staff-space)) Y)))))))
     total-lines))

% Example using markup paths
#(define (wavy-line grob thickness x1 x2)
   (grob-interpret-markup grob
     (markup #:path thickness
;;;; CHANGED
          ;;(let ((w (- x2 x1)))
            (let ((w (- x2 x1 (* -1.5 thickness))))
;;;; CHANGED
            ;;(list (list 'moveto 0 0)
              (list (list 'moveto (* 1.5 thickness) 0)
                    (list 'curveto (* w 0.4) 1 (* w 0.6) -1 w 0))))))

\new Staff {
  \override Staff.StaffSymbol #'layer = #-10
  c'1
  \stopStaff
  \override Staff.StaffSymbol #'stencil = #(custom-staff-lines
wavy-line wavy-line #f wavy-line wavy-line)
  \override Staff.StaffSymbol #'color = #red
  \override Staff.StaffSymbol #'layer = #10
  \startStaff
  c'1
  \stopStaff
  \revert Staff.StaffSymbol #'layer
  \revert Staff.StaffSymbol #'color
  \revert Staff.StaffSymbol #'stencil
  \startStaff
  c'1
}


Cheers,
  Harm

BTW,
http://lsr.dsi.unimi.it/LSR/Item?id=700
has the same problem.