[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Editorial ties in scheme
From: |
Mike |
Subject: |
Re: Editorial ties in scheme |
Date: |
Mon, 18 Jun 2012 15:40:38 +0100 |
User-agent: |
Mutt/1.5.18 (2008-05-17) |
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'}
>>
}