From 8cf0096791821c7711c9dc2431e4d920f0b678ba Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 29 Jun 2014 21:32:28 -0400
Subject: Add transition module.

* sly/transition.scm: New file.
* Makefile.am (SOURCES): Add it.
---
 Makefile.am        |   1 +
 sly/transition.scm | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 165 insertions(+)
 create mode 100644 sly/transition.scm

diff --git a/Makefile.am b/Makefile.am
index 8ed383a..59c89c0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -44,6 +44,7 @@ SOURCES = 					\
   sly/texture.scm				\
   sly/tileset.scm				\
   sly/transform.scm				\
+  sly/transition.scm				\
   sly/vector.scm					\
   sly/window.scm					\
   $(WRAPPER_SOURCES)
diff --git a/sly/transition.scm b/sly/transition.scm
new file mode 100644
index 0000000..f813828
--- /dev/null
+++ b/sly/transition.scm
@@ -0,0 +1,164 @@
+;;; Sly
+;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;;
+;;; Sly is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Sly is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;;; License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Interpolate values over time with easing.  Useful for animation.
+;;
+;;; Code:
+
+(define-module (sly transition)
+  #:use-module (sly agenda)
+  #:use-module (sly color)
+  #:use-module (sly coroutine)
+  #:use-module (sly math)
+  #:use-module (sly signal)
+  #:use-module (sly vector)
+  #:export (ease-linear
+            ease-in-sine ease-out-sine ease-in-out-sine
+            ease-in-quad ease-out-quad ease-in-out-quad
+            interpolator
+            number-interpolate vector-interpolate color-interpolate
+            transition))
+
+;;;
+;;; Easings
+;;;
+
+(define (ease-linear t d)
+  (/ t d))
+
+(define (ease-in-sine t d)
+  (let ((delta (/ t d)))
+    (+ (* (- delta) (cos (* delta pi/2))) delta)))
+
+(define (ease-out-sine t d)
+  (let ((delta (/ t d)))
+    (* delta (sin (* delta pi/2)))))
+
+(define (ease-in-out-sine t d)
+  (* (/ t d -2)
+     (1- (cos (/ (* t pi) d)))))
+
+(define (ease-in-quad t d)
+  (expt (/ t d) 3))
+
+(define (ease-out-quad t d)
+  (let ((delta (/ t d)))
+    (* (- delta) delta (- delta 2))))
+
+(define (ease-in-out-quad t d)
+  (let ((delta (/ t d))
+        (t (/ t (/ d 2))))
+    (if (< t 1)
+        (* (/ delta 2) t t)
+        (* (/ delta -2)
+           (1- (* (1- t) (- t 3)))))))
+
+;; TODO: See
+;; <http://gsgd.co.uk/sandbox/jquery/easing/jquery.easing.1.3.js> for
+;; implementation details.
+;;
+;; ease-in-cubic
+;; ease-out-cubic
+;; ease-in-out-cubic
+;; ease-in-quart
+;; ease-out-quart
+;; ease-in-out-quart
+;; ease-in-quint
+;; ease-out-quint
+;; ease-in-out-quint
+;; ease-in-expo
+;; ease-out-expo
+;; ease-in-out-expo
+;; ease-in-circ
+;; ease-out-circ
+;; ease-in-out-circ
+;; ease-in-back
+;; ease-out-back
+;; ease-in-out-back
+;; ease-in-elastic
+;; ease-out-elastic
+;; ease-in-out-elastic
+;; ease-in-bounce
+;; ease-out-bounce
+;; ease-in-out-bounce
+
+;;;
+;;; Interpolators
+;;;
+
+(define (interpolator + *)
+  "Return a new procedure that accepts three arguments: a, b, and
+delta.  The returned procedure uses the operations + and * to
+interpolate a value between a and b.  Delta should always be in the
+range [0, 1]."
+  (lambda (a b delta)
+    (+ (* a (- 1 delta))
+       (* b delta))))
+
+(define number-interpolate (interpolator + *))
+(define vector-interpolate (interpolator v+ v*))
+(define color-interpolate (interpolator color+ color-scale))
+
+(define (guess-interpolator a b)
+  (define (both? pred)
+    (and (pred a) (pred b)))
+
+  (cond ((both? number?)
+         number-interpolate)
+        ((both? vector?)
+         vector-interpolate)
+        ((both? color?)
+         color-interpolate)
+        (else
+         (error "Failed to guess interpolator: " a b))))
+
+;;;
+;;; Transitions
+;;;
+
+(define* (transition start end duration
+                     #:optional #:key
+                     (interpolator #f)
+                     (ease ease-linear)
+                     (step 1))
+  "Return a signal that transitions from START to END in DURATION
+ticks. The INTERPOLATOR procedure is used to compute intermediate
+values.  When no interpolator is specified, it is inferred.
+Interpolation procedures can be inferred for numbers, vectors, and
+colors.  For other values, an error is thrown unless INTERPOLATOR is
+passed explicitly.  EASE specifies the easing procedure to apply to
+the transition.  Linear easing is used by default.  STEP specifies the
+number of ticks between each interpolation sample.  By default, a step
+of 1 is used for the smoothest, but most computationally expensive
+transition."
+  (let ((interpolator (or interpolator
+                          (guess-interpolator start end))))
+    (define (value-at t)
+      (interpolator start end (ease t duration)))
+
+    (let ((signal (make-signal start)))
+      (coroutine
+       (let lp ((t 0))
+         (if (< t duration)
+             (begin
+               (wait (min step (- duration t)))
+               (signal-set! signal (value-at t))
+               (lp (+ t step)))
+             (signal-set! signal end))))
+      signal)))
-- 
cgit v1.2.3