Fran Users Manual
John Peterson
Gary Shu Ling
Yale Haskell Project

1  Introduction

Fran (Function Reactive Animation) is a collection of data types and functions for composing interactive multimedia animations. It is implemented in Haskell and runs under Hugs 1.4, the Haskell User's Gofer System.

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.

2  Behaviors

The key concepts in Fran are behaviors and events. A behavior is a value of any type which varies over time. In Fran, a value of type Behavior T is a time-varying value of type T. Behaviors are similar to functions over time: the type Behavior T is very similar to Time -> T, where Time is a synonym for Double, the type is used to represent the current time. For example, this behavior oscilates between -1 and 1:

wiggle :: Behavior Double
wiggle = sin (pi * time)

This definition of wiggle relies on a built-in behavior: time. Note that the sin and (+)functions are being applied to behaviors instead of ordinary numeric values. This works because Fran supplies an instance of the Behavior type for many built-in classes. Much more will be said of this later.

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.

3  Events

Events allow behaviors to interact with their surroundings. An event can be either external, such as a mouse click, or internal, as defined by a predicate over behaviors. When an event occurs (happens) it generates a value that can be used by behaviors. This is similar to the I/O monad in which each action returns a value. In Fran, the type Event T describes an event that generates a value of type T. Events that do not generate interesting values have type Event (). The type Event T is similar to (Time,T): that is, a pair containing the time when the event occurs (if ever) and the value it produces.

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.

4  Basic Events and Behaviours

These are some of the basic behaviors built into Fran:

constantB       ::   a -> Behavior a
time            ::   TimeB
mouse           ::   Time -> Point2B

Any Haskell value can be converted to a constant behavior using constantB. As mentioned earlier, numeric constants need not be explicitly converted as they are overloaded for behavioral types. The time behavior, as used previously, is not `wall clock' time: behaviors have a localized idea of time. The mouse behavior defines the current mouse position. Type Point2 is used by the graphics system for points in two-dimensional space. The graphics operators are described in Section 8.4.

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.

5  Combining Events and Behaviors

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.

6  Lifting

We say a type or function which has been raised from the domain of ordinary Haskell values to behaviors is "lifted". For example, a function such as

(&&)   ::    Bool -> Bool -> Bool

can be promoted to a corresponding function over behaviors:

(&&*)   ::    BoolB -> BoolB -> BoolB

The type BoolB is a synonym for Behavior Bool; most commonly used types have a behavioral synonym defined in Fran. The name &&* arises from a simple naming convention in Fran: lifted operators are appended with a * and lifted vars are appended with B.

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.

7  Imaging in Fran

So far, we have explored behaviors and events using a very limited set of imaging primitives. Here we will explore the full set of imaging operators available in Fran. The functions described here are all behavioral - the non-behavioral underlying functions are not usually necessary.

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.

8  Fran Reference

All available Fran functions are listed here. In general, only operations on behaviors are presented here. The underlying system builds behavioral operators on top of ordinary operators which are not exported from Fran internal modules.

8.1  Basic Data Types

These are implemented as synonyms:

type RealVal  = Double
  Classes: Scalable2, VectorSpace
type Time     = Double
type Length   = RealVal
type Radians  = RealVal
type Fraction = RealVal  -- 0 to 1 (inclusive)
type Scalar   = Double

These are the basic types:

data Event a 
  Classes: Functor, Monad, MonadZero, MonadPlus
data Behavior a
  Classes: See below
data Point2  = Point2XY RealVal RealVal
  Classes: Translateable2, Transformable2, 
data Vector2 = Vector2XY RealVal RealVal
  Classes: Translateable2, Transformable2, Scalable2, VectorSpace
data Transform2 

data Font = Font { family   :: Family, isBold   :: Bool, isItalic :: Bool}
data Family = System | TimesRoman | Courier | Arial | Symbol
data TextT = TextT Font String
data Color
data Image
  Classes: transformable2

These are abbreviations for commonly used behavioral types:

type BoolB       = Behavior Bool
type IntB        = Behavior Int
type IntegerB    = Behavior Integer
type RealB       = Behavior RealVal
type FractionB   = Behavior Fraction
type TimeB       = Behavior Time
type ColorB      = Behavior Color
type TextB       = Behavior TextT
type Transform2B = Behavior Transform2
type ImageB      = Behavior Image
type StringB     = Behavior String

8.2  Points and Vectors

These are the basic Point2B operators:

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  
pointPlusVector2    :: Point2B -> Vector2B -> Point2B             
pointMinusVector2   :: Point2B -> Vector2B -> Point2B             
pointMinusPoint2    :: Point2B -> Point2B  -> Vector2B            

Note that Point2B is not a member of Num.

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.

8.3  Transformations

Transformations are defined with the help of the two classes Translateable2, Scaleable2. Types in Translateable2 are mapped onto translations. Vectors and points induce the obvious movement translation . Objects in Scalable2 serve as scaling translations. The RealVal type creates a scale which is uniform in both the x and y component; a Vector2 scales x and y independantly. The class Transformable2 contains types which can be transformed: Image, Point2, and Vector2. These are the translation functions:

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

8.4  Graphics

Color operators:

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

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

8.5  Behaviors and Events

A Haskell value is converted to a behavior using the following function:

constantB :: a -> Behavior a

Converting functions into their behavioral counterparts is harder since Fran may need to be informed about properties of the function being lifted. This topic is beyond the scope of this manual.

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 ()

8.6  Utilities

These are general utilities for creating animations. To make sense of these signatures, try reading Translateable a => a as Vector2B and Transformable2 a => a as ImageB. Function suffixed by XY take x and y coordinates separately instead as a Point2B.

-- move an object to a point
move       ::  (Translateable2 a,Transformable2 b) =>
                   Behavior a -> Behavior b -> Behavior b
moveXY     :: Transformable2 a =>
                RealB -> RealB -> Behavior a -> Behavior a 

-- Multiply size
bigger     :: Transformable2 a => RealB -> Behavior a -> Behavior a
biggerXY   :: Transformable2 a => RealB -> RealB -> Behavior a -> Behavior a 

-- divide size
smaller    :: Transformable2 a => RealB -> Behavior a -> Behavior a
smallerXY  :: Transformable2 a => RealB -> RealB -> Behavior a -> Behavior a 

-- rotate image; fraction (1.0 = 360 degrees) left / right about the origin
turnLeft   :: Transformable2 a => RealB -> Behavior a -> Behavior a 
turnRight  :: Transformable2 a => RealB -> Behavior a -> Behavior a 

-- Oscillates between -1 and 1
wiggle     :: RealB
wiggle     =  sin (pi * time)
-- Ditto, but delayed 0.5 sec
waggle     :: RealB
waggle     = later 0.5 wiggle
-- Wiggles between given min and max, same period
wiggleRange :: RealB -> RealB -> RealB

-- Time transforming of behaviors
later       :: TimeB -> Behavior a -> Behavior a
earlier     :: TimeB -> Behavior a -> Behavior a
faster      :: RealB -> Behavior a -> Behavior a
slower      :: RealB -> Behavior a -> Behavior a

-- String to image conversions
stringIm    :: String -> ImageB
stringBIm   :: StringB -> ImageB

-- Continuous show, rendered into an image (good for debugging)
showIm      :: Show a => Behavior a -> ImageB

-- Synonym for integral
atRate      :: VectorSpace v => Behavior v -> Time -> Behavior v

-- Given an image and a canonical size, stretch the image so that the size
-- maps exactly onto the window view size.

viewStretch :: Vector2B -> Time -> ImageB -> ImageB

8.7  Fixities

All renamed operators like &&* have the same fixity as the original operator.

infixl 1 +>>=                      -- Event binding
infixl 2 .|.                       -- `or' events
infixr 2 ||*                       -- lifted ||

infixl 3 +=>                       -- General event transform
infixl 3 ==>                       -- ignores time
infixl 3 -=>                       -- ignores value
infixl 3 *=>                       -- ignores both event time and value
infixr 3 &&*                       -- lifted &&

infix 4 ==*, <*, <=* , >=*, >*     -- Lifted comparisons
infix 4 .+^, .-^, .-.              -- point / vector addition/subtraction

infixl 6 .+^, .-.                  -- point + vector, point - point
infixl 6 ^+^, ^-^                  -- vector add and subtract

infixr 7 `dot`, *^, ^/             -- scalar * vector, vector / scalar
infixr 7 *%, `compose2`            -- transform *% object

infixr 8  ^*, ^^*                  -- lifted ^, ^^

infixl 9 `snapshot`

8.8  Static Functions

Fran is built on a library of static functions which implement points, vectors, colors, and other Fran objects. While behavioral versions of these functions are usually the only ones necessary, the static (non-behavioral) functions are sometimes needed. The module FranStatic contains all of the static Fran functions and types. By convention, this is imported using
import qualified FranStatic as S
Some function names in FranStatic clash with those in Fran; the qualified import of FranStatic prevents import errors. The static functions are not described in this manual but are easily found in the Fran source code.

9  Known Bugs and Problems

The following problems are known to exist in Fran 0.9: