# HG changeset patch # User Steve Losh # Date 1467150349 0 # Node ID 7f6f46164312f8a6b5affed6c14ce36a080fb5b3 # Parent 0e40a0899f0f7daedaf907f6f97283e3f3af2752 Episode 29: Tweening Part 1 diff -r 0e40a0899f0f -r 7f6f46164312 .lispwords --- 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) diff -r 0e40a0899f0f -r 7f6f46164312 coding-math.asd --- 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") diff -r 0e40a0899f0f -r 7f6f46164312 package.lisp --- 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 ) diff -r 0e40a0899f0f -r 7f6f46164312 src/2d/demo.lisp --- 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)) diff -r 0e40a0899f0f -r 7f6f46164312 src/tween.lisp --- /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)))))) diff -r 0e40a0899f0f -r 7f6f46164312 src/utils.lisp --- 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)))