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 DoRec #-} > > module Main where > > import Control.Applicative > import Control.Monad > import Data.IORef > import FRP.Elerea.Param > 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 simple loop, 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 >> return True) > initGL 640 480 > > network ← start $ do > mouseClick ← edge mousePress > rec let newVel clk v0 = case clk of > True → Just <$> integralVec v0 acc > False → return Nothing > acc = (mousePosition^-^pos)^*.0.3 > vel0 ← integralVec vnull acc > vels ← storeJust vel0 =<< generator (newVel <$> mouseClick <*> vel^+^pos^-^mousePosition) > vel ← delay vnull (join vels) > pos ← delay vnull =<< integralVec vnull vel > > return $ render <$> windowSize <*> mousePosition <*> pos > > driveNetwork network (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.Param > > 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 (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
A rising edge detector.
> edge s = do > s' ← delay False s > return $ s' >>= \x → if x then return False else s
A latch that always remembers the last value of a Maybe signal wrapped in Just.
> storeJust x0 s = transfer x0 store s > where store _ Nothing x = x > store _ (Just x) _ = x
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, TypeSynonymInstances #-} > > module Common.Vector where > > import Control.Applicative > import FRP.Elerea.Param > import Graphics.Rendering.OpenGL > > data Vec = V { getX :: !GLfloat, getY :: !GLfloat } > > 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 GLfloat 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 GLfloat) where > (^+^) = liftA2 (^+^) > (^-^) = liftA2 (^-^) > (^*.) = liftA2 (^*.) > (.*^) = liftA2 (.*^) > vnull = pure vnull > dot = liftA2 dot > cross = liftA2 cross