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
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
This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type. We use CFloat as the coordinate type, because GLfloat is its synonym.
> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-} > > module Common.Vector where > > import Control.Applicative > import FRP.Elerea > import Foreign.C.Types > > data Vec = V { getX :: !CFloat, getY :: !CFloat } > > 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 CFloat 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 CFloat) where > (^+^) = liftA2 (^+^) > (^-^) = liftA2 (^-^) > (^*.) = liftA2 (^*.) > (.*^) = liftA2 (.*^) > vnull = pure vnull > dot = liftA2 dot > cross = liftA2 cross