packages feed

reflex-animation 0.1 → 0.1.1

raw patch · 6 files changed

+116/−37 lines, 6 filesdep +bifunctors

Dependencies added: bifunctors

Files

+ .gitignore view
@@ -0,0 +1,15 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#+.cabal-sandbox+cabal.sandbox.config
+ .travis.yml view
@@ -0,0 +1,29 @@+sudo: false+cache:+  directories:+    - $HOME/hlint+before_install:+ - travis_retry cabal-$CABALVER update+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/happy/1.19.5/bin:/opt/alex/3.1.4/bin:~/hlint/bin:$PATH+ - travis/install-hlint.sh+install:+ - cabal-$CABALVER sandbox init+ - git clone -b develop https://github.com/ryantrinkle/reflex reflex+ - cabal-$CABALVER sandbox add-source $PWD/reflex+ - cabal-$CABALVER install -v --only-dependencies --enable-tests --enable-benchmarks -j++script:+ - travis/script.sh+ - hlint src++matrix:+  allow_failures:+   - env: CABALVER=head GHCVER=head +  include:+    - env: CABALVER=1.18 GHCVER=7.8.4+      addons: {apt: {packages: [cabal-install-1.18, ghc-7.8.4, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.22 GHCVER=7.10.1+      addons: {apt: {packages: [cabal-install-1.22, ghc-7.10.1, alex-3.1.4, happy-1.19.5],sources: [hvr-ghc]}}+    - env: CABALVER=head GHCVER=head+      addons: {apt: {packages: [cabal-install-head, ghc-head, alex-3.1.4, happy-1.19.5],  sources: [hvr-ghc]}}+  fast_finish: true
+ README.md view
@@ -0,0 +1,8 @@+reflex-animation [![Build Status](https://secure.travis-ci.org/Saulzar/reflex-animation.png?branch=master)](http://travis-ci.org/Saulzar/reflex-animation)+====================+++This package provides a set of functions for creating and playing continuous animations of the form Time -> a.+Finite animations (with a length) and infinite animations complement one another, we chose a representation of +finite animations which has only a length (and not a starting point) to keep things simple. If needed such animations+can be converted to infinite animations, combined, and clipped as required
reflex-animation.cabal view
@@ -1,5 +1,5 @@ name:                reflex-animation-version:             0.1+version:             0.1.1 synopsis:            Continuous animations support for reflex description:         This package provides a set of functions for creating and playing continuous animations of the form Time -> a.                      Finite animations (with a length) and infinite animations complement one another, we chose a representation of @@ -18,13 +18,16 @@ build-type:          Simple cabal-version:       >=1.10 -+extra-source-files:+  .gitignore+  .travis.yml+  README.md  +   source-repository head   type: git   location: https://github.com/saulzar/reflex-animation.git  - library   exposed-modules:     Reflex.Animation                        Reflex.Monad.Time@@ -35,7 +38,8 @@                        vector-space,                        semigroups >= 0.16 && < 0.18,                        profunctors,-                       containers+                       containers,+                       bifunctors    default-extensions:     FlexibleInstances@@ -47,6 +51,7 @@     GeneralizedNewtypeDeriving     MultiParamTypeClasses     RecursiveDo+    ConstraintKinds     ScopedTypeVariables                           hs-source-dirs:      src
src/Reflex/Animation.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-}  module Reflex.Animation@@ -11,8 +10,9 @@   , sampleClip   , toMaybe   , stretchTo+  , apply -  , section+  , crop   , clamped    , repeat@@ -20,28 +20,34 @@    , cropEnd   , cropStart-  , crop+  , reCrop    , linear   , linearIn   , linearOut   , piecewise+   +   , keyframes+  , keyframesWith   +  , half+  , sine+  , cosine+     )      where  import Control.Applicative -import Data.Bifunctor import Data.Profunctor import Data.Semigroup  import Data.VectorSpace- import Data.List.NonEmpty (NonEmpty(..))+import Data.Functor  import Data.Maybe import Data.Map.Strict (Map)@@ -50,7 +56,10 @@ import Prelude hiding (repeat, replicate)  --- | Infinite animations  'time -> a'+-- | Infinite animations time -> a. Supports operations:+-- * Mapping over either time or the value using the Functor/Profunctor(lmap, rmap)+-- * Combined in parallel with other infinite animations using Applicative/Monad+-- * Turned into a finite animation by 'crop' newtype Animation time a = Animation { sampleAt :: time -> a }            deriving (Functor, Applicative, Monad, Profunctor)                      @@ -63,7 +72,14 @@ delayed t = lmap (subtract t)  --- | Infinite animations, Animation with a period  +-- | Finite animations, Animation with a period. Supports operations:+-- * Combined end-to end using Semigroup instance, e.g. 'sconcat'+-- * Combined with Infinite animations with 'apply'+-- * Turned into Inifinite animations by either: +--   > Clamping time - 'clamped' +--   > Using Maybe - 'toMaybe'+--   > Repeating - 'repeat'+-- * Futher cropped in various ways data Clip time a = Clip { clipAnim :: Animation time a, period :: time }  instance Functor (Clip time) where@@ -72,12 +88,12 @@       instance (Num time, Ord time) => Semigroup (Clip time a) where-  clip <> clip'           = piecewise [clip, clip']-  sconcat (clip :| clips) = piecewise (clip : clips)+  c <> c'           = piecewise [c, c']+  sconcat (c :| cs) = piecewise (c : cs)  -- | Constructor for clips to simplify creation clip :: (time -> a) -> time -> Clip time a-clip anim p = Clip (Animation anim) p+clip anim = Clip (Animation anim)   apply :: Clip time (a -> b) -> Animation time a -> Clip time b apply (Clip anim p) a = Clip (anim <*> a) p@@ -86,18 +102,18 @@   -- | Take a section of an infinite animation as a Clip-section :: (Ord time, Num time) => (time, time) -> Animation time a -> Clip time a-section (s, e) a = Clip (lmap (+s) a) (s - e)+crop :: (Ord time, Num time) => (time, time) -> Animation time a -> Clip time a+crop (s, e) a = Clip (lmap (+s) a) (s - e)   -- | Sample from a clip, returning Nothing outside the domain sampleClip :: (Ord time, Num time) => Clip time a -> time -> Maybe a-sampleClip clip t | t >= 0 && t <= period clip = Just $ sampleAt (clipAnim clip) t +sampleClip c t | t >= 0 && t <= period c = Just $ sampleAt (clipAnim c) t                  | otherwise    = Nothing           -- | Turn a clip into an infinite Animation by using Maybe toMaybe :: (Ord time, Num time) => Clip time a -> Animation time (Maybe a)-toMaybe clip = Animation (sampleClip clip)+toMaybe c = Animation (sampleClip c)     -- | Make an infinite animation by clamping time to lie within the period@@ -120,8 +136,8 @@  -- | Stretch a clip to a specific size by scaling time stretchTo :: (RealFrac time)  => time -> Clip time a -> Clip time a-stretchTo p clip = Clip (lmap (* factor) (clipAnim clip)) p-  where factor = period clip / p +stretchTo p c = Clip (lmap (* factor) (clipAnim c)) p+  where factor = period c / p    @@ -136,12 +152,12 @@   where s' = clamp (0, p) s  -- | Crop the clip to a range-crop ::  (Ord time, Num time) => (time, time) -> Clip time a -> Clip time a-crop (s, e) = cropStart s . cropEnd e +reCrop ::  (Ord time, Num time) => (time, time) -> Clip time a -> Clip time a+reCrop (s, e) = cropStart s . cropEnd e   -- | Crop the clip to half the period half :: (RealFrac time) => Clip time a -> Clip time a-half clip = cropStart (0.5 * period clip) clip+half c = cropStart (0.5 * period c) c   @@ -152,16 +168,20 @@    - intervalsWith ::  (RealFrac time) => Interpolater time a -> a -> [(time, a)] -> [Clip time a]-intervalsWith interp start []     = [clip (const start) 0]+intervalsWith _ start []     = error "intervalsWith: empty list" intervalsWith interp start frames = zipWith toInterval ((0, start) : frames) frames   where toInterval (_, k) (p, k') = interp p (k, k')    +  +-- | Keyframes using an interpolator between intervals (e.g. 'linear') keyframesWith ::  (RealFrac time) => Interpolater time a -> a -> [(time, a)] -> Clip time a keyframesWith interp start frames  =  piecewise $ intervalsWith interp start frames  +-- | Keyframer using linear interpolation+-- Specified as pairs of (value, interval)+-- First key is provided separately and always starts at time = 0 keyframes :: (VectorSpace v, RealFrac (Scalar v)) =>  v -> [(Scalar v, v)] -> Clip (Scalar v) v keyframes = keyframesWith linear  @@ -169,7 +189,8 @@ sampleInterval start m t = sampleAt anim0 (t - t0) where   (t0, anim0) = fromMaybe (0, start) (Map.lookupLT t m)   -  +-- | Piecewise animation using several clips concatenated end to end, +-- one playing after the other, equivalent to 'sconcat'. piecewise :: (Ord time, Num time) => [Clip time a] -> Clip time a piecewise []    = error "piecewise: empty list" piecewise [a]   = a@@ -181,11 +202,13 @@   -- | Predefined clips based on special functions for building up animations linearIn ::  (RealFrac time) => time -> Clip time time-linearIn p = clip (\t -> t / p) p+linearIn p | p <= 0.0  = error "linearIn: time must be >= 0"+           | otherwise = clip (/ p) p   linearOut ::  (RealFrac time) => time -> Clip time time-linearOut p = clip (\t -> 1.0 - t / p) p +linearOut p | p <= 0    = error "linearOut: time must be >= 0"+            | otherwise = clip (\t -> 1.0 - t / p) p   sine :: (RealFrac time, Floating time) => time -> Clip time time sine p = stretchTo p (clip sin pi)@@ -198,14 +221,10 @@ fmod :: RealFrac a => a -> a -> a fmod x d | x > 0 || frac == 0 =  frac * d          | otherwise          = (frac + 1) * d-  where frac = snd $ properFraction (x / d)+  where (_::Int, frac) = properFraction (x / d)                  -fDivMod :: RealFrac a => a -> a -> (a, a)-fDivMod x d | x > 0 || frac == 0 =  (fromIntegral n, frac * d)-            | otherwise          =  (fromIntegral n, (frac + 1) * d)-  where (n, frac) = properFraction (x / d)-        +           clamp :: Ord a => (a, a) -> a -> a clamp (lower, upper) a = max lower (min upper a)
src/Reflex/Monad/Time.hs view
@@ -29,6 +29,9 @@ import Reflex  import Data.VectorSpace+import Data.Functor+import Control.Applicative+ import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty) @@ -68,20 +71,20 @@     sampleOn :: (Reflex t, RealFrac time) => Event t (time -> a) -> Behavior t time -> Event t (Behavior t a) sampleOn e t = attachWith startAt t e where-  startAt start f = f . (subtract start) <$> t+  startAt start f = f . subtract start <$> t          animateOn :: (Reflex t, RealFrac time) => Event t (Animation time a) -> Behavior t time -> Event t (Behavior t a)-animateOn e t = sampleOn (sampleAt <$> e) t+animateOn e = sampleOn (sampleAt <$> e)   fromNow ::  MonadTime t time m => m (Behavior t time) fromNow = do   time  <- getTime   start <- sample time-  return $ (subtract start <$> time)+  return (subtract start <$> time)   playClip :: MonadTime t time m =>  Clip time a ->  m (Behavior t (Maybe a), Event t ())