# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1486391570 0
# Node ID 6b1e5154d5decf8ad760ce7f707aacf765a0aa68
# Parent  03240af4df9bace2f710f6fa860b15266cfd30cf
Add little easing system

diff -r 03240af4df9b -r 6b1e5154d5de package.lisp
--- 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
diff -r 03240af4df9b -r 6b1e5154d5de sand.asd
--- 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")
diff -r 03240af4df9b -r 6b1e5154d5de src/easing.lisp
--- /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*))