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