# HG changeset patch # User Steve Losh # Date 1467291714 0 # Node ID 783609c42ef0955634097267531ee06541275574 # Parent 7f6f46164312f8a6b5affed6c14ce36a080fb5b3 Episode 30: Tweening Part 2 diff -r 7f6f46164312 -r 783609c42ef0 .lispwords --- a/.lispwords Tue Jun 28 21:45:49 2016 +0000 +++ b/.lispwords Thu Jun 30 13:01:54 2016 +0000 @@ -6,3 +6,4 @@ (1 setf-slots) (2 with-cga) (1 with-elapsed) +(1 tween-places!) diff -r 7f6f46164312 -r 783609c42ef0 package.lisp --- a/package.lisp Tue Jun 28 21:45:49 2016 +0000 +++ b/package.lisp Thu Jun 30 13:01:54 2016 +0000 @@ -15,7 +15,6 @@ #:ensure-car #:ensure-cadr #:with-place - #:with-elapsed #:draw-axes #:juxt #:graph-function)) @@ -71,6 +70,9 @@ #:tween-quadratic-in #:tween-quadratic-out #:tween-quadratic-inout + #:tween-place! + #:tween-places! + #:update-tweens! )) diff -r 7f6f46164312 -r 783609c42ef0 src/2d/demo.lisp --- a/src/2d/demo.lisp Tue Jun 28 21:45:49 2016 +0000 +++ b/src/2d/demo.lisp Thu Jun 30 13:01:54 2016 +0000 @@ -48,18 +48,11 @@ (outsidep (- 0 r) (+ *height* r) (vec-y p)))) - (defsketch cm ((width *width*) (height *height*) (y-axis :down) (title "Coding Math 2D") (mouse (make-vec 0 0)) ;; Data - (start (make-vec 100 100)) - (current start) - (target nil) - (amount nil) - (ease-time 0.0) - (duration 2.0) - (timestamp nil) + (current (make-vec 100 100)) ;; Pens (particle-pen (make-pen :fill (gray 0.9) :stroke (gray 0.4))) (line-pen (make-pen :curve-steps 40 :stroke (gray 0.7))) @@ -68,19 +61,7 @@ ;; (in-context (draw-axes *width* *height*) - (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)) + (update-tweens!) (with-pen particle-pen (draw-circle current))) ;; @@ -97,15 +78,25 @@ ) ) +(defun draw-time () + (text (format nil "~d" (get-internal-real-time)) + 300 300)) (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)) + (with-slots (current) instance + (tween-places! + (#'tween-quadratic-out 2.0 + :callback-progress #'draw-time + :callback-finished + (let ((x (vec-x current)) + (y (vec-y current))) + (lambda () + (tween-places! (#'tween-quadratic-in 2.0) + (vec-x current) x + (vec-y current) y)))) + (vec-x current) x + (vec-y current) y))) (defun mousedown-right (instance x y) (declare (ignorable instance x y)) @@ -171,4 +162,3 @@ ;;;; Run ; (defparameter *demo* (make-instance 'cm)) - diff -r 7f6f46164312 -r 783609c42ef0 src/tween.lisp --- a/src/tween.lisp Tue Jun 28 21:45:49 2016 +0000 +++ b/src/tween.lisp Thu Jun 30 13:01:54 2016 +0000 @@ -1,5 +1,59 @@ (in-package #:coding-math.tween) +;;;; Utils +(declaim (inline get-seconds-real-time)) +(defun get-seconds-real-time () + (/ (get-internal-real-time) internal-time-units-per-second)) + + +;;;; Framework +(defvar *active-tweens* nil) +(defvar *callbacks* nil) + +(defmacro tween-place! (place target duration tweening-function + &key callback-progress callback-finished + &environment env) + "Tween `place` to `target` over `duration` seconds with `tweening-function`" + (multiple-value-bind (temp-vars temp-vals stores store-expr access-expr) + (get-setf-expansion place env) + (once-only (duration callback-progress callback-finished) + (with-gensyms (start-time start-value change time finished) + `(let* (,@(mapcar #'list temp-vars temp-vals) + (,start-value ,access-expr) + (,start-time (get-seconds-real-time)) + (,change (- ,target ,start-value))) + (push + (lambda () + (let* ((,time (- (get-seconds-real-time) ,start-time)) + (,finished (> ,time ,duration)) + (,(car stores) + (funcall ,tweening-function + ,start-value ,change ,duration ,time))) + ,store-expr + (when ,callback-progress + (push ,callback-progress *callbacks*)) + (when (and ,finished ,callback-finished) + (push ,callback-finished *callbacks*)) + ,finished)) + *active-tweens*)))))) + +(defmacro tween-places! + ((tweening-function duration &key callback-progress callback-finished) + &rest places) + (once-only (duration tweening-function) + `(progn + ,@(loop :for (place target . remaining) :on places :by #'cddr :collect + `(tween-place! ,place ,target ,duration ,tweening-function + ,@(when (null remaining) + `(:callback-progress ,callback-progress + :callback-finished ,callback-finished))))))) + +(defun update-tweens! () + (setf *active-tweens* (remove-if #'funcall *active-tweens*) + *callbacks* (map nil #'funcall *callbacks*))) + + +;;;; Tweening Functions (defun tween-linear (start amount duration time) (let ((time (/ time duration))) (+ start (* amount time)))) diff -r 7f6f46164312 -r 783609c42ef0 src/utils.lisp --- a/src/utils.lisp Tue Jun 28 21:45:49 2016 +0000 +++ b/src/utils.lisp Thu Jun 30 13:01:54 2016 +0000 @@ -66,25 +66,6 @@ (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)))