packages feed

reflex-animation (empty) → 0.1

raw patch · 5 files changed

+435/−0 lines, 5 filesdep +basedep +containersdep +profunctorssetup-changed

Dependencies added: base, containers, profunctors, reflex, reflex-transformers, semigroups, vector-space

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Oliver Batchelor++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jeffrey Rosenbluth nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ reflex-animation.cabal view
@@ -0,0 +1,53 @@+name:                reflex-animation+version:             0.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 +                     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.++homepage:            https://github.com/reflex-animation+bug-reports:         https://github.com/reflex-animation/issues+license:             BSD3+license-file:        LICENSE++author:              Oliver Batchelor+maintainer:          saulzar@gmail.com+copyright:           2015 Oliver Batchelor+category:            FRP+build-type:          Simple+cabal-version:       >=1.10+++source-repository head+  type: git+  location: https://github.com/saulzar/reflex-animation.git++++library+  exposed-modules:     Reflex.Animation+                       Reflex.Monad.Time++  build-depends:       base >=4.6 && <4.9,+                       reflex >=0.2 && <0.4,+                       reflex-transformers >= 0.2,+                       vector-space,+                       semigroups >= 0.16 && < 0.18,+                       profunctors,+                       containers++  default-extensions:+    FlexibleInstances+    TupleSections+    FlexibleContexts+    StandaloneDeriving+    FunctionalDependencies+    TypeFamilies+    GeneralizedNewtypeDeriving+    MultiParamTypeClasses+    RecursiveDo+    ScopedTypeVariables+                       +  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Reflex/Animation.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Reflex.Animation+  ( Animation (..)+    +  , stretched+  , delayed++  , Clip (..)+  , sampleClip+  , toMaybe+  , stretchTo++  , section+  , clamped++  , repeat+  , replicate++  , cropEnd+  , cropStart+  , crop++  , linear+  , linearIn+  , linearOut+  , piecewise++  , keyframes+  +  )+  +  where++import Control.Applicative++import Data.Bifunctor+import Data.Profunctor+import Data.Semigroup++import Data.VectorSpace++import Data.List.NonEmpty (NonEmpty(..))++import Data.Maybe+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map++import Prelude hiding (repeat, replicate)+++-- | Infinite animations  'time -> a'+newtype Animation time a = Animation { sampleAt :: time -> a } +          deriving (Functor, Applicative, Monad, Profunctor) +                    +          ++stretched :: (Num time) => time -> Animation time a -> Animation time a+stretched factor = lmap (* factor)+  +delayed :: (Num time) => time -> Animation time a -> Animation time a+delayed t = lmap (subtract t)+++-- | Infinite animations, Animation with a period  +data Clip time a = Clip { clipAnim :: Animation time a, period :: time }++instance Functor (Clip time) where+  fmap f (Clip anim p) = Clip (f <$> anim) p+  +  +  +instance (Num time, Ord time) => Semigroup (Clip time a) where+  clip <> clip'           = piecewise [clip, clip']+  sconcat (clip :| clips) = piecewise (clip : clips)++-- | Constructor for clips to simplify creation+clip :: (time -> a) -> time -> Clip time a+clip anim p = Clip (Animation anim) p++apply :: Clip time (a -> b) -> Animation time a -> Clip time b+apply (Clip anim p) a = Clip (anim <*> a) p+++++-- | 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)+++-- | 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 +                | 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)++  +-- | Make an infinite animation by clamping time to lie within the period+clamped ::  (Ord time, Num time) => Clip time a -> Animation time a+clamped (Clip anim p) = lmap (clamp (0, p)) anim+++-- | Make an infinite animation by repeating the clip +repeat :: (RealFrac time) => Clip time a -> Animation time a+repeat (Clip anim p) = lmap (`fmod` p) anim+  +  +-- | Repeat a clip a fixed number of times to make a new one  +replicate :: (RealFrac time) => Int -> Clip time a -> Clip time a +replicate n (Clip anim p) = Clip (lmap time anim) (fromIntegral n * p) where+  time t | t < 0                      = 0.0+         | t >= fromIntegral n * p    = p+         | otherwise     = t `fmod` p+++-- | 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 ++++-- | Shorten a clip to a certain period by cropping the end+cropEnd :: (Ord time, Num time) => time -> Clip time a -> Clip time a+cropEnd p' (Clip anim p) = Clip anim (clamp (0, p) p')+++-- | Shorten a clip by cropping the start+cropStart :: (Ord time, Num time) => time -> Clip time a -> Clip time a+cropStart s (Clip anim p) = Clip (lmap (+ s') anim) (p - s')+  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 ++-- | Crop the clip to half the period+half :: (RealFrac time) => Clip time a -> Clip time a+half clip = cropStart (0.5 * period clip) clip++++type Interpolater time a = time -> (a, a) ->  Clip time a++linear :: (VectorSpace v, RealFrac (Scalar v)) => Interpolater (Scalar v) v+linear p (s, e) = clip (\t -> lerp s e (t / p)) p+ ++++intervalsWith ::  (RealFrac time) => Interpolater time a -> a -> [(time, a)] -> [Clip time a]+intervalsWith interp start []     = [clip (const start) 0]+intervalsWith interp start frames = zipWith toInterval ((0, start) : frames) frames+  where toInterval (_, k) (p, k') = interp p (k, k') +  +keyframesWith ::  (RealFrac time) => Interpolater time a -> a -> [(time, a)] -> Clip time a+keyframesWith interp start frames  =  piecewise $ intervalsWith interp start frames+++keyframes :: (VectorSpace v, RealFrac (Scalar v)) =>  v -> [(Scalar v, v)] -> Clip (Scalar v) v+keyframes = keyframesWith linear+ +sampleInterval ::  (Ord time, Num time) => Animation time a -> Map time (Animation time a) -> time -> a+sampleInterval start m t = sampleAt anim0 (t - t0) where+  (t0, anim0) = fromMaybe (0, start) (Map.lookupLT t m)+  +  +piecewise :: (Ord time, Num time) => [Clip time a] -> Clip time a+piecewise []    = error "piecewise: empty list"+piecewise [a]   = a+piecewise clips = clip (sampleInterval start m) (last times) where+  m = Map.fromList (zip times (clipAnim <$> clips))+  times = scanl (+) 0 (period <$> clips)+  start = clipAnim $ head clips+ + +-- | Predefined clips based on special functions for building up animations+linearIn ::  (RealFrac time) => time -> Clip time time+linearIn p = clip (\t -> t / p) p+++linearOut ::  (RealFrac time) => time -> Clip time time+linearOut p = clip (\t -> 1.0 - t / p) p ++sine :: (RealFrac time, Floating time) => time -> Clip time time+sine p = stretchTo p (clip sin pi)++cosine :: (RealFrac time, Floating time) => time -> Clip time time+cosine p = stretchTo p (clip cos pi)+++-- | Utility functions +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)+        +        +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
@@ -0,0 +1,137 @@+module Reflex.Monad.Time +  ( MonadTime (..)++  , observeChanges+  , delay_+  +  , pushFor+  +  , animate+  , animateClip+  , animateOn++  +  , play+  , playClip+  , playClamp+  , playOn+    +  , match+  , matchBy+ +  +  ) where++  +import Reflex.Animation++import Reflex.Monad+import Reflex++import Data.VectorSpace+import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty)+++import Control.Monad++ +  +class (MonadReflex t m, RealFrac time) => MonadTime t time m | m -> t time where+  +  integrate :: (VectorSpace v, Scalar v ~ time) => v -> Behavior t v -> m (Behavior t v)+  observe :: Behavior t a -> m (Event t a)+  +  getTime :: m (Behavior t time)+  +  after :: time -> m (Event t ())+  delay :: Event t (a, time) ->  m (Event t (NonEmpty a))+  ++pushFor ::  Reflex t => Event t a -> (a -> PushM t b) -> Event t b+pushFor = flip pushAlways++++delay_ :: (MonadTime t time m) => Event t time ->  m (Event t ())+delay_ e = void <$> delay (((), ) <$>  e)+    ++-- | Sample a Clip during it's period, outside it's period return Nothing+animateClip :: (Reflex t, RealFrac time) => Clip time a -> Behavior t time -> Behavior t (Maybe a)+animateClip clip = animate $ toMaybe clip++animate :: (Reflex t, RealFrac time) => Animation time a -> Behavior t time -> Behavior t a+animate anim time = sampleAt anim <$> time ++   +   +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+  +++   +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+++fromNow ::  MonadTime t time m => m (Behavior t time)+fromNow = do+  time  <- getTime+  start <- sample time+  return $ (subtract start <$> time)+++playClip :: MonadTime t time m =>  Clip time a ->  m (Behavior t (Maybe a), Event t ())+playClip clip = do+  (b, done) <- playClamp clip+  b' <- switcher (Just <$> b) (constant Nothing <$ done)+  return (b', done)++  +playClamp :: MonadTime t time m =>  Clip time a ->  m (Behavior t a, Event t ())+playClamp clip = do+  b <- play (clamped clip)+  done <- after (period clip)+  return (b, done)  +  +  +  +play :: MonadTime t time m =>  Animation time a ->  m (Behavior t a)+play anim = do+  time <- fromNow+  return (sampleAt anim <$> time)  +  ++  ++playOn :: MonadTime t time m => Event t (Clip time a) ->  m (Behavior t (Maybe a), Event t ())+playOn e = do+  time <- getTime+  done <- delay_ (period <$> e)+  +  b <- hold (constant Nothing) $ +      leftmost [constant Nothing <$ done, fmap Just <$> animateOn (clamped <$> e) time]+  return (join b, done)+  +  +observeChanges :: (Eq a, MonadTime t time m) => Behavior t a -> m (Event t a)+observeChanges b = do+  initial <- sample b+  d <- holdDyn initial =<< observe b+  return (updated $ nubDyn d)  ++++match :: (Reflex t, Eq a) => a -> Event t a -> Event t ()+match a = matchBy (== a)++matchBy :: (Reflex t) => (a -> Bool) -> Event t a -> Event t ()+matchBy f = void . ffilter f  ++++  +