# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1466960104 0
# Node ID 0e40a0899f0f7daedaf907f6f97283e3f3af2752
# Parent  9ad941538426b51eb568b13b752c958089fb5bd2
Episode 28: More on Easing

diff -r 9ad941538426 -r 0e40a0899f0f package.lisp
--- a/package.lisp	Sun May 29 11:47:47 2016 +0000
+++ b/package.lisp	Sun Jun 26 16:55:04 2016 +0000
@@ -142,6 +142,7 @@
     #:particle-gravitate-to!
     #:particle-gravitate-add!
     #:particle-gravitate-remove!
+    #:particle-ease-to!
     #:particle-spring-to!
     #:particle-spring-add!
     #:particle-spring-remove!))
diff -r 9ad941538426 -r 0e40a0899f0f src/2d/demo.lisp
--- a/src/2d/demo.lisp	Sun May 29 11:47:47 2016 +0000
+++ b/src/2d/demo.lisp	Sun Jun 26 16:55:04 2016 +0000
@@ -46,14 +46,40 @@
   (or (outsidep (- 0 r) (+ *width* r) (vec-x p))
       (outsidep (- 0 r) (+ *height* r) (vec-y p))))
 
+(defparameter *wheel-rim-pen* (make-pen :weight 10 :stroke (rgb 0.5 0 0)))
+(defparameter *wheel-point-pen* (make-pen :fill (rgb 0.8 0 0)))
+
+(defun draw-wheel (angle)
+  (in-context
+    (translate *center-x* *center-y*)
+    (rotate angle)
+    (with-pen *wheel-rim-pen*
+      (circle 0 0 100))
+    (with-pen *wheel-point-pen*
+      (ngon 3 0 80 30 30 (degrees (/ tau 4)))
+      (rect -5 0 10 80)
+      (rotate (degrees (/ tau 8)))
+      (rect -5 -90 10 80)
+      (rotate (degrees (- (/ tau 4))))
+      (rect -5 -90 10 80))))
+
+
+(defun ease (rate current goal)
+  (+ current (* rate (- goal current))))
+
+(defmacro easef (rate place goal)
+  `(zap% ,place #'ease ,rate % ,goal))
 
 (defsketch cm
     ((width *width*) (height *height*) (y-axis :up) (title "Coding Math 2D")
      (mouse (make-vec 0 0))
      ;; Data
      (p (make-particle 0.0 (random height) :radius 10))
+     (points (loop :repeat 50
+                   :collect (make-particle 0.0 0.0 :radius 5)))
      (target (make-vec width (random height)))
-     (ease 0.1)
+     (easing nil)
+     (wheel-angle 0.0)
      ;; Pens
      (particle-pen (make-pen :fill (gray 0.9) :stroke (gray 0.4)))
      (line-pen (make-pen :curve-steps 100
@@ -63,12 +89,26 @@
     ;;
     (in-context
       (draw-axes *width* *height*)
-      (let* ((distance (vec-sub target (particle-pos p)))
-             (velocity (vec-mul distance ease)))
-        (setf (particle-vel p) velocity)
-        (particle-update! p)
-        (with-pen particle-pen
-          (draw-particle p)))
+      (easef 0.05 wheel-angle
+             (degrees (map-range 0 *width*
+                                 (/ tau 2) (- (/ tau 2))
+                                 (vec-x mouse))))
+      (draw-wheel wheel-angle)
+      (when easing
+        ; (text "easing" 0 100)
+        ; (text (format nil "points: ~D" (length points)) 0 100)
+        (setf easing (particle-ease-to! p target 0.2))
+        (particle-update! p))
+      (with-pen particle-pen
+        (draw-particle p)
+        (do ((previous p current)
+             (current (car points) (car remaining))
+             (remaining (cdr points) (cdr remaining)))
+            ((null current))
+          (particle-ease-to! current (particle-pos previous) 0.2 t)
+          (particle-update! current)
+          (draw-particle current)
+          ))
 
       )
     ;;
@@ -78,10 +118,11 @@
 
 ;;;; Mouse
 (defun mousemove (instance x y)
-  (with-slots (target mouse) instance
+  (with-slots (target mouse easing) instance
     (setf mouse (make-vec x (- *height* y)))
     ;;
-    (setf target mouse)
+    (setf target mouse
+          easing t)
     ;;
     )
   )
@@ -155,3 +196,4 @@
 
 ;;;; Run
 ; (defparameter *demo* (make-instance 'cm))
+
diff -r 9ad941538426 -r 0e40a0899f0f src/2d/particles.lisp
--- a/src/2d/particles.lisp	Sun May 29 11:47:47 2016 +0000
+++ b/src/2d/particles.lisp	Sun Jun 26 16:55:04 2016 +0000
@@ -156,3 +156,20 @@
 
 (defmethod (setf drag-location-vec) (new-value (p particle))
   (setf (particle-pos p) new-value))
+
+
+(defun particle-ease-to! (particle target &optional (ease 0.1) (always nil))
+  "Ease this particle toward the target vector.
+
+  Returns whether or not the easing still needs to continue.
+
+  "
+  (with-slots (pos vel) particle
+    (let* ((new-vel (vec-mul (vec-sub target pos) ease))
+           (done (and (not always)
+                      (< (abs (vec-x new-vel)) 0.0001)
+                      (< (abs (vec-y new-vel)) 0.0001))))
+      (if done
+        (setf pos target)
+        (setf vel new-vel))
+      (not done))))