--- a/package.lisp Mon Feb 06 14:01:17 2017 +0000
+++ b/package.lisp Mon Feb 06 14:32:50 2017 +0000
@@ -258,6 +258,16 @@
(:export
))
+(defpackage :sand.easing
+ (:use
+ :cl
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
+ (:export
+ ))
+
(defpackage :sand.sketch
(:use
--- a/sand.asd Mon Feb 06 14:01:17 2017 +0000
+++ b/sand.asd Mon Feb 06 14:32:50 2017 +0000
@@ -19,13 +19,14 @@
:clss
:compiler-macro
:drakma
+ :easing
:flexi-streams
:function-cache
:html-entities
:iterate
:losh
+ :parenscript
:parse-float
- :parenscript
:plump
:rs-colors
:sanitize
@@ -77,6 +78,7 @@
(:file "qud")
(:file "istruct")
(:file "names")
+ (:file "easing")
(:module "turing-omnibus"
:serial t
:components ((:file "wallpaper")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/easing.lisp Mon Feb 06 14:32:50 2017 +0000
@@ -0,0 +1,82 @@
+(in-package :sand.easing)
+
+
+;;;; Data ---------------------------------------------------------------------
+(defparameter *new-eases* nil)
+(defparameter *current-eases* nil)
+
+
+
+;;;; Internal ------------------------------------------------------------------
+(eval-dammit
+ (defun elapsed-time (start-time)
+ (-<> (get-internal-real-time)
+ (- <> start-time)
+ (/ <> internal-time-units-per-second)))
+
+ (defun elapsed-time-normalized (start-time duration)
+ (min 1.0 (/ (elapsed-time start-time) duration)))
+
+ (defun ease% (place from to duration easing-function after environment)
+ (multiple-value-bind (temps exprs stores store-expr access-expr)
+ (get-setf-expansion place environment)
+ (declare (ignore access-expr))
+ (with-gensyms (start)
+ (once-only (duration from to)
+ `(push (let ((,start (get-internal-real-time)))
+ (lambda ()
+ (let* ((n (elapsed-time-normalized ,start ,duration))
+ ,@(mapcar #'list temps exprs)
+ (,(car stores)
+ (map-range 0 1 ,from ,to
+ (funcall ,easing-function n))))
+ ,store-expr
+ (if (= n 1.0)
+ (progn ,after t)
+ nil))))
+ *new-eases*))))))
+
+
+;;;; API ----------------------------------------------------------------------
+(defmacro ease (place from to &key
+ (easing-function #'easing:linear)
+ (duration 1.0)
+ (after nil)
+ &environment environment)
+ (ease% place from to duration easing-function after environment))
+
+(defmacro ease-to (place to &key
+ (easing-function #'easing:linear)
+ (duration 1.0)
+ (after nil)
+ &environment environment)
+ (with-gensyms (from)
+ (multiple-value-bind (temps exprs stores store-expr access-expr)
+ (get-setf-expansion place environment)
+ (declare (ignore stores store-expr))
+ `(let* (,@(mapcar #'list temps exprs)
+ (,from ,access-expr))
+ ,(ease% place from to duration easing-function after environment)))))
+
+(defmacro chain-eases (&rest eases)
+ (destructuring-bind (ease . remaining) eases
+ (if (null remaining)
+ ease
+ (append ease `(:after (chain-eases ,@remaining))))))
+
+(defun run-eases ()
+ (setf *current-eases* (append *new-eases* *current-eases*)
+ *new-eases* nil
+ *current-eases* (delete-if #'funcall *current-eases*)))
+
+
+;;;; Scratch ------------------------------------------------------------------
+; (defparameter *foo* (cons 0 10))
+; (pprint *foo*)
+
+; (chain-eases
+; (ease-to (car *foo*) 1000 :duration 10)
+; (ease (cdr *foo*) 99 50 :duration 5.0)
+; (ease-to (car *foo*) 0.0 :duration 10.0))
+
+; (progn (run-eases) (pprint *foo*))