added tween combination functions

3 files changed, 111 insertions, 13 deletions

diff --git a/animise.asd b/animise.asd
index 51a382b..1117e94 100644
--- a/animise.asd
+++ b/animise.asd
@@ -6,5 +6,6 @@
   :license  "Specify license here"
   :version "0.0.1"
   :serial t
+  :depends-on (#:lettuce)
   :components ((:file "package")
                (:file "animise")))
diff --git a/animise.lisp b/animise.lisp
index 81cea4e..99dbc54 100644
--- a/animise.lisp
+++ b/animise.lisp
@@ -136,8 +136,7 @@
 
 ;;; TWEENS
 
-(defstruct tween
-  "A TWEEN is function to produce a sequence of values over time for the purpose
+"A TWEEN is function to produce a sequence of values over time for the purpose
   of animating an object.
 
   START-TIME and DURATION arguments are a representation of time and must use
@@ -153,28 +152,50 @@
   Every TWEEN instance must have an EFFECTOR, which should be a closure that
   accepts a single argument. The purpose of the EFFECTOR is to apply the values
   generated by the TWEEN to some object."
-  (start-time (error "Must supply a start time."))
-  (duration 1.0)
-  (ease #'linear)
-  (start-val (error "Must supply a start value."))
-  (delta-val (error "Must supply a delta value."))
-  (effector (error "Must supply an effector function")))
+
+
+(defclass tween ()
+  ((start-time
+    :accessor start-time
+    :initarg :start-time
+    :initform (error "Must supply a start time."))
+   (duration
+    :reader duration
+    :initarg :duration
+    :initform 1000.0) ; 1 second
+   (ease-fn
+    :initarg :ease-fn
+    :initform #'linear)
+   (start-val
+    :accessor start-val
+    :initarg start-val
+    :initform (error "Must supply a start value."))
+   (delta-val
+    :accessor delta-val
+    :initarg :delta-val
+    :initform (error "Must supply a delta value."))
+   (effector
+    :initarg :effector
+    :initform (error "Must supply an effector function"))))
 
 (defun end-time (tween)
-  (with-slots (start-time duration) tween
-      (+ start-time duration)))
+    (+ (start-time tween) (duration tween)))
 
 (defun tween-finished-p (tween current-time)
   (>= current-time (end-time tween)))
 
-(defun run-tween (tween time)
+(defgeneric run-tween (tween time))
+
+(defmethod run-tween ((tween tween) time)
   (with-slots (start-time duration ease start-val delta-val effector) tween
     (when (>= time start-time)
       (funcall effector
                (+ start-val
                   (funcall ease start-time duration time delta-val))))))
 
-(defun reverse-tween (tween &optional start)
+(defgeneric reverse-tween (tween &optional start))
+
+(defmethod reverse-tween ((tween tween) &optional start)
   (with-slots (start-time duration ease start-val delta-val effector) tween
     (make-tween :start-time (if start start (+ duration start-time))
                 :duration duration
@@ -182,3 +203,79 @@
                 :delta-val (* -1 delta-val)
                 :effector effector)))
 
+(defclass tween-seq ()
+  ((tweens
+    :accessor tweens
+    :initarg :tweens
+    :initform nil)
+   (loop-mode
+    :accessor loop-mode
+    :initarg :loop-mode
+    :initform nil)))  ; :looping :reflecting
+
+(defmethod start-time ((ob tween-seq))
+  (when (tweens ob)
+    (start-time (car (tweens ob)))))
+
+(defmethod duration ((ob tween-seq))
+  (when (tweens ob)
+    (reduce #'+ (tweens ob) :key #'duration :initial-value 0)))
+
+;; TODO implmeent the reflecting tween behavior
+(defun apply-looping (seq)
+  (case (loop-mode seq)
+    (:looping
+     (setf (start-time seq) (end-time seq))
+     (correct-sequencing seq)
+     (car (tweens seq)))
+    (:reflecting nil)))
+
+(defmethod run-tween ((ob tween-seq) time)
+  (let-cond
+    (tween (find-if-not (lambda (tween) (tween-finished-p tween time))
+                               (tweens ob))
+           (run-tween tween time))
+    (tween (apply-looping ob)
+           (run-tween tween time))))
+
+(defgeneric add-after (first second)
+  (:documentation "A potentialy destructive function that puts its tween
+  arguments into sequence. In the case of a TWEEN-SEQ in the first position, it
+  is that argument that will be returned. Consider the second argument as
+  discarded."))
+
+(defmethod add-after ((first tween) (second tween))
+  (setf (start-time second) (end-time first))
+  (make-instance 'tween-seq :tweens (list first second)))
+
+(defmethod add-after ((first tween-seq) (second tween))
+  (setf (start-time second) (end-time first))
+  (setf (tweens first)
+        (append (tweens first) (list second)))
+  first)
+
+(defun correct-sequencing (seq)
+  (when (tweens seq)
+    (let ((end (end-time (car (tweens seq)))))
+      (doist (tween (cdr (tweens seq))
+        (setf (start-time tween) end)
+        (setf end (end-time tween))))))
+
+(defmethod add-after ((first tween) (second tween-seq))
+  (push first (tweens second))
+  (correct-sequencing second)
+  second)
+
+(defmethod add-after ((first tween-seq) (second tween-seq))
+  (setf (tweens first)
+        (append (tweens first) (tweens second)))
+  (correct-sequencing first)
+  first)
+
+;; TODO perhaps a little slow b/c of the unnecessary calls to correct-sequencing
+;; in the intermediate steps
+(defun join (tween1 tween2 &rest tweens)
+  (let ((tween (add-after tween1 tween2)))
+    (dolist (tw tweens)
+      (setf tween (add-after tween tw)))
+    tween))
diff --git a/package.lisp b/package.lisp
index fe96911..5f739c5 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,7 +1,7 @@
 ;;;; package.lisp
 
 (defpackage #:animise
-  (:use #:cl)
+  (:use #:cl #:lettuce)
   (:export
 
    ;; TWEENS