[add] bezier curve surrport

2 files changed, 46 insertions, 0 deletions

diff --git a/src/grid-geometry.lisp b/src/grid-geometry.lisp
index 218cdf2..b23b207 100644
--- a/src/grid-geometry.lisp
+++ b/src/grid-geometry.lisp
@@ -99,3 +99,15 @@ top right corners of the bounding box for POLY "
            (loop for ,y from (- ,sy ,rad)  to (+ ,sy ,rad) do
              (when (,comparator ,rad (round (euclidean-dist ,x ,y ,sx ,sy)))
                ,@body)))))))
+
+
+(defmacro with-grid-bezier
+    ((x y) (control-pts &key (step 0.001)) &body body)
+  (with-gensyms (fn points a)
+    `(let* ((,points
+              ,control-pts)
+            (,fn
+              (apply #'bezier-lambda ,points)))
+       (loop for ,a from 0.0 to 1.0 by ,step
+             for (,x ,y) = (mapcar #'round (funcall ,fn ,a))
+             do ,@body))))
diff --git a/src/utils.lisp b/src/utils.lisp
index 7b68e3d..4a35aee 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -116,3 +116,37 @@ the path."
   (let ((dx (- x2 x1))
         (dy (- y2 y1)))
     (sqrt (+ (* dx dx) (* dy dy)))))
+
+(let ((cache
+        (make-array 100 :adjustable t :initial-element nibbles:)))
+ (defun factorial (n)
+   (cond
+     ((zerop n) 1)
+     ((< n (length cache))
+      (or (aref cache n)
+          (setf (aref cache n)
+                (* n (factorial (1- n))))))
+     ((>= n (length cache))
+      (setf cache (adjust-array cache (* 2 (length cache))))
+      (factorial n)))))
+
+(defun binomial-coefficient (n k)
+  (/ (factorial n)
+     (* (factorial k) (factorial (- n k)))))
+
+(defun bezier-lambda (&rest points)
+  (let* ((n
+           (1- (length points)))
+         (bin-coeffs
+           (loop for i from 0 to n collect (binomial-coefficient n i))))
+    (lambda (a)
+      (loop for (x y) in points
+            for i from 0
+            for bin-coeff in bin-coeffs
+            for coeff = (* bin-coeff
+                           (expt (- 1 a) (- n i))
+                           (expt a i))
+            sum (* coeff x) into bx
+            sum (* coeff y) into by
+            finally (return (list bx by))))))
+