| Copyright | (c) 2011 Brent Yorgey | 
|---|---|
| License | BSD-style (see LICENSE) | 
| Maintainer | byorgey@cis.upenn.edu | 
| Safe Haskell | None | 
| Language | Haskell2010 | 
Data.Active
Contents
Description
Inspired by the work of Kevin Matlage and Andy Gill (Every
 Animation Should Have a Beginning, a Middle, and an End, Trends
 in Functional Programming,
 2010. http://ittc.ku.edu/csdl/fpg/node/46), this module defines a
 simple abstraction for working with time-varying values.  A value
 of type Active a is either a constant value of type a, or a
 time-varying value of type a (i.e. a function from time to
 a) with specific start and end times.  Since active values
 have start and end times, they can be aligned, sequenced,
 stretched, or reversed.
In a sense, this is sort of like a stripped-down version of functional reactive programming (FRP), without the reactivity.
The original motivating use for this library is to support making animations with the diagrams framework (http://projects.haskell.org/diagrams), but the hope is that it may find more general utility.
There are two basic ways to create an Active value.  The first is
 to use mkActive to create one directly, by specifying a start and
 end time and a function of time.  More indirectly, one can use the
 Applicative instance together with the unit interval ui, which
 takes on values from the unit interval from time 0 to time 1, or
 interval, which creates an active over an arbitrary interval.
For example, to create a value of type Active Double which
 represents one period of a sine wave starting at time 0 and ending
 at time 1, we could write
mkActive 0 1 (\t -> sin (fromTime t * tau))
or
(sin . (*tau)) <$> ui
pure can also be used to create Active values which are
 constant and have no start or end time.  For example,
mod <$> (floor <$> interval 0 100) <*> pure 7
cycles repeatedly through the numbers 0-6.
Note that the "idiom bracket" notation supported by the SHE
 preprocessor (http://personal.cis.strath.ac.uk/~conor/pub/she/,
 http://hackage.haskell.org/package/she) can make for somewhat
 more readable Applicative code.  For example, the above example
 can be rewritten using SHE as
{-# OPTIONS_GHC -F -pgmF she #-}
... (| mod (| floor (interval 0 100) |) ~7 |)There are many functions for transforming and composing active values; see the documentation below for more details.
With careful handling, this module should be suitable to generating
 deep embeddings if Active values.
- data Time n
 - toTime :: n -> Time n
 - fromTime :: Time n -> n
 - data Duration n
 - toDuration :: n -> Duration n
 - fromDuration :: Duration n -> n
 - data Era n
 - mkEra :: Time n -> Time n -> Era n
 - start :: Era n -> Time n
 - end :: Era n -> Time n
 - duration :: Num n => Era n -> Duration n
 - data Dynamic a = Dynamic {}
 - mkDynamic :: Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
 - onDynamic :: (Time Rational -> Time Rational -> (Time Rational -> a) -> b) -> Dynamic a -> b
 - shiftDynamic :: Duration Rational -> Dynamic a -> Dynamic a
 - data Active a
 - mkActive :: Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
 - fromDynamic :: Dynamic a -> Active a
 - isConstant :: Active a -> Bool
 - isDynamic :: Active a -> Bool
 - onActive :: (a -> b) -> (Dynamic a -> b) -> Active a -> b
 - modActive :: (a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
 - runActive :: Active a -> Time Rational -> a
 - activeEra :: Active a -> Maybe (Era Rational)
 - setEra :: Era Rational -> Active a -> Active a
 - atTime :: Time Rational -> Active a -> Active a
 - activeStart :: Active a -> a
 - activeEnd :: Active a -> a
 - ui :: Fractional a => Active a
 - interval :: Fractional a => Time Rational -> Time Rational -> Active a
 - stretch :: Rational -> Active a -> Active a
 - stretchTo :: Duration Rational -> Active a -> Active a
 - during :: Active a -> Active a -> Active a
 - shift :: Duration Rational -> Active a -> Active a
 - backwards :: Active a -> Active a
 - snapshot :: Time Rational -> Active a -> Active a
 - clamp :: Active a -> Active a
 - clampBefore :: Active a -> Active a
 - clampAfter :: Active a -> Active a
 - trim :: Monoid a => Active a -> Active a
 - trimBefore :: Monoid a => Active a -> Active a
 - trimAfter :: Monoid a => Active a -> Active a
 - after :: Active a -> Active a -> Active a
 - (->>) :: Semigroup a => Active a -> Active a -> Active a
 - (|>>) :: Active a -> Active a -> Active a
 - movie :: [Active a] -> Active a
 - discrete :: [a] -> Active a
 - simulate :: Rational -> Active a -> [a]
 
Representing time
Time and duration
An abstract type for representing points in time.  Note that
   literal numeric values may be used as Times, thanks to the the
   Num and Fractional instances.
Instances
| Functor Time Source | |
| Affine Time Source | |
| Enum n => Enum (Time n) Source | |
| Eq n => Eq (Time n) Source | |
| Fractional n => Fractional (Time n) Source | |
| Num n => Num (Time n) Source | |
| Ord n => Ord (Time n) Source | |
| Read n => Read (Time n) Source | |
| Real n => Real (Time n) Source | |
| RealFrac n => RealFrac (Time n) Source | |
| Show n => Show (Time n) Source | |
| Wrapped (Time n) Source | |
| (~) * (Time n1) t0 => Rewrapped (Time n) t Source | |
| type Diff Time = Duration Source | |
| type Unwrapped (Time n0) = n0 Source | 
An abstract type representing elapsed time between two points
   in time.  Note that durations can be negative. Literal numeric
   values may be used as Durations thanks to the Num and
   Fractional instances.
Instances
| Functor Duration Source | |
| Applicative Duration Source | |
| Additive Duration Source | |
| Enum n => Enum (Duration n) Source | |
| Eq n => Eq (Duration n) Source | |
| Fractional n => Fractional (Duration n) Source | |
| Num n => Num (Duration n) Source | |
| Ord n => Ord (Duration n) Source | |
| Read n => Read (Duration n) Source | |
| Real n => Real (Duration n) Source | |
| RealFrac n => RealFrac (Duration n) Source | |
| Show n => Show (Duration n) Source | |
| Num n => Monoid (Duration n) Source | |
| Num n => Semigroup (Duration n) Source | |
| Wrapped (Duration n) Source | |
| (~) * (Duration n1) t0 => Rewrapped (Duration n) t Source | |
| type Unwrapped (Duration n0) = n0 Source | 
toDuration :: n -> Duration n Source
A convenient wrapper function to convert a numeric value into a duration.
fromDuration :: Duration n -> n Source
A convenient unwrapper function to turn a duration into a numeric value.
Eras
An Era is a concrete span of time, that is, a pair of times
   representing the start and end of the era. Eras form a
   semigroup: the combination of two Eras is the smallest Era
   which contains both.  They do not form a Monoid, since there is
   no Era which acts as the identity with respect to this
   combining operation.
Era is abstract. To construct Era values, use mkEra; to
   deconstruct, use start and end.
Dynamic values
A Dynamic a can be thought of as an a value that changes over
   the course of a particular Era.  It's envisioned that Dynamic
   will be mostly an internal implementation detail and that
   Active will be most commonly used.  But you never know what
   uses people might find for things.
Instances
| Functor Dynamic Source | |
| Apply Dynamic Source | 
  | 
| Semigroup a => Semigroup (Dynamic a) Source | 
  | 
mkDynamic :: Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a Source
Create a Dynamic from a start time, an end time, and a
   time-varying value.
onDynamic :: (Time Rational -> Time Rational -> (Time Rational -> a) -> b) -> Dynamic a -> b Source
Fold for Dynamic.
shiftDynamic :: Duration Rational -> Dynamic a -> Dynamic a Source
Shift a Dynamic value by a certain duration.
Active values
For working with time-varying values, it is convenient to have an
 Applicative instance: <*> lets us apply time-varying
 functions to time-varying values; pure allows treating constants
 as time-varying values which do not vary.  However, as explained in
 its documentation, Dynamic cannot be made an instance of
 Applicative since there is no way to implement pure.  The
 problem is that all Dynamic values must have a finite start and
 end time.  The solution is to adjoin a special constructor for
 pure/constant values with no start or end time, giving us Active.
There are two types of Active values:
- An 
Activecan simply be aDynamic, that is, a time-varying value with start and end times. - An 
Activevalue can also be a constant: a single value, constant across time, with no start and end times. 
The addition of constant values enable Monoid and Applicative
   instances for Active.
Instances
| Functor Active Source | |
| Applicative Active Source | |
| Apply Active Source | |
| (Monoid a, Semigroup a) => Monoid (Active a) Source | |
| Semigroup a => Semigroup (Active a) Source | Active values over a type with a   | 
| Wrapped (Active a) Source | |
| (~) * (Active a1) t0 => Rewrapped (Active a) t Source | |
| type Unwrapped (Active a0) = MaybeApply Dynamic a0 Source | 
mkActive :: Time Rational -> Time Rational -> (Time Rational -> a) -> Active a Source
Create a dynamic Active from a start time, an end time, and a
   time-varying value.
isConstant :: Active a -> Bool Source
Test whether an Active value is constant.
modActive :: (a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b Source
Modify an Active value using a case analysis to see whether it
   is constant or dynamic.
runActive :: Active a -> Time Rational -> a Source
Interpret an Active value as a function from time.
atTime :: Time Rational -> Active a -> Active a Source
atTime t a is an active value with the same behavior as a,
   shifted so that it starts at time t.  If a is constant it is
   returned unchanged.
activeStart :: Active a -> a Source
Get the value of an Active a at the beginning of its era.
Combinators
Special active values
ui :: Fractional a => Active a Source
ui represents the unit interval, which takes on the value t
   at time t, and has as its era [0,1]. It is equivalent to
   , and can be visualized as follows:interval 0 1
On the x-axis is time, and the value that ui takes on is on the
   y-axis.  The shaded portion represents the era.  Note that the
   value of ui (as with any active) is still defined outside its
   era, and this can make a difference when it is combined with
   other active values with different eras.  Applying a function
   with fmap affects all values, both inside and outside the era.
   To manipulate values outside the era specifically, see clamp
   and trim.
To alter the values that ui takes on without altering its
   era, use its Functor and Applicative instances.  For example,
   (*2) <$> ui varies from 0 to 2 over the era [0,1].  To
   alter the era, you can use stretch or shift.
interval :: Fractional a => Time Rational -> Time Rational -> Active a Source
interval a b is an active value starting at time a, ending at
   time b, and taking the value t at time t.
Transforming active values
stretch :: Rational -> Active a -> Active a Source
stretch s act "stretches" the active act so that it takes
   s times as long (retaining the same start time).
shift :: Duration Rational -> Active a -> Active a Source
shift d act shifts the start time of act by duration d.
   Has no effect on constant values.
backwards :: Active a -> Active a Source
Reverse an active value so the start of its era gets mapped to
   the end and vice versa.  For example, backwards  can be
   visualized asui
snapshot :: Time Rational -> Active a -> Active a Source
Take a "snapshot" of an active value at a particular time, resulting in a constant value.
Working with values outside the era
clamp :: Active a -> Active a Source
"Clamp" an active value so that it is constant before and after
   its era.  Before the era, clamp a takes on the value of a at
   the start of the era.  Likewise, after the era, clamp a takes
   on the value of a at the end of the era. clamp has no effect
   on constant values.
For example, clamp  can be visualized asui
See also clampBefore and clampAfter, which clamp only before
   or after the era, respectively.
clampBefore :: Active a -> Active a Source
clampAfter :: Active a -> Active a Source
trim :: Monoid a => Active a -> Active a Source
"Trim" an active value so that it is empty outside its era.
   trim has no effect on constant values.
For example, trim  can be visualized asui
Actually, trim ui is not well-typed, since it is not guaranteed
   that ui's values will be monoidal (and usually they won't be)!
   But the above image still provides a good intuitive idea of what
   trim is doing. To make this precise we could consider something
   like trim (First . Just $ ui).
See also trimBefore and trimActive, which trim only before or
   after the era, respectively.
trimBefore :: Monoid a => Active a -> Active a Source
Composing active values
after :: Active a -> Active a -> Active a Source
a1 `after` a2 produces an active that behaves like a1 but is
   shifted to start at the end time of a2.  If either a1 or a2
   are constant, a1 is returned unchanged.
movie :: [Active a] -> Active a Source
Splice together a list of active values using |>>.  The list
   must be nonempty.
Discretization
discrete :: [a] -> Active a Source
Create an Active which takes on each value in the given list in
   turn during the time [0,1], with each value getting an equal
   amount of time.  In other words, discrete creates a "slide
   show" that starts at time 0 and ends at time 1.  The first
   element is used prior to time 0, and the last element is used
   after time 1.
It is an error to call discrete on the empty list.
simulate :: Rational -> Active a -> [a] Source
simulate r act simulates the Active value act, returning a
   list of "snapshots" taken at regular intervals from the start
   time to the end time.  The interval used is determined by the
   rate r, which denotes the "frame rate", that is, the number
   of snapshots per unit time.
If the Active value is constant (and thus has no start or end
   times), a list of length 1 is returned, containing the constant
   value.