Navigation Menu

Skip to content
This repository has been archived by the owner on May 7, 2020. It is now read-only.

Commit

Permalink
Initial commit
Browse files Browse the repository at this point in the history
  • Loading branch information
@dleslie
dleslie committed Jan 8, 2013
0 parents commit 1004445
Show file tree
Hide file tree
Showing 8 changed files with 524 additions and 0 deletions.
212 changes: 212 additions & 0 deletions easing.scm
@@ -0,0 +1,212 @@
(define (linear-ease direction percent)
(assert (and (<= 0 percent) (>= 1 percent)))
percent)

(define (quadratic-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(linear-ease
direction
(cond
((eq? direction 'in)
(expt percent 2))
((eq? direction 'out)
(* percent (- 2 percent)))
((eq? direction 'inout)u
(let ((p (* percent 2)))
(if (< p 1)
(* 0.5 (expt percent 2))
(let ((p (- p 1)))
(* -0.5 (- (* p (- p 2)) 1)))))))))

(define (cubic-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(linear-ease
direction
(cond
((eq? direction 'in)
(expt percent 3))
((eq? direction 'out)
(let ((p (- percent 1)))
(+ 1 (* (expt p 3)))))
((eq? direction 'inout)
(let ((p (* percent 2)))
(if (< p 1)
(* 0.5 (expt p 3))
(let ((p (- p 2)))
(* 0.5 (+ 2 (expt p 3))))))))))

(define (quartic-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(linear-ease
direction
(cond
((eq? direction 'in)
(expt percent 4))
((eq? direction 'out)
(let ((p (- percent 1)))
(- 1 (expt p 4))))
((eq? direction 'inout)
(let ((p (* percent 2)))
(if (< p 1)
(* 0.5 (expt p 4))
(let ((p (- p 2)))
(* -0.5 (- (expt p 4) 2)))))))))

(define (quintic-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(linear-ease
direction
(cond
((eq? direction 'in)
(expt percent 5))
((eq? direction 'out)
(let ((p (- percent 1)))
(+ 1 (expt p 5))))
((eq? direction 'inout)
(let ((p (* percent 2)))
(if (< p 1)
(* 0.5 (expt p 5))
(let ((p (- p 2)))
(* 0.5 (+ (expt p 5) 2)))))))))

(define (sinusoidal-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(define pi 3.14159265358979)
(linear-ease
direction
(cond
((eq? direction 'in)
(- 1 (cos (* percent pi 0.5))))
((eq? direction 'out)
(sin (* percent pi 0.5)))
((eq? direction 'inout)
(* 0.5 (- 1 (cos (* pi percent))))))))

(define (exponential-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(linear-ease
direction
(cond
((eq? direction 'in)
(if (= percent 0)
0
(expt 1024 (- percent 1))))
((eq? direction 'out)
(if (= percent 1)
1
(- 1 (expt 2 (* -10 percent)))))
((eq? direction 'inout)
(cond
((= percent 0) 0)
((= percent 1) 1)
((< (* percent 2) 1)
(* 0.5 (expt 1024 (- (* percent 2) 1))))
(else
(* 0.5 (- 2 (expt 2 (* -10 (- (* percent 2) 1)))))))))))

(define (circular-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(linear-ease
direction
(cond
((eq? direction 'in)
(- 1 (sqrt (- 1 (expt percent 2)))))
((eq? direction 'out)
(sqrt (- 1 (expt (- percent 1) 2))))
((eq? direction 'inout)
(let ((p (* percent 2)))
(if (< p 1)
(* -0.5 (- (sqrt (- 1 (expt p 2))) 1))
(* 0.5 (+ (sqrt (- 1 (expt (- p 2) 2))) 1))))))))

(define (elastic-ease direction percent #!optional (a 1.0) (p 0.4))
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(define pi 3.14159265358979)
(define invpi (/ 1 pi))
(define invp (/ 1 p))
(define k
(let ((s (if (< a 1)
(/ p 4)
(* p (asin (/ 1 a)) 0.5 invpi)))
(a (if (< a 1) 1 a)))
(cond
((= percent 0) 0)
((= percent 1) 1)
((eq? direction 'in)
(let ((percent (- percent 1)))
(- (* a
(expt 2 (* 10 percent))
(sin (* (- percent s) 2 pi invp))))))
((eq? direction 'out)
(+ (* a
(expt 2 (* -10 percent))
(sin (* (- percent s) 2 pi invp)))
1))
((eq? direction 'inout)
(let ((p (* percent 2)))
(if (< p 1)
(* -0.5 a
(expt 2 (* 10 (- p 1)))
(sin (* (- p 1 s) 2 pi invp)))
(+ 1 (* a 0.5
(expt 2 (* -10 (- p 1)))
(sin (* (- p 1 s) 2 pi invpi))))))))))
(linear-ease
direction
(cond
((< k 0) 0)
((> k 1) 1)
(else k))))

(define (back-ease direction percent #!optional (s 1.70158))
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(define k (cond
((eq? direction 'in)
(* (expt percent 2)
(- (* percent (+ s 1)) s)))
((eq? direction 'out)
(let ((p (- percent 1)))
(+ 1 (* (expt p 2)
(+ s (* p (+ s 1)))))))
((eq? direction 'inout)
(let ((s (* s 1.525))
(p (* percent 2)))
(if (< p 1)
(* 0.5 (* (expt p 2) (- (* p (+ s 1)) s)))
(let ((p (- p 2)))
(* 0.5 (+ 2 (* (expt p 2) (+ s (* p (+ s 1))))))))))))
(linear-ease
direction
(cond
((< k 0) 0)
((> k 1) 1)
(else k))))

(define (bounce-ease direction percent)
(assert (or (eq? direction 'in) (eq? direction 'out) (eq? direction 'inout)))
(define (out p)
(cond
((< p (/ 1 2.75))
(* 7.5625 (expt p 2)))
((< p (/ 2 2.75))
(let ((p (- p (/ 1.5 2.75))))
(+ 0.75 (* 7.5625 (expt p 2)))))
((< p (/ 2.5 2.75))
(let ((p (- p (/ 2.25 2.75))))
(+ 0.9375 (* 7.5625 (expt p 2)))))
(else
(let ((p (- p (/ 2.625 2.75))))
(+ 0.984375 (* 7.5625 (expt p 2)))))))
(define (in p)
(- 1 (out (- 1 p))))
(linear-ease
direction
(cond
((eq? direction 'in)
(in percent))
((eq? direction 'out)
(out percent))
((eq? direction 'inout)
(if (< percent 0.5)
(* 0.5 (in (* percent 2)))
(+ 0.5 (* 0.5 (out (- (* percent 2) 1)))))))))
72 changes: 72 additions & 0 deletions selectors.scm
@@ -0,0 +1,72 @@
(define (linear-select v p)
(define (fn p0 p1 t)
(+ (* (- p1 p0) t) p0))
(define m (- (vector-length v) 1))
(define f (* m p))
(define idx (floor f))
(case
((< p 0) (fn (vector-ref v 0)
(vector-ref v 1)
f))
((> p 1) (fn (vector-ref v m)
(vector-ref v (- m 1))
(- m f)))
(else (fn (vector-ref v idx)
(vector-ref v (if (> (+ idx 1) m) m (+ idx 1)))
(- f idx)))))

(define (bezier-select v p)
(define (fn n i)
(/ (factorial n) (* (factorial i) (factorial (- n i)))))
(define n (vector-length v))
(define (loop i b)
(if (> i n) b
(loop (+ i 1)
(+ b (* (expt (- 1 p) (- n i))
(vector-ref v i)
(fn n i))))))
(loop 0 0))

(define (catmullrom-select v p)
(define (fn p0 p1 p2 p3 t)
(define v0 (* 0.5 (- p2 p0)))
(define v1 (* 0.5 (- p3 p1)))
(define t2 (expt t 2))
(define t3 (expt t 3))
(+ p1
(* v0 t)
(* (- v1 (* 2 v0) (* -3 p2) (* 3 p1)) t2)
(* (+ (* 2 p1) (* -2 p2) v0 v1) t3)))
(define m (- (vector-length v) 1))
(define f (* m p))
(define i (floor f))
(if
(and (= (vector-ref v 0) (vector-ref v m))
(< p 0))
(let* ((f (* m (+ 1 p)))
(i (floor f)))
(fn (vector-ref v (modulo (+ i -1 m) m))
(vector-ref v i)
(vector-ref v (modulo (+ i 1) m))
(vector-ref v (modulo (+ i 2) m))
(- f i)))
(cond
((< p 0) (- (vector-ref v 0)
(fn (vector-ref v 0)
(vector-ref v 0)
(vector-ref v 1)
(vector-ref v 1)
(- f))
(vector-ref v 0)))
((> p 1) (- (vector-ref v m)
(fn (vector-ref v m)
(vector-ref v m)
(vector-ref v (- m 1))
(vector-ref v (- m 1))
(- f m))
(vector-ref v m)))
(else (fn (vector-ref v (if (< 0 i) (- i 1) 0))
(vector-ref v i)
(vector-ref v (if (< m (+ i 1)) m (+ i 1)))
(vector-ref v (if (< m (+ i 2)) m (+ i 2)))
(- f i))))))

0 comments on commit 1004445

Please sign in to comment.