The Fran project has been carried out jointly by Microsoft Research and the Yale Haskell Project. Currently Fran runs under the Microsoft Windows '95/NT systems. This is research in progress; it is very likely that Fran will continue to change in the near future. We have tested all of the examples distributed with Fran but there are sure to be bugs in the current system. Please report any problems to fran-bugs@haskell.org. This document is associated with version 0.9 of Fran, distributed with Hugs 1.4. Newer versions of Fran will appear at http://www.research.microsoft.com/~conal/Fran. Information about the this version of Fran, including manuals and more animations, is at http://haskell.org/fran.
This manual contains a short tutorial on Fran and an overview of the pre-defined functions available in Fran. A more detailed Fran tutorial is also included in the file tutorial.lhs.
We assume readers of this manual have a basic knowledge of Haskell. All of the examples used in this manual are found in the hugs/lib/fran/demos/examples.hs. If you are unfamiliar with Fran, the best way to use this manual is to open (double click) examples.hs in the hugs/lib/fran/demos directory. Each example here can be executed using the run function. Typing run 1 executes the first example. The animation window may be initially hidden when you first run an animation -- just click it on the task bar to make it visible. Terminate the animation by closing the animation window. Experimenting with these examples is encouraged. Make a separate copy of examples.lhs if you want to keep the original set of examples. Exit Hugs using :q when you are done. If you encounter a program error while an animation is running you may need to exit and restart Hugs. Running main () displays all of the examples in sequence. Use the spacebar to go to the next example and the `B' key to go back to the previous example.
Since behaviors change over time, a behavior must be `played':
that is, the user watches (or listens to) an object as it changes
and reacts to input. Fran includes a graphics library for
constructing animations that are played in a window on the screen.
Full details of this library are presented later; here we will introduce
just enough of it so that we can explore behaviors. Here is a small
graphics library:
-- Basic data types
data Image -- data type of images
data Color -- data type of colors
type RealVal = Double
type Time = Double
data Point2 = Point2XY RealVal RealVal -- a 2D point
-- synonyms for common behavioral types
type RealB = Behavior RealVal
type ColorB = Behavior Color
type ImageB = Behavior Image
type Point2B = Behavior Point2
type TimeB = Behavior Time
-- Graphics operations
-- A behavioral point constructor
point2XY :: RealB -> RealB -> Point2B -- Construct a 2D point
origin2 :: RealB -- The origin (maps to screen center)
circle :: ImageB -- A circle at (0,0) with unit radius
withColor :: ColorB -> ImageB -> ImageB -- Paint with a solid color
move :: Point2B -> ImageB -> ImageB -- Move an image
red, blue,green :: ColorB -- Some built-in colors
over :: ImageB -> ImageB -> ImageB -- Place one image over another
bigger :: RealB -> ImageB -> ImageB -- Enlarge (or reduce) the
-- size of an image
-- Display routine. Initial screen scaled to (-1,-1) , (1,1)
disp :: (Time -> ImageB) -> IO () -- display an image behavior
Rather than clutter up type signatures with the Behavior type
constructor, many types have pre-defined synonyms for their behavioral
counterparts. The type declarations above show some of these
synonyms.
The argument to disp needs a little explanation: disp is a function
that takes the time at which the animation starts and returns an
image. For now, we don't need to use this initial time so we'll
ignore it. Here is a very simple program to display a pulsing
circle:
module Main where
import Fran -- Basic Fran functionality
circ :: ImageB
circ = bigger (sin time) (withColor red circle)
example1 t = circ
Programs using Fran must import the module Fran, which should be on the
standard hugs search path.
The run function displays a selected examples from this manual. To display
the first animation, type run 1 to hugs. You can also run the
example directly using disp example1.
The wiggle function, as defined earlier, could also be used here.
Here is a slightly more complex behavior:
ball1, ball2, movingBall1, movingBall2 :: ImageB
ball1 = bigger 0.3 (withColor red circle)
movingBall1 = move (point2XY 0 wiggle) ball1
ball2 = bigger 0.4 (withColor blue circle)
movingBall2 = move (point2XY wiggle 0) ball2
example2 t = movingBall1 `over` movingBall2
Numeric constants are valid behaviors, hence, 0.3 can be used as a
RealB argument to bigger.
Events may occur in streams. For example, a mouse button generates an
event every time it is pressed. The stream of
events generated by typing "test" at the keyboard can be represented
by this list:
[(3,'t'), (4.5,'e'), (5.2, 's'), (6, 't')]
This stream records both what was typed and when the individual events
happened.
To identify a particular event in a stream of events, Fran uses an
initial event time to select the first event in the stream
after that time. In the previous example, there are many keyboard
events but, given a specific time, the `next event' after that time is
well defined. The primitives which define external events such as
mouse clicks or key presses use a time parameter to identify
the specific event of interest. Here is the lbp function:
lbp :: Time -> Event (Event ())
This selects the first left button press event at or after the given
time. The lbp event returns another event as its value: the release event
which occurs when the button is released.
Event times are used to direct the flow of events in a Fran program. You will notice many such time parameters in a typical program. Ongoing research may eliminate the need for explicit control of event sequencing.
The Time argument to the mouse function needs explanation. Just
as a time can be used to select an event from an series of events,
this time parameter determines at what global time the mouse will
start tracking. More generally, many behaviors require a time
parameter to synchronize them with the outside world. A value of type
b :: Time -> Behavior T1
describes a behavior that depends on outside events or
behaviors starting at a particular time. Behaviors or events which
represent or use external stimuli such as the mouse or keyboard will
commonly take a time argument.
Recall that the argument to the disp function takes a similar argument:
disp :: (Time -> ImageB) -> IO ()
The disp function passes the time at which the animation starts into
the animation it displays. This
is, in fact, the time argument needed by mouse. In this example,
the ball follows the mouse:
example3 t = move (mouse t) ball1
These are built-in events:
lbp,rbp :: Time -> Event (Event ()) -- Mouse button presses
lbr,rbr :: Time -> Event () -- Mouse button releases
keyPress :: Time -> Event (Char, Event ()) -- keyboard input
As with mouse, these events all take a time parameter which selects
a particular event from among the stream of events associated with a
device. The character returned by keyPress is not be a standard
character but an encoding of a physical key on the keyboard. Keys
like `shift' are passed directly into the animation instead of
modifying other keys.
The lbp (left button press) and rbp (right button press) events are triggered by the mouse button. When they occur, they return the associated button release event. These release events, rbr and lbr, can also be referenced directly. The keyboard is similar except that keyboard presses yield a Char as well as a release event.
Events and behaviors may be combined in a number of interesting ways: a behavior may react to an event; a predicate over behaviors may define an event. This section presents the basic Fran functions which build events and behaviors.
The untilB function defines a behavior which becomes another
behavior when an event occurs:
untilB :: Behavior a -> Event (Behavior a) -> Behavior a
The event returns a new behavior which is used after the event
occurs.
Before we can write a reactive Fran program, we need an event
which returns a behavior. None of the built-in events do:
we need another primitive to accomplish this. The +=>
operator filters the output of an event through a function:
(+=>) :: Event a -> (Time -> a -> b) -> Event b
The event ev +=> f occurs exactly when ev occurs. Its value is
f eventTime eventValue, where eventTime and eventValue are the
time and value of ev's occurrence.
The event time is important since it may be used to select events which
follow the one which has just occured.
These functions are small variations on +=>:
(==>) :: Event a -> (a -> b) -> Event b
(*=>) :: Event a -> (Time -> b) -> Event b
(-=>) :: Event a -> b -> Event b
ev ==> f = ev +=> \ _ v -> f v -- ignore event time
ev *=> f = ev +=> \ t _ -> f t -- ignore event value
ev -=> x = ev +=> \ _ _ -> x -- ignore event time and value
We're now ready to create some reactive animations. First, we
use the left button on the mouse to change the color of a circle:
color4 :: Time -> ColorB
color4 t = red `untilB` lbp t -=> green
example4 t = withColor (color4 t) circle
Once the left button is pressed the color remains green thereafter --
there is no further reactivity in this behavior.
Note that the starting time of the animation is passed to lbp. This
selects the next button press event after the animation commences.
To make the circle toggle color between red and green
upon each left button click, we can use a cyclic representation:
color5 :: Time -> ColorB
color5 t = red `untilB` lbp t *=>
(\t' -> green `untilB` lbp t' *=> color5)
example5 t = withColor (color5 t) circle
Note that the time returned at each event occurance is passed to the
next event. This assures that each left button press event is
successor to the previous one.
This behavioral structure can be lifted into a function:
toggle :: Time -> Behavior a -> Behavior a -> Behavior a
toggle t v1 v2 = v1 `untilB` lbp t *=> (\t' -> toggle t' v2 v1)
ball61 t = withColor (toggle t red green) (bigger 0.4 circle)
ball62 t = withColor (toggle t green red) (bigger 0.6 circle)
example6 t = ball61 t `over` ball62 t
Both circles are toggled by the same mouse clicks: an event may be
seen by many behaviors.
Events are combined using the .|. operator:
(.|.) :: Event a -> Event a -> Event a
This chooses the earlier of two events. In this example, the color of
the ball is changed by either the left or the right mouse button:
color7 :: Time -> ColorB
color7 t = red `untilB` ((lbp t *=>
(\t' -> green `untilB` lbp t' *=> color7))
.|.
(rbp t *=>
(\t' -> blue `untilB` rbp t' *=> color7)))
example7 t = withColor (color7 t) circle
The fixities of untilB, *=>, and .|. allow most of the
parenthesis to be omitted in this example. The use of .|. and *=>
is similar to a case statement.
A very useful operation on behaviors is integration. Both
reals and vectors can be integrated. The function:
integral :: VectorSpace v => Behavior v -> Time -> Behavior v
performs numerical integration of a behavior, starting at a given
time. Integrals are very useful for modelling the physical world.
Here is a falling ball:
gravity8 :: RealB
gravity8 = -0.1
velocity8, position8 :: Time -> RealB
velocity8 t0 = integral gravity8 t0
position8 t0 = integral (velocity8 t0) t0
example8 t = withColor red (moveXY 0 (position8 t) (bigger 0.1 circle))
Mutually recursive integrals are allowed.
At the moment an event occurs, the current value of a behavior can be
captured in a "snapshot" of a behavior's value at that point in
time. The snapshot function combines and event and a behavior into
a new event which caputures the behavior:
snapshot :: Event a -> Behavior b -> Event (a,b)
This program captures the mouse position when the left button is
pressed and moves the ball to that position:
p9 :: Time -> Point2B -> Point2B
p9 t p = p `untilB` lbp t `snapshot` (mouse t) +=>
\t' (_,p') -> p9 t' (constantB p')
-- A more terse style:
-- p9 t p = p `untilB` lbp t `snapshot` (mouse t) ==> snd +=> p9
example9 t = withColor red (move (p9 t origin2) (bigger 0.1 circle))
A time transform allows the user to transform local time-frames.
It has the following type.
timeTransform :: Behavior a -> Behavior Time -> Behavior a
That is, timeTransform b1 tb yields a new behavior of b2, such that
the only difference from b1 is that b2 is evaluated in a transformed
time-frame according to behavior tb. A time transformation example:
-- A circling ball, r = radius, c = color
cball r c = withColor c (moveXY (r*sin time) (r*cos time)
(bigger 0.1 circle))
-- using polar form would be perhaps clearer:
-- cball r c = withColor c (move (vector2Polar r time) (bigger 0.1 circle))
example10 t = cball 0.5 red `over`
(cball 0.7 blue `timeTransform` (2*time)) `over`
(cball 0.9 green `timeTransform` (time + wiggle))
Besides the external events, there are also internal events,
as expressed by using the predicate construct:
predicate :: Behavior Bool -> Time -> Event ()
Given a behavior of Bool, say b, and some time t, predicate
yields an event that reflects the moment when b becomes True after
time t. In this example, a predicate is used to change bounce the
ball when it hits the floor:
gravity11 :: RealB
gravity11 = -0.6
velocity11 :: Time -> RealB -> RealB
velocity11 t0 v0 = v0 + integral gravity11 t0
-- Assume floor is at y = -1
position11 :: Time -> RealB -> RealB -> RealB
position11 t0 x0 v0 = p where
v = velocity11 t0 v0
p = x0 + integral v t0 `untilB`
predicate (p <* (-1)) t0 `snapshot` v +=>
\t' (_,v') -> position11 t' (-1) (constantB (-v' * 0.9))
-- Bounces with only 0.9 of the velocity each time
example11 t = withColor red (moveXY 0 (position11 t 0 (-0.1))
(bigger 0.1 circle))
This version of Fran has an alternate function, predicate', which uses
interval analysis rather than continuous sampling to implement this
construct. It is much more efficient but is not defined in some
situations. A runtime error occurs when predicate' cannot be
used because the necessary support for interval analysis has not
yet been implemented; when these errors occur predicate should be
used instead.
The renaming required by && can sometimes be avoided using type
classes. For example, an instance declaration such as the following
instance Num a => Num (Behavior a)
allows all of the methods in Num to be applied directly to behaviors
without renaming. Constant types in the class definition cannot be
lifted by such a declaration. In the Num instance
above, the type of fromInteger is
fromInteger :: Num a => Integer -> (Behavior a)
The argument to fromInteger is not lifted - only the result. This
allows integer constants to be treated as constant behaviors. While
fromInteger works in the expected way, other class methods cannot be
used. In the declaration
instance Ord a => Ord (Behavior a)
is not useful since it defines operations such as
(>) :: Behavior a -> Behavior a -> Bool
Unfortunately, Fran needs a > function which returns Behavior Bool
instance of just Bool. The Eq and Ord classes are not lifted
using instance declarations. Rather, each method is individually
renamed and lifted.
Many Prelude functions have been lifted in Fran; see Section
8 for a complete list.
In composing an image, several other data types are also needed.
The following data types are defined for this purpose: Vector2B (two
dimensional vectors) , Point2B (two dimensional points),
Font, TextB (a string coupled with a font), ColorB, and
Transform2B. These are the basic data types used:
type RealVal = Double
type Time = Double
type Length = RealVal
type Radians = RealVal
type Fraction = RealVal -- 0 to 1 (inclusive)
type Scalar = Double
These operations on points and vectors are self-explanatory
origin2 :: Point2B
point2XY :: RealB -> RealB -> Point2B
point2Polar :: Behavior Length -> Behavior Radians -> Point2B
point2XYCoords :: Point2B -> Behavior (RealVal, RealVal)
point2PolarCoords :: Point2B -> Behavior (Radians, Length )
distance2 :: Point2B -> Point2B -> Behavior Length
distance2Squared :: Point2B -> Point2B -> Behavior Length
linearInterpolate2 :: Point2B -> Point2B -> RealB -> Point2B
(.+^) :: Point2B -> Vector2B -> Point2B
(.-^) :: Point2B -> Vector2B -> Point2B
(.-.) :: Point2B -> Point2B -> Vector2B
xVector2, yVector2 :: Vector2B -- unit vectors
vector2XY :: RealB -> RealB -> Vector2B
vector2Polar :: Behavior Length -> Behavior Radians -> Vector2B
vector2XYCoords :: Vector2B -> Behavior (RealVal, RealVal)
vector2PolarCoords :: Vector2B -> Behavior (Length, Radians)
Note that vectors and points have distinct types. You cannot use + to
add a point to a vector. Vectors are a member of the Num class
while points are not; thus + works with vectors but not points.
Although it is in class Num, the * operator cannot be used for
vectors.
Read the `.' in the operators above as `point' and `^' as `vector'. Thus .+^ means `point plus vector'.
The type Transformation2B represents geometric transformation on
images, points, or vectors. The basic transformations are
translation, rotation, and scaling. Complex transformations are
created by composing basic transformations using compose2.
These are the transformation operations:
identity2 :: Transform2B
rotate2 :: RealB -> Transform2B
compose2 :: Transform2B -> Transform2B -> Transform2B
inverse2 :: Transform2B -> Transform2B
translate2 :: Translateable2 a => Behavior a -> Transform2B
scale2 :: Scaleable2 a => Behavior a -> Transform2B
uscale2 :: RealB -> Transform2B
(*%) :: Transformable2 a => Transform2B -> Behavior a -> Behavior a
The contexts used in these signatures merit further explanation. The
Translateable class includes values which define a translation. Both
Point2 and Vector2 are members of this class. The Scaleable
class contains objects which define scaling transforms. Typically,
this is RealVal, which scales the x and y component of an object by
the same factor. The Vector2 type scales the x and y components
independently. The uscale2 function (for uniform scale) is the same
a scale2 restricted to RealVal.
A transformation which doubles the size of an object and then rotates it 90 degrees would be rotate2 (pi/2) `compose2` uscale2 2. Note that the first transform applied is the one on the right, as with Haskell's function composition operator (.).
Transformations are applied to objects using *%. The class Transformable2 contains types which may be transformed - normally images but also points and vectors.
Fonts are defined as follows:
data Font = Font {
family :: Family,
isBold :: Bool,
isItalic :: Bool}
data Family = System | TimesRoman | Courier | Arial | Symbol
data TextT = TextT Font String
type TextB = BBehavior TextT
simpleText :: StringB -> TextB
boldT :: TextB -> TextB
italicT :: TextB -> TextB
textFont :: Font -> TextB -> TextB
The simpleText function creates a text object using a default font.
The other operators transform text objects by changing their font.
These functions define Fran colors:
rgb :: FractionB -> FractionB -> FractionB -> ColorB
hsl :: FractionB -> FractionB -> FractionB -> ColorB
gray :: FractionB -> ColorB
stronger :: FractionB -> ColorB -> ColorB
duller :: FractionB -> ColorB -> ColorB
darker :: FractionB -> ColorB -> ColorB
brighter :: FractionB -> ColorB -> ColorB
shade :: FractionB -> ColorB -> ColorB
interpolateColor :: ColorB -> ColorB -> RealB -> ColorB
white, black, red, green, blue :: ColorB
lightBlue, royalBlue, yellow, brown :: ColorB
The Fraction type is a synonym for RealVal, with the intention that
its values be between zero and one inclusive.
The withColor
function, defined later, paints an object with a color. Both the red,
green, blue and hue, saturation, lightness color models are supported.
With the above supporting data types, we can work on images. Images
are constructed by these functions:
emptyImage :: ImageB
line :: Point2B -> Point2B -> ImageB
polyline :: [Point2B] -> ImageB
bezier :: Point2B -> Point2B -> Point2B -> Point2B -> ImageB
circle :: ImageB -- Center (0,0) radius 1
square :: ImageB -- Within unit circle
polygon :: [Point2B] -> ImageB
ellipse :: Vector2B -> ImageB
rectangle :: Vector2B -> ImageB
star :: IntB -> IntB -> ImageB
regularPolygon :: IntB -> ImageB
squareMin :: Point2B -- upper right of square in unit circle
squareMax :: Point2B -- lower left of square in unit circle
circleRadius :: RealB -- radius of unit cirle
renderedText :: TextB -> ImageB -- Height is about 0.1
importBitmap :: String -> ImageB -- String is file name
bitmap :: Vector2 -> HBITMAP -> ImageB -- HBITMAP is in Win32.hs
over :: ImageB -> ImageB -> ImageB
bboxed2 :: Point2B -> Point2B -> ImageB -> ImageB
unitBBoxed2 :: ImageB -> ImageB
withColor :: ColorB -> ImageB -> ImageB
pick2 :: ImageB -> Point2B -> BoolB
Most of these operations are self-explanitory. The line,
polyline, and bezier functions form lines and curves of a fixed
system-determined width. Polygon filling uses a odd-even rule to
determine whether a region is inside the polygon (try star 7 3 to
see this behavior). All but the bitmaps are painted with a solid
color, as selected by withColor. Most of these objects are
centered at the origin. Text is centered just below the origin.
Bitmaps are centered at the origin and are displayed actual size unless scaled. Bitmaps must be stored in .bmp files. The bitmap function is useful only if the primitives defined in the Win32 library are used to construct HBITMAP values. Bitmaps are rectangular and do not support transparancy.
The bounding box functions, bboxed2 and unitBBoxed2, assert a
bounding box around an image. If the bounding box is too small (1
pixel) the image will not be displayed. This is used to cut off
infinite images. For example, in
im12 = unitBBoxed2 (moveXY 0.5 0.5 (bigger 0.3 circle)
`over` moveXY (wiggle/4) 0 (bigger 0.5 im12))
example12 t = withColor red im12
the bounding box prevents an infinite loop in the display routine.
The pick2 predicate determines whether a point is within an object. It is currently limited to a subset of images: circles, squares, and bitmaps and transformations of these images.
These are the basic 2D vector operations:
xVector2, yVector2 :: Vector2B
vector2XY :: RealB -> RealB -> Vector2B
vector2Polar :: Behavior Length -> Behavior Radians -> Vector2B
vector2XYCoords :: Vector2B -> Behavior (RealVal, RealVal)
vector2PolarCoords :: Vector2B -> Behavior (Length, Radians)
Type Vector2B is a member of the Num class, although only the
additive operators, + and -, are defined.
The Vector2B type as well as the scalar numeric types (Float and
Double) are the class VectorSpace. The following operations are
generalized to arbitrary vector spaces.
zeroVector :: VectorSpace v => Behavior v
(^+^) :: VectorSpace v => Behavior v -> Behavior v -> Behavior v
(^-^) :: VectorSpace v => Behavior v -> Behavior v -> Behavior v
(*^) :: VectorSpace v => ScalarB -> Behavior v -> Behavior v
(^/) :: VectorSpace v => Behavior v -> ScalarB -> Behavior v
dot :: VectorSpace v => Behavior v -> Behavior v -> ScalarB
magnitude :: VectorSpace v => Behavior v -> ScalarB
magnitudeSquared :: VectorSpace v => Behavior v -> ScalarB
normalize :: VectorSpace v => Behavior v -> Behavior v
The *^ operator multiplies a scalar and a vector; the /^ operator
divides a vector by a scalar. The normalize function returns a vector
of unit magnitude with the same orientation.
Text operators:
simpleText :: StringB -> TextB -- Uses a default font
boldT :: TextB -> TextB -- changes font characteristics
italicT :: TextB -> TextB
textFont :: Font -> TextB -> TextB
Image operators:
emptyImage :: ImageB
line :: Point2B -> Point2B -> ImageB
polyline :: [Point2B] -> ImageB
bezier :: Point2B -> Point2B -> Point2B -> Point2B -> ImageB
circle :: ImageB -- Center (0,0) radius 1
square :: ImageB -- Within unit circle
polygon :: [Point2B] -> ImageB
ellipse :: Vector2B -> ImageB
rectangle :: Vector2B -> ImageB
star :: IntB -> IntB -> ImageB
regularPolygon :: IntB -> ImageB
squareMin :: Point2B -- upper right of square in unit circle
squareMax :: Point2B -- lower left of square in unit circle
circleRadius :: RealB -- radius of unit cirle
renderedText :: TextB -> ImageB -- Height is about 0.1
importBitmap :: String -> ImageB -- String is file name
bitmap :: Vector2 -> HBITMAP -> ImageB -- HBITMAP is in Win32.hs
over :: ImageB -> ImageB -> ImageB
bboxed2 :: Point2B -> Point2B -> ImageB -> ImageB
unitBBoxed2 :: ImageB -> ImageB
withColor :: ColorB -> ImageB -> ImageB
pick2 :: ImageB -> Point2B -> BoolB
The following overloaded functions operate as expected on behaviors:
(+) :: Num a => Behavior a -> Behavior a -> Behavior a
(*) :: Num a => Behavior a -> Behavior a -> Behavior a
negate :: Num a => Behavior a -> Behavior a
abs :: Num a => Behavior a -> Behavior a
fromInteger :: Num a => Integer -> Behavior a
fromInt :: Num a => Int -> Behavior a
quot :: Integral a => Behavior a -> Behavior a -> Behavior a
rem :: Integral a => Behavior a -> Behavior a -> Behavior a
div :: Integral a => Behavior a -> Behavior a -> Behavior a
mod :: Integral a => Behavior a -> Behavior a -> Behavior a
quotRem :: Integral a => Behavior a -> Behavior a ->
(Behavior a, Behavior a)
divMod :: Integral a => Behavior a -> Behavior a ->
(Behavior a, Behavior a)
fromDouble :: Fractional a => Double -> Behavior a
fromRational :: Fractional a => Rational -> Behavior a
(/) :: Fractional a => Behavior a -> Behavior a -> Behavior a
sin :: Floating a => Behavior a -> Behavior a
cos :: Floating a => Behavior a -> Behavior a
tan :: Floating a => Behavior a -> Behavior a
asin :: Floating a => Behavior a -> Behavior a
acos :: Floating a => Behavior a -> Behavior a
atan :: Floating a => Behavior a -> Behavior a
sinh :: Floating a => Behavior a -> Behavior a
cosh :: Floating a => Behavior a -> Behavior a
tanh :: Floating a => Behavior a -> Behavior a
asinh :: Floating a => Behavior a -> Behavior a
acosh :: Floating a => Behavior a -> Behavior a
atanh :: Floating a => Behavior a -> Behavior a
pi :: Floating a => Behavior a
exp :: Floating a => Behavior a -> Behavior a
log :: Floating a => Behavior a -> Behavior a
sqrt :: Floating a => Behavior a -> Behavior a
(**) :: Floating a => Behavior a -> Behavior a -> Behavior a
logBase :: Floating a => Behavior a -> Behavior a -> Behavior a
These operations correspond to functions which cannot be overloaded
for behaviors. The convention is to use the B suffix for vars and a
* suffix for ops.
fromIntegerB :: Num a => IntegerB -> Behavior a
toRationalB :: Real a => Behavior a -> Behavior Rational
toIntegerB :: Integral a => Behavior a -> IntegerB
evenB, oddB :: Integral a => Behavior a -> BoolB
toIntB :: Integral a => Behavior a -> IntB
properFractionB :: (RealFrac a, Integral b) => Behavior a -> Behavior (b,a)
truncateB :: (RealFrac a, Integral b) => Behavior a -> Behavior b
roundB :: (RealFrac a, Integral b) => Behavior a -> Behavior b
ceilingB :: (RealFrac a, Integral b) => Behavior a -> Behavior b
floorB :: (RealFrac a, Integral b) => Behavior a -> Behavior b
(^*) :: (Num a, Integral b) =>
Behavior a -> Behavior b -> Behavior a
(^^*) :: (Fractional a, Integral b) =>
Behavior a -> Behavior b -> Behavior a
(==*) :: Eq a => Behavior a -> Behavior a -> BoolB
(/=*) :: Eq a => Behavior a -> Behavior a -> BoolB
(<*) :: Ord a => Behavior a -> Behavior a -> BoolB
(<=) :: Ord a => Behavior a -> Behavior a -> BoolB
(>=*) :: Ord a => Behavior a -> Behavior a -> BoolB
(>*) :: Ord a => Behavior a -> Behavior a -> BoolB
cond :: BoolB -> Behavior a -> Behavior a -> Behavior a
notB :: BoolB -> BoolB
(&&*) :: BoolB -> BoolB -> BoolB
(||*) :: BoolB -> BoolB -> BoolB
pairB :: Behavior a -> Behavior b -> Behavior (a,b)
fstB :: Behavior (a,b) -> Behavior a
sndB :: Behavior (a,b) -> Behavior b
pairBSplit :: Behavior (a,b) -> (Behavior a, Behavior b)
nilB :: Behavior [a]
consB :: Behavior a -> Behavior [b] -> Behavior [b]
headB :: Behavior [a] -> Behavior a
tailB :: Behavior [a] -> Behavior [a]
lift1 :: (a -> b) ->
Behavior a -> Behavior b
lift2 :: (a -> b -> c) ->
Behavior a -> Behavior b -> Behavior c
lift3 :: (a -> b -> c -> d) ->
Behavior a -> Behavior b -> Behavior c -> Behavior d
lift4 :: (a -> b -> c -> d -> e) ->
Behavior a -> Behavior b -> Behavior c -> Behavior d -> Behavior e
liftLs :: [Behavior a] -> Behavior [a]
These behaviors are defined by Fran:
time :: TimeB
mouse :: Time -> Point2B
viewSize :: Time -> Vector2B -- size of viewing window
fps :: Time -> Behavior Double -- current frame rate
These events are defined by Fran:
lbp :: Time -> Event (Event ()) -- left mouse press
rbp :: Time -> Event (Event ()) -- right mouse press
lbr :: Time -> Event () -- left mouse release
rbr :: Time -> Event () -- right mouse release
keyPress :: Time -> Event (Char, Event ()) -- returns release event
constEvent :: Time -> a -> Event a
neverEvent :: Event a
Basic event and behavior operations:
untilB :: Behavior a -> Event (Behavior a) -> Behavior a
(+=>) :: Event a -> (Time -> a -> b) -> Event b
(==>) :: Event a -> (a -> b) -> Event b
(*=>) :: Event a -> (Time -> b) -> Event b
(-=>) :: Event a -> b -> Event b
(+>>=) :: Event a -> (Time -> a -> Event b) -> Event b
(.|.) :: Event a -> Event a -> Event a
suchThat :: (Time -> Event a) -> (a -> Bool) -> Time -> Event a
filterEv :: (Time -> Event a) -> (a -> Maybe b) -> Time -> Event b
timeIs :: Time -> Event ()
joinEvent :: Event (Event a) -> Event a
snapshot :: Event a -> Behavior b -> Event (a,b)
predicate :: BoolB -> Time -> Event ()
predicate' :: BoolB -> Time -> Event () -- faster but not fully implemented
integral :: VectorSpace v =>
Behavior v -> Time -> Behavior v
timeTransform :: Behavior a -> TimeB -> Behavior a
The driver to display animations:
disp :: (Time -> ImageB) -> IO ()