diff options
| -rw-r--r-- | chickadee/graphics/path.scm | 135 | ||||
| -rw-r--r-- | doc/api.texi | 7 |
2 files changed, 93 insertions, 49 deletions
diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm index 66617db..30f759d 100644 --- a/chickadee/graphics/path.scm +++ b/chickadee/graphics/path.scm @@ -153,7 +153,7 @@ angle-end**)) (angle-end (if counter-clockwise? angle-end* - (- angle-end* (* 2.0 pi)))) + (- angle-end* tau))) ;; Don't bother making a curve for an angle smaller than ;; this. (min-angle .00001) @@ -251,54 +251,91 @@ '())))) `(expand ,expand-arc))) -;; TODO: Make this work correctly. -;; (define* (arc-to control point radius) -;; (define distance-tolerance 0.01) -;; (define (close? a b) -;; (let ((dx (- (vec2-x b) (vec2-x a))) -;; (dy (- (vec2-y b) (vec2-y a)))) -;; (< (+ (* dx dx) (* dy dy)) -;; (* distance-tolerance distance-tolerance)))) -;; (define (expand-arc-to prev-point) -;; (unless prev-point -;; (error "path cannot start with arc-to")) -;; ;; If the points are really close together, just use a line -;; ;; segment instead of an arc. -;; (if (or (close? prev-point control) -;; (close? control point) -;; (< radius distance-tolerance)) -;; `((line-to ,point)) -;; (let* ((d0 (vec2-normalize (vec2- prev-point control))) -;; (d1 (vec2-normalize (vec2- point control))) -;; (a (acos (+ (* (vec2-x d0) (vec2-x d1)) -;; (* (vec2-y d0) (vec2-y d1))))) -;; (d (/ radius (tan (/ a 2.0))))) -;; (cond -;; ((> d 10000.0) -;; `((line-to ,point))) -;; ((> (vec2-cross d0 d1) 0.0) -;; (pk 'clockwise) -;; (let ((cx (+ (vec2-x control) -;; (* (vec2-x d0) d) -;; (* (vec2-y d0) radius))) -;; (cy (+ (vec2-y control) -;; (* (vec2-y d0) d) -;; (* (- (vec2-x d0)) radius))) -;; (angle-start (atan (- (vec2-y d0)) (vec2-x d0))) -;; (angle-end (atan (vec2-y d1) (- (vec2-x d1))))) -;; (list (arc (vec2 cx cy) radius radius angle-start angle-end)))) -;; (else -;; (pk 'counter-clockwise) -;; (let ((cx (+ (vec2-x control) -;; (* (vec2-x d0) d) -;; (* (- (vec2-y d0)) radius))) -;; (cy (+ (vec2-y control) -;; (* (vec2-y d0) d) -;; (* (vec2-x d0) radius))) -;; (angle-start (atan (vec2-y d0) (- (vec2-x d0)))) -;; (angle-end (atan (- (vec2-y d1)) (vec2-x d1)))) -;; (list (arc (vec2 cx cy) radius radius angle-start angle-end)))))))) -;; `(expand ,expand-arc-to)) +(define* (arc-to c1 c2 radius) + (define distance-tolerance 0.01) + (define (close? a b) + (let ((dx (- (vec2-x b) (vec2-x a))) + (dy (- (vec2-y b) (vec2-y a)))) + (< (+ (* dx dx) (* dy dy)) + (* distance-tolerance distance-tolerance)))) + (define (intersection d0 d1 x0 y0 x1 y1) + ;; Calculate the coefficients for lines in standard form: + ;; + ;; Ax + By = C + ;; + ;; We use a point on each line and a direction vector to define + ;; the line. Then, we calculate the determinant and follow a + ;; formula to get the intersection point. We technically need two + ;; points on the line in order to find the intersection, but we + ;; get away with only calculating one point because we have the + ;; direction vector which can be used to represent the difference + ;; between the point (either (x0, y0) or (x1, y1)) and another + ;; point that is d0 or d1 away. + ;; + ;; See: + ;; https://en.wikipedia.org/wiki/Line%E2%80%93line_intersection#Given_two_points_on_each_line + (let* ((a0 (vec2-y d0)) + (b0 (- (vec2-x d0))) + (c0 (+ (* a0 x0) (* b0 y0))) + (a1 (vec2-y d1)) + (b1 (- (vec2-x d1))) + (c1 (+ (* a1 x1) (* b1 y1))) + (det (- (* a0 b1) (* a1 b0)))) + (vec2 (/ (- (* b1 c0) (* b0 c1)) det) + (/ (- (* a0 c1) (* a1 c0)) det)))) + (define (expand-arc-to c0) + (unless c0 + (error "path cannot start with arc-to")) + ;; If the points are really close together, just use a line + ;; segment instead of an arc. + (if (or (close? c0 c1) + (close? c1 c2) + (< radius distance-tolerance)) + `((line-to ,c2)) + ;; Calculate direction vectors from the middle control point, + ;; c1, to the starting point, c0, and the target control + ;; point, c2. + (let* ((d0 (vec2-normalize (vec2- c0 c1))) + (d1 (vec2-normalize (vec2- c2 c1))) + ;; The cross product tells us if the arc moves + ;; counter-clockwise (< 0), clockwise (> 0), or if + ;; there is no arc because the lines are parallel (0). + (cross (vec2-cross d0 d1))) + (cond + ;; Just draw a straight line if the lines are parallel. + ;; The line intersection calculations would generate bogus + ;; values in this case. + ((= cross 0.0) + `((line-to ,c2))) + ((< cross 0.0) + ;; Find the center of the circle that touches the lines + ;; defined by the three control points. First, calculate + ;; vectors that are perpendicular to d0 and d1. For any + ;; vector, there are *two* perpendicular vectors: (-y, x) + ;; and (y, -x). Which we use depends on if the arc is + ;; going clockwise or counterclockwise. + (let* ((x0 (+ (vec2-x c0) + (* (vec2-y d0) radius))) + (y0 (- (vec2-y c0) + (* (vec2-x d0) radius))) + (x1 (- (vec2-x c2) (* (vec2-y d1) radius))) + (y1 (+ (vec2-y c2) (* (vec2-x d1) radius))) + (center (intersection d0 d1 x0 y0 x1 y1)) + (a0 (atan (vec2-x d0) (- (vec2-y d0)))) + (a1 (atan (- (vec2-x d1)) (vec2-y d1)))) + (list (arc center radius radius a0 a1)))) + (else + (let* ((x0 (- (vec2-x c0) + (* (vec2-y d0) radius))) + (y0 (+ (vec2-y c0) + (* (vec2-x d0) radius))) + (x1 (+ (vec2-x c2) (* (vec2-y d1) radius))) + (y1 (- (vec2-y c2) (* (vec2-x d1) radius))) + (center (intersection d0 d1 x0 y0 x1 y1)) + (a0 (atan (- (vec2-x d0)) (vec2-y d0))) + (a1 (atan (vec2-x d1) (- (vec2-y d1))))) + (list (arc center radius radius a0 a1 #f)))))))) + `(expand ,expand-arc-to)) (define-record-type <path> (make-path commands bounding-box) diff --git a/doc/api.texi b/doc/api.texi index 9a36bc4..a237d97 100644 --- a/doc/api.texi +++ b/doc/api.texi @@ -2095,6 +2095,13 @@ Draw an elliptical arc spanning the angle range [@var{angle-start}, @var{ry} (set both to the same value for a circular arc.) @end deffn +@deffn {Procedure} arc-to c1 c2 radius +Draw a circular arc with radius @var{radius} that is tangential to the +line segment formed by the current pen position and @var{c1}, as well +as the line segment formed by @var{c1} and @var{c2}. The result is a +smooth corner. +@end deffn + Included are some helpful procedures for generating common types of paths: |