# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1462397806 0
# Node ID 7a40282385de5068590a711b795a69f821d0c1a2
# Parent  6c055494d41d4022eb4a108bcfc3e072aa2bdcf6
Episode 19: Bézier Curves

diff -r 6c055494d41d -r 7a40282385de .lispwords
--- a/.lispwords	Wed May 04 20:05:07 2016 +0000
+++ b/.lispwords	Wed May 04 21:36:46 2016 +0000
@@ -1,3 +1,5 @@
 (1 scancode-case)
 (1 make-sketch)
 (2 with-vals)
+(2 with-vec)
+(1 with-vecs)
diff -r 6c055494d41d -r 7a40282385de package.lisp
--- a/package.lisp	Wed May 04 20:05:07 2016 +0000
+++ b/package.lisp	Wed May 04 21:36:46 2016 +0000
@@ -21,6 +21,7 @@
     #:coding-math.utils)
   (:export
     #:tau
+    #:square
     #:distance
     #:random-range
     #:random-around
@@ -62,6 +63,7 @@
     #:make-vec
     #:make-vec-md
     #:make-vec-ma
+    #:make-random-vec
     #:vec-magnitude
     #:vec-direction
     #:vec-angle
@@ -69,12 +71,15 @@
     #:vec-sub
     #:vec-mul
     #:vec-div
+    #:vec-lerp
     #:vec-add!
     #:vec-sub!
     #:vec-mul!
     #:vec-div!
     #:vec-to-string
-    #:with-vec))
+    #:with-vec
+    #:with-vecs
+    ))
 
 (defpackage #:coding-math.particles
   (:use
@@ -106,7 +111,19 @@
     #:particle-gravitate-remove!
     #:particle-spring-to!
     #:particle-spring-add!
-    #:particle-spring-remove!
+    #:particle-spring-remove!))
+
+(defpackage #:coding-math.points
+  (:use
+    #:cl
+    #:coding-math.math
+    #:coding-math.vectors
+    #:coding-math.quickutils
+    #:coding-math.utils)
+  (:export
+    #:quadratic-bezier
+    #:fast-quadratic-bezier
+    #:cubic-bezier
     ))
 
 (defpackage #:coding-math.fps
@@ -128,6 +145,7 @@
     #:coding-math.fps
     #:coding-math.math
     #:coding-math.vectors
+    #:coding-math.points
     #:coding-math.particles))
 
 (defpackage #:coding-math.ballistics
diff -r 6c055494d41d -r 7a40282385de src/main.lisp
--- a/src/main.lisp	Wed May 04 20:05:07 2016 +0000
+++ b/src/main.lisp	Wed May 04 21:36:46 2016 +0000
@@ -13,17 +13,39 @@
   (with-pen pen
     (circle (particle-x p) (particle-y p) (particle-radius p))))
 
+(defun draw-line (p1 p2)
+  (with-vecs ((x1 y1) p1 (x2 y2) p2)
+    (line x1 y1 x2 y2)))
 
-(defun add-result (results)
-  (incf (aref results (floor (random-dist 0 100 4)))))
+(defun draw-circle (p radius)
+  (circle (vec-x p) (vec-y p) radius))
+
+(defun draw-square (p radius)
+  (rect (- (vec-x p) radius)
+        (- (vec-y p) radius)
+        (* 2 radius)
+        (* 2 radius)))
+
+(defun draw-point (p)
+  (point (vec-x p) (vec-y p)))
+
 
 (defsketch cm (:width *width*
                :height *height*
                :debug :scancode-d)
     ((ready)
      (mouse)
-     (graph-pen (make-pen :fill (gray 0.8)))
-     (dot-pen (make-pen :fill (gray 0.8)))
+     (p-from)
+     (p-to)
+     (p-c1)
+     (p-c2)
+     (ts)
+     (l0-pen (make-pen :stroke (gray 0) :fill (rgb 0.0 0.0 0.0)))
+     (l1-pen (make-pen :stroke (rgb 0 0 0.5) :fill (rgb 0.0 0.0 1.0)))
+     (l2-pen (make-pen :stroke (rgb 0 0.5 0.0) :fill (rgb 0.0 1.0 0.0)))
+     (lines-pen (make-pen :stroke (gray 0)))
+     (final-pen (make-pen :stroke (rgb 0.5 0 0) :fill (rgb 1.0 0.0 0.0)))
+     (fast-pen (make-pen :fill (rgb 0.0 0.0 1.0)))
      (results)
      (dots)
      )
@@ -32,24 +54,48 @@
     ;;
     (when ready
 
-      (with-pen dot-pen
-        (loop :for (x . y) :in dots
-              :do (circle x y 2)))
-      (add-result results)
-      (with-pen graph-pen
-        (loop :for r :across results
-              :for i :from 0
-              :do (rect (map-range 0 100
-                                   0 *width*
-                                   i)
-                        0
-                        (- (/ *width* 100) 1)
-                        (map-range 0 200
-                                   0 *height*
-                                   r))))
+      (incf ts 0.01)
 
+      (let* ((n (abs (sin ts)))
+             (i1 (vec-lerp p-from p-c1 n))
+             (i2 (vec-lerp p-c1 p-c2 n))
+             (i3 (vec-lerp p-c2 p-to n))
+             (ii1 (vec-lerp i1 i2 n))
+             (ii2 (vec-lerp i2 i3 n))
+             (f (vec-lerp ii1 ii2 n))
+             )
+        (with-pen lines-pen
+          (draw-line p-from p-c1)
+          (draw-line p-c1 p-c2)
+          (draw-line p-c2 p-to))
+        (with-pen l0-pen
+          (draw-circle p-from 10)
+          (draw-circle p-to 10)
+          (draw-square p-c1 6)
+          (draw-square p-c2 6))
+        (with-pen l1-pen
+          (draw-line i1 i2)
+          (draw-line i2 i3)
+          (draw-circle i1 5)
+          (draw-circle i2 5)
+          (draw-circle i3 5))
+        (with-pen l2-pen
+          (draw-line ii1 ii2)
+          (draw-circle ii1 3)
+          (draw-circle ii2 3))
+        (with-pen final-pen
+          (bezier (vec-x p-from) (vec-y p-from)
+                  (vec-x p-c1) (vec-y p-c1)
+                  (vec-x p-c2) (vec-y p-c2)
+                  (vec-x p-to) (vec-y p-to))
+          (loop :for i :from 0.0 :to 1.0 :by 0.01
+                :do (draw-point (cubic-bezier p-from p-to p-c1 p-c2 i)))
+          (draw-circle f 5))
+
+        )
       )
 
+
     ;;
     ))
 
@@ -60,12 +106,20 @@
 
 (defun reset (game)
   (setf (slot-value game 'ready) nil)
-  (setf (slot-value game 'results)
-        (make-array 100 :initial-element 0)
-        (slot-value game 'dots)
-        (loop :repeat 500
-              :collect (cons (random-dist 0 *width* 4)
-                             (random-dist 0 *height* 4))))
+  (setf (slot-value game 'p-from)
+        (make-vec 20 (random-around *center-y* 50))
+
+        (slot-value game 'p-c1)
+        (make-vec (* *width* 1/3) (random *height*))
+
+        (slot-value game 'p-c2)
+        (make-vec (* *width* 2/3) (random *height*))
+
+        (slot-value game 'p-to)
+        (make-vec (- *width* 20) (random-around *center-y* 50))
+
+        (slot-value game 'ts) 0
+        )
   (setf (slot-value game 'ready) t))
 
 
diff -r 6c055494d41d -r 7a40282385de src/math.lisp
--- a/src/math.lisp	Wed May 04 20:05:07 2016 +0000
+++ b/src/math.lisp	Wed May 04 21:36:46 2016 +0000
@@ -1,12 +1,18 @@
 (in-package #:coding-math.math)
 
-(declaim (inline outsidep insidep wrap-zero wrap-range))
-(declaim (inline norm lerp clamp distance))
+(declaim (inline square outsidep insidep wrap-zero wrap-range
+                 norm lerp clamp distance))
+
 
 ;;;; Constants
 (defparameter tau (* pi 2))
 
 
+;; Basics
+(defun square (x)
+  (* x x))
+
+
 ;; Geometry
 (defun distance (x0 y0 x1 y1)
   (sqrt (+ (square (- x0 x1))
diff -r 6c055494d41d -r 7a40282385de src/points.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/points.lisp	Wed May 04 21:36:46 2016 +0000
@@ -0,0 +1,31 @@
+(in-package #:coding-math.points)
+
+(defun quadratic-bezier (from to control n)
+  (vec-lerp (vec-lerp from control n)
+            (vec-lerp control to n)
+            n))
+
+(defun fast-quadratic-bezier (from to control n
+                              &optional (destination (make-vec)))
+  (with-vecs ((fx fy) from
+              (tx ty) to
+              (cx cy) control)
+    (setf (vec-x destination)
+          (+ (* (square (- 1 n)) fx)
+             (* 2 (- 1 n) n cx)
+             (* n n tx))
+          (vec-y destination)
+          (+ (* (square (- 1 n)) fy)
+             (* 2 (- 1 n) n cy)
+             (* n n ty))))
+  (values))
+
+
+(defun cubic-bezier (from to control-1 control-2 n)
+  (vec-lerp (vec-lerp (vec-lerp from control-1 n)
+                      (vec-lerp control-1 control-2 n)
+                      n)
+            (vec-lerp (vec-lerp control-1 control-2 n)
+                      (vec-lerp control-2 to n)
+                      n)
+            n))
diff -r 6c055494d41d -r 7a40282385de src/vectors.lisp
--- a/src/vectors.lisp	Wed May 04 20:05:07 2016 +0000
+++ b/src/vectors.lisp	Wed May 04 21:36:46 2016 +0000
@@ -1,7 +1,12 @@
 (in-package #:coding-math.vectors)
 
 
-(declaim (inline vec-x vec-y make-vec))
+(declaim (inline vec-x vec-y make-vec
+                 vec-magnitude vec-angle vec-direction
+                 vec-add vec-sub vec-mul vec-div
+                 vec-add! vec-sub! vec-mul! vec-div!
+                 vec-lerp
+                 ))
 
 (defstruct (vec
              (:constructor make-vec
@@ -10,6 +15,9 @@
   (x 0 :type real)
   (y 0 :type real))
 
+(defun make-random-vec (max-x max-y)
+  (make-vec (random max-x) (random max-y)))
+
 
 (defun make-vec-md (magnitude angle)
   (let ((v (make-vec 0 0)))
@@ -27,6 +35,12 @@
            (,(second bindings) (vec-y ,vec)))
        ,@body)))
 
+(defmacro with-vecs (bindings &body body)
+  (if (null bindings)
+    `(progn ,@body)
+    (destructuring-bind (vars vec-form . remaining) bindings
+      `(with-vec ,vars ,vec-form (with-vecs ,remaining ,@body)))))
+
 
 (defun vec-magnitude (vec)
   (with-vec (x y) vec
@@ -91,6 +105,13 @@
         (vec-y v) (/ (vec-y v) s)))
 
 
+(defun vec-lerp (v1 v2 n)
+  (with-vecs ((x1 y1) v1
+              (x2 y2) v2)
+    (make-vec (lerp x1 x2 n)
+              (lerp y1 y2 n))))
+
+
 (defun vec-to-string (v)
   (format nil "[~A ~A]" (vec-x v) (vec-y v)))