diff options
| -rw-r--r-- | animise.asd | 1 | ||||
| -rw-r--r-- | animise.lisp | 121 | ||||
| -rw-r--r-- | package.lisp | 2 |
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 |