massive changes ↓

- added trivia dependency
- changed tween to explicitly store an 'end value'
- added tween-group

3 files changed, 202 insertions, 230 deletions

diff --git a/animise.asd b/animise.asd
index 1117e94..7c59066 100644
--- a/animise.asd
+++ b/animise.asd
@@ -6,6 +6,7 @@
   :license  "Specify license here"
   :version "0.0.1"
   :serial t
-  :depends-on (#:lettuce)
+  :depends-on (#:lettuce #:trivia)
   :components ((:file "package")
+               (:file "easing")
                (:file "animise")))
diff --git a/animise.lisp b/animise.lisp
index 99dbc54..1de9f33 100644
--- a/animise.lisp
+++ b/animise.lisp
@@ -2,157 +2,32 @@
 
 (in-package #:animise)
 
-;;; Utilities for defining easing functions
+;;; Interface generices
 
-(defun time-frac (start duration current)
-  (let* ((end (+ start duration))
-        (progress (max 0 (- end current))))
-    (- 1.0 (/ progress duration))))
 
-(defmacro def-ease (name &rest body)
-  `(defun ,name (start duration current &optional (delta 1))
-     (let ((frac (time-frac start duration current)))
-       ,@body)))
-
-(defmacro def-mirror-for (name-of-ease)
-  (let ((mirror-name (read-from-string (format nil "mirror-~a" name-of-ease))))
-    `(def-ease ,mirror-name
-         (if (<= frac 0.5)
-             (,name-of-ease start (* 0.5 duration) current delta)
-             (,name-of-ease start (* 0.5 duration)
-                            (- (+ start (* 0.5 duration))
-                               (- current (+ start (* 0.5 duration))))
-                            delta)))))
-
-;;; EASING FUNCTION DEFINITIONS ;;;
-
-;;; The DEF-EASE macro defines a function. the BODY of the function has the
-;;; following variables available to it:
-;;; START the start time in MS
-;;; DURATION intended duration of this animation
-;;; CURRENT the current time, sometime after START
-;;; DELTA, a number, the total change in the value being animated (e.g. X coordinate)
-;;; FRAC, a number between 0 and 1, the how close to completion this animation is.
-
-(def-ease linear (* delta frac))
-
-(def-mirror-for linear)
-
-(def-ease quad-in (* frac frac delta))
-
-(def-mirror-for quad-in)
-
-(def-ease quad-out (* frac (- frac 2.0) -1 delta))
-
-(def-mirror-for quad-out)
-
-(def-ease quad-in-out
-  (setf frac (/ frac 0.5))
-  (if (< frac 1) (* frac frac 0.5 delta)
-      (progn (decf frac)
-             (* -1 delta 0.5 (1- (* frac (- frac 2)))))))
-
-(def-mirror-for quad-in-out)
-
-(def-ease cubic-in (* frac frac frac delta))
-
-(def-mirror-for cubic-in)
-
-(def-ease cubic-out
-    (decf frac)
-    (* (1+ (* frac frac frac)) delta))
-
-(def-mirror-for cubic-out)
-
-(def-ease cubic-in-out
-  (setf frac (/ frac 0.5))
-  (if (< frac 1) (* delta 0.5 frac frac frac)
-      (progn
-        (decf frac 2)
-        (* delta 0.5 (+ 2 (* frac frac frac))))))
-
-(def-mirror-for cubic-in-out)
-
-(def-ease sinusoidal-in
-  (+ delta (* -1 delta (cos (* frac pi 0.5)))))
-
-(def-mirror-for sinusoidal-in)
-
-(def-ease sinusoidal-out
-  (* delta (sin (* frac pi 0.5))))
-(def-mirror-for sinusoidal-out)
-
-(def-ease sinusoidal-in-out
-  (* delta -0.5 (1- (cos (* pi frac)))))
-(def-mirror-for sinusoidal-in-out)
-
-(def-ease elastic-out
-      (let ((sqrd (* frac frac))
-            (cubed (* frac frac frac)))
-        (* 100 delta (+ (* 0.33 sqrd cubed)
-                        (* -1.06 sqrd sqrd)
-                        (* 1.26 cubed)
-                        (* -0.67 sqrd)
-                        (* 0.15 frac)))))
-
-(def-mirror-for elastic-out)
-
-(def-ease bounce-out
-    (let ((coeff 7.5627)
-          (step (/ 1 2.75)))
-      (cond ((< frac step)
-             (* delta coeff frac frac))
-            ((< frac (* 2 step))
-             (decf frac (* 1.5 step))
-             (* delta
-                (+ 0.75
-                   (* coeff frac frac))))
-            ((< frac ( * 2.5 step))
-             (decf frac (* 2.25 step))
-             (* delta
-                (+ 0.9375
-                   (* coeff frac frac))))
-            (t
-             (decf frac (* 2.65 step))
-             (* delta
-                (+ 0.984375
-                   (* coeff frac frac)))))))
-
-(def-mirror-for bounce-out)
+;; In addition to the following, both a `DURATION' method and
+;; a `START-TIME' setf-able method are implemented for each class. 
 
-;;; Some functions to check your intuitions about the output of easing functions
-
-(defun make-frames (ease-fn &optional (step 0.1))
-  (loop :for time :from 0 :upto (+ 1 step) :by step
-        :collect (funcall ease-fn 0 1.0 time)))
-
-(defun print-frames (fn &key (width 20) (mark #\.) (step 0.1))
-  (loop for frame in (make-frames fn step) do
-    (dotimes (x width) (princ #\Space))
-    (dotimes (x (round (* frame width)))
-      (princ #\Space))
-    (princ mark)
-    (terpri)))
+(defgeneric run-tween (tween time))
 
 ;;; TWEENS
 
-"A TWEEN is function to produce a sequence of values over time for the purpose
-  of animating an object.
+;; A TWEEN is effectively a function. A tween is used to produce a sequence of
+;; values over time the purpose of animating an object.
 
-  START-TIME and DURATION arguments are a representation of time and must use
-  the same units. START-TIME must be supplied on TWEEN instantiation, and is
-  used to record when the tween begins running.
+;; START-TIME and DURATION arguments are a representation of time and must use
+;; the same units. START-TIME must be supplied on TWEEN instantiation, and is
+;; used to record when the tween begins running.
 
-  DELTA-VAL is a number, the amount by which the animated object's target
-  property should have changed by the time the animation is over.
+;; DELTA-VAL is a number, the amount by which the animated object's target
+;; property should have changed by the time the animation is over.
 
-  Different EASE functions may be supplied to modulate the way that sequence is
-  produced.  EASE is the heart of the TWEEN's behavior.
-
-  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."
+;; Different EASE functions may be supplied to modulate the way that sequence is
+;; produced.  EASE is the heart of the TWEEN's behavior.
 
+;; 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.
 
 (defclass tween ()
   ((start-time
@@ -170,112 +45,196 @@
     :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."))
+   (end-val
+    :accessor end-val
+    :initarg :end-val
+    :initform (error "Must supply an end value."))
    (effector
     :initarg :effector
     :initform (error "Must supply an effector function"))))
 
+;;; TWEEN-SEQ combines tweens to run one after another.
+
+(defclass tween-seq ()
+  ((tweens
+    :accessor tweens
+    :initarg :tweens
+    :initform (error "empty tween sequences are disallowed."))
+   (loop-mode
+    :accessor loop-mode
+    :initarg :loop-mode
+    :initform nil)))  ; :looping :reflecting (:looping max n) (:reflecting max n)
+
+;;; TWEEN-GROUP
+
+(defclass tween-group ()
+  ((members
+    :accessor members
+    :initarg :members
+    :initform nil
+    :type list)))
+
+;;; Some functions that use the protocol defined by the generics
+
+(defun in-sequence (t1 &rest tws)
+  (let ((seq (make-instance 'tween-seq :tweens (cons t1 tws))))
+    (correct-sequencing seq)
+    seq))
+
 (defun end-time (tween)
-    (+ (start-time tween) (duration tween)))
+  "Some tweens dont have a duration ,and hence never end. NIL is returned to
+  reflect this."
+  (let-when (dur (duration tween))
+            (+ (start-time tween) dur)))
 
-(defun tween-finished-p (tween current-time)
-  (>= current-time (end-time tween)))
+(defun tween-finished-p (tween time)
+  "Returns T if  TWEEN is done running."
+  (let-when (end (end-time tween))
+            (>= time end)))
 
-(defgeneric run-tween (tween time))
+(defun add-to-group (group tween &keys (offset 0))
+  "Adds TWEEN to GROUP. If TWEEN is the first tween added to GROUP, then TWEEN'S
+   start time becomes the GROUP'S start time and the OFFSET is ignored.
+   Otherwise, TWEEN's start time is set to the start time of the GROUP modified
+   by OFFSET."
+  (let-when (start-time (and (members group) (start-time group)))
+    (setf (start-time tween)
+          (+ offset start-time)))
+  (push (members group) tween))
+
+
+(defun as-group (tween &rest tweens)
+  (make-instance 'tween-group :members (cons tween tweens)))
+
+;;; Interface implementations for TWEEN class
 
 (defmethod run-tween ((tween tween) time)
-  (with-slots (start-time duration ease start-val delta-val effector) tween
+  (with-slots (start-time duration ease start-val end-val effector) tween
     (when (>= time start-time)
       (funcall effector
                (+ start-val
-                  (funcall ease start-time duration time delta-val))))))
-
-(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
-                :start-val (+ start-val delta-val)
-                :delta-val (* -1 delta-val)
-                :effector effector)))
+                  (funcall ease
+                           start-time
+                           duration
+                           time
+                           (- end-val start-val)))))))
 
-(defclass tween-seq ()
-  ((tweens
-    :accessor tweens
-    :initarg :tweens
-    :initform nil)
-   (loop-mode
-    :accessor loop-mode
-    :initarg :loop-mode
-    :initform nil)))  ; :looping :reflecting
+;;; Interface implementations for TWEEN-SEQ
 
 (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)
+  ;; A helper function that sets the start and stop time for each tween in a
+  ;; tween sequence. It assumes the first tween is correctly configured.
   (when (tweens seq)
     (let ((end (end-time (car (tweens seq)))))
-      (doist (tween (cdr (tweens seq))
+      (dolist (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))
+
+(defmethod (setf start-time) (val (ob tween-seq))
+  (unless (tweens ob) (error "Cannot set start time of empty sequence."))
+  (setf (start-time (car (tweens ob))) val)
+  (correct-sequencing ob)
+  val)
+
+
+(defmethod duration ((ob tween-seq))
+  "NIL means that the tween is infinitely looping."
+  (unless (tweens ob) (error "Cannot determine the duration of an empty sequence."))
+  (with-slots (tweens loop-mode) ob
+    (match loop-mode
+      (:looping nil)
+      (:reflecting nil)
+      ((list _ max _)
+       (* max
+          (reduce #'+ tweens :key #'duration :initial-value 0)))
+      (nil
+       (reduce #'+ tweens :key #'duration :initial-value 0)))))
+
+(defun reset-child-loops (seq)
+  ;; Resets LOOP-MODEs that have counts to whatever their initial count was.
+  ;; Does the same for all tweens in the sequence that might themselves be
+  ;; TWEEN-SEQ instances
+  (dolist (sub (tweens seq))
+    (when (typep sub tween-seq)
+      (reset-child-loops seq)))
+
+  (with-slots (loop-mode) seq
+    (when (consp loop-mode)
+      (setf (nth 2 loop-mode)
+            (nth 1 loop-mode)))))
+
+;; TODO implmeent the reflecting tween behavior
+(defun apply-looping (seq now)
+  ;; Applies any looping in order to see if, after doing so, a runnable tween
+  ;; becomes available.
+  (with-slots (loop-mode) seq
+    (match loop-mode
+
+      (:looping
+       ;; If you're simply looping, you need to make sure each non-infinite subloop
+       ;; be reset.
+       (reset-child-loops seq)
+       ;; then set the start time to right now and correct start times of the
+       ;; subsequent loops
+       (setf (start-time seq) now)
+       (car (tweens seq)))
+
+      ((list :looping _ n)
+       (when (plusp n)
+         (decf (nth 2 loop-mode))
+         (reset-child-loops seq)
+         (setf (start-time seq) now)
+         (car (tweens seq)))) )))
+
+      ;; (:reflecting
+      ;;  (reverse-tween seq)
+      ;;  (car (tweens seq)))
+
+      ;; ((list :reflecting max n)
+      ;;  (when (plusp n)
+      ;;    (decf (nth 2 loop-mode))
+      ;;    (reverse-tween seq)
+      ;;    (car (tweens seq)))))))
+
+
+(defmethod run-tween ((ob tween-seq) time)
+  (let-when (tween (or
+                    ;; find the first unfinished tween in the sequence
+                    (find-if-not (lambda (tween)
+                                   (tween-finished-p tween time))
+                                 (tweens ob))
+                    ;; otherwise apply any looping configuration on the sequence
+                    ;; and apply the tween that results
+                    (apply-looping ob time)))
+            (run-tween tween time)))
+
+
+;;; Interface Implementations for TWEEN-GROUP
+
+(defmethod start-time ((ob tween-group))
+  (loop :for tw :in (members ob) :minimizing (start-time tw)))
+
+(defmethod (setf start-time) (val (ob tween-group))
+  (unless (members ob) (error "Can't setf the start time on an empty group"))
+  (let* ((old-start-time (start-time ob))
+         (offset (- now old-start-time)))
+    (dolist (tween (members ob))
+      (incf (start-time tween) offset))
+    val))
+
+(defmethod duration ((ob tween-group))
+  (when (members ob)
+    (let ((start-time (start-time ob))
+          (end-time (loop :for tw :in (members ob) :maximizing (end-time tw))))
+      (- end-time start-time))))
+
+(defmethod run-tween ((ob tween-group) now)
+  (dolist (tween (members ob))
+    (run-tween tween now)))
+
+;;; Sequencing operations
diff --git a/package.lisp b/package.lisp
index 5f739c5..e79e1a7 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,13 +2,25 @@
 
 (defpackage #:animise
   (:use #:cl #:lettuce)
+  (:import-from #:trivia #:match)
   (:export
 
-   ;; TWEENS
+   ;; TWEEN CLASSES
    #:tween
-   #:make-tween
-   #:end-time
+   #:tween-seq
+   #:tween-group
+
+   ;; TWEEN PROTOCOL
+   #:start-time
+   #:duration
+   #:run-tween
+
+   ;; TWEEN FUNCTIONS
    #:tween-finished-p
+   #:in-sequence
+   #:end-time
+   #:add-to-group
+   #:as-group
 
    ;; EASING FUNCTIONS
    #:bouce-out