elerea-examples 2.2.0 → 2.2.1
raw patch · 13 files changed
+587/−314 lines, 13 files
Files
- README +11/−18
- doc/Breakout.html +276/−82
- doc/Chase.html +120/−38
- elerea-examples.cabal +9/−12
- src/Bounce/Event.hs +12/−12
- src/Bounce/Main.hs +36/−33
- src/Bounce/Math.hs +10/−10
- src/Bounce/Util.hs +13/−16
- src/Bounce/Vector.hs +3/−3
- src/Breakout.lhs +54/−61
- src/Chase.lhs +27/−26
- src/Common/Utils.lhs +15/−2
- src/Common/Vector.lhs +1/−1
README view
@@ -1,23 +1,16 @@-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.+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: -* bounce (legacy): an example for creating dynamic collections of- signals with the experimental interface; left click to create- balls, drag existing balls with left button to propel them and- drag with right to select balls for deletion (upon release)--* chase (legacy): a minimal example that demonstrates reactivity and- mutually recursive signals--* breakout (legacy): a not too fancy breakout clone that also- demonstrates Graphviz output; you can get an SVG rendition of the- signal structure with the following command if Graphviz is- installed:+* bounce: an example for creating dynamic collections of signals; left+ click to create balls, drag existing balls with left button to+ propel them and drag with right to select balls for deletion (upon+ release); - elerea-breakout --dump-dot | dot -Tsvg -o breakout.svg+* chase: a minimal example that demonstrates reactivity and mutually+ recursive signals; - You can simply use the mouse to move the paddle.+* breakout: a not too fancy breakout clone; you can simply use the+ mouse to move the paddle.
doc/Breakout.html view
@@ -1,16 +1,27 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head>+ <title></title> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <meta name="generator" content="pandoc" />- <title></title>+ <meta name="date" content="" /> <link rel="stylesheet" href="hscolour.css" type="text/css" /> </head> <body>-<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><html>+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<html> <head> <!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ --><title>Haskell code</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /></head>-<body><h1 id="elerea-breakout-example">Elerea Breakout example</h1><p>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.</p><p>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.</p><img src="Breakout.png" alt="Elerea Breakout in action" /><p>You can also have the program output the signal structure in <a href="http://www.graphviz.org/">Graphviz</a> dot format with the <code>--dump-dot</code> switch after the game is over. For instance, if Graphviz is installed, you can get an SVG rendition of the graph using the following command:</p><p><code>elerea-breakout --dump-dot | dot -Tsvg -o breakout.svg</code></p><p>Below follows the full source of the example.</p><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE RecursiveDo #-}</span>+<body><div id="elerea-breakout-example"+><h1+ >Elerea Breakout example</h1+ ><p+ >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.</p+ ><p+ >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.</p+ ><img src="Breakout.png" alt="Elerea Breakout in action" /><p+ >Below follows the full source of the example.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE DoRec #-}</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Main</span> <span class='hs-keyword'>where</span> <span class='hs-varop'>></span>@@ -21,8 +32,7 @@ <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Traversable</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span><span class='hs-varop'>.</span><span class='hs-conid'>Graph</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Param</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>UI</span><span class='hs-varop'>.</span><span class='hs-conid'>GLFW</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>GLFW</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Rendering</span><span class='hs-varop'>.</span><span class='hs-conid'>OpenGL</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Environment</span>@@ -30,25 +40,58 @@ </pre> <pre><span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Vector</span>-</pre><h2 id="global-constants">Global constants</h2><p>The dimensions of the ball, which behaves as a rectangle in collision detection, but is drawn as an ellipse.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>ballW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.04</span>-<span class='hs-varop'>></span> <span class='hs-definition'>ballH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.04</span>-</pre><p>The initial position and velocity of the ball.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>ballPos0</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-num'>0</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.4</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-definition'>ballVel0</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.4</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>0.35</span><span class='hs-layout'>)</span>-</pre><p>The dimensions and vertical position of the player.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>playerW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.2</span>-<span class='hs-varop'>></span> <span class='hs-definition'>playerH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.03</span>-<span class='hs-varop'>></span> <span class='hs-definition'>playerY</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-</span><span class='hs-varid'>fieldH</span><span class='hs-varop'>+</span><span class='hs-num'>0.01</span>-</pre><p>The dimensions of the field.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>fieldW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.8</span>-<span class='hs-varop'>></span> <span class='hs-definition'>fieldH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.5</span>-</pre><p>The dimensions of each brick.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>brickW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.05</span>-<span class='hs-varop'>></span> <span class='hs-definition'>brickH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.03</span>-</pre><p>The data structure describing the state of each brick. A brick can either be alive or dying. Dying bricks also keep track of their fadeout level.</p><pre><span class='hs-varop'>></span> <span class='hs-keyword'>data</span> <span class='hs-conid'>BrickState</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Live</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Dying</span> <span class='hs-varop'>!</span><span class='hs-conid'>GLfloat</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>-</pre><p>The starting positions of the bricks.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>brickPos0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>distributeBricks</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.7</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>0.7</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>0.4</span><span class='hs-layout'>)</span> <span class='hs-num'>18</span> <span class='hs-num'>10</span>+</pre><div id="global-constants"+ ><h2+ >Global constants</h2+ ><p+ >The dimensions of the ball, which behaves as a rectangle in collision detection, but is drawn as an ellipse.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>ballW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.04</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.04</span>+</pre><p+ >The initial position and velocity of the ball.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>ballPos0</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-num'>0</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.4</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballVel0</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.4</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>0.35</span><span class='hs-layout'>)</span>+</pre><p+ >The dimensions and vertical position of the player.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>playerW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.2</span>+<span class='hs-varop'>></span> <span class='hs-varid'>playerH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.03</span>+<span class='hs-varop'>></span> <span class='hs-varid'>playerY</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-</span><span class='hs-varid'>fieldH</span><span class='hs-varop'>+</span><span class='hs-num'>0.01</span>+</pre><p+ >The dimensions of the field.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>fieldW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.8</span>+<span class='hs-varop'>></span> <span class='hs-varid'>fieldH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.5</span>+</pre><p+ >The dimensions of each brick.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>brickW</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.05</span>+<span class='hs-varop'>></span> <span class='hs-varid'>brickH</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.03</span>+</pre><p+ >The data structure describing the state of each brick. A brick can either be alive or dying. Dying bricks also keep track of their fadeout level.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-keyword'>data</span> <span class='hs-conid'>BrickState</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Live</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Dying</span> <span class='hs-varop'>!</span><span class='hs-conid'>GLfloat</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>+</pre><p+ >The starting positions of the bricks.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>brickPos0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>distributeBricks</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.7</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>0.1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>0.7</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>0.4</span><span class='hs-layout'>)</span> <span class='hs-num'>18</span> <span class='hs-num'>10</span> <span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>distributeBricks</span> <span class='hs-varid'>xmin</span> <span class='hs-varid'>ymin</span> <span class='hs-varid'>xmax</span> <span class='hs-varid'>ymax</span> <span class='hs-varid'>xn</span> <span class='hs-varid'>yn</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>xmin</span><span class='hs-varop'>+</span><span class='hs-varid'>xstep</span><span class='hs-varop'>*</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>ymin</span><span class='hs-varop'>+</span><span class='hs-varid'>ystep</span><span class='hs-varop'>*</span><span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varop'>></span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>←</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>xn</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>←</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>yn</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>xstep</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>xmax</span><span class='hs-comment'>-</span><span class='hs-varid'>xmin</span><span class='hs-comment'>-</span><span class='hs-varid'>xn</span><span class='hs-varop'>*</span><span class='hs-varid'>brickW</span><span class='hs-layout'>)</span><span class='hs-varop'>/</span><span class='hs-layout'>(</span><span class='hs-varid'>xn</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-varop'>+</span><span class='hs-varid'>brickW</span> <span class='hs-varop'>></span> <span class='hs-varid'>ystep</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>ymax</span><span class='hs-comment'>-</span><span class='hs-varid'>ymin</span><span class='hs-comment'>-</span><span class='hs-varid'>yn</span><span class='hs-varop'>*</span><span class='hs-varid'>brickH</span><span class='hs-layout'>)</span><span class='hs-varop'>/</span><span class='hs-layout'>(</span><span class='hs-varid'>yn</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-varop'>+</span><span class='hs-varid'>brickH</span>-</pre><p>The rate at which a brick fades out. The reciprocal of this value gives the fadeout time in seconds.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>brickFade</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.5</span>-</pre><h2 id="game-logic">Game logic</h2><p>The entry point performs some lightweight initialisation, and defines the two user-driven signals: window size and mouse position. The <code>external</code> function creates the signal and the corresponding sink at the same time.</p><p>When all is done <code>driveNetwork</code> is invoked. It is not a library function, but part of the tiny <code>Utils</code> module .</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>main</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The rate at which a brick fades out. The reciprocal of this value gives the fadeout time in seconds.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>brickFade</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0.5</span>+</pre></div+ ><div id="game-logic"+ ><h2+ >Game logic</h2+ ><p+ >The entry point performs some lightweight initialisation, and defines the two user-driven signals: window size and mouse position. The <code+ >external</code+ > function creates the signal and the corresponding sink at the same time.</p+ ><p+ >When all is done <code+ >driveNetwork</code+ > is invoked. It is not a library function, but part of the tiny <code+ >Utils</code+ > module .</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>main</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-comment'>-- Creating a window without a depth buffer</span> <span class='hs-varop'>></span> <span class='hs-varid'>initialize</span> <span class='hs-varop'>></span> <span class='hs-varid'>openWindow</span> <span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-num'>640</span> <span class='hs-num'>480</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DisplayRGBBits</span> <span class='hs-num'>8</span> <span class='hs-num'>8</span> <span class='hs-num'>8</span><span class='hs-layout'>,</span> <span class='hs-conid'>DisplayAlphaBits</span> <span class='hs-num'>8</span><span class='hs-keyglyph'>]</span> <span class='hs-conid'>Window</span>@@ -66,64 +109,143 @@ <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-comment'>-- All we need to get going is an IO-valued signal and an IO</span> <span class='hs-varop'>></span> <span class='hs-comment'>-- function to update the external signals</span>-<span class='hs-varop'>></span> <span class='hs-varid'>game</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>createSignal</span> <span class='hs-varop'>$</span> <span class='hs-varid'>breakout</span> <span class='hs-varid'>mousePosition</span> <span class='hs-varid'>windowSize</span>+<span class='hs-varop'>></span> <span class='hs-varid'>game</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>start</span> <span class='hs-layout'>(</span><span class='hs-varid'>breakout</span> <span class='hs-varid'>mousePosition</span> <span class='hs-varid'>windowSize</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-varid'>game</span> <span class='hs-layout'>(</span><span class='hs-varid'>readInput</span> <span class='hs-varid'>mousePositionSink</span> <span class='hs-varid'>closed</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-comment'>-- The inevitable sad ending</span> <span class='hs-varop'>></span> <span class='hs-varid'>closeWindow</span>+</pre><p+ >The <code+ >breakout</code+ > 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:</p+ ><ul+ ><li+ ><code+ >playerX</code+ >: the position of the player, a direct function of the mouse position;</li+ ><li+ ><code+ >ballPos</code+ >: the position of the ball given as an integral of its velocity, <code+ >ballVel</code+ >;</li+ ><li+ ><code+ >bricks</code+ >: the collection of live and dying bricks along with collision information.</li+ ></ul+ ><p+ >The position and velocity of the ball form a circular dependency through the bricks, as velocity is changed whenever a collision is detected, which is a function of the position.</p+ ><p+ >The signal carrying the collection of the bricks is a higher-order signal, where each element of the list is a signal representing an individual brick. Bricks behave independently of each other: they are defined as separate transfer functions with the ball position as input signal. As soon as a brick is touched it enters the dying phase and fades out. Also, since other signals are mostly interested in the current state of the bricks, we have to define a flattened version, which carries the snapshots of all the brick signals. This is the <code+ >brickSamples</code+ > signal.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>breakout</span> <span class='hs-varid'>mousePos</span> <span class='hs-varid'>windowSize</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >User-driven player position:</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>rec</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>playerX</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>adjustPlayerPos</span> <span class='hs-varop'><$></span> <span class='hs-varid'>mousePos</span> <span class='hs-varop'><*></span> <span class='hs-varid'>windowSize</span>+<span class='hs-varop'>></span> <span class='hs-varid'>adjustPlayerPos</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>w</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>min</span> <span class='hs-layout'>(</span><span class='hs-varid'>fieldW</span><span class='hs-comment'>-</span><span class='hs-varid'>playerW</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>max</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>fieldW</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-num'>2</span><span class='hs-varop'>*</span><span class='hs-varid'>x</span><span class='hs-varop'>/</span><span class='hs-varid'>w</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-comment'>-</span><span class='hs-varid'>playerW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span>+<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varop'>||@</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftA2</span> <span class='hs-layout'>(</span><span class='hs-varop'>||</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>toMaybe</span> <span class='hs-varid'>c</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>c</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>v</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Nothing</span>+</pre><p+ >Ball state: position and velocity. We use a combination of <code+ >storeJust</code+ > and <code+ >toMaybe</code+ > to produce a latcher element that stores the value of a certain signal whenever a boolean control signal yields true. We need to create delayed versions in order to have well-defined feedback loops.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>ballPos</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>ballPos0</span> <span class='hs-varid'>ballVel</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballVel</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>storeJust</span> <span class='hs-varid'>ballVel0</span> <span class='hs-varop'>$</span>+<span class='hs-varop'>></span> <span class='hs-varid'>toMaybe</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>ballCollHorz</span> <span class='hs-varop'>||@</span> <span class='hs-varid'>ballCollVert</span> <span class='hs-varop'>||@</span> <span class='hs-varid'>ballCollPlayer</span><span class='hs-layout'>)</span> <span class='hs-varop'><*></span>+<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>adjustVel</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballCollHorz</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballCollVert</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballCollPlayer</span> <span class='hs-varop'><*></span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballVel'</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballNewVelX</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-comment'>-- Providing input for graphviz</span>-<span class='hs-varop'>></span> <span class='hs-varid'>args</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>getArgs</span>-<span class='hs-varop'>></span> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-str'>"--dump-dot"</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>-<span class='hs-varop'>></span> <span class='hs-varid'>gameGraph</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>signalToDot</span> <span class='hs-varid'>game</span>-<span class='hs-varop'>></span> <span class='hs-varid'>putStr</span> <span class='hs-varid'>gameGraph</span>-</pre><p>The <code>breakout</code> 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:</p><ul><li><code>playerX</code>: the position of the player, a direct function of the mouse position;</li><li><code>ballPos</code>: the position of the ball given as an integral of its velocity, <code>ballVel</code>;</li><li><code>bricks</code>: the collection of live and dying bricks along with collision information.</li></ul><p>The position and velocity of the ball form a circular dependency through the bricks, as velocity is changed whenever a collision is detected, which is a function of the position.</p><p>The signal carrying the collection of the bricks is a higher-order signal, where each element of the list is a signal representing an individual brick. Bricks behave independently of each other: they are defined as separate transfer functions with the ball position as input signal. As soon as a brick is touched it enters the dying phase and fades out. Also, since other signals are mostly interested in the current state of the bricks, we have to define a flattened version, which carries the snapshots of all the brick signals. This is the <code>brickSamples</code> signal.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>breakout</span> <span class='hs-varid'>mousePos</span> <span class='hs-varid'>windowSize</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>mdo</span>-</pre><p>User-driven player position:</p><pre><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>playerX</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>adjustPlayerPos</span> <span class='hs-varop'><$></span> <span class='hs-varid'>mousePos</span> <span class='hs-varop'><*></span> <span class='hs-varid'>windowSize</span>-<span class='hs-varop'>></span> <span class='hs-varid'>adjustPlayerPos</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>w</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>min</span> <span class='hs-layout'>(</span><span class='hs-varid'>fieldW</span><span class='hs-comment'>-</span><span class='hs-varid'>playerW</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>max</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>fieldW</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-num'>2</span><span class='hs-varop'>*</span><span class='hs-varid'>x</span><span class='hs-varop'>/</span><span class='hs-varid'>w</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-comment'>-</span><span class='hs-varid'>playerW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span>-</pre><p>Ball state: position and velocity. We use a combination of <code>storeJust</code> and <code>toMaybe</code> to produce a latcher element that stores the value of a certain signal whenever a boolean control signal yields true.</p><pre><span class='hs-varop'>></span> <span class='hs-varid'>ballPos</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>ballPos0</span> <span class='hs-varid'>ballVel</span>-<span class='hs-varop'>></span> <span class='hs-varid'>ballVel</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>storeJust</span> <span class='hs-varid'>ballVel0</span> <span class='hs-varop'>$</span>-<span class='hs-varop'>></span> <span class='hs-varid'>toMaybe</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>ballCollHorz</span> <span class='hs-varop'>||@</span> <span class='hs-varid'>ballCollVert</span> <span class='hs-varop'>||@</span> <span class='hs-varid'>ballCollPlayer</span><span class='hs-layout'>)</span> <span class='hs-varop'><*></span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>adjustVel</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballCollHorz</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballCollVert</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballCollPlayer</span> <span class='hs-varop'><*></span>-<span class='hs-varop'>></span> <span class='hs-varid'>ballVel</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballNewVelX</span><span class='hs-layout'>)</span>-</pre><p>The <code>adjustVel</code> 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 don’t evaluate it at all thanks to the laziness of applicative nodes. In the end, velocity is only recalculated when a collision is detected.</p><pre><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>adjustVel</span> <span class='hs-varid'>ch</span> <span class='hs-varid'>cv</span> <span class='hs-varid'>cp</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bvx</span> <span class='hs-varid'>bvy</span><span class='hs-layout'>)</span> <span class='hs-varid'>bvx'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>ch</span> <span class='hs-keyword'>then</span> <span class='hs-comment'>-</span><span class='hs-num'>1</span> <span class='hs-keyword'>else</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-varop'>*</span><span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>cp</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>bvx'</span><span class='hs-varop'>*</span><span class='hs-num'>4</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>bvx</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>cv</span> <span class='hs-varop'>||</span> <span class='hs-varid'>cp</span> <span class='hs-keyword'>then</span> <span class='hs-comment'>-</span><span class='hs-varid'>bvy</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>bvy</span>-<span class='hs-varop'>></span> <span class='hs-varid'>ballNewVelX</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>getX</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos</span><span class='hs-layout'>)</span><span class='hs-comment'>-</span><span class='hs-varid'>playerX</span><span class='hs-comment'>-</span><span class='hs-varid'>pure</span> <span class='hs-layout'>(</span><span class='hs-varid'>playerW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span>-</pre><p>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 <code>edge</code> transfer function.</p><pre><span class='hs-varop'>></span> <span class='hs-varid'>ballCollHorz</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>or</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>getBrickHColl</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varop'>||@</span> <span class='hs-layout'>(</span><span class='hs-varid'>check</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballVel</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bx</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bvx</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>bx</span> <span class='hs-varop'><</span> <span class='hs-comment'>-</span><span class='hs-varid'>fieldW</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bvx</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>bx</span> <span class='hs-varop'>></span> <span class='hs-varid'>fieldW</span><span class='hs-comment'>-</span><span class='hs-varid'>ballW</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bvx</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varid'>ballCollVert</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>or</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>getBrickVColl</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varop'>||@</span> <span class='hs-layout'>(</span><span class='hs-varid'>check</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballVel</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>by</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>bvy</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>by</span> <span class='hs-varop'>></span> <span class='hs-varid'>fieldH</span><span class='hs-comment'>-</span><span class='hs-varid'>ballH</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bvy</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span>-<span class='hs-varop'>></span> <span class='hs-varid'>ballCollPlayer</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>check</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballVel</span> <span class='hs-varop'><*></span> <span class='hs-varid'>playerX</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>bvy</span><span class='hs-layout'>)</span> <span class='hs-varid'>px</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bvy</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span> <span class='hs-varop'>&&</span>-<span class='hs-varop'>></span> <span class='hs-varid'>doRectsIntersect</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span> <span class='hs-varid'>ballW</span> <span class='hs-varid'>ballH</span> <span class='hs-varid'>px</span> <span class='hs-varid'>playerY</span> <span class='hs-varid'>playerW</span> <span class='hs-varid'>playerH</span>-</pre><p>Bricks are defined by the updater function <code>evolveBrick</code> as a transformer of the ball position. The transfer function takes care of fading and checking collision. Collision information is part of the state of the transfer function, even though it is strictly a function of the brick data and the ball position at the moment. However, since we need to check collisions in order to update the state of the brick, it’s simpler and more efficient to let the outer world see the results of these checks instead of having to recalculate them.</p><pre><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>brick</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-conid'>Live</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-varid'>evolveBrick</span> <span class='hs-varid'>ballPos</span>-<span class='hs-varop'>></span> <span class='hs-varid'>getBrickData</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varid'>getBrickHColl</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span>-<span class='hs-varop'>></span> <span class='hs-varid'>getBrickVColl</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballPos'</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-varid'>ballPos0</span> <span class='hs-varid'>ballPos</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballVel'</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-varid'>ballVel0</span> <span class='hs-varid'>ballVel</span>+</pre><p+ >The <code+ >adjustVel</code+ > 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 don’t evaluate it at all thanks to the laziness of applicative nodes. In the end, velocity is only recalculated when a collision is detected.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>adjustVel</span> <span class='hs-varid'>ch</span> <span class='hs-varid'>cv</span> <span class='hs-varid'>cp</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bvx</span> <span class='hs-varid'>bvy</span><span class='hs-layout'>)</span> <span class='hs-varid'>bvx'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>ch</span> <span class='hs-keyword'>then</span> <span class='hs-comment'>-</span><span class='hs-num'>1</span> <span class='hs-keyword'>else</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-varop'>*</span><span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>cp</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>bvx'</span><span class='hs-varop'>*</span><span class='hs-num'>4</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>bvx</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>cv</span> <span class='hs-varop'>||</span> <span class='hs-varid'>cp</span> <span class='hs-keyword'>then</span> <span class='hs-comment'>-</span><span class='hs-varid'>bvy</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>bvy</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballNewVelX</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>getX</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos'</span><span class='hs-layout'>)</span><span class='hs-comment'>-</span><span class='hs-varid'>playerX</span><span class='hs-comment'>-</span><span class='hs-varid'>pure</span> <span class='hs-layout'>(</span><span class='hs-varid'>playerW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span>+</pre><p+ >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 <code+ >edge</code+ > transfer function.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>ballCollHorz</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-varid'>getBrickHColl</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples'</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varop'>||@</span> <span class='hs-layout'>(</span><span class='hs-varid'>check</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos'</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballVel'</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bx</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bvx</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>bx</span> <span class='hs-varop'><</span> <span class='hs-comment'>-</span><span class='hs-varid'>fieldW</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bvx</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span>+<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>bx</span> <span class='hs-varop'>></span> <span class='hs-varid'>fieldW</span><span class='hs-comment'>-</span><span class='hs-varid'>ballW</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bvx</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballCollVert</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-varid'>getBrickVColl</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples'</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varop'>||@</span> <span class='hs-layout'>(</span><span class='hs-varid'>check</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos'</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballVel'</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>by</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>bvy</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>by</span> <span class='hs-varop'>></span> <span class='hs-varid'>fieldH</span><span class='hs-comment'>-</span><span class='hs-varid'>ballH</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bvy</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span>+<span class='hs-varop'>></span> <span class='hs-varid'>ballCollPlayer</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>check</span> <span class='hs-varop'><$></span> <span class='hs-varid'>ballPos'</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballVel'</span> <span class='hs-varop'><*></span> <span class='hs-varid'>playerX</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>bvy</span><span class='hs-layout'>)</span> <span class='hs-varid'>px</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bvy</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span> <span class='hs-varop'>&&</span>+<span class='hs-varop'>></span> <span class='hs-varid'>doRectsIntersect</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span> <span class='hs-varid'>ballW</span> <span class='hs-varid'>ballH</span> <span class='hs-varid'>px</span> <span class='hs-varid'>playerY</span> <span class='hs-varid'>playerW</span> <span class='hs-varid'>playerH</span>+</pre><p+ >Bricks are defined by the updater function <code+ >evolveBrick</code+ > as a transformer of the ball position. The transfer function takes care of fading and checking collision. Collision information is part of the state of the transfer function, even though it is strictly a function of the brick data and the ball position at the moment. However, since we need to check collisions in order to update the state of the brick, it’s simpler and more efficient to let the outer world see the results of these checks instead of having to recalculate them.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>brick</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-conid'>Live</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-varid'>evolveBrick</span> <span class='hs-varid'>ballPos</span>+<span class='hs-varop'>></span> <span class='hs-varid'>getBrickData</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>getBrickHColl</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span>+<span class='hs-varop'>></span> <span class='hs-varid'>getBrickVColl</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-varid'>evolveBrick</span> <span class='hs-varid'>dt</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-conid'>Dying</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-conid'>Dying</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-comment'>-</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-varop'>*</span><span class='hs-varid'>brickFade</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varid'>evolveBrick</span> <span class='hs-varid'>dt</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-keyword'>if</span> <span class='hs-varid'>isKilled</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Dying</span> <span class='hs-num'>1</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Live</span><span class='hs-layout'>,</span><span class='hs-varid'>collHorz</span><span class='hs-layout'>,</span><span class='hs-varid'>collVert</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>isKilled</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isHit</span> <span class='hs-varop'>||</span> <span class='hs-varid'>by</span> <span class='hs-varop'><</span> <span class='hs-comment'>-</span><span class='hs-varid'>fieldH</span><span class='hs-comment'>-</span><span class='hs-varid'>ballH</span>-<span class='hs-varop'>></span> <span class='hs-varid'>isHit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doRectsIntersect</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span> <span class='hs-varid'>ballW</span> <span class='hs-varid'>ballH</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-varid'>brickW</span> <span class='hs-varid'>brickH</span>-<span class='hs-varop'>></span> <span class='hs-varid'>collHorz</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isHit</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isHorz</span>-<span class='hs-varop'>></span> <span class='hs-varid'>collVert</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isHit</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>not</span> <span class='hs-varid'>isHorz</span>-<span class='hs-varop'>></span> <span class='hs-varid'>isHorz</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>xDist</span><span class='hs-varop'>/</span><span class='hs-varid'>brickW</span> <span class='hs-varop'>></span> <span class='hs-varid'>yDist</span><span class='hs-varop'>/</span><span class='hs-varid'>brickH</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>xDist</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>abs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-varop'>+</span><span class='hs-varid'>brickW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-comment'>-</span><span class='hs-layout'>(</span><span class='hs-varid'>bx</span><span class='hs-varop'>+</span><span class='hs-varid'>ballW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varid'>yDist</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>abs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-varop'>+</span><span class='hs-varid'>brickH</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-comment'>-</span><span class='hs-layout'>(</span><span class='hs-varid'>by</span><span class='hs-varop'>+</span><span class='hs-varid'>ballH</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>-</pre><p>The <code>isBrickNeeded</code> function is used to decide whether a brick should be kept in the collection. As soon as it turns false, the brick in question is removed from the <code>bricks</code> signal.</p><pre><span class='hs-varop'>></span> <span class='hs-varid'>isBrickNeeded</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>Dying</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span>-<span class='hs-varop'>></span> <span class='hs-varid'>isBrickNeeded</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>Live</span> <span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>-</pre><p>The <code>brickSamples</code> signal contains a snapshot of every brick, and it’s obtained simply by traversing the collection (this is equivalent to rebuilding the structure with lifted constructors), then applying a sampler, which collapses the two signal layers into one. We take advantage of the fact that lists are instances of Traversable.</p><pre><span class='hs-varop'>></span> <span class='hs-varid'>brickSamples</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sampler</span> <span class='hs-layout'>(</span><span class='hs-varid'>sequenceA</span> <span class='hs-varop'><$></span> <span class='hs-varid'>bricks</span><span class='hs-layout'>)</span>-</pre><p>The <code>bricks</code> signal carries the dynamic list of bricks along with ball-brick collision information, all of which are updated in each frame. We start out with a number of live bricks in the positions given by the <code>brickPos0</code> list, and derive the list of the next frame from the current one by filtering out the bricks for which <code>isBrickNeeded</code> evaluates to false. These updates are made explicit by using <code>delay</code> to define the dynamic collection.</p><pre><span class='hs-varop'>></span> <span class='hs-varid'>bricks</span> <span class='hs-keyglyph'>←</span> <span class='hs-keyword'>do</span>-<span class='hs-varop'>></span> <span class='hs-varid'>bricksInit</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>brick</span> <span class='hs-varid'>brickPos0</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>bricksNext</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>snd</span> <span class='hs-varop'>.</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>isBrickNeeded</span> <span class='hs-varop'>.</span> <span class='hs-varid'>fst</span><span class='hs-layout'>)</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples</span> <span class='hs-varop'><*></span> <span class='hs-varid'>bricks</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-varid'>delay</span> <span class='hs-varid'>bricksInit</span> <span class='hs-varid'>bricksNext</span>-</pre><p>And knowing all these signals we can finally assemble the signal of rendering actions, i.e. the animation:</p><pre><span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>renderLevel</span> <span class='hs-varop'><$></span> <span class='hs-varid'>playerX</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballPos</span> <span class='hs-varop'><*></span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>getBrickData</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples</span><span class='hs-layout'>)</span>-</pre><p>The <code>doRectsIntersect</code> function decides whether two rectangles defined by their top left corners and dimensions overlap.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>doRectsIntersect</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>y1</span> <span class='hs-varid'>sx1</span> <span class='hs-varid'>sy1</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>y2</span> <span class='hs-varid'>sx2</span> <span class='hs-varid'>sy2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>collIV</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>sx1</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>sx2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>collIV</span> <span class='hs-varid'>y1</span> <span class='hs-varid'>sy1</span> <span class='hs-varid'>y2</span> <span class='hs-varid'>sy2</span>+<span class='hs-varop'>></span> <span class='hs-varid'>evolveBrick</span> <span class='hs-varid'>dt</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-conid'>Dying</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-conid'>Dying</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-comment'>-</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-varop'>*</span><span class='hs-varid'>brickFade</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>evolveBrick</span> <span class='hs-varid'>dt</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span><span class='hs-keyword'>if</span> <span class='hs-varid'>isKilled</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Dying</span> <span class='hs-num'>1</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Live</span><span class='hs-layout'>,</span><span class='hs-varid'>collHorz</span><span class='hs-layout'>,</span><span class='hs-varid'>collVert</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>isKilled</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isHit</span> <span class='hs-varop'>||</span> <span class='hs-varid'>by</span> <span class='hs-varop'><</span> <span class='hs-comment'>-</span><span class='hs-varid'>fieldH</span><span class='hs-comment'>-</span><span class='hs-varid'>ballH</span>+<span class='hs-varop'>></span> <span class='hs-varid'>isHit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doRectsIntersect</span> <span class='hs-varid'>bx</span> <span class='hs-varid'>by</span> <span class='hs-varid'>ballW</span> <span class='hs-varid'>ballH</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-varid'>brickW</span> <span class='hs-varid'>brickH</span>+<span class='hs-varop'>></span> <span class='hs-varid'>collHorz</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isHit</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isHorz</span>+<span class='hs-varop'>></span> <span class='hs-varid'>collVert</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isHit</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>not</span> <span class='hs-varid'>isHorz</span>+<span class='hs-varop'>></span> <span class='hs-varid'>isHorz</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>xDist</span><span class='hs-varop'>/</span><span class='hs-varid'>brickW</span> <span class='hs-varop'>></span> <span class='hs-varid'>yDist</span><span class='hs-varop'>/</span><span class='hs-varid'>brickH</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>xDist</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>abs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-varop'>+</span><span class='hs-varid'>brickW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-comment'>-</span><span class='hs-layout'>(</span><span class='hs-varid'>bx</span><span class='hs-varop'>+</span><span class='hs-varid'>ballW</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>yDist</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>abs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-varop'>+</span><span class='hs-varid'>brickH</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-comment'>-</span><span class='hs-layout'>(</span><span class='hs-varid'>by</span><span class='hs-varop'>+</span><span class='hs-varid'>ballH</span><span class='hs-varop'>/</span><span class='hs-num'>2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>+</pre><p+ >The <code+ >isBrickNeeded</code+ > function is used to decide whether a brick should be kept in the collection. As soon as it turns false, the brick in question is removed from the <code+ >bricks</code+ > signal.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>isBrickNeeded</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>Dying</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span>+<span class='hs-varop'>></span> <span class='hs-varid'>isBrickNeeded</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>Live</span> <span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>+</pre><p+ >The <code+ >brickSamples</code+ > signal contains a snapshot of every brick, and it’s obtained simply by traversing the collection (this is equivalent to rebuilding the structure with lifted constructors), then applying a sampler, which collapses the two signal layers into one. We take advantage of the fact that lists are instances of Traversable.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>brickSamples</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>join</span> <span class='hs-layout'>(</span><span class='hs-varid'>sequenceA</span> <span class='hs-varop'><$></span> <span class='hs-varid'>bricks</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span>+<span class='hs-varop'>></span> <span class='hs-varid'>brickSamples'</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>brickSamples</span>+</pre><p+ >The <code+ >bricks</code+ > signal carries the dynamic list of bricks along with ball-brick collision information, all of which are updated in each frame. We start out with a number of live bricks in the positions given by the <code+ >brickPos0</code+ > list, and derive the list of the next frame from the current one by filtering out the bricks for which <code+ >isBrickNeeded</code+ > evaluates to false. These updates are made explicit by using <code+ >delay</code+ > to define the dynamic collection.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>bricks</span> <span class='hs-keyglyph'>←</span> <span class='hs-keyword'>do</span>+<span class='hs-varop'>></span> <span class='hs-varid'>bricksInit</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>brick</span> <span class='hs-varid'>brickPos0</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>bricksNext</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>snd</span> <span class='hs-varop'>.</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>isBrickNeeded</span> <span class='hs-varop'>.</span> <span class='hs-varid'>fst</span><span class='hs-layout'>)</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples</span> <span class='hs-varop'><*></span> <span class='hs-varid'>bricks</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>delay</span> <span class='hs-varid'>bricksInit</span> <span class='hs-varid'>bricksNext</span>+</pre><p+ >And knowing all these signals we can finally assemble the signal of rendering actions, i.e. the animation:</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>renderLevel</span> <span class='hs-varop'><$></span> <span class='hs-varid'>playerX</span> <span class='hs-varop'><*></span> <span class='hs-varid'>ballPos</span> <span class='hs-varop'><*></span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>getBrickData</span> <span class='hs-varop'><$></span> <span class='hs-varid'>brickSamples</span><span class='hs-layout'>)</span>+</pre><p+ >The <code+ >doRectsIntersect</code+ > function decides whether two rectangles defined by their top left corners and dimensions overlap.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>doRectsIntersect</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>y1</span> <span class='hs-varid'>sx1</span> <span class='hs-varid'>sy1</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>y2</span> <span class='hs-varid'>sx2</span> <span class='hs-varid'>sy2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>collIV</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>sx1</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>sx2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>collIV</span> <span class='hs-varid'>y1</span> <span class='hs-varid'>sy1</span> <span class='hs-varid'>y2</span> <span class='hs-varid'>sy2</span> <span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>collIV</span> <span class='hs-varid'>p1</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>p2</span> <span class='hs-varid'>s2</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>p1</span> <span class='hs-varop'><=</span> <span class='hs-varid'>p2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>p2</span> <span class='hs-varop'><=</span> <span class='hs-varid'>p1</span><span class='hs-varop'>+</span><span class='hs-varid'>s1</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-layout'>(</span><span class='hs-varid'>p2</span> <span class='hs-varop'><=</span> <span class='hs-varid'>p1</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>p1</span> <span class='hs-varop'><=</span> <span class='hs-varid'>p2</span><span class='hs-varop'>+</span><span class='hs-varid'>s2</span><span class='hs-layout'>)</span>-</pre><p>The <code>renderLevel</code> function takes a snapshot of the game and turns it into an IO action that displays this snapshot on the screen. The <code>breakout</code> signal is the time-varying version of this IO action.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>renderLevel</span> <span class='hs-varid'>playerX</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>ballX</span> <span class='hs-varid'>ballY</span><span class='hs-layout'>)</span> <span class='hs-varid'>bricks</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The <code+ >renderLevel</code+ > function takes a snapshot of the game and turns it into an IO action that displays this snapshot on the screen. The <code+ >breakout</code+ > signal is the time-varying version of this IO action.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>renderLevel</span> <span class='hs-varid'>playerX</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>ballX</span> <span class='hs-varid'>ballY</span><span class='hs-layout'>)</span> <span class='hs-varid'>bricks</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>drawRect</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>ys</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>loadIdentity</span> <span class='hs-varop'>></span> <span class='hs-varid'>renderPrimitive</span> <span class='hs-conid'>Quads</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>@@ -159,7 +281,27 @@ <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-varid'>flush</span> <span class='hs-varop'>></span> <span class='hs-varid'>swapBuffers</span>-</pre><h2 id="backend">Backend</h2><p>The <code>readInput</code> function has two responsibilities: it provides input for the <code>mousePosition</code> 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 <code>Nothing</code> instead of the current <code>dt</code> value wrapped in <code>Just</code>).</p><p>The <code>threadDelay</code> 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.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>readInput</span> <span class='hs-varid'>mousePos</span> <span class='hs-varid'>closed</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre></div+ ><div id="backend"+ ><h2+ >Backend</h2+ ><p+ >The <code+ >readInput</code+ > function has two responsibilities: it provides input for the <code+ >mousePosition</code+ > 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 <code+ >Nothing</code+ > instead of the current <code+ >dt</code+ > value wrapped in <code+ >Just</code+ >).</p+ ><p+ >The <code+ >threadDelay</code+ > 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.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>readInput</span> <span class='hs-varid'>mousePos</span> <span class='hs-varid'>closed</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>threadDelay</span> <span class='hs-num'>0</span> <span class='hs-varop'>></span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>get</span> <span class='hs-conid'>GLFW</span><span class='hs-varop'>.</span><span class='hs-varid'>time</span> <span class='hs-varop'>></span> <span class='hs-conid'>GLFW</span><span class='hs-varop'>.</span><span class='hs-varid'>time</span> <span class='hs-varop'>$=</span> <span class='hs-num'>0</span>@@ -168,12 +310,20 @@ <span class='hs-varop'>></span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>getKey</span> <span class='hs-conid'>ESC</span> <span class='hs-varop'>></span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>closed</span> <span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>c</span> <span class='hs-varop'>||</span> <span class='hs-varid'>k</span> <span class='hs-varop'>==</span> <span class='hs-conid'>Press</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>-</pre><p>The <code>initGL</code> function sets up almost nothing, which means that most functionality is turned off. Only alpha blending is enabled to provide some minimalistic eye candy.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>initGL</span> <span class='hs-varid'>width</span> <span class='hs-varid'>height</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The <code+ >initGL</code+ > function sets up almost nothing, which means that most functionality is turned off. Only alpha blending is enabled to provide some minimalistic eye candy.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>initGL</span> <span class='hs-varid'>width</span> <span class='hs-varid'>height</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>clearColor</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Color4</span> <span class='hs-num'>0</span> <span class='hs-num'>0</span> <span class='hs-num'>0</span> <span class='hs-num'>1</span> <span class='hs-varop'>></span> <span class='hs-varid'>blend</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Enabled</span> <span class='hs-varop'>></span> <span class='hs-varid'>blendFunc</span> <span class='hs-varop'>$=</span> <span class='hs-layout'>(</span><span class='hs-conid'>SrcAlpha</span><span class='hs-layout'>,</span><span class='hs-conid'>OneMinusSrcAlpha</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varid'>cullFace</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Just</span> <span class='hs-conid'>Back</span>-</pre><p>The resize callback feeds the <code>windowSize</code> signal through its sink besides adjusting the projection matrix.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>resizeGLScene</span> <span class='hs-varid'>winSize</span> <span class='hs-varid'>size</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The resize callback feeds the <code+ >windowSize</code+ > signal through its sink besides adjusting the projection matrix.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>resizeGLScene</span> <span class='hs-varid'>winSize</span> <span class='hs-varid'>size</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>winSize</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-varid'>viewport</span> <span class='hs-varop'>$=</span> <span class='hs-layout'>(</span><span class='hs-conid'>Position</span> <span class='hs-num'>0</span> <span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-varid'>size</span><span class='hs-layout'>)</span>@@ -183,27 +333,68 @@ <span class='hs-varop'>></span> <span class='hs-varid'>scale</span> <span class='hs-num'>1</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>w</span><span class='hs-varop'>/</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GLfloat</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-varid'>matrixMode</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Modelview</span> <span class='hs-num'>0</span>-</pre><h1 id="utils-module">Utils module</h1><p>This module contains some functions that might make it into the core library eventually.</p><pre><span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-keyword'>where</span>+</pre></div+ ></div+><div id="utils-module"+><h1+ >Utils module</h1+ ><p+ >This module contains some functions that might make it into the core library eventually.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-keyword'>where</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Param</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Vector</span>-</pre><p>The <code>driveNetwork</code> function simply executes the supersteps while the <code>driver</code> function keeps returning valid delta time values.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-varid'>driver</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The <code+ >driveNetwork</code+ > function simply executes the supersteps while the <code+ >driver</code+ > function keeps returning valid delta time values.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-varid'>driver</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>driver</span> <span class='hs-varop'>></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>dt</span> <span class='hs-keyword'>of</span>-<span class='hs-varop'>></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>→</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>join</span> <span class='hs-varop'>$</span> <span class='hs-varid'>superstep</span> <span class='hs-varid'>network</span> <span class='hs-varid'>dt</span>+<span class='hs-varop'>></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>→</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>join</span> <span class='hs-layout'>(</span><span class='hs-varid'>network</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-varid'>driver</span> <span class='hs-varop'>></span> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>-</pre><p>A scalar integral function for <code>Fractional</code> instances.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>integral</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>+</span><span class='hs-varid'>v</span><span class='hs-varop'>*</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>-</pre><p>An integral function for two-dimensional vectors defined in the <code>Vector</code> module.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>integralVec</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>^+^</span><span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-varop'>^*.</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>-</pre><h1 id="vector-module">Vector module</h1><p>This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type.</p><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances #-}</span>+</pre><p+ >A scalar integral function for <code+ >Fractional</code+ > instances.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>integral</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>+</span><span class='hs-varid'>v</span><span class='hs-varop'>*</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>+</pre><p+ >An integral function for two-dimensional vectors defined in the <code+ >Vector</code+ > module.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>^+^</span><span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-varop'>^*.</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>+</pre><p+ >A rising edge detector.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>edge</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+<span class='hs-varop'>></span> <span class='hs-varid'>s'</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-conid'>False</span> <span class='hs-varid'>s</span>+<span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>s'</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>x</span> <span class='hs-keyglyph'>→</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>s</span>+</pre><p+ >A latch that always remembers the last value of a <code+ >Maybe</code+ > signal wrapped in <code+ >Just</code+ >.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>storeJust</span> <span class='hs-varid'>x0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>x0</span> <span class='hs-varid'>store</span> <span class='hs-varid'>s</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>store</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>+<span class='hs-varop'>></span> <span class='hs-varid'>store</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>+</pre></div+><div id="vector-module"+><h1+ >Vector module</h1+ ><p+ >This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances #-}</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Vector</span> <span class='hs-keyword'>where</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Param</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Rendering</span><span class='hs-varop'>.</span><span class='hs-conid'>OpenGL</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>data</span> <span class='hs-conid'>Vec</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-layout'>{</span> <span class='hs-varid'>getX</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>GLfloat</span><span class='hs-layout'>,</span> <span class='hs-varid'>getY</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>GLfloat</span> <span class='hs-layout'>}</span>@@ -244,5 +435,8 @@ </pre></body> </html> +</div+> </body> </html>+
doc/Chase.html view
@@ -1,57 +1,84 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head>+ <title></title> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <meta name="generator" content="pandoc" />- <title></title>+ <meta name="date" content="" /> <link rel="stylesheet" href="hscolour.css" type="text/css" /> </head> <body>-<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><html>+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<html> <head> <!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ --><title>Haskell code</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /></head>-<body><h1 id="elerea-chase-example">Elerea Chase example</h1><p>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.</p><p>For a slightly more complex example check out <code>Breakout.lhs</code>.</p><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE RecursiveDo #-}</span>+<body><div id="elerea-chase-example"+><h1+ >Elerea Chase example</h1+ ><p+ >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.</p+ ><p+ >For a slightly more complex example check out <code+ >Breakout.lhs</code+ >.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE DoRec #-}</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Main</span> <span class='hs-keyword'>where</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IORef</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Param</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>UI</span><span class='hs-varop'>.</span><span class='hs-conid'>GLFW</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>GLFW</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Rendering</span><span class='hs-varop'>.</span><span class='hs-conid'>OpenGL</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Vector</span>-</pre><p>The <code>main</code> function contains the whole reactive logic. Note that <code>driveNetwork</code> is just a wrapper around the <code>superstep</code> function of the core library, and you can see its source below in the <code>Utils</code> module.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>main</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>-<span class='hs-varop'>></span> <span class='hs-varid'>initialize</span>-<span class='hs-varop'>></span> <span class='hs-varid'>openWindow</span> <span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-num'>640</span> <span class='hs-num'>480</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DisplayRGBBits</span> <span class='hs-num'>8</span> <span class='hs-num'>8</span> <span class='hs-num'>8</span><span class='hs-layout'>,</span> <span class='hs-conid'>DisplayAlphaBits</span> <span class='hs-num'>8</span><span class='hs-layout'>,</span> <span class='hs-conid'>DisplayDepthBits</span> <span class='hs-num'>24</span><span class='hs-keyglyph'>]</span> <span class='hs-conid'>Window</span>-<span class='hs-varop'>></span> <span class='hs-varid'>windowTitle</span> <span class='hs-varop'>$=</span> <span class='hs-str'>"Elerea Chase"</span>+</pre><p+ >The <code+ >main</code+ > function contains the whole reactive logic. Note that <code+ >driveNetwork</code+ > is just a simple loop, and you can see its source below in the <code+ >Utils</code+ > module.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>main</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+<span class='hs-varop'>></span> <span class='hs-varid'>initialize</span>+<span class='hs-varop'>></span> <span class='hs-varid'>openWindow</span> <span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-num'>640</span> <span class='hs-num'>480</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DisplayRGBBits</span> <span class='hs-num'>8</span> <span class='hs-num'>8</span> <span class='hs-num'>8</span><span class='hs-layout'>,</span> <span class='hs-conid'>DisplayAlphaBits</span> <span class='hs-num'>8</span><span class='hs-layout'>,</span> <span class='hs-conid'>DisplayDepthBits</span> <span class='hs-num'>24</span><span class='hs-keyglyph'>]</span> <span class='hs-conid'>Window</span>+<span class='hs-varop'>></span> <span class='hs-varid'>windowTitle</span> <span class='hs-varop'>$=</span> <span class='hs-str'>"Elerea Chase"</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>windowSize</span><span class='hs-layout'>,</span><span class='hs-varid'>windowSizeSink</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>external</span> <span class='hs-varid'>vnull</span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>mousePosition</span><span class='hs-layout'>,</span><span class='hs-varid'>mousePositionSink</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>external</span> <span class='hs-varid'>vnull</span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>mousePress</span><span class='hs-layout'>,</span><span class='hs-varid'>mousePressSink</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>external</span> <span class='hs-conid'>False</span>+<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>windowSize</span><span class='hs-layout'>,</span><span class='hs-varid'>windowSizeSink</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>external</span> <span class='hs-varid'>vnull</span>+<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>mousePosition</span><span class='hs-layout'>,</span><span class='hs-varid'>mousePositionSink</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>external</span> <span class='hs-varid'>vnull</span>+<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>mousePress</span><span class='hs-layout'>,</span><span class='hs-varid'>mousePressSink</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>external</span> <span class='hs-conid'>False</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-varid'>closed</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>newIORef</span> <span class='hs-conid'>False</span>-<span class='hs-varop'>></span> <span class='hs-varid'>windowSizeCallback</span> <span class='hs-varop'>$=</span> <span class='hs-varid'>resizeGLScene</span> <span class='hs-varid'>windowSizeSink</span>-<span class='hs-varop'>></span> <span class='hs-varid'>windowCloseCallback</span> <span class='hs-varop'>$=</span> <span class='hs-varid'>writeIORef</span> <span class='hs-varid'>closed</span> <span class='hs-conid'>True</span>-<span class='hs-varop'>></span> <span class='hs-varid'>initGL</span> <span class='hs-num'>640</span> <span class='hs-num'>480</span>+<span class='hs-varop'>></span> <span class='hs-varid'>closed</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>newIORef</span> <span class='hs-conid'>False</span>+<span class='hs-varop'>></span> <span class='hs-varid'>windowSizeCallback</span> <span class='hs-varop'>$=</span> <span class='hs-varid'>resizeGLScene</span> <span class='hs-varid'>windowSizeSink</span>+<span class='hs-varop'>></span> <span class='hs-varid'>windowCloseCallback</span> <span class='hs-varop'>$=</span> <span class='hs-varid'>writeIORef</span> <span class='hs-varid'>closed</span> <span class='hs-conid'>True</span>+<span class='hs-varop'>></span> <span class='hs-varid'>initGL</span> <span class='hs-num'>640</span> <span class='hs-num'>480</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-varid'>greyPos</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>createSignal</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>mdo</span>+<span class='hs-varop'>></span> <span class='hs-varid'>network</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>start</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>mouseClick</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>edge</span> <span class='hs-varid'>mousePress</span>-<span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>acc</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>mousePosition</span><span class='hs-varop'>^-^</span><span class='hs-varid'>pos</span><span class='hs-layout'>)</span><span class='hs-varop'>^*.</span><span class='hs-num'>0.3</span>-<span class='hs-varop'>></span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>vnull</span> <span class='hs-varid'>vel</span>-<span class='hs-varop'>></span> <span class='hs-varid'>vel0</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>vnull</span> <span class='hs-varid'>acc</span>-<span class='hs-varop'>></span> <span class='hs-varid'>vel</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>sampler</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>storeJust</span> <span class='hs-varid'>vel0</span> <span class='hs-varop'>.</span> <span class='hs-varid'>generator</span> <span class='hs-varid'>mouseClick</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>integralVec</span> <span class='hs-varop'><$></span> <span class='hs-varid'>vel</span><span class='hs-varop'>^+^</span><span class='hs-varid'>pos</span><span class='hs-varop'>^-^</span><span class='hs-varid'>mousePosition</span> <span class='hs-varop'><*></span> <span class='hs-varid'>pure</span> <span class='hs-varid'>acc</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>rec</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>newVel</span> <span class='hs-varid'>clk</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>clk</span> <span class='hs-keyword'>of</span>+<span class='hs-varop'>></span> <span class='hs-conid'>True</span> <span class='hs-keyglyph'>→</span> <span class='hs-conid'>Just</span> <span class='hs-varop'><$></span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>acc</span>+<span class='hs-varop'>></span> <span class='hs-conid'>False</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>+<span class='hs-varop'>></span> <span class='hs-varid'>acc</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>mousePosition</span><span class='hs-varop'>^-^</span><span class='hs-varid'>pos</span><span class='hs-layout'>)</span><span class='hs-varop'>^*.</span><span class='hs-num'>0.3</span>+<span class='hs-varop'>></span> <span class='hs-varid'>vel0</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>vnull</span> <span class='hs-varid'>acc</span>+<span class='hs-varop'>></span> <span class='hs-varid'>vels</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>storeJust</span> <span class='hs-varid'>vel0</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>generator</span> <span class='hs-layout'>(</span><span class='hs-varid'>newVel</span> <span class='hs-varop'><$></span> <span class='hs-varid'>mouseClick</span> <span class='hs-varop'><*></span> <span class='hs-varid'>vel</span><span class='hs-varop'>^+^</span><span class='hs-varid'>pos</span><span class='hs-varop'>^-^</span><span class='hs-varid'>mousePosition</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>vel</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-varid'>vnull</span> <span class='hs-layout'>(</span><span class='hs-varid'>join</span> <span class='hs-varid'>vels</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-varid'>vnull</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>vnull</span> <span class='hs-varid'>vel</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-varid'>pos</span>+<span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>render</span> <span class='hs-varop'><$></span> <span class='hs-varid'>windowSize</span> <span class='hs-varop'><*></span> <span class='hs-varid'>mousePosition</span> <span class='hs-varop'><*></span> <span class='hs-varid'>pos</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-layout'>(</span><span class='hs-varid'>render</span> <span class='hs-varop'><$></span> <span class='hs-varid'>windowSize</span> <span class='hs-varop'><*></span> <span class='hs-varid'>mousePosition</span> <span class='hs-varop'><*></span> <span class='hs-varid'>greyPos</span><span class='hs-layout'>)</span>-<span class='hs-varop'>></span> <span class='hs-layout'>(</span><span class='hs-varid'>readInput</span> <span class='hs-varid'>mousePositionSink</span> <span class='hs-varid'>mousePressSink</span> <span class='hs-varid'>closed</span><span class='hs-layout'>)</span>+<span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-layout'>(</span><span class='hs-varid'>readInput</span> <span class='hs-varid'>mousePositionSink</span> <span class='hs-varid'>mousePressSink</span> <span class='hs-varid'>closed</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span>-<span class='hs-varop'>></span> <span class='hs-varid'>closeWindow</span>-</pre><p>The <code>render</code> 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 <code>driveNetwork</code> function is the time-varying version of the IO action returned here.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>render</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>cx</span> <span class='hs-varid'>cy</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>ox</span> <span class='hs-varid'>oy</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+<span class='hs-varop'>></span> <span class='hs-varid'>closeWindow</span>+</pre><p+ >The <code+ >render</code+ > 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 <code+ >driveNetwork</code+ > function is the time-varying version of the IO action returned here.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>render</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>cx</span> <span class='hs-varid'>cy</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-varid'>ox</span> <span class='hs-varid'>oy</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>drawSquare</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>loadIdentity</span> <span class='hs-varop'>></span> <span class='hs-varid'>translate</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Vector3</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-varop'>/</span><span class='hs-varid'>w</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>h</span><span class='hs-varop'>/</span><span class='hs-varid'>w</span><span class='hs-comment'>-</span><span class='hs-varid'>y</span><span class='hs-varop'>/</span><span class='hs-varid'>w</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>)</span> <span class='hs-num'>0</span>@@ -70,7 +97,13 @@ <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-varid'>flush</span> <span class='hs-varop'>></span> <span class='hs-varid'>swapBuffers</span>-</pre><p>The <code>readInput</code> function provides the driver layer. It feeds the peripheral-bound signals and also decides when to stop execution by returning <code>Nothing</code> instead of the time elapsed since its last call.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>readInput</span> <span class='hs-varid'>mousePos</span> <span class='hs-varid'>mouseBut</span> <span class='hs-varid'>closed</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The <code+ >readInput</code+ > function provides the driver layer. It feeds the peripheral-bound signals and also decides when to stop execution by returning <code+ >Nothing</code+ > instead of the time elapsed since its last call.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>readInput</span> <span class='hs-varid'>mousePos</span> <span class='hs-varid'>mouseBut</span> <span class='hs-varid'>closed</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>get</span> <span class='hs-conid'>GLFW</span><span class='hs-varop'>.</span><span class='hs-varid'>time</span> <span class='hs-varop'>></span> <span class='hs-conid'>GLFW</span><span class='hs-varop'>.</span><span class='hs-varid'>time</span> <span class='hs-varop'>$=</span> <span class='hs-num'>0</span> <span class='hs-varop'>></span> <span class='hs-conid'>Position</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>get</span> <span class='hs-conid'>GLFW</span><span class='hs-varop'>.</span><span class='hs-varid'>mousePos</span>@@ -80,11 +113,17 @@ <span class='hs-varop'>></span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>getKey</span> <span class='hs-conid'>ESC</span> <span class='hs-varop'>></span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>closed</span> <span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>c</span> <span class='hs-varop'>||</span> <span class='hs-varid'>k</span> <span class='hs-varop'>==</span> <span class='hs-conid'>Press</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>-</pre><p>OpenGL is initialised with practically everything turned off. Only alpha blending is needed to be able to use translucent colours.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>initGL</span> <span class='hs-varid'>width</span> <span class='hs-varid'>height</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >OpenGL is initialised with practically everything turned off. Only alpha blending is needed to be able to use translucent colours.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>initGL</span> <span class='hs-varid'>width</span> <span class='hs-varid'>height</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>clearColor</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Color4</span> <span class='hs-num'>0</span> <span class='hs-num'>0</span> <span class='hs-num'>0</span> <span class='hs-num'>1</span> <span class='hs-varop'>></span> <span class='hs-varid'>blend</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Enabled</span> <span class='hs-varop'>></span> <span class='hs-varid'>blendFunc</span> <span class='hs-varop'>$=</span> <span class='hs-layout'>(</span><span class='hs-conid'>SrcAlpha</span><span class='hs-layout'>,</span><span class='hs-conid'>OneMinusSrcAlpha</span><span class='hs-layout'>)</span>-</pre><p>The window size callback takes care of the <code>windowSize</code> signal and the projection matrix.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>resizeGLScene</span> <span class='hs-varid'>winSize</span> <span class='hs-varid'>size</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The window size callback takes care of the <code+ >windowSize</code+ > signal and the projection matrix.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>resizeGLScene</span> <span class='hs-varid'>winSize</span> <span class='hs-varid'>size</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Size</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>winSize</span> <span class='hs-layout'>(</span><span class='hs-conid'>V</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-varid'>viewport</span> <span class='hs-varop'>$=</span> <span class='hs-layout'>(</span><span class='hs-conid'>Position</span> <span class='hs-num'>0</span> <span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-varid'>size</span><span class='hs-layout'>)</span>@@ -94,27 +133,67 @@ <span class='hs-varop'>></span> <span class='hs-varid'>scale</span> <span class='hs-num'>1</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>w</span><span class='hs-varop'>/</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GLfloat</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-varid'>matrixMode</span> <span class='hs-varop'>$=</span> <span class='hs-conid'>Modelview</span> <span class='hs-num'>0</span>-</pre><h1 id="utils-module">Utils module</h1><p>This module contains some functions that might make it into the core library eventually.</p><pre><span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-keyword'>where</span>+</pre></div+><div id="utils-module"+><h1+ >Utils module</h1+ ><p+ >This module contains some functions that might make it into the core library eventually.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-keyword'>where</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Param</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Vector</span>-</pre><p>The <code>driveNetwork</code> function simply executes the supersteps while the <code>driver</code> function keeps returning valid delta time values.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-varid'>driver</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+</pre><p+ >The <code+ >driveNetwork</code+ > function simply executes the supersteps while the <code+ >driver</code+ > function keeps returning valid delta time values.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-varid'>driver</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varop'>></span> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>driver</span> <span class='hs-varop'>></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>dt</span> <span class='hs-keyword'>of</span>-<span class='hs-varop'>></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>→</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>join</span> <span class='hs-varop'>$</span> <span class='hs-varid'>superstep</span> <span class='hs-varid'>network</span> <span class='hs-varid'>dt</span>+<span class='hs-varop'>></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>→</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>join</span> <span class='hs-layout'>(</span><span class='hs-varid'>network</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span> <span class='hs-varop'>></span> <span class='hs-varid'>driveNetwork</span> <span class='hs-varid'>network</span> <span class='hs-varid'>driver</span> <span class='hs-varop'>></span> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>-</pre><p>A scalar integral function for <code>Fractional</code> instances.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>integral</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>+</span><span class='hs-varid'>v</span><span class='hs-varop'>*</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>-</pre><p>An integral function for two-dimensional vectors defined in the <code>Vector</code> module.</p><pre><span class='hs-varop'>></span> <span class='hs-definition'>integralVec</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>^+^</span><span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-varop'>^*.</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>-</pre><h1 id="vector-module">Vector module</h1><p>This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type.</p><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances #-}</span>+</pre><p+ >A scalar integral function for <code+ >Fractional</code+ > instances.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>integral</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>+</span><span class='hs-varid'>v</span><span class='hs-varop'>*</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>+</pre><p+ >An integral function for two-dimensional vectors defined in the <code+ >Vector</code+ > module.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>integralVec</span> <span class='hs-varid'>v0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>v0</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dt</span> <span class='hs-varid'>v</span> <span class='hs-varid'>v0</span> <span class='hs-keyglyph'>→</span> <span class='hs-varid'>v0</span><span class='hs-varop'>^+^</span><span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-varop'>^*.</span><span class='hs-varid'>realToFrac</span> <span class='hs-varid'>dt</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>+</pre><p+ >A rising edge detector.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>edge</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>+<span class='hs-varop'>></span> <span class='hs-varid'>s'</span> <span class='hs-keyglyph'>←</span> <span class='hs-varid'>delay</span> <span class='hs-conid'>False</span> <span class='hs-varid'>s</span>+<span class='hs-varop'>></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>s'</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>x</span> <span class='hs-keyglyph'>→</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>s</span>+</pre><p+ >A latch that always remembers the last value of a <code+ >Maybe</code+ > signal wrapped in <code+ >Just</code+ >.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-varid'>storeJust</span> <span class='hs-varid'>x0</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transfer</span> <span class='hs-varid'>x0</span> <span class='hs-varid'>store</span> <span class='hs-varid'>s</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>where</span> <span class='hs-varid'>store</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>+<span class='hs-varop'>></span> <span class='hs-varid'>store</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>+</pre></div+><div id="vector-module"+><h1+ >Vector module</h1+ ><p+ >This module contains a class for two-dimensional vectors, a strict datatype to instantiate it, and another instance for signals of the same type.</p+ ><pre><span class='hs-varop'>></span> <span class='hs-comment'>{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances #-}</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>module</span> <span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>Vector</span> <span class='hs-keyword'>where</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span>-<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Legacy</span>+<span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>FRP</span><span class='hs-varop'>.</span><span class='hs-conid'>Elerea</span><span class='hs-varop'>.</span><span class='hs-conid'>Param</span> <span class='hs-varop'>></span> <span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Rendering</span><span class='hs-varop'>.</span><span class='hs-conid'>OpenGL</span> <span class='hs-varop'>></span> <span class='hs-varop'>></span> <span class='hs-keyword'>data</span> <span class='hs-conid'>Vec</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>V</span> <span class='hs-layout'>{</span> <span class='hs-varid'>getX</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>GLfloat</span><span class='hs-layout'>,</span> <span class='hs-varid'>getY</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>GLfloat</span> <span class='hs-layout'>}</span>@@ -155,5 +234,8 @@ </pre></body> </html> +</div+> </body> </html>+
elerea-examples.cabal view
@@ -1,5 +1,5 @@ Name: elerea-examples-Version: 2.2.0+Version: 2.2.1 Cabal-Version: >= 1.2 Synopsis: Example applications for Elerea Category: reactivity, FRP@@ -12,19 +12,16 @@ . The programs included are the following: .- * bounce (current): an example for creating dynamic collections of- signals with the experimental interface; left click to create- balls, drag existing balls with left button to propel them and- drag with right to select balls for deletion (upon release)+ * bounce: an example for creating dynamic collections of signals;+ left click to create balls, drag existing balls with left button+ to propel them and drag with right to select balls for deletion+ (upon release); .- * chase (legacy): a minimal example that demonstrates reactivity and- mutually recursive signals+ * chase: a minimal example that demonstrates reactivity and mutually+ recursive signals; .- * breakout (legacy): a not too fancy breakout clone that also- demonstrates Graphviz output; you can get an SVG rendition of the- signal structure with the following command if Graphviz is- installed: @elerea-breakout --dump-dot | dot -Tsvg -o- breakout.svg@+ * breakout: a not too fancy breakout clone; you can simply use the+ mouse to move the paddle. Author: Patai Gergely Maintainer: Patai Gergely (patai@iit.bme.hu)
src/Bounce/Event.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE DoRec #-} module Event where @@ -6,27 +6,27 @@ import Control.Monad import Control.Monad.Fix import Data.Maybe-import FRP.Elerea.Legacy.Delayed+import FRP.Elerea.Param import Util -- | Events are signals with an option type.-type Event p a = Signal p (Maybe a)+type Event a = Signal (Maybe a) -- | Sample a signal whenever a changing condition is true.-ifE :: Signal p Bool -> Signal p a -> Event p a+ifE :: Signal Bool -> Signal a -> Event a ifE c s = c >>= \b -> if b then Just <$> s else return Nothing -- | Left-biased merge.-leftE :: Event p a -> Event p a -> Event p a+leftE :: Event a -> Event a -> Event a leftE e1 e2 = e1 >>= maybeE e2 -- | Right-biased merge.-rightE :: Event p a -> Event p a -> Event p a+rightE :: Event a -> Event a -> Event a rightE e1 e2 = e2 >>= maybeE e1 -- | Left-biased merge of several events.-mergeE :: [Event p a] -> Event p a+mergeE :: [Event a] -> Event a mergeE [] = return Nothing mergeE (e:es) = e >>= maybeE (mergeE es) @@ -34,13 +34,13 @@ -- a function to derive the corresponding signal of the removal -- condition (the signal is removed when the associated removal signal -- is 'True' for the first time).-collectE :: Event p a -> (a -> Signal p Bool) -> SignalGen p (Signal p [a])-collectE e f = mdo- col <- delay [] col'- col' <- dmemo [] $ filterM (fmap not . f) =<< liftM2 ((++).maybeToList) e col+collectE :: Event a -> (a -> Signal Bool) -> SignalGen p (Signal [a])+collectE e f = do+ rec col <- delay [] col'+ col' <- memo $ filterM (fmap not . f) =<< liftM2 ((++).maybeToList) e col return col' -- | A helper function equivalent to @flip maybe (return.Just)@.-maybeE :: Event p a -> Maybe a -> Event p a+maybeE :: Event a -> Maybe a -> Event a maybeE e Nothing = e maybeE _ jx = return jx
src/Bounce/Main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecursiveDo, NoMonomorphismRestriction #-}+{-# LANGUAGE DoRec, NoMonomorphismRestriction #-} module Main where @@ -7,7 +7,7 @@ import Data.IORef import Data.List import Data.Maybe-import FRP.Elerea.Legacy.Delayed+import FRP.Elerea.Param import Graphics.UI.GLFW as GLFW import Graphics.Rendering.OpenGL @@ -32,26 +32,27 @@ -- * existing balls can be dragged and propelled with the left button, -- * dragging with the right button creates a rectangle; every ball -- within the rectangle is deleted when the button is released.-bounceDemo renderFun mousePos mousePress = mdo- leftPress <- memo $ fst <$> mousePress- rightPress <- memo $ snd <$> mousePress+bounceDemo renderFun mousePos mousePress = do+ rec leftPress <- memo $ fst <$> mousePress+ rightPress <- memo $ snd <$> mousePress - (killDrag,killNow) <- dragRectangle mousePos rightPress- killRect <- (vnull,vnull) --> killDrag- let within (V tlx tly,V brx bry) (V x y) = x > min tlx brx && x < max tlx brx &&- y > min tly bry && y < max tly bry+ (killDrag,killNow) <- dragRectangle mousePos rightPress+ killRect <- (vnull,vnull) --> killDrag+ let within (V tlx tly,V brx bry) (V x y) = x > min tlx brx && x < max tlx brx &&+ y > min tly bry && y < max tly bry - ballList <- collectE newBallE $ \bs -> killNow &&@ (within <$> killRect <*> (ballPos <$> bs))- ballData <- memo $ sequence =<< ballList- -- Change edge to memo below to be able to add lots of balls with ease!- newBallCond <- edge $ leftPress &&@ (all (not.ballDrag) <$> ballData)- newBallE <- generator $ newBall <$> mousePos <*> newBallCond- let newBall pos cond = if cond- then Just <$> ball pos mousePos leftPress- else return Nothing+ ballList <- collectE newBallE' $ \bs -> killNow &&@ (within <$> killRect <*> (ballPos <$> bs))+ ballData <- memo $ sequence =<< ballList+ -- Change edge to memo below to be able to add lots of balls with ease!+ newBallCond <- edge $ leftPress &&@ (all (not.ballDrag) <$> ballData)+ newBallE <- generator $ newBall <$> mousePos <*> newBallCond+ newBallE' <- delay Nothing newBallE+ let newBall pos cond = if cond+ then Just <$> ball pos mousePos leftPress+ else return Nothing - frameCount <- stateful 0 (const (+1))- fps <- derivT 2 frameCount+ frameCount <- stateful 0 (const (+1))+ fps <- derivT 2 frameCount return $ renderFun <$> ballData <*> killDrag <*> fps @@ -71,21 +72,23 @@ -- A ball that bounces within the box and can be dragged. It flashes -- every time its velocity changes.-ball initPos mousePos mousePress = mdo- mouseDown <- edge mousePress- let dragBegin = mouseDown &&@ (vlen (pos^-^mousePos) <@ ballSize/2)- dragEnd <- edge (not <$> mousePress)- drag <- flipflop dragBegin dragEnd- dragVel <- derivTV 0.05 mousePos+ball initPos mousePos mousePress = do+ rec mouseDown <- edge mousePress+ let dragBegin = mouseDown &&@ (vlen (pos'^-^mousePos) <@ ballSize/2)+ dragEnd <- edge (not <$> mousePress)+ drag <- flipflop dragBegin dragEnd+ dragVel <- derivTV 0.05 mousePos - let collHorz (V vx _) (V px _) = collFrame vx px- collVert (V _ vy) (V _ py) = collFrame vy py- collFrame v p = abs (p-0.5) > 0.5-(frameThickness+ballSize/2) && (p-0.5)*v > 0- pos <- integralV initPos vel- vel <- vnull --> velE- velE <- memo $ mergeE [ifE drag dragVel,- ifE (collHorz <$> vel <*> pos) (mul (V (-1) 1) <$> vel),- ifE (collVert <$> vel <*> pos) (mul (V 1 (-1)) <$> vel)]+ let collHorz (V vx _) (V px _) = collFrame vx px+ collVert (V _ vy) (V _ py) = collFrame vy py+ collFrame v p = abs (p-0.5) > 0.5-(frameThickness+ballSize/2) && (p-0.5)*v > 0+ pos <- integralV initPos vel+ pos' <- delay initPos pos+ vel <- vnull --> velE+ vel' <- delay vnull vel+ velE <- memo $ mergeE [ifE drag dragVel,+ ifE (collHorz <$> vel' <*> pos') (mul (V (-1) 1) <$> vel'),+ ifE (collVert <$> vel' <*> pos') (mul (V 1 (-1)) <$> vel')] colour <- ballColour (isJust <$> velE)
src/Bounce/Math.hs view
@@ -1,38 +1,38 @@-{-# LANGUAGE RecursiveDo, NoMonomorphismRestriction #-}+{-# LANGUAGE NoMonomorphismRestriction #-} module Math where import Control.Applicative import Data.List-import FRP.Elerea.Legacy.Delayed+import FRP.Elerea.Param import Vector import Util {-| Scalar integral. -}-integral :: (Num a) => a -> Signal a a -> SignalGen a (Signal a a)+integral :: (Num a) => a -> Signal a -> SignalGen a (Signal a) integral v0 s = transfer v0 (\dt v v0 -> v0+v*dt) s {-| Vector integral. -}-integralV :: (Vector2D v c) => v -> Signal c v -> SignalGen c (Signal c v)+integralV :: (Vector2D v c) => v -> Signal v -> SignalGen c (Signal v) integralV v0 s = transfer v0 (\dt v v0 -> v0^+^(v^*.dt)) s {-| Scalar derivative by the last two values. -}-deriv :: (Fractional a) => Signal a a -> SignalGen a (Signal a a)+deriv :: (Fractional a) => Signal a -> SignalGen a (Signal a) deriv s = do sig <- transfer (0,0,1) (\dt v (v0,_,_) -> (v,v0,dt)) s initSignal 0 (d <$> sig) where d (x',x,dt) = (x'-x)/dt {-| Vector derivative by the last two values. -}-derivV :: (Vector2D v c, Num c) => Signal c v -> SignalGen c (Signal c v)+derivV :: (Vector2D v c, Num c) => Signal v -> SignalGen c (Signal v) derivV s = do sig <- transfer (vnull,vnull,1) (\dt v (v0,_,_) -> (v,v0,dt)) s initSignal vnull (d <$> sig) where d (x',x,dt) = (x'^-^x)^/.dt {-| Scalar derivative by a given time period. -}-derivT :: (Fractional a, Ord a) => a -> Signal a a -> SignalGen a (Signal a a)+derivT :: (Fractional a, Ord a) => a -> Signal a -> SignalGen a (Signal a) derivT wt s = do sig <- transfer (0,(0,0)) d s return (fst <$> sig)@@ -40,7 +40,7 @@ where t' = dt+t {-| Vector derivative by a given time period. -}-derivTV :: (Vector2D v c, Ord c, Num c) => c -> Signal c v -> SignalGen c (Signal c v)+derivTV :: (Vector2D v c, Ord c, Num c) => c -> Signal v -> SignalGen c (Signal v) derivTV wt s = do sig <- transfer (vnull,(vnull,0)) d s return (fst <$> sig)@@ -48,13 +48,13 @@ where t' = dt+t {-| Scalar moving average of a given number of recent samples. -}-movingAvg :: (Fractional a) => a -> Signal p a -> SignalGen p (Signal p a)+movingAvg :: (Fractional a) => a -> Signal a -> SignalGen p (Signal a) movingAvg n s = do sig <- scanM n (delay 0) s return $ ((/n).sum) <$> sequence sig {-| Vector moving average of a given number of recent samples. -}-movingAvgV :: (Vector2D v c, Num c) => c -> Signal p v -> SignalGen p (Signal p v)+movingAvgV :: (Vector2D v c, Num c) => c -> Signal v -> SignalGen p (Signal v) movingAvgV n s = do sig <- scanM n (delay vnull) s return $ ((^/.n).foldl1' (^+^)) <$> sequence sig
src/Bounce/Util.hs view
@@ -1,7 +1,7 @@ module Util where import Control.Applicative-import FRP.Elerea.Legacy.Delayed+import FRP.Elerea.Param -- Lifted conditional. ifS c s1 s2 = c >>= \b -> if b then s1 else s2@@ -17,9 +17,6 @@ xs <- scanM (n-1) f x return (x:xs) --- Optional delay. Should memo behave like this?-dmemo = flip transfer (const const)- -- Functions moved over from the old Experimental top module infix 4 ==@, /=@, <@, <=@, >=@, >@@@ -30,47 +27,47 @@ -- | 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.-edge :: Signal p Bool -> SignalGen p (Signal p Bool)+edge :: Signal Bool -> SignalGen p (Signal Bool) edge b = delay True b >>= \db -> return $ (not <$> db) &&@ b -- | The '-->' transfer function behaves as a latch on a 'Maybe' -- input: it keeps its state when the input is 'Nothing', and replaces -- it with the input otherwise.-(-->) :: a -- ^ Initial output- -> Signal p (Maybe a) -- ^ Maybe signal to latch on- -> SignalGen p (Signal p a)+(-->) :: a -- ^ Initial output+ -> Signal (Maybe a) -- ^ Maybe signal to latch on+ -> SignalGen p (Signal a) x0 --> s = transfer x0 store s where store _ Nothing x = x store _ (Just x) _ = x -- | Point-wise equality of two signals.-(==@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool+(==@) :: Eq a => Signal a -> Signal a -> Signal Bool (==@) = liftA2 (==) -- | Point-wise inequality of two signals.-(/=@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool+(/=@) :: Eq a => Signal a -> Signal a -> Signal Bool (/=@) = liftA2 (/=) -- | Point-wise comparison of two signals.-(<@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(<@) :: Ord a => Signal a -> Signal a -> Signal Bool (<@) = liftA2 (<) -- | Point-wise comparison of two signals.-(<=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(<=@) :: Ord a => Signal a -> Signal a -> Signal Bool (<=@) = liftA2 (<=) -- | Point-wise comparison of two signals.-(>=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(>=@) :: Ord a => Signal a -> Signal a -> Signal Bool (>=@) = liftA2 (>=) -- | Point-wise comparison of two signals.-(>@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(>@) :: Ord a => Signal a -> Signal a -> Signal Bool (>@) = liftA2 (>) -- | Point-wise OR of two boolean signals.-(||@) :: Signal p Bool -> Signal p Bool -> Signal p Bool+(||@) :: Signal Bool -> Signal Bool -> Signal Bool s1 ||@ s2 = s1 >>= \b -> if b then return True else s2 -- | Point-wise AND of two boolean signals.-(&&@) :: Signal p Bool -> Signal p Bool -> Signal p Bool+(&&@) :: Signal Bool -> Signal Bool -> Signal Bool s1 &&@ s2 = s1 >>= \b -> if b then s2 else return False
src/Bounce/Vector.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances #-} module Vector where import Control.Applicative-import FRP.Elerea.Legacy.Delayed+import FRP.Elerea.Param import Graphics.Rendering.OpenGL data Vec = V { getX :: {-# UNPACK #-} !GLfloat, getY :: {-# UNPACK #-} !GLfloat }@@ -40,7 +40,7 @@ vlen (V x y) = sqrt (x*x+y*y) V x1 y1 `mul` V x2 y2 = V (x1*x2) (y1*y2) -instance Vector2D (Signal p Vec) (Signal p GLfloat) where+instance Vector2D (Signal Vec) (Signal GLfloat) where (^+^) = liftA2 (^+^) (^-^) = liftA2 (^-^) (^*.) = liftA2 (^*.)
src/Breakout.lhs view
@@ -21,17 +21,9 @@ <img src="Breakout.png" alt="Elerea Breakout in action" /> -You can also have the program output the signal structure in-[Graphviz](http://www.graphviz.org/) dot format with the `--dump-dot`-switch after the game is over. For instance, if Graphviz is-installed, you can get an SVG rendition of the graph using the-following command:--`elerea-breakout --dump-dot | dot -Tsvg -o breakout.svg`- Below follows the full source of the example. -> {-# LANGUAGE RecursiveDo #-}+> {-# LANGUAGE DoRec #-} > > module Main where >@@ -42,8 +34,7 @@ > import Data.List > import Data.Maybe > import Data.Traversable hiding (mapM)-> import FRP.Elerea.Legacy-> import FRP.Elerea.Legacy.Graph+> import FRP.Elerea.Param > import Graphics.UI.GLFW as GLFW > import Graphics.Rendering.OpenGL > import System.Environment@@ -130,17 +121,11 @@ > > -- All we need to get going is an IO-valued signal and an IO > -- function to update the external signals-> game <- createSignal $ breakout mousePosition windowSize+> game <- start (breakout mousePosition windowSize) > driveNetwork game (readInput mousePositionSink closed) > > -- The inevitable sad ending > closeWindow->-> -- Providing input for graphviz-> args <- getArgs-> when ("--dump-dot" `elem` args) $ do-> gameGraph <- signalToDot game-> putStr gameGraph The `breakout` function creates a reactive signal that carries the rendering actions to be performed at each instant. The principal@@ -167,23 +152,29 @@ which carries the snapshots of all the brick signals. This is the `brickSamples` signal. -> breakout mousePos windowSize = mdo+> breakout mousePos windowSize = do User-driven player position: -> let playerX = adjustPlayerPos <$> mousePos <*> windowSize-> adjustPlayerPos (V x _) (V w _) = min (fieldW-playerW) $ max (-fieldW) $ 2*x/w-1-playerW/2+> rec let playerX = adjustPlayerPos <$> mousePos <*> windowSize+> adjustPlayerPos (V x _) (V w _) = min (fieldW-playerW) $ max (-fieldW) $ 2*x/w-1-playerW/2+> (||@) = liftA2 (||)+> toMaybe c v = if c then Just v else Nothing Ball state: position and velocity. We use a combination of `storeJust` and `toMaybe` to produce a latcher element that stores the value of a certain signal whenever a boolean control signal yields-true.+true. We need to create delayed versions in order to have+well-defined feedback loops. -> ballPos <- integralVec ballPos0 ballVel-> ballVel <- storeJust ballVel0 $-> toMaybe <$> (ballCollHorz ||@ ballCollVert ||@ ballCollPlayer) <*>-> (adjustVel <$> ballCollHorz <*> ballCollVert <*> ballCollPlayer <*>-> ballVel <*> ballNewVelX)+> ballPos <- integralVec ballPos0 ballVel+> ballVel <- storeJust ballVel0 $+> toMaybe <$> (ballCollHorz ||@ ballCollVert ||@ ballCollPlayer) <*>+> (adjustVel <$> ballCollHorz <*> ballCollVert <*> ballCollPlayer <*>+> ballVel' <*> ballNewVelX)+>+> ballPos' <- delay ballPos0 ballPos+> ballVel' <- delay ballVel0 ballVel The `adjustVel` function calculates a candidate velocity for the next frame given collision information and the current velocity. Even@@ -192,10 +183,10 @@ nodes. In the end, velocity is only recalculated when a collision is detected. -> let 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)+> let 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@@ -203,16 +194,16 @@ does not hold in the next instant, so there is no need to push these through an `edge` transfer function. -> ballCollHorz = (or . map getBrickHColl <$> brickSamples)-> ||@ (check <$> ballPos <*> ballVel)-> where check (V bx _) (V bvx _) = (bx < -fieldW && bvx < 0) ||-> (bx > fieldW-ballW && bvx > 0)-> ballCollVert = (or . map getBrickVColl <$> brickSamples)-> ||@ (check <$> ballPos <*> ballVel)-> where check (V _ 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+> ballCollHorz = (any getBrickHColl <$> brickSamples')+> ||@ (check <$> ballPos' <*> ballVel')+> where check (V bx _) (V bvx _) = (bx < -fieldW && bvx < 0) ||+> (bx > fieldW-ballW && bvx > 0)+> ballCollVert = (any getBrickVColl <$> brickSamples')+> ||@ (check <$> ballPos' <*> ballVel')+> where check (V _ 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 Bricks are defined by the updater function `evolveBrick` as a transformer of the ball position. The transfer function takes care of@@ -223,27 +214,27 @@ it's simpler and more efficient to let the outer world see the results of these checks instead of having to recalculate them. -> let brick (x,y) = transfer (x,y,Live,False,False) evolveBrick ballPos-> getBrickData (x,y,s,_,_) = (x,y,s)-> getBrickHColl (_,_,_,c,_) = c-> getBrickVColl (_,_,_,_,c) = c+> let brick (x,y) = transfer (x,y,Live,False,False) evolveBrick ballPos+> getBrickData (x,y,s,_,_) = (x,y,s)+> getBrickHColl (_,_,_,c,_) = c+> getBrickVColl (_,_,_,_,c) = c >-> evolveBrick dt _ (x,y,Dying a,_,_) = (x,y,Dying (a-realToFrac dt*brickFade),False,False)-> evolveBrick dt (V bx by) (x,y,_,_,_) = (x,y,if isKilled then Dying 1 else Live,collHorz,collVert)-> where isKilled = isHit || by < -fieldH-ballH-> isHit = doRectsIntersect bx by ballW ballH x y brickW brickH-> collHorz = isHit && isHorz-> collVert = isHit && not isHorz-> isHorz = xDist/brickW > yDist/brickH-> where xDist = abs ((x+brickW/2)-(bx+ballW/2))-> yDist = abs ((y+brickH/2)-(by+ballH/2))+> evolveBrick dt _ (x,y,Dying a,_,_) = (x,y,Dying (a-realToFrac dt*brickFade),False,False)+> evolveBrick dt (V bx by) (x,y,_,_,_) = (x,y,if isKilled then Dying 1 else Live,collHorz,collVert)+> where isKilled = isHit || by < -fieldH-ballH+> isHit = doRectsIntersect bx by ballW ballH x y brickW brickH+> collHorz = isHit && isHorz+> collVert = isHit && not isHorz+> isHorz = xDist/brickW > yDist/brickH+> where xDist = abs ((x+brickW/2)-(bx+ballW/2))+> yDist = abs ((y+brickH/2)-(by+ballH/2)) The `isBrickNeeded` function is used to decide whether a brick should be kept in the collection. As soon as it turns false, the brick in question is removed from the `bricks` signal. -> isBrickNeeded (_,_,Dying a,_,_) = a > 0-> isBrickNeeded (_,_,Live ,_,_) = True+> isBrickNeeded (_,_,Dying a,_,_) = a > 0+> isBrickNeeded (_,_,Live ,_,_) = True The `brickSamples` signal contains a snapshot of every brick, and it's obtained simply by traversing the collection (this is equivalent to@@ -251,7 +242,9 @@ sampler, which collapses the two signal layers into one. We take advantage of the fact that lists are instances of Traversable. -> brickSamples = sampler (sequenceA <$> bricks)+> brickSamples = join (sequenceA <$> bricks)+>+> brickSamples' <- delay [] brickSamples The `bricks` signal carries the dynamic list of bricks along with ball-brick collision information, all of which are updated in each@@ -261,10 +254,10 @@ `isBrickNeeded` evaluates to false. These updates are made explicit by using `delay` to define the dynamic collection. -> bricks <- do-> bricksInit <- mapM brick brickPos0-> let bricksNext = map snd . filter (isBrickNeeded . fst) <$> (zip <$> brickSamples <*> bricks)-> delay bricksInit bricksNext+> bricks <- do+> bricksInit <- mapM brick brickPos0+> let bricksNext = map snd . filter (isBrickNeeded . fst) <$> (zip <$> brickSamples <*> bricks)+> delay bricksInit bricksNext And knowing all these signals we can finally assemble the signal of rendering actions, i.e. the animation:
src/Chase.lhs view
@@ -9,13 +9,14 @@ For a slightly more complex example check out `Breakout.lhs`. -> {-# LANGUAGE RecursiveDo #-}+> {-# LANGUAGE DoRec #-} > > module Main where > > import Control.Applicative+> import Control.Monad > import Data.IORef-> import FRP.Elerea.Legacy+> import FRP.Elerea.Param > import Graphics.UI.GLFW as GLFW > import Graphics.Rendering.OpenGL >@@ -23,39 +24,39 @@ > 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.+`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"+> 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+> (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+> closed <- newIORef False+> windowSizeCallback $= resizeGLScene windowSizeSink+> windowCloseCallback $= writeIORef closed True+> initGL 640 480 >-> greyPos <- createSignal $ mdo+> network <- start $ do > 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)+> 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 pos+> return $ render <$> windowSize <*> mousePosition <*> pos >-> driveNetwork (render <$> windowSize <*> mousePosition <*> greyPos)-> (readInput mousePositionSink mousePressSink closed)+> driveNetwork network (readInput mousePositionSink mousePressSink closed) >-> closeWindow+> 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
src/Common/Utils.lhs view
@@ -7,7 +7,7 @@ > > import Control.Applicative > import Control.Monad-> import FRP.Elerea.Legacy+> import FRP.Elerea.Param > > import Common.Vector @@ -17,7 +17,7 @@ > driveNetwork network driver = do > dt <- driver > case dt of-> Just dt -> do join $ superstep network dt+> Just dt -> do join (network dt) > driveNetwork network driver > Nothing -> return () @@ -29,3 +29,16 @@ `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
src/Common/Vector.lhs view
@@ -10,7 +10,7 @@ > module Common.Vector where > > import Control.Applicative-> import FRP.Elerea.Legacy+> import FRP.Elerea.Param > import Graphics.Rendering.OpenGL > > data Vec = V { getX :: !GLfloat, getY :: !GLfloat }