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.

> {-# LANGUAGE RecursiveDo #-}
>
> 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
> 
>   greyPos ← createSignal $ mdo
>         mouseClick ← edge mousePress
>
>         let acc = (mousePosition^-^pos)^*.0.3
>         pos ← integralVec vnull vel
>         vel0 ← integralVec vnull acc
>         vel ← sampler <$> (storeJust vel0 . generator mouseClick)
>                (integralVec <$> vel^+^pos^-^mousePosition <*> pure acc)
>
>         return pos
>
>   driveNetwork (render <$> windowSize <*> mousePosition <*> greyPos)
>                (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

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

A scalar integral function for Fractional instances.

> 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.

> integralVec v0 s = transfer v0 (\dt v v0 → v0^+^(v^*.realToFrac dt)) s

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