diff options
| -rw-r--r-- | src/grid-geometry.lisp | 12 | ||||
| -rw-r--r-- | src/utils.lisp | 34 |
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)))))) + |