LSR/878
< LSR
 |
Der Inhalt dieser Seite wurde aus dem LilyPond Snippet Repository übernommen und steht unter folgender Lizenz: CC0. See Public Domain Help Pages for more info. | |
Beschreibung
This snippet is a near-exact copy of snippet #700 (Coloring individual staff lines).
It allows you to provide separate functions for drawing each staff line. #f will draw the staff line normally.
%%http://lsr.di.unimi.it/LSR/Item?id=878
#(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
(- (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 0.1
(let ((w (- x2 x1)))
(list (list 'moveto 0 0)
(list 'curveto (* w 0.4) 1 (* w 0.6) -1 w 0))))))
\new Staff {
c'1
\stopStaff
\override Staff.StaffSymbol.stencil = #(custom-staff-lines wavy-line wavy-line #f wavy-line wavy-line)
\startStaff
c'1
\stopStaff
\revert Staff.StaffSymbol.stencil
\startStaff
c'1
}
%%http://lsr.di.unimi.it/LSR/Item?id=878
#(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
(- (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 0.1
(let ((w (- x2 x1)))
(list (list 'moveto 0 0)
(list 'curveto (* w 0.4) 1 (* w 0.6) -1 w 0))))))
\new Staff {
c'1
\stopStaff
\override Staff.StaffSymbol.stencil = #(custom-staff-lines wavy-line wavy-line #f wavy-line wavy-line)
\startStaff
c'1
\stopStaff
\revert Staff.StaffSymbol.stencil
\startStaff
c'1
}