7f6f46164312

Episode 29: Tweening Part 1
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 28 Jun 2016 21:45:49 +0000
parents 0e40a0899f0f
children 783609c42ef0
branches/tags (none)
files .lispwords coding-math.asd package.lisp src/2d/demo.lisp src/tween.lisp src/utils.lisp

Changes

--- a/.lispwords	Sun Jun 26 16:55:04 2016 +0000
+++ b/.lispwords	Tue Jun 28 21:45:49 2016 +0000
@@ -5,3 +5,4 @@
 (2 with-shape-perspective)
 (1 setf-slots)
 (2 with-cga)
+(1 with-elapsed)
--- a/coding-math.asd	Sun Jun 26 16:55:04 2016 +0000
+++ b/coding-math.asd	Tue Jun 28 21:45:49 2016 +0000
@@ -25,6 +25,7 @@
     :components ((:file "utils")
                  (:file "math")
                  (:file "fps")
+                 (:file "tween")
                  (:module "2d"
                   :serial t
                   :components ((:file "vectors")
--- a/package.lisp	Sun Jun 26 16:55:04 2016 +0000
+++ b/package.lisp	Tue Jun 28 21:45:49 2016 +0000
@@ -15,6 +15,7 @@
     #:ensure-car
     #:ensure-cadr
     #:with-place
+    #:with-elapsed
     #:draw-axes
     #:juxt
     #:graph-function))
@@ -59,6 +60,19 @@
     #:with-fps
     #:draw-fps))
 
+(defpackage #:coding-math.tween
+  (:use
+    #:cl
+    #:coding-math.quickutils
+    #:coding-math.math
+    #:coding-math.utils)
+  (:export
+    #:tween-linear
+    #:tween-quadratic-in
+    #:tween-quadratic-out
+    #:tween-quadratic-inout
+    ))
+
 
 ;;;; 2D stuff
 (defpackage #:coding-math.2d.vectors
@@ -173,6 +187,7 @@
     #:coding-math.utils
     #:coding-math.fps
     #:coding-math.math
+    #:coding-math.tween
     #:coding-math.2d.vectors
     #:coding-math.2d.points
     #:coding-math.2d.hitboxes
@@ -183,6 +198,7 @@
     #:cl
     #:sketch
     #:coding-math.quickutils
+    #:coding-math.tween
     #:coding-math.2d.particles
     #:coding-math.2d.hitboxes
     #:coding-math.utils
@@ -229,6 +245,7 @@
     #:coding-math.utils
     #:coding-math.fps
     #:coding-math.math
+    #:coding-math.tween
     #:coding-math.3d.vectors
     #:coding-math.3d.coordinates
     )
--- a/src/2d/demo.lisp	Sun Jun 26 16:55:04 2016 +0000
+++ b/src/2d/demo.lisp	Tue Jun 28 21:45:49 2016 +0000
@@ -42,75 +42,47 @@
 (defun draw-point (p)
   (point (vec-x p) (vec-y p)))
 
+
 (defun oob-p (p &optional (r 0.0))
   (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")
+    ((width *width*) (height *height*) (y-axis :down) (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)))
-     (easing nil)
-     (wheel-angle 0.0)
+     (start (make-vec 100 100))
+     (current start)
+     (target nil)
+     (amount nil)
+     (ease-time 0.0)
+     (duration 2.0)
+     (timestamp nil)
      ;; Pens
      (particle-pen (make-pen :fill (gray 0.9) :stroke (gray 0.4)))
-     (line-pen (make-pen :curve-steps 100
-                         :stroke (gray 0.7)))
+     (line-pen (make-pen :curve-steps 40 :stroke (gray 0.7)))
      )
   (with-setup
     ;;
     (in-context
       (draw-axes *width* *height*)
-      (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-elapsed (timestamp elapsed)
+        (when ease-time
+          (incf ease-time elapsed)))
+      (when target
+        (with-vecs ((sx sy) start
+                    (ax ay) amount)
+          (setf current
+                (make-vec (tween-quadratic-out sx ax duration ease-time)
+                          (tween-quadratic-out sy ay duration ease-time)))))
+      (when (> ease-time duration)
+        (setf target nil
+              amount nil
+              ease-time 0.0))
       (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)
-          ))
-
-      )
+        (draw-circle current)))
     ;;
     )
   )
@@ -118,11 +90,9 @@
 
 ;;;; Mouse
 (defun mousemove (instance x y)
-  (with-slots (target mouse easing) instance
+  (with-slots (mouse) instance
     (setf mouse (make-vec x (- *height* y)))
     ;;
-    (setf target mouse
-          easing t)
     ;;
     )
   )
@@ -130,7 +100,12 @@
 
 (defun mousedown-left (instance x y)
   (declare (ignorable instance x y))
-  )
+  (setf-slots instance
+              start current
+              current start
+              target (make-vec x y)
+              amount (vec-sub target start)
+              ease-time 0.0))
 
 (defun mousedown-right (instance x y)
   (declare (ignorable instance x y))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/tween.lisp	Tue Jun 28 21:45:49 2016 +0000
@@ -0,0 +1,13 @@
+(in-package #:coding-math.tween)
+
+(defun tween-linear (start amount duration time)
+  (let ((time (/ time duration)))
+    (+ start (* amount time))))
+
+(defun tween-quadratic-in (start amount duration time)
+  (let ((time (/ time duration)))
+    (+ start (* amount (* time time)))))
+
+(defun tween-quadratic-out (start amount duration time)
+  (let ((time (/ time duration)))
+    (+ start (* (- amount) (* time (- time 2))))))
--- a/src/utils.lisp	Sun Jun 26 16:55:04 2016 +0000
+++ b/src/utils.lisp	Tue Jun 28 21:45:49 2016 +0000
@@ -66,6 +66,25 @@
     (mapcar (rcurry #'apply args) fns)))
 
 
+(defmacro with-elapsed ((timestamp-place elapsed-symbol)
+                        &body body &environment env)
+  (multiple-value-bind (temps exprs stores store-expr access-expr)
+      (get-setf-expansion timestamp-place env)
+    (with-gensyms (previous-time current-time)
+      `(let* ((,current-time (get-internal-real-time)) ; get current time
+              ,@(mapcar #'list temps exprs) ; grab prev timestamp from place
+              (,previous-time ,access-expr)
+              (,(car stores) ,current-time))
+        ,store-expr ; update timestamp place
+        (let ((,elapsed-symbol ; bind lexical elapsed var
+               (if (null ,previous-time)
+                 0.0
+                 (/ (- ,current-time ,previous-time)
+                    internal-time-units-per-second))))
+          ,@body)))))
+
+
+
 ;;;; Handy drawing functions
 (defparameter axis-pen (make-pen :stroke (gray 0.7)))