graphics: path: Add arc-to procedure.

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: