diff options
| -rw-r--r-- | animise.asd | 3 | ||||
| -rw-r--r-- | animise.lisp | 411 | ||||
| -rw-r--r-- | package.lisp | 18 |
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 |