[add] bezier curve surrport

1 files changed, 34 insertions, 0 deletions

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))))))
+