Breakout is one of the simplest test applications that brings up some problems with non-trivial solutions. In particular, there is a circular dependency between the position and the velocity of the ball. The position is the integral of the velocity, while velocity can have instantaneous changes due to collisions, which is a function of the position of the ball and the current state of the field. The field is dynamic, and it also forms a mutual dependency loop with the ball position. On top of these, part of the field (at least if we regard the paddle as part of it) depends on user input, and its effects start propagating in the game state as soon as the ball reaches the level of the paddle.
Elerea lets us express all these circular dependencies in a natural way, by simply referring to the respective signals by their names. User input is also seen as a signal from inside the reactive part, while the imperative framework is given a sink fuction to update it as needed. Type safety is ensured all the way.
Below follows the full source of the example.
> module Main where +> +> import Control.Applicative +> import Control.Concurrent +> import Control.Monad +> import Data.IORef +> import Data.List +> import Data.Maybe +> import FRP.Elerea +> import Graphics.UI.GLFW as GLFW +> import Graphics.Rendering.OpenGL +> +> import Common.Utils +> import Common.Vector +
The dimensions of the ball, which behaves as a rectangle in collision detection, but is drawn as an ellipse.
> ballW = 0.04 +> ballH = 0.04 +
The initial position and velocity of the ball.
> ballPos0 = V 0 (-0.4) +> ballVel0 = V (-0.4) (0.35) +
The dimensions and vertical position of the player.
> playerW = 0.2 +> playerH = 0.03 +> playerY = -fieldH+0.01 +
The dimensions of the field.
> fieldW = 0.8 +> fieldH = 0.5 +
The dimensions of each brick.
> brickW = 0.05 +> brickH = 0.03 +
The starting positions of the bricks. The third element of the triples is the state of the brick. A brick can either be alive or dying. Dying bricks also keep track of their fadeout level.
> data BrickState = Live | Dying Double deriving Eq +> +> brickPos0 = distributeBricks (-0.7) (-0.1) (0.7) (0.4) 18 10 +> where distributeBricks xmin ymin xmax ymax xn yn = [(xmin+xstep*x,ymin+ystep*y,Live) | +> x ← [0..xn-1], y ← [0..yn-1]] +> where xstep = (xmax-xmin-xn*brickW)/(xn-1)+brickW +> ystep = (ymax-ymin-yn*brickH)/(yn-1)+brickH +
The rate at which a brick fades out. The reciprocal of this value gives the fadeout time in seconds.
> brickFade = 0.5 +
The entry point performs some lightweight initialisation, and defines the two user-driven signals: window size and mouse position. The external function creates the signal and the corresponding sink at the same time.
When all is done driveNetwork is invoked. It is not a library function, but part of the tiny Utils module .
> main = do +> -- Creating a window without a depth buffer +> initialize +> openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8] Window +> windowTitle $= "Elerea Breakout" +> +> -- External signals available for the game logic +> (windowSize,windowSizeSink) ← external vnull +> (mousePosition,mousePositionSink) ← external vnull +> +> -- Wrapping up the init phase +> closed ← newIORef False +> windowSizeCallback $= resizeGLScene windowSizeSink +> windowCloseCallback $= writeIORef closed True +> initGL 640 480 +> +> -- All we need to get going is an IO-valued signal and an IO +> -- function to update the external signals +> driveNetwork (breakout mousePosition windowSize) +> (readInput mousePositionSink closed) +> +> -- The inevitable sad ending +> closeWindow +
The breakout function creates a reactive signal that carries the rendering actions to be performed at each instant. The principal signals forming the game logic are the following:
playerX: the position of the player, a direct function of the mouse position;ballPos: the position of the ball given as an integral of its velocity, ballVel;bricks: the collection of live and dying bricks along with collision information.The position and velocity of the ball form a circular dependency, as velocity is changed whenever a collision is detected, which is a function of the position.
The signal carrying the collection of the bricks is obtained by applying a stateful transformation (a transfer function) on the ball position. The state contains the bricks still relevant to the game as well as collision information. Although the latter is technically redundant, it is still worth including here, since it has to be calculated while advancing the state of the bricks, and it is needed elsewhere too.
> breakout mousePos windowSize = renderLevel <$> playerX <*> ballPos <*> (getBricks <$> bricks) +> where +
User-driven player position:
> playerX = adjustPlayerPos <$> mousePos <*> windowSize +> adjustPlayerPos (V x _) (V w _) = min (fieldW-playerW) $ max (-fieldW) $ 2*x/w-1-playerW/2 +
Ball state: position and velocity. Note the use of the latcher: we wrap a signal created by adjustVel in a pure, hence adding another signal layer around it.
> ballPos = integralVec (ballPos0) ballVel +> ballVel = latcher (pure ballVel0) +> (ballCollHorz ||@ ballCollVert ||@ ballCollPlayer) +> (pure <$> (adjustVel <$> ballCollHorz <*> ballCollVert <*> ballCollPlayer <*> +> ballVel <*> ballNewVelX)) +
The adjustVel function calculates a candidate velocity for the next frame given collision information and the current velocity. Even though it would return the current speed if there are no collisions, we rather not evaluate it at all thanks to the latcher. In the end, velocity is not recalculated in each frame.
> adjustVel ch cv cp (V bvx bvy) bvx' = V x y +> where x = (if ch then -1 else 1)*(if cp then bvx'*4 else bvx) +> y = if cv || cp then -bvy else bvy +> ballNewVelX = (getX <$> ballPos)-playerX-pure (playerW/2) +
Collision events are modelled with bool signals that turn true while the ball overlaps the offending surface and approaches it at the same time. Collision response will make sure that the second condition does not hold in the next instant, so there is no need to push these through an edge transfer function.
> ballCollHorz = (getHColl <$> bricks) ||@ (check <$> ballPos <*> ballVel) +> where check (V bx _) (V bvx _) = (bx < -fieldW && bvx < 0) || +> (bx > fieldW-ballW && bvx > 0) +> ballCollVert = (getVColl <$> bricks) ||@ (check <$> ballPos <*> ballVel) +> where check (V bx by) (V _ bvy) = by > fieldH-ballH && bvy > 0 +> ballCollPlayer = check <$> ballPos <*> ballVel <*> playerX +> where check (V bx by) (V _ bvy) px = bvy < 0 && doRectsIntersect bx by ballW ballH +> px playerY playerW playerH +> +
The dynamic list of bricks along with ball-brick collision information, all of which are updated in each frame.
> bricks = transfer (False,False,brickPos0) updateBricks ballPos +> getBricks (_,_,bs) = bs +> getHColl (c,_,_) = c +> getVColl (_,c,_) = c +
Brick updater function: fading and checking collision. We need to do this the traditional way, because Elerea does not provide constructs to deal with collections of signals in the reactive layer, unlike Yampa.
> updateBricks dt (V bx by) (_,_,bricksPrev) = (collHorz,collVert,bricksNext) +> where bricksNext = catMaybes (map evolveBrick (map killBrick bricksDel++bricksRem)) +> (bricksDel,bricksNotHit) = partition classifyBrick bricksPrev +> bricksRem = if by > -fieldH-ballH then bricksNotHit else map killBrick bricksNotHit +> classifyBrick (x,y,s) = s == Live && killed +> where killed = doRectsIntersect bx by ballW ballH x y brickW brickH +> evolveBrick (x,y,Dying a) = if a < fade then Nothing else Just (x,y,Dying (a-fade)) +> where fade = realToFrac dt*brickFade +> evolveBrick b = Just b +> killBrick (x,y,Live) = (x,y,Dying 1) +> killBrick b = b +> collHorz = or collHBricks +> collVert = or (map not collHBricks) +> collHBricks = map isHorz bricksDel +> isHorz (x,y,_) = xDist/brickW > yDist/brickH +> where xDist = abs ((x+brickW/2)-(bx+ballW/2)) +> yDist = abs ((y+brickH/2)-(by+ballH/2)) +
The doRectsIntersect function decides whether two rectangles defined by their top left corners and dimensions overlap.
> doRectsIntersect x1 y1 sx1 sy1 x2 y2 sx2 sy2 = collIV x1 sx1 x2 sx2 && collIV y1 sy1 y2 sy2 +> where collIV p1 s1 p2 s2 = (p1 <= p2 && p2 <= p1+s1) || (p2 <= p1 && p1 <= p2+s2) +
The renderLevel function takes a snapshot of the game and turns it into an IO action that displays this snapshot on the screen. The breakout signal is the time-varying version of this IO action.
> renderLevel playerX (V ballX ballY) bricks = do +> let drawRect x y xs ys = do +> loadIdentity +> renderPrimitive Quads $ do +> vertex $ Vertex3 (x) (y) (0 :: GLfloat) +> vertex $ Vertex3 (x+xs) (y) (0 :: GLfloat) +> vertex $ Vertex3 (x+xs) (y+ys) (0 :: GLfloat) +> vertex $ Vertex3 (x) (y+ys) (0 :: GLfloat) +> drawEllipse x y xs ys n = do +> let xc = x+xs/2 +> yc = y+ys/2 +> loadIdentity +> renderPrimitive TriangleStrip $ forM_ [0..n] $ \i → do +> let a = 2*pi*fromIntegral i/fromIntegral n +> vertex $ Vertex3 (xc+xs/2*sin a) (yc+ys/2*cos a) (0 :: GLfloat) +> vertex $ Vertex3 xc yc (0 :: GLfloat) +> +> clear [ColorBuffer] +> +> color $ Color4 0.2 0.2 0.2 (1 :: GLfloat) +> drawRect (-fieldW) (-fieldH) (fieldW*2) (fieldH*2) +> +> forM_ bricks $ \(x,y,s) → do +> case s of +> Live → color $ Color4 0.8 0.5 0.5 (0.6 :: GLfloat) +> Dying a → color $ Color4 0.9 0.9 0.2 a +> drawRect x y brickW brickH +> +> color $ Color4 1 1 1 (0.6 :: GLfloat) +> drawEllipse ballX ballY ballW ballH 20 +> +> color $ Color4 0.3 0.4 0.8 (0.5 :: GLfloat) +> drawRect playerX playerY playerW playerH +> +> flush +> swapBuffers +
The readInput function has two responsibilities: it provides input for the mousePosition peripheral signal through its associated sink, and also feeds the time difference between two states into the system, deciding when to exit altogether (by returning Nothing instead of the current dt value wrapped in Just).
The threadDelay call at the beginning is just a trick to give the scheduler a breath. It will cause a wait equal to a scheduler tick, which is 20ms by default. The program can run perfectly without it, but it eats up all the free CPU to produce an unnecessarily high frame rate.
> readInput mousePos closed = do +> threadDelay 0 +> t ← get GLFW.time +> GLFW.time $= 0 +> Position x y ← get GLFW.mousePos +> mousePos (V (fromIntegral x) (fromIntegral y)) +> k ← getKey ESC +> c ← readIORef closed +> return (if c || k == Press then Nothing else Just t) +
The initGL function sets up almost nothing, which means that most functionality is turned off. Only alpha blending is enabled to provide some minimalistic eye candy.
> initGL width height = do +> clearColor $= Color4 0 0 0 1 +> blend $= Enabled +> blendFunc $= (SrcAlpha,OneMinusSrcAlpha) +> cullFace $= Just Back +
The resize callback feeds the windowSize signal through its sink besides adjusting the projection matrix.
> resizeGLScene winSize size@(Size w h) = do +> winSize (V (fromIntegral w) (fromIntegral h)) +> +> viewport $= (Position 0 0,size) +> +> matrixMode $= Projection +> loadIdentity +> scale 1 (fromIntegral w/fromIntegral h) (1 :: GLfloat) +> +> matrixMode $= Modelview 0 +
This module contains some functions that might make it into the core library eventually.
> module Common.Utils where +> +> import Control.Applicative +> import Control.Monad +> import FRP.Elerea +> +> import Common.Vector +
The driveNetwork function simply executes the supersteps while the driver function keeps returning valid delta time values.
> driveNetwork network driver = do +> dt ← driver +> case dt of +> Just dt → do join $ superstep network dt +> driveNetwork network driver +> Nothing → return () +
The edge transfer function takes a bool signal and emits another bool signal that turns true only at the moment when there is a rising edge on the input. We are relying on the delay introduced by the transfer primitive for this to work.
> edge b = (transfer False (\dt b _ → not b) b) &&@ b +
A scalar integral function. Since it is based on transfer, it is delayed by one superstep, i.e. the value of the input signal in the nth step affects its output only in the (n+1)th step.
> integral v0 s = transfer v0 (\dt v v0 → v0+v*realToFrac dt) s +
An integral function for two-dimensional vectors defined in the Vector module with the same caveat.
> integralVec v0 s = transfer v0 (\dt v v0 → v0^+^(v^*.realToFrac dt)) s +
Logic relations lifted into signals. Useful to combine event-like signals.
> (||@) :: Signal Bool → Signal Bool → Signal Bool +> (||@) = liftA2 (||) +> +> (&&@) :: Signal Bool → Signal Bool → Signal Bool +> (&&@) = liftA2 (&&) +
This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type.
> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-} +> +> module Common.Vector where +> +> import Control.Applicative +> import FRP.Elerea +> import Graphics.Rendering.OpenGL +> +> data Vec = V { getX :: !Float, getY :: !Float } +> +> infixl 7 ^*. +> infixl 7 .*^ +> infixl 7 `dot` +> infixl 7 `cross` +> infixl 6 ^+^ +> infixl 6 ^-^ +> +> class Vector2D v c | v → c where +> (^+^) :: v → v → v +> (^-^) :: v → v → v +> (^*.) :: v → c → v +> (.*^) :: c → v → v +> vnull :: v +> dot :: v → v → c +> cross :: v → v → c +> +> instance Vector2D Vec Float where +> V x1 y1 ^+^ V x2 y2 = V (x1+x2) (y1+y2) +> V x1 y1 ^-^ V x2 y2 = V (x1-x2) (y1-y2) +> V x y ^*. t = V (x*t) (y*t) +> t .*^ V x y = V (x*t) (y*t) +> vnull = V 0 0 +> V x1 y1 `dot` V x2 y2 = x1*y1+x2*y2 +> V x1 y1 `cross` V x2 y2 = x1*y2-x2*y1 +> +> instance Vector2D (Signal Vec) (Signal Float) where +> (^+^) = liftA2 (^+^) +> (^-^) = liftA2 (^-^) +> (^*.) = liftA2 (^*.) +> (.*^) = liftA2 (.*^) +> vnull = pure vnull +> dot = liftA2 dot +> cross = liftA2 cross ++ diff --git a/doc/Breakout.png b/doc/Breakout.png new file mode 100644 Binary files /dev/null and b/doc/Breakout.png differ diff --git a/doc/Chase.html b/doc/Chase.html new file mode 100644 --- /dev/null +++ b/doc/Chase.html @@ -0,0 +1,144 @@ +
This is a minimal example to show how to define signals that can be mutually recursive and can optionally depend on user input too. The grey square accelerates towards the red square at a rate proportional to their relative position, and it can be given a momentary impulse with the left mouse button.
For a slightly more complex example check out Breakout.lhs.
> module Main where +> +> import Control.Applicative +> import Data.IORef +> import FRP.Elerea +> import Graphics.UI.GLFW as GLFW +> import Graphics.Rendering.OpenGL +> +> import Common.Utils +> import Common.Vector +
The main function contains the whole reactive logic. Note that driveNetwork is just a wrapper around the superstep function of the core library, and you can see its source below in the Utils module.
> main = do +> initialize +> openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window +> windowTitle $= "Elerea Chase" +> +> (windowSize,windowSizeSink) ← external vnull +> (mousePosition,mousePositionSink) ← external vnull +> (mousePress,mousePressSink) ← external False +> +> closed ← newIORef False +> windowSizeCallback $= resizeGLScene windowSizeSink +> windowCloseCallback $= writeIORef closed True +> initGL 640 480 +> +> let ballPos = integralVec vnull ballVel +> ballVel = latcher (integralVec vnull ballAcc) +> (edge mousePress) +> (integralVec <$> ballVel^+^ballPos^-^mousePosition <*> pure ballAcc) +> ballAcc = (mousePosition^-^ballPos)^*.0.3 +> +> driveNetwork (render <$> windowSize <*> mousePosition <*> ballPos) +> (readInput mousePositionSink mousePressSink closed) +> +> closeWindow +
The render function takes a snapshot of the system (window size and the positions of the squares) and turns it into OpenGL calls. The signal executed by the driveNetwork function is the time-varying version of the IO action returned here.
> render (V w h) (V cx cy) (V ox oy) = do +> let drawSquare x y s = do +> loadIdentity +> translate $ Vector3 (x/w*2-1) (h/w-y/w*2) 0 +> renderPrimitive Quads $ do +> vertex $ Vertex3 (-s) (-s) (0 :: GLfloat) +> vertex $ Vertex3 ( s) (-s) (0 :: GLfloat) +> vertex $ Vertex3 ( s) ( s) (0 :: GLfloat) +> vertex $ Vertex3 (-s) ( s) (0 :: GLfloat) +> +> clear [ColorBuffer] +> +> color $ Color4 1 0 0 (0.5 :: GLfloat) +> drawSquare cx cy 0.05 +> color $ Color4 1 1 1 (0.6 :: GLfloat) +> drawSquare ox oy 0.03 +> +> flush +> swapBuffers +
The readInput function provides the driver layer. It feeds the peripheral-bound signals and also decides when to stop execution by returning Nothing instead of the time elapsed since its last call.
> readInput mousePos mouseBut closed = do +> t ← get GLFW.time +> GLFW.time $= 0 +> Position x y ← get GLFW.mousePos +> mousePos (V (fromIntegral x) (fromIntegral y)) +> b ← GLFW.getMouseButton GLFW.ButtonLeft +> mouseBut (b == GLFW.Press) +> k ← getKey ESC +> c ← readIORef closed +> return (if c || k == Press then Nothing else Just t) +
OpenGL is initialised with practically everything turned off. Only alpha blending is needed to be able to use translucent colours.
> initGL width height = do +> clearColor $= Color4 0 0 0 1 +> blend $= Enabled +> blendFunc $= (SrcAlpha,OneMinusSrcAlpha) +
The window size callback takes care of the windowSize signal and the projection matrix.
> resizeGLScene winSize size@(Size w h) = do +> winSize (V (fromIntegral w) (fromIntegral h)) +> +> viewport $= (Position 0 0,size) +> +> matrixMode $= Projection +> loadIdentity +> scale 1 (fromIntegral w/fromIntegral h) (1 :: GLfloat) +> +> matrixMode $= Modelview 0 +
This module contains some functions that might make it into the core library eventually.
> module Common.Utils where +> +> import Control.Applicative +> import Control.Monad +> import FRP.Elerea +> +> import Common.Vector +
The driveNetwork function simply executes the supersteps while the driver function keeps returning valid delta time values.
> driveNetwork network driver = do +> dt ← driver +> case dt of +> Just dt → do join $ superstep network dt +> driveNetwork network driver +> Nothing → return () +
The edge transfer function takes a bool signal and emits another bool signal that turns true only at the moment when there is a rising edge on the input. We are relying on the delay introduced by the transfer primitive for this to work.
> edge b = (transfer False (\dt b _ → not b) b) &&@ b +
A scalar integral function. Since it is based on transfer, it is delayed by one superstep, i.e. the value of the input signal in the nth step affects its output only in the (n+1)th step.
> integral v0 s = transfer v0 (\dt v v0 → v0+v*realToFrac dt) s +
An integral function for two-dimensional vectors defined in the Vector module with the same caveat.
> integralVec v0 s = transfer v0 (\dt v v0 → v0^+^(v^*.realToFrac dt)) s +
Logic relations lifted into signals. Useful to combine event-like signals.
> (||@) :: Signal Bool → Signal Bool → Signal Bool +> (||@) = liftA2 (||) +> +> (&&@) :: Signal Bool → Signal Bool → Signal Bool +> (&&@) = liftA2 (&&) +
This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type.
> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-} +> +> module Common.Vector where +> +> import Control.Applicative +> import FRP.Elerea +> import Graphics.Rendering.OpenGL +> +> data Vec = V { getX :: !Float, getY :: !Float } +> +> infixl 7 ^*. +> infixl 7 .*^ +> infixl 7 `dot` +> infixl 7 `cross` +> infixl 6 ^+^ +> infixl 6 ^-^ +> +> class Vector2D v c | v → c where +> (^+^) :: v → v → v +> (^-^) :: v → v → v +> (^*.) :: v → c → v +> (.*^) :: c → v → v +> vnull :: v +> dot :: v → v → c +> cross :: v → v → c +> +> instance Vector2D Vec Float where +> V x1 y1 ^+^ V x2 y2 = V (x1+x2) (y1+y2) +> V x1 y1 ^-^ V x2 y2 = V (x1-x2) (y1-y2) +> V x y ^*. t = V (x*t) (y*t) +> t .*^ V x y = V (x*t) (y*t) +> vnull = V 0 0 +> V x1 y1 `dot` V x2 y2 = x1*y1+x2*y2 +> V x1 y1 `cross` V x2 y2 = x1*y2-x2*y1 +> +> instance Vector2D (Signal Vec) (Signal Float) where +> (^+^) = liftA2 (^+^) +> (^-^) = liftA2 (^-^) +> (^*.) = liftA2 (^*.) +> (.*^) = liftA2 (.*^) +> vnull = pure vnull +> dot = liftA2 dot +> cross = liftA2 cross ++ diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,10 @@ +.SUFFIXES: .lhs .html + +PANDOC := pandoc --no-wrap -s -S +HSCOLOUR := HsColour -lit +UNIOPS := sed "s/><-\←->\→ $(notdir $@) diff --git a/doc/hscolour.css b/doc/hscolour.css new file mode 100644 --- /dev/null +++ b/doc/hscolour.css @@ -0,0 +1,11 @@ +.hs-keyword { color: #000; font-weight: bold } + +.hs-keyglyph { color: #033 } + +.hs-varid { color: #00c } + +.hs-varop { color: #990 } + +.hs-conid { color: #080 } + +.hs-comment { color: #a00 } diff --git a/elerea-examples.cabal b/elerea-examples.cabal new file mode 100644 --- /dev/null +++ b/elerea-examples.cabal @@ -0,0 +1,49 @@ +Name: elerea-examples +Version: 0.1.0 +Cabal-Version: >= 1.2 +Synopsis: Example applications for Elerea +Category: reactivity, FRP +Description: + + Example applications for Elerea. They are factored out into their + own package so as to avoid unnecessary dependencies in the + library. Check out the @doc@ directory for the colourful literate + sources. + . + The programs included are the following: + . + * chase: a minimal example that demonstrates reactivity and mutually + recursive signals + . + * breakout: a not too fancy breakout clone + +Author: Patai Gergely +Maintainer: Patai Gergely (patai@iit.bme.hu) +Copyright: (c) 2009, Patai Gergely +License: BSD3 +License-File: LICENSE +Stability: experimental +Build-Type: Simple +Extra-Source-Files: + src/Common/Vector.lhs + src/Common/Utils.lhs + + doc/Breakout.html + doc/Breakout.png + doc/Chase.html + doc/hscolour.css + doc/Makefile + +Executable elerea-breakout + Executable: elerea-breakout + HS-Source-Dirs: src + Main-IS: Breakout.lhs + Build-Depends: base, elerea, OpenGL, GLFW + GHC-Options: -O2 + +Executable elerea-chase + Executable: elerea-chase + HS-Source-Dirs: src + Main-IS: Chase.lhs + Build-Depends: base, elerea, OpenGL, GLFW + GHC-Options: -O2 diff --git a/src/Breakout.lhs b/src/Breakout.lhs new file mode 100644 --- /dev/null +++ b/src/Breakout.lhs @@ -0,0 +1,316 @@ +Elerea Breakout example +======================= + +Breakout is one of the simplest test applications that brings up some +problems with non-trivial solutions. In particular, there is a +circular dependency between the position and the velocity of the ball. +The position is the integral of the velocity, while velocity can have +instantaneous changes due to collisions, which is a function of the +position of the ball and the current state of the field. The field is +dynamic, and it also forms a mutual dependency loop with the ball +position. On top of these, part of the field (at least if we regard +the paddle as part of it) depends on user input, and its effects start +propagating in the game state as soon as the ball reaches the level of +the paddle. + +Elerea lets us express all these circular dependencies in a natural +way, by simply referring to the respective signals by their names. +User input is also seen as a signal from inside the reactive part, +while the imperative framework is given a sink fuction to update it as +needed. Type safety is ensured all the way. + +
+
+Below follows the full source of the example.
+
+> module Main where
+>
+> import Control.Applicative
+> import Control.Concurrent
+> import Control.Monad
+> import Data.IORef
+> import Data.List
+> import Data.Maybe
+> import FRP.Elerea
+> import Graphics.UI.GLFW as GLFW
+> import Graphics.Rendering.OpenGL
+>
+> import Common.Utils
+> import Common.Vector
+
+Global constants
+----------------
+
+The dimensions of the ball, which behaves as a rectangle in collision
+detection, but is drawn as an ellipse.
+
+> ballW = 0.04
+> ballH = 0.04
+
+The initial position and velocity of the ball.
+
+> ballPos0 = V 0 (-0.4)
+> ballVel0 = V (-0.4) (0.35)
+
+The dimensions and vertical position of the player.
+
+> playerW = 0.2
+> playerH = 0.03
+> playerY = -fieldH+0.01
+
+The dimensions of the field.
+
+> fieldW = 0.8
+> fieldH = 0.5
+
+The dimensions of each brick.
+
+> brickW = 0.05
+> brickH = 0.03
+
+The starting positions of the bricks. The third element of the
+triples is the state of the brick. A brick can either be alive or
+dying. Dying bricks also keep track of their fadeout level.
+
+> data BrickState = Live | Dying Double deriving Eq
+>
+> brickPos0 = distributeBricks (-0.7) (-0.1) (0.7) (0.4) 18 10
+> where distributeBricks xmin ymin xmax ymax xn yn = [(xmin+xstep*x,ymin+ystep*y,Live) |
+> x <- [0..xn-1], y <- [0..yn-1]]
+> where xstep = (xmax-xmin-xn*brickW)/(xn-1)+brickW
+> ystep = (ymax-ymin-yn*brickH)/(yn-1)+brickH
+
+The rate at which a brick fades out. The reciprocal of this value
+gives the fadeout time in seconds.
+
+> brickFade = 0.5
+
+Game logic
+----------
+
+The entry point performs some lightweight initialisation, and defines
+the two user-driven signals: window size and mouse position. The
+`external` function creates the signal and the corresponding sink at
+the same time.
+
+When all is done `driveNetwork` is invoked. It is not a library
+function, but part of the tiny `Utils` module .
+
+> main = do
+> -- Creating a window without a depth buffer
+> initialize
+> openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8] Window
+> windowTitle $= "Elerea Breakout"
+>
+> -- External signals available for the game logic
+> (windowSize,windowSizeSink) <- external vnull
+> (mousePosition,mousePositionSink) <- external vnull
+>
+> -- Wrapping up the init phase
+> closed <- newIORef False
+> windowSizeCallback $= resizeGLScene windowSizeSink
+> windowCloseCallback $= writeIORef closed True
+> initGL 640 480
+>
+> -- All we need to get going is an IO-valued signal and an IO
+> -- function to update the external signals
+> driveNetwork (breakout mousePosition windowSize)
+> (readInput mousePositionSink closed)
+>
+> -- The inevitable sad ending
+> closeWindow
+
+The `breakout` function creates a reactive signal that carries the
+rendering actions to be performed at each instant. The principal
+signals forming the game logic are the following:
+
+* `playerX`: the position of the player, a direct function of the
+ mouse position;
+* `ballPos`: the position of the ball given as an integral of its
+ velocity, `ballVel`;
+* `bricks`: the collection of live and dying bricks along with
+ collision information.
+
+The position and velocity of the ball form a circular dependency, as
+velocity is changed whenever a collision is detected, which is a
+function of the position.
+
+The signal carrying the collection of the bricks is obtained by
+applying a stateful transformation (a transfer function) on the ball
+position. The state contains the bricks still relevant to the game as
+well as collision information. Although the latter is technically
+redundant, it is still worth including here, since it has to be
+calculated while advancing the state of the bricks, and it is needed
+elsewhere too.
+
+> breakout mousePos windowSize = renderLevel <$> playerX <*> ballPos <*> (getBricks <$> bricks)
+> where
+
+User-driven player position:
+
+> playerX = adjustPlayerPos <$> mousePos <*> windowSize
+> adjustPlayerPos (V x _) (V w _) = min (fieldW-playerW) $ max (-fieldW) $ 2*x/w-1-playerW/2
+
+Ball state: position and velocity. Note the use of the latcher: we
+wrap a signal created by `adjustVel` in a `pure`, hence adding another
+signal layer around it.
+
+> ballPos = integralVec (ballPos0) ballVel
+> ballVel = latcher (pure ballVel0)
+> (ballCollHorz ||@ ballCollVert ||@ ballCollPlayer)
+> (pure <$> (adjustVel <$> ballCollHorz <*> ballCollVert <*> ballCollPlayer <*>
+> ballVel <*> ballNewVelX))
+
+The `adjustVel` function calculates a candidate velocity for the next
+frame given collision information and the current velocity. Even
+though it would return the current speed if there are no collisions,
+we rather not evaluate it at all thanks to the latcher. In the end,
+velocity is not recalculated in each frame.
+
+> adjustVel ch cv cp (V bvx bvy) bvx' = V x y
+> where x = (if ch then -1 else 1)*(if cp then bvx'*4 else bvx)
+> y = if cv || cp then -bvy else bvy
+> ballNewVelX = (getX <$> ballPos)-playerX-pure (playerW/2)
+
+Collision events are modelled with bool signals that turn true while
+the ball overlaps the offending surface and approaches it at the same
+time. Collision response will make sure that the second condition
+does not hold in the next instant, so there is no need to push these
+through an `edge` transfer function.
+
+> ballCollHorz = (getHColl <$> bricks) ||@ (check <$> ballPos <*> ballVel)
+> where check (V bx _) (V bvx _) = (bx < -fieldW && bvx < 0) ||
+> (bx > fieldW-ballW && bvx > 0)
+> ballCollVert = (getVColl <$> bricks) ||@ (check <$> ballPos <*> ballVel)
+> where check (V bx by) (V _ bvy) = by > fieldH-ballH && bvy > 0
+> ballCollPlayer = check <$> ballPos <*> ballVel <*> playerX
+> where check (V bx by) (V _ bvy) px = bvy < 0 && doRectsIntersect bx by ballW ballH
+> px playerY playerW playerH
+>
+
+The dynamic list of bricks along with ball-brick collision
+information, all of which are updated in each frame.
+
+> bricks = transfer (False,False,brickPos0) updateBricks ballPos
+> getBricks (_,_,bs) = bs
+> getHColl (c,_,_) = c
+> getVColl (_,c,_) = c
+
+Brick updater function: fading and checking collision. We need to do
+this the traditional way, because Elerea does not provide constructs
+to deal with collections of signals in the reactive layer, unlike
+Yampa.
+
+> updateBricks dt (V bx by) (_,_,bricksPrev) = (collHorz,collVert,bricksNext)
+> where bricksNext = catMaybes (map evolveBrick (map killBrick bricksDel++bricksRem))
+> (bricksDel,bricksNotHit) = partition classifyBrick bricksPrev
+> bricksRem = if by > -fieldH-ballH then bricksNotHit else map killBrick bricksNotHit
+> classifyBrick (x,y,s) = s == Live && killed
+> where killed = doRectsIntersect bx by ballW ballH x y brickW brickH
+> evolveBrick (x,y,Dying a) = if a < fade then Nothing else Just (x,y,Dying (a-fade))
+> where fade = realToFrac dt*brickFade
+> evolveBrick b = Just b
+> killBrick (x,y,Live) = (x,y,Dying 1)
+> killBrick b = b
+> collHorz = or collHBricks
+> collVert = or (map not collHBricks)
+> collHBricks = map isHorz bricksDel
+> isHorz (x,y,_) = xDist/brickW > yDist/brickH
+> where xDist = abs ((x+brickW/2)-(bx+ballW/2))
+> yDist = abs ((y+brickH/2)-(by+ballH/2))
+
+The `doRectsIntersect` function decides whether two rectangles defined
+by their top left corners and dimensions overlap.
+
+> doRectsIntersect x1 y1 sx1 sy1 x2 y2 sx2 sy2 = collIV x1 sx1 x2 sx2 && collIV y1 sy1 y2 sy2
+> where collIV p1 s1 p2 s2 = (p1 <= p2 && p2 <= p1+s1) || (p2 <= p1 && p1 <= p2+s2)
+
+The `renderLevel` function takes a snapshot of the game and turns it
+into an IO action that displays this snapshot on the screen. The
+`breakout` signal is the time-varying version of this IO action.
+
+> renderLevel playerX (V ballX ballY) bricks = do
+> let drawRect x y xs ys = do
+> loadIdentity
+> renderPrimitive Quads $ do
+> vertex $ Vertex3 (x) (y) (0 :: GLfloat)
+> vertex $ Vertex3 (x+xs) (y) (0 :: GLfloat)
+> vertex $ Vertex3 (x+xs) (y+ys) (0 :: GLfloat)
+> vertex $ Vertex3 (x) (y+ys) (0 :: GLfloat)
+> drawEllipse x y xs ys n = do
+> let xc = x+xs/2
+> yc = y+ys/2
+> loadIdentity
+> renderPrimitive TriangleStrip $ forM_ [0..n] $ \i -> do
+> let a = 2*pi*fromIntegral i/fromIntegral n
+> vertex $ Vertex3 (xc+xs/2*sin a) (yc+ys/2*cos a) (0 :: GLfloat)
+> vertex $ Vertex3 xc yc (0 :: GLfloat)
+>
+> clear [ColorBuffer]
+>
+> color $ Color4 0.2 0.2 0.2 (1 :: GLfloat)
+> drawRect (-fieldW) (-fieldH) (fieldW*2) (fieldH*2)
+>
+> forM_ bricks $ \(x,y,s) -> do
+> case s of
+> Live -> color $ Color4 0.8 0.5 0.5 (0.6 :: GLfloat)
+> Dying a -> color $ Color4 0.9 0.9 0.2 a
+> drawRect x y brickW brickH
+>
+> color $ Color4 1 1 1 (0.6 :: GLfloat)
+> drawEllipse ballX ballY ballW ballH 20
+>
+> color $ Color4 0.3 0.4 0.8 (0.5 :: GLfloat)
+> drawRect playerX playerY playerW playerH
+>
+> flush
+> swapBuffers
+
+Backend
+-------
+
+The `readInput` function has two responsibilities: it provides input
+for the `mousePosition` peripheral signal through its associated sink,
+and also feeds the time difference between two states into the system,
+deciding when to exit altogether (by returning `Nothing` instead of
+the current `dt` value wrapped in `Just`).
+
+The `threadDelay` call at the beginning is just a trick to give the
+scheduler a breath. It will cause a wait equal to a scheduler tick,
+which is 20ms by default. The program can run perfectly without it,
+but it eats up all the free CPU to produce an unnecessarily high frame
+rate.
+
+> readInput mousePos closed = do
+> threadDelay 0
+> t <- get GLFW.time
+> GLFW.time $= 0
+> Position x y <- get GLFW.mousePos
+> mousePos (V (fromIntegral x) (fromIntegral y))
+> k <- getKey ESC
+> c <- readIORef closed
+> return (if c || k == Press then Nothing else Just t)
+
+The `initGL` function sets up almost nothing, which means that most
+functionality is turned off. Only alpha blending is enabled to
+provide some minimalistic eye candy.
+
+> initGL width height = do
+> clearColor $= Color4 0 0 0 1
+> blend $= Enabled
+> blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+> cullFace $= Just Back
+
+The resize callback feeds the `windowSize` signal through its sink
+besides adjusting the projection matrix.
+
+> resizeGLScene winSize size@(Size w h) = do
+> winSize (V (fromIntegral w) (fromIntegral h))
+>
+> viewport $= (Position 0 0,size)
+>
+> matrixMode $= Projection
+> loadIdentity
+> scale 1 (fromIntegral w/fromIntegral h) (1 :: GLfloat)
+>
+> matrixMode $= Modelview 0
diff --git a/src/Chase.lhs b/src/Chase.lhs
new file mode 100644
--- /dev/null
+++ b/src/Chase.lhs
@@ -0,0 +1,113 @@
+Elerea Chase example
+====================
+
+This is a minimal example to show how to define signals that can be
+mutually recursive and can optionally depend on user input too. The
+grey square accelerates towards the red square at a rate proportional
+to their relative position, and it can be given a momentary impulse
+with the left mouse button.
+
+For a slightly more complex example check out `Breakout.lhs`.
+
+> module Main where
+>
+> import Control.Applicative
+> import Data.IORef
+> import FRP.Elerea
+> import Graphics.UI.GLFW as GLFW
+> import Graphics.Rendering.OpenGL
+>
+> import Common.Utils
+> import Common.Vector
+
+The `main` function contains the whole reactive logic. Note that
+`driveNetwork` is just a wrapper around the `superstep` function of
+the core library, and you can see its source below in the `Utils`
+module.
+
+> main = do
+> initialize
+> openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
+> windowTitle $= "Elerea Chase"
+>
+> (windowSize,windowSizeSink) <- external vnull
+> (mousePosition,mousePositionSink) <- external vnull
+> (mousePress,mousePressSink) <- external False
+>
+> closed <- newIORef False
+> windowSizeCallback $= resizeGLScene windowSizeSink
+> windowCloseCallback $= writeIORef closed True
+> initGL 640 480
+>
+> let ballPos = integralVec vnull ballVel
+> ballVel = latcher (integralVec vnull ballAcc)
+> (edge mousePress)
+> (integralVec <$> ballVel^+^ballPos^-^mousePosition <*> pure ballAcc)
+> ballAcc = (mousePosition^-^ballPos)^*.0.3
+>
+> driveNetwork (render <$> windowSize <*> mousePosition <*> ballPos)
+> (readInput mousePositionSink mousePressSink closed)
+>
+> closeWindow
+
+The `render` function takes a snapshot of the system (window size and
+the positions of the squares) and turns it into OpenGL calls. The
+signal executed by the `driveNetwork` function is the time-varying
+version of the IO action returned here.
+
+> render (V w h) (V cx cy) (V ox oy) = do
+> let drawSquare x y s = do
+> loadIdentity
+> translate $ Vector3 (x/w*2-1) (h/w-y/w*2) 0
+> renderPrimitive Quads $ do
+> vertex $ Vertex3 (-s) (-s) (0 :: GLfloat)
+> vertex $ Vertex3 ( s) (-s) (0 :: GLfloat)
+> vertex $ Vertex3 ( s) ( s) (0 :: GLfloat)
+> vertex $ Vertex3 (-s) ( s) (0 :: GLfloat)
+>
+> clear [ColorBuffer]
+>
+> color $ Color4 1 0 0 (0.5 :: GLfloat)
+> drawSquare cx cy 0.05
+> color $ Color4 1 1 1 (0.6 :: GLfloat)
+> drawSquare ox oy 0.03
+>
+> flush
+> swapBuffers
+
+The `readInput` function provides the driver layer. It feeds the
+peripheral-bound signals and also decides when to stop execution by
+returning `Nothing` instead of the time elapsed since its last call.
+
+> readInput mousePos mouseBut closed = do
+> t <- get GLFW.time
+> GLFW.time $= 0
+> Position x y <- get GLFW.mousePos
+> mousePos (V (fromIntegral x) (fromIntegral y))
+> b <- GLFW.getMouseButton GLFW.ButtonLeft
+> mouseBut (b == GLFW.Press)
+> k <- getKey ESC
+> c <- readIORef closed
+> return (if c || k == Press then Nothing else Just t)
+
+OpenGL is initialised with practically everything turned off. Only
+alpha blending is needed to be able to use translucent colours.
+
+> initGL width height = do
+> clearColor $= Color4 0 0 0 1
+> blend $= Enabled
+> blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+
+The window size callback takes care of the `windowSize` signal and the
+projection matrix.
+
+> resizeGLScene winSize size@(Size w h) = do
+> winSize (V (fromIntegral w) (fromIntegral h))
+>
+> viewport $= (Position 0 0,size)
+>
+> matrixMode $= Projection
+> loadIdentity
+> scale 1 (fromIntegral w/fromIntegral h) (1 :: GLfloat)
+>
+> matrixMode $= Modelview 0
diff --git a/src/Common/Utils.lhs b/src/Common/Utils.lhs
new file mode 100644
--- /dev/null
+++ b/src/Common/Utils.lhs
@@ -0,0 +1,50 @@
+Utils module
+============
+
+This module contains some functions that might make it into the core library eventually.
+
+> module Common.Utils where
+>
+> import Control.Applicative
+> import Control.Monad
+> import FRP.Elerea
+>
+> import Common.Vector
+
+The `driveNetwork` function simply executes the supersteps while the
+`driver` function keeps returning valid delta time values.
+
+> driveNetwork network driver = do
+> dt <- driver
+> case dt of
+> Just dt -> do join $ superstep network dt
+> driveNetwork network driver
+> Nothing -> return ()
+
+The `edge` transfer function takes a bool signal and emits another
+bool signal that turns true only at the moment when there is a rising
+edge on the input. We are relying on the delay introduced by the
+`transfer` primitive for this to work.
+
+> edge b = (transfer False (\dt b _ -> not b) b) &&@ b
+
+A scalar integral function. Since it is based on `transfer`, it is
+delayed by one superstep, i.e. the value of the input signal in the
+nth step affects its output only in the (n+1)th
+step.
+
+> integral v0 s = transfer v0 (\dt v v0 -> v0+v*realToFrac dt) s
+
+An integral function for two-dimensional vectors defined in the
+`Vector` module with the same caveat.
+
+> integralVec v0 s = transfer v0 (\dt v v0 -> v0^+^(v^*.realToFrac dt)) s
+
+Logic relations lifted into signals. Useful to combine event-like
+signals.
+
+> (||@) :: Signal Bool -> Signal Bool -> Signal Bool
+> (||@) = liftA2 (||)
+>
+> (&&@) :: Signal Bool -> Signal Bool -> Signal Bool
+> (&&@) = liftA2 (&&)
diff --git a/src/Common/Vector.lhs b/src/Common/Vector.lhs
new file mode 100644
--- /dev/null
+++ b/src/Common/Vector.lhs
@@ -0,0 +1,50 @@
+Vector module
+=============
+
+This module contains a class for two-dimensional vectors, a strict
+datatype to instantiate it, and another instance for signals of the
+same type.
+
+> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
+>
+> module Common.Vector where
+>
+> import Control.Applicative
+> import FRP.Elerea
+> import Graphics.Rendering.OpenGL
+>
+> data Vec = V { getX :: !Float, getY :: !Float }
+>
+> infixl 7 ^*.
+> infixl 7 .*^
+> infixl 7 `dot`
+> infixl 7 `cross`
+> infixl 6 ^+^
+> infixl 6 ^-^
+>
+> class Vector2D v c | v -> c where
+> (^+^) :: v -> v -> v
+> (^-^) :: v -> v -> v
+> (^*.) :: v -> c -> v
+> (.*^) :: c -> v -> v
+> vnull :: v
+> dot :: v -> v -> c
+> cross :: v -> v -> c
+>
+> instance Vector2D Vec Float where
+> V x1 y1 ^+^ V x2 y2 = V (x1+x2) (y1+y2)
+> V x1 y1 ^-^ V x2 y2 = V (x1-x2) (y1-y2)
+> V x y ^*. t = V (x*t) (y*t)
+> t .*^ V x y = V (x*t) (y*t)
+> vnull = V 0 0
+> V x1 y1 `dot` V x2 y2 = x1*y1+x2*y2
+> V x1 y1 `cross` V x2 y2 = x1*y2-x2*y1
+>
+> instance Vector2D (Signal Vec) (Signal Float) where
+> (^+^) = liftA2 (^+^)
+> (^-^) = liftA2 (^-^)
+> (^*.) = liftA2 (^*.)
+> (.*^) = liftA2 (.*^)
+> vnull = pure vnull
+> dot = liftA2 dot
+> cross = liftA2 cross