I've written code to do rounded polygons /properly/ in both PostScript and SVG. The SVG was a bit tricky because SVG doesn't have PostScript's arct. I would greatly appreciate some help changing the code in lookup.cc to match my new drawing procedures. I'm still not sure whether the polygon drawer should take a list of vertices or an array of vertices. A list makes more sense for the PostScript backend, an array makes more sense for the SVG backend. The attached implementation takes an array.
The essential advantage of the new code over the old is that it explicitly draws the outline of the rounded polygon rather than fudging it by shrinking a polygon and stroking it with a certain line thickness. This provides several advantages over the current LilyPond code: 1. Full support for non-convex, and even self-intersecting, polygons. Currently, Lilypond can't round concave corners. 2. Intuitive implementation. 3. Much more flexibility. In particular, corners can be rounded differently depending on their geometry. The current code and the code I attach give strange results when corners are very sharp or sides are very short. I think it would probably be good to make the rounding radius vary smoothly with the angle, using the exact specified radius only for 90 degree corners. I haven't experimented with it yet, but I have a couple of ideas for how it might vary. David Feuer
(define (polygon points radius)
(let ((pointlist (vector->list points)))
(format "~a~%~a~%~a ~a poly~%"
(numbers->string4 (map car pointlist))
(numbers->string4 (map cdr pointlist))
(vector-length points)
radius)))
polygon.ps
Description: PostScript document
(use-modules (ice-9 receive)
(srfi srfi-1))
;; represent 2D vectors as pairs
(define x car)
(define y cdr)
(define mkvec cons)
(define (vbin+ v1 v2)
(mkvec (+ (x v1) (x v2)) (+ (y v1) (y v2))))
(define (v+ . vectors)
(fold vbin+ '(0 . 0) vectors))
(define (v* r v)
(mkvec (* r (x v)) (* r (y v))))
(define (v- v . rest)
(if (null? rest)
(mkvec (- (x v)) (- (y v)))
(v+ v (v* -1 (apply v+ rest)))))
(define (vmag v)
(sqrt (+ (sqr (x v)) (sqr (y v)))))
(define (vsqrmag v)
(+ (sqr (x v)) (sqr (y v))))
(define (normalize v)
(v* (/ (vmag v)) v))
(define (findparams p1 p2 p3 r)
(let ((p1-p2 (v- p1 p2))
(p3-p2 (v- p3 p2)))
(let ((v1 (normalize p1-p2))
(v3 (normalize p3-p2)))
(let* ((F (/ (vsqrmag (v- v1 v3)) 4))
(scale (* r (sqrt (- (/ 1 F) 1))))
(e1 (v* scale v1))
(e3 (v* scale v3))
(ccw? (> (- (* (x v3) (y v1)) (* (x v1) (y v3))) 0)))
(values (v+ p2 e1) (v+ p2 e3) ccw?)))))
(define (do-vertex index points n radius)
(receive (endpoint1 endpoint2 ccw?)
(findparams (vector-ref points (modulo (- index 1) n))
(vector-ref points index)
(vector-ref points (modulo (+ index 1) n))
radius)
(format #f "L~a,~a A~a,~a 0 0 ~a ~a,~a~%"
(x endpoint1)
(y endpoint1)
radius
radius
(if ccw? 1 0)
(x endpoint2)
(y endpoint2))))
(define (polygon points radius)
(define n (vector-length points))
(define startpoint (v* 0.5 (v+ (vector-ref points (- n 1)) (vector-ref points 0))))
(entity 'path ""
`(d . ,(format
#f "M~a,~a~%~aZ"
(x startpoint) (y startpoint)
(let loop ((index 0) (str ""))
(if (= index n)
str
(loop (+ index 1)
(string-append str
(do-vertex index points n radius)))))))
'(style . "fill:currentColor; stroke:none")))
_______________________________________________ lilypond-devel mailing list lilypond-devel@gnu.org http://lists.gnu.org/mailman/listinfo/lilypond-devel
