--- 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!)
--- 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!
))
--- 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))
-
--- 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))))
--- 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)))