transition: Move interpolation procedures to their relevant module.

* sly/color.scm (color-lerp): New procedure.
* sly/math.scm (make-lerp, lerp): New procedures.
* sly/math/vector.scm (vlerp): New procedure.
* sly/transition.scm (interpolator, number-interpolate,
  vector-interpolate, color-interpolate): Delete procedures.
  (guess-interpolator): Rewrite with 'match-lambda*'.

4 files changed, 47 insertions, 83 deletions

diff --git a/sly/color.scm b/sly/color.scm
index 4b82df7..2611b31 100644
--- a/sly/color.scm
+++ b/sly/color.scm
@@ -30,53 +30,19 @@
   #:export (<color>
             make-color
             color?
-            color-r
-            color-g
-            color-b
-            color-a
-            rgba
-            rgb
-            color*
-            color-scale
-            color+
-            color-
-            color-inverse
-            white
-            black
-            red
-            green
-            blue
-            yellow
-            magenta
-            cyan
-            transparent
-            tango-light-butter
-            tango-butter
-            tango-dark-butter
-            tango-light-orange
-            tango-orange
-            tango-dark-orange
-            tango-light-chocolate
-            tango-chocolate
-            tango-dark-chocolate
-            tango-light-chameleon
-            tango-chameleon
-            tango-dark-chameleon
-            tango-light-sky-blue
-            tango-sky-blue
-            tango-dark-sky-blue
-            tango-light-plum
-            tango-plum
-            tango-dark-plum
-            tango-light-scarlet-red
-            tango-scarlet-red
-            tango-dark-scarlet-red
-            tango-aluminium-1
-            tango-aluminium-2
-            tango-aluminium-3
-            tango-aluminium-4
-            tango-aluminium-5
-            tango-aluminium-6))
+            color-r color-g color-b color-a
+            rgba rgb
+            color* color+ color- color-inverse color-lerp
+            white black red green blue yellow magenta cyan transparent
+            tango-light-butter tango-butter tango-dark-butter
+            tango-light-orange tango-orange tango-dark-orange
+            tango-light-chocolate tango-chocolate tango-dark-chocolate
+            tango-light-chameleon tango-chameleon tango-dark-chameleon
+            tango-light-sky-blue tango-sky-blue tango-dark-sky-blue
+            tango-light-plum tango-plum tango-dark-plum
+            tango-light-scarlet-red tango-scarlet-red tango-dark-scarlet-red
+            tango-aluminium-1 tango-aluminium-2 tango-aluminium-3
+            tango-aluminium-4 tango-aluminium-5 tango-aluminium-6))
 
 (define-record-type <color>
   (%make-color r g b a)
@@ -157,6 +123,8 @@ For example: #xffffff will return a color with RGBA values 1, 1, 1,
                 (- 1 b)
                 a)))) ; Do not alter alpha channel.
 
+(define color-lerp (make-lerp color+ color*))
+
 ;;;
 ;;; Pre-defined Colors
 ;;;
diff --git a/sly/math.scm b/sly/math.scm
index 4169ae4..923a93d 100644
--- a/sly/math.scm
+++ b/sly/math.scm
@@ -33,7 +33,8 @@
             cotan
             clamp
             linear-scale
-            half square))
+            half square
+            make-lerp lerp))
 
 ;; Dave was editing this module on Pi Approximation Day.
 ;;
@@ -110,3 +111,14 @@ actually less than MAX."
 
 (define (square x)
   (* x x))
+
+(define (make-lerp + *)
+  "Return a new procedure that accepts three arguments: A, B, and
+ALPHA.  The returned procedure uses the procedures + and * to linearly
+interpolate a value between A and B.  ALPHA should always be in the
+range [0, 1]."
+  (lambda (a b alpha)
+    (+ (* a (- 1 alpha))
+       (* b alpha))))
+
+(define lerp (make-lerp + *))
diff --git a/sly/math/vector.scm b/sly/math/vector.scm
index b9e0302..717c5f6 100644
--- a/sly/math/vector.scm
+++ b/sly/math/vector.scm
@@ -33,7 +33,7 @@
             vector2? vector3? vector4?
             vx vy vz vw
             v+ v- v* vdot vcross
-            magnitude normalize))
+            magnitude normalize vlerp))
 
 (define-record-type <vector2>
   (vector2 x y)
@@ -153,3 +153,5 @@
            (vector3 (/ x m) (/ y m) (/ z m)))
           (($ <vector4> x y z w)
            (vector4 (/ x m) (/ y m) (/ z m) (/ w m)))))))
+
+(define vlerp (make-lerp v+ v*))
diff --git a/sly/transition.scm b/sly/transition.scm
index 7910962..6871071 100644
--- a/sly/transition.scm
+++ b/sly/transition.scm
@@ -22,6 +22,7 @@
 ;;; Code:
 
 (define-module (sly transition)
+  #:use-module (ice-9 match)
   #:use-module (sly agenda)
   #:use-module (sly color)
   #:use-module (sly coroutine)
@@ -100,43 +101,24 @@
 ;; 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*))
-
-(define (guess-interpolator a b)
-  (define (both? pred)
-    (and (pred a) (pred b)))
-
-  (cond ((both? number?)
-         number-interpolate)
-        ((or (both? vector2?)
-             (both? vector3?)
-             (both? vector4?))
-         vector-interpolate)
-        ((both? color?)
-         color-interpolate)
-        ((both? quaternion?)
-         quaternion-slerp)
-        (else
-         (error "Failed to guess interpolator: " a b))))
-
-;;;
 ;;; Transitions
 ;;;
 
+(define guess-interpolator
+  (match-lambda*
+   (((? number? _) (? number? _))
+    lerp)
+   ((or ((? vector2? _) (? vector2? _))
+        ((? vector3? _) (? vector3? _))
+        ((? vector4? _) (? vector4? _)))
+    vlerp)
+   (((? color? _) (? color? _))
+    color-lerp)
+   (((? quaternion? _) (? quaternion? _))
+    quaternion-slerp)
+   ((a b)
+    (error "Failed to guess interpolator: " a b))))
+
 (define* (transition start end duration
                      #:optional #:key
                      (interpolator #f)