Carview!

CARVIEW

MOTORHOMES

Select Language

HTTP/2 200 cross-origin-resource-policy: cross-origin etag: W/"47e5a79460a6a2c0c37ba785e39037bff82d048ac3f848d5563823ae8aa1c283" date: Sat, 17 Jan 2026 12:31:34 GMT content-type: application/atom+xml; charset=UTF-8 server: blogger-renderd expires: Sat, 17 Jan 2026 12:31:35 GMT cache-control: public, must-revalidate, proxy-revalidate, max-age=1 x-content-type-options: nosniff x-xss-protection: 0 last-modified: Sat, 01 Nov 2025 14:37:43 GMT content-encoding: gzip content-length: 39715 x-frame-options: SAMEORIGIN alt-svc: h3=":443"; ma=2592000,h3-29=":443"; ma=2592000 tag:blogger.com,1999:blog-63552491209992524182025-11-01T07:37:43.643-07:00Writing JavaScript games in HaskellExploring writing browser games with HaskellNathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.comBlogger6125tag:blogger.com,1999:blog-6355249120999252418.post-83507396189754000742012-11-12T04:34:00.000-08:002013-08-21T23:08:29.128-07:00Breakout - Improved and with netwireHi, welcome to the 6th article of this blog. In this blog post, the breakout example from the <a href="https://jshaskell.blogspot.de/2012/09/breakout.html">last Post</a> has been improved, giving it more features: <ul> <li>The Paddle and Blocks have rounded edges. The ball bounces of them depending on the surface normal where it hits.</li> <li>The blocks are fading out when destroyed.</li> <li>The paddle can shot to destroy blocks. When the game starts one shot is available, shots can be gained by destroying green blocks.</li> <li>The game is aware when the player lost or won and displays this information when the game ends.</li> </ul> But that is not all! Instead of using the simple Coroutines we are now using a full blown FRP library called <a href="https://hackage.haskell.org/package/netwire">netwire</a>. But more about that later, here is the preview. As alwyas you have to click the canvas to get input focus. If you are not viewing this blog article on blogspot and the application does not work, try the original <a href="https://jshaskell.blogspot.de/2012/11/breakout-improved-and-with-netwire.html">aricle page</a>. <script src="https://rawgithub.com/RudolfVonKrugstein/jshaskell-blog/master/6_BreakoutImproved/code/compiled/BreakoutImproved.js" type="text/javascript"></script> <canvas height="400" id="canvas4" style="background-color: white;" width="600" tabindex="1"></canvas> I had a lot of help over the <a href="https://www.haskell.org/mailman/listinfo/beginners">haskell beginners mailing list</a>. I will try to add links to the specific topics whenever I am writing something I had help with. As a final note before I start: Being a haskell beginner, I might not do everything here the best way. I encourage you to comment if you think something could be done better! Of course, I also encourage you to comment if you have any questions. <h1 id="about-netwire">About Netwire</h1> <a href="https://hackage.haskell.org/package/netwire">Netwire</a> is a arrowized functional reactive programming (AFRP) library for haskell and the version 4 of the library has recently been released on <a href="https://hackage.haskell.org/package/netwire">hackage</a>. Since it uses Arrows, some of the things we did with Coroutines can be done the same way with netwires, but it has tons of other features. <a href="https://hackage.haskell.org/packages/archive/netwire/4.0.5/doc/html/Control-Wire.html">Here</a> is a short introduction to netwire, but I will try to explain all the features when I use them. Also I will explain some of <a href="https://hackage.haskell.org/package/netwire">netwires</a> usage here, this is by no means a complete tutorial to <a href="https://hackage.haskell.org/package/netwire">netwire</a>. One obvious reason for this is, that I myself do not (yet?) understand all the features and Ideas of netwire (remember, I am still a haskell beginner doing this for my own education). Maybe some of this will be useful for someone wanting to start with <a href="https://hackage.haskell.org/package/netwire">netwire</a>. To install netwire, just type <pre class="sourceCode bash"><code class="sourceCode bash">haste-inst install netwire</code></pre> This will most likely fail on lifted-base and time. There is a (potentially dangerous) workaround <a href="https://github.com/valderman/haste-compiler/issues/28">here</a>, that should work for now. <h1 id="new-javascript-functions">New Javascript functions</h1> To Draw a rounded rectangle a new function "fillRoundedRect" is defined in <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/6_BreakoutImproved/code/haste/JavaScript.hs">JavaScript.hs</a>. Also a new type for Colors has been added: <pre class="sourceCode haskell"><code class="sourceCode haskell">data Color = Color {red :: Double, green :: Double, blue :: Double, alpha :: Double}</code></pre> "jsFillColor" now takes this as argument instead of a string. <h1 id="collision-detection">Collision detection</h1> See <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/6_BreakoutImproved/code/Collision.hs">here</a> for the complete code. We want to represent our objects as Circles (the ball, bullets) and rounded rectangles (the paddle, blocks), so we define data structures for this: <pre class="sourceCode haskell"><code class="sourceCode haskell">-- Information about collision type Vector = (Double, Double) -- thanks to vector-space we can do ^+^ and similar data Collision = Collision { normal :: Vector } deriving (Show) type Radius = Double data Circle = Circle { circlePos :: Vector, circleRadius :: Radius} data Rectangle = Rectangle Vector Vector data RoundedRect = RoundedRect { rectMin :: Vector, rectMax :: Vector, rectRadius :: Radius}</code></pre> The Collision information now contains the normal of the collision. This is needed to correctly bounce the ball. For convenience in the usage of the collision functions, we will define type classes for the objects having the shape of a circle or a rounded rectangle: <pre class="sourceCode haskell"><code class="sourceCode haskell">class CircleShaped a where circle :: a -> Maybe Circle class RoundedRectShaped a where roundedRect :: a -> Maybe RoundedRect instance CircleShaped Circle where circle c = Just c instance RoundedRectShaped RoundedRect where roundedRect r = Just r</code></pre> This allows us to apply the collision functions directly to our game objects (when they are instances of the corresponding class) without always explicitly extracting the shape. In other words, instead of writing: <pre class="sourceCode haskell"><code class="sourceCode haskell">circleRectCollision (ballCircle ball) (blockRect block)</code></pre> we can write <pre class="sourceCode haskell"><code class="sourceCode haskell">circleRectCollision ball block</code></pre> The type classes return maybe types, because some objects might become "shapeless" and should not collide (for example a block that is fading out). Ok, the first thing we need is a collision between circles <pre class="sourceCode haskell"><code class="sourceCode haskell">import Control.Monad circleCollision :: (CircleShaped a, CircleShaped b) => a -> b -> Maybe Collision circleCollision a b = do (Circle p1 r1) <- circle a (Circle p2 r2) <- circle b let centerDiff = p2 ^-^ p1 guard (centerDiff <.> centerDiff <= (r1 + r2) * (r1 + r2)) return $ Collision $ normalized centerDiff</code></pre> It returns a "Maybe Collision" because a collision might not take place. Notice the "do" notation. We are in the "Maybe" monad, which causes the function to automatically return Nothing if one of out circle shapes return Nothing (if you do not understand, see <a href="https://en.wikipedia.org/wiki/Monad_(functional_programming)#The_Maybe_monad">here</a>). So we are getting the vector between the center positions and testing its square against the square of the sums of the radian of the circles. The guard function (from Control.Monad) causes the monad to return with "Nothing" if the circles are not close enough. Then we return the normalized vector as the normal. Notice that the normal always points from the first circle to the second. As a helper function, we test if a point is inside a rectangle: <pre class="sourceCode haskell"><code class="sourceCode haskell">pointInRectangle :: Vector -> Rectangle -> Bool pointInRectangle (px,py) (Rectangle (minX,minY) (maxX,maxY)) | px > maxX = False | px < minX = False | py > maxY = False | py < minY = False | otherwise = True</code></pre> That should be clear. So how do we test a circle against a rounded rectangle? A rounded rectangle is rectangle where the corners have been replaced by quarter circles. We have do test against these circles or the "inner" rectangle depending on where the colliding circle is, see this picture: <div class="figure"> <img src="https://raw.github.com/RudolfVonKrugstein/jshaskell-blog/master/6_BreakoutImproved/roundedRect.png" alt="Areas of rounded rectangle" />Areas of rounded rectangle </div> When the center of the colliding circle is in one of the red areas, collision testing is done with the corresponding corner circles. Otherwise collision is done against the "unrounded" rectangle (which is the same as rounded rectangle when we not in one of the red areas). The normal is then determined by the normal of the closest rectangle side. Here is the code: <pre class="sourceCode haskell"><code class="sourceCode haskell">circleRoundedRectCollision :: (CircleShaped a, RoundedRectShaped b) => a -> b -> Maybe Collision circleRoundedRectCollision c r = do circle <- circle c rect <- roundedRect r circleRoundedRectCollision' circle rect where circleRoundedRectCollision' circle@(Circle (cx,cy) cr) (RoundedRect (minX,minY) (maxX,maxY) rr) --test the corners | cx <= innerMinX && cy <= innerMinY = circleCollision (Circle (innerMinX, innerMinY) rr) circle | cx >= innerMaxX && cy <= innerMinY = circleCollision (Circle (innerMaxX, innerMinY) rr) circle | cx >= innerMaxX && cy >= innerMaxY = circleCollision (Circle (innerMaxX, innerMaxY) rr) circle | cx <= innerMinX && cy <= innerMinY = circleCollision (Circle (innerMinX, innerMaxY) rr) circle -- test if collision with rectangle occured | not $ pointInRectangle (cx,cy) (Rectangle ((minX-cr), (minY-cr)) ((maxX+cr), (maxY+cr))) = Nothing -- collision definitly occured, find correct normal | otherwise = Just $ fst $ minimumBy (\(_,a) (_,b) -> compare a b) [ (Collision (-1.0,0.0), cx - minX), (Collision (1.0, 0.0), maxX - cx), (Collision (0.0,-1.0), cy - minY), (Collision (0.0, 1.0), maxY - cy) ] where innerMinX = minX + rr innerMinY = minY + rr innerMaxX = maxX - rr innerMaxY = maxY - rr</code></pre> I am a bit unhappy that I have to define the inner function "circleRoundedRectCollision'", but I do not know how else I could use this nice pattern guards. <h1 id="wire-helpers">Wire helpers</h1> To handle bullets and blocks we need some way to manage a set of objects where objects can be removed. For this I got a lot of help <a href="https://www.haskell.org/pipermail/beginners/2012-November/010901.html">here</a> and <a href="https://www.haskell.org/pipermail/beginners/2012-November/010930.html">here</a>. The code is <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/6_BreakoutImproved/code/WireUtils.hs">here</a>. Let's look at the type of a wire: <pre class="sourceCode haskell"><code class="sourceCode haskell">data Wire e m a b</code></pre> The m parameter is the underlying monad. We will set it to Identity and be fine with it. "a" is the input type. Quoting from <a href="https://hackage.haskell.org/packages/archive/netwire/4.0.5/doc/html/Control-Wire.html">here</a>: From these inputs it (the wire) <ul> <li>either produces an output value of type "b" or inhibits with a value of type "e",</li> <li>produces a new wire of type Wire e m a b.</li> </ul> When a wire produces, it is the same as our Coroutines producing output. The possibility that a wire can inhibit is often used to switch to different wires. See <a href="https://hackage.haskell.org/packages/archive/netwire/4.0.5/doc/html/Control-Wire.html">here</a>. We will explore this possibility a little bit further down. <h2 id="dynamicset">dynamicSet</h2> When a wire inhibits, there are several combinators which allows to switch to other wires (permanently or just for one instance). Here inhibiting wires will be removed from the set. To create new wires a creator function and an additional input will be used. <pre class="sourceCode haskell"><code class="sourceCode haskell">dynamicSet :: (Monad m) => (c -> Wire e m a b) -> [Wire e m a b] -> Wire e m (a, [c]) [b] dynamicSet creator ws' = mkGen $ \dt (i,new) -> do res <- mapM (\w -> stepWire w dt i) ws' let filt (Right a, b) = Just (a,b) filt _ = Nothing resx = mapMaybe filt res return (Right $ (fmap fst resx), dynamicSet creator $ (fmap snd resx) ++ (map creator new))</code></pre> mkGen is passed a function that is turned into a wire. The parameters for this function are the time delta (dt) and the input (i,new) of the wire. We use the do notation because we are in the inner Monad "m" (of which we know nothing but that it is a monad). After we stepped all wires ("stepWire" steps a wire ,see <a href="https://hackage.haskell.org/packages/archive/netwire/4.0.5/doc/html/Control-Wire.html">netwire tutorial</a>) we filter those that produced (by returning a right value) and return there outputs as list. The new wire is again a dynamics set with the ramaing wires and the newly created ones using the creator function. <h2 id="dynamicsetmap">dynamicSetMap</h2> To use dynamic set in the breakout game, we assign each wire in the set a unique key (Int) and change the input to a Map that maps from the key to the input values of the individual wires. Since a map lookup may fail, the input of the wires will be Maybes. To archive this we define a wire that takes a list as inputs and pairs it with a given (infinite) list (which will be our keys): <pre class="sourceCode haskell"><code class="sourceCode haskell">-- queue for the objects in the list given as parameter -- The Int argument says how many objects should be returned staticQueue :: (Monad m) => [a] -> Wire e m Int [a] staticQueue set = unfold give set where give s n = (take n s, drop n s) -- Pairs the input list with the given list, which is assumed to be infinite pairListsWith :: (Monad m) => [p] -> Wire e m [a] [(p,a)] pairListsWith pairs = proc as -> do p <- staticQueue pairs -< length as returnA -< zip p as</code></pre> using these wires we define dynamicSetMap: <pre class="sourceCode haskell"><code class="sourceCode haskell">dynamicSetMap :: (Monad m) => (c -> Wire e m (Maybe a) b) -> [Wire e m (Maybe a) b] -> Wire e m (M.Map Int a, [c]) [(Int,b)] dynamicSetMap creator ws = dynamicSet creator' ws' . (second $ pairListsWith restKeys) where wireWithLookupAndKey :: (Monad m) => Int -> Wire e m (Maybe a) b -> Wire e m (M.Map Int a) (Int,b) wireWithLookupAndKey i w = (pure i) &&& (w . (arr (M.lookup i))) keys = [0,1..] restKeys = drop (length ws) keys ws' = map (uncurry wireWithLookupAndKey) $ zip keys ws creator' (i,c) = wireWithLookupAndKey i (creator c)</code></pre> <h2 id="shrinking-and-shrinkingmap">shrinking and shrinkingMap</h2> Since blocks can not be created, only destroyed, we define a simplified version of dynamicSet and dynamicSetMap where no new wires can be created. <pre class="sourceCode haskell"><code class="sourceCode haskell">-- same as dynamicSet, only that it can not grow shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b] shrinking ws = dynamicSet undefined ws <<< arr (\a -> (a,[])) -- same as dynamicSetMap, only that it can not grow shrinkingMap :: (Monad m) => [Wire e m (Maybe a) b] -> Wire e m (M.Map Int a) [(Int,b)] shrinkingMap ws = dynamicSetMap undefined ws <<< arr (\a -> (a,[]))</code></pre> To conclude these helper wires, I am not sure if these are the best choices but they work for now. <h1 id="the-game">The Game</h1> Finally we are ready to define the game itself! The code is <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/6_BreakoutImproved/code/BreakoutImproved.hs">here</a>. <h2 id="input">Input</h2> In difference to the <a href="https://jshaskell.blogspot.de/2012/09/breakout.html">last</a> post, we will step the wire on every input event. An input event will be a keyboard event or an "Update" event which causes the main wire to update all game objects. <pre class="sourceCode haskell"><code class="sourceCode haskell">data InputEvent = KeyUp Int | KeyDown Int | Update deriving (Eq)</code></pre> <h2 id="data-objects">Data objects</h2> Here are the data objects defining the state of the game: <pre class="sourceCode haskell"><code class="sourceCode haskell">-- state of game objects data Paddle = Paddle { xPos :: Double } data Gun = Gun { ammo :: Int } data Ball = Ball { ballPos :: Vector, ballSpeed :: Vector} data Block = Block { blockType :: BlockType, blockPos :: Vector, blockState :: BlockState} data BlockState = Alive Int | Dying Double data BlockType = NormalBlock | PowerBlock deriving (Eq) data Bullet = Bullet { bulletPos :: Vector } data GameState = GameState { paddle :: Paddle, gun :: Gun, ball :: Ball, blocks :: [Block], bullets :: [Bullet]} | StartScreen String</code></pre> The StartScreen constructor of the GameState is to show a message when the game is not running (in the beginning and when the player won or lost). We gave the ball the ballSpeed property (which is not necessary for viewing the game state) because it will be needed outside the balls own wires later. You will see. The Double parameter for a Dying block is the fade level (going from 1.0 to 0.0 as the block is removed). A Block now also as a BlockType. A PowerBlock is a block that gives the player ammo when destroyed. <h2 id="constants">constants</h2> A lot of constants follow which define the properties of the game <pre class="sourceCode haskell"><code class="sourceCode haskell">-- constants screenWidth = 600.0 screenHeight = 400.0 paddleColor = Color 0.0 0.0 0.0 1.0 paddleYPos = screenHeight - paddleHeight paddleHeight = 15.0 paddleWidth = 50.0 paddleRadius = 7.0 paddleSpeed = 7.0 initPaddleXPos = (screenWidth - paddleWidth) / 2.0 initPaddle = Paddle initPaddleXPos initGun = Gun 1 ballColor = Color 1.0 0.0 0.0 1.0 ballRadius = 5.0 initBallSpeed = (3.0, -3.0) initBallPos = (screenWidth / 2.0, screenHeight - 50.0) initBall = Ball initBallPos initBallSpeed blockWidth = 60.0 blockHeight = 20.0 blockRadius = 5.0 normalBlockColor = [Color 0.0 0.0 1.0 1.0, Color 0.0 0.0 0.5 1.0] powerBlockColor = [Color 0.0 0.5 0.0 1.0] initBlocks = [Block t (x,y) (Alive l) | x <- [20.0, 140.0, 240.0, 340.0, 440.0, 520.0], (y,t,l) <- [(60.0, PowerBlock, 1), (100.0, NormalBlock,2), (140.0,NormalBlock,1), (180.0,NormalBlock,2), (260.0,NormalBlock,2)]] bulletRadius = 3.0 bulletSpeed = (0.0, -10.0) bulletColor = Color 0.0 0.5 0.0 1.0 -- technical constants leftKeyCode = 37 rightKeyCode = 39 startKeyCode = 13 fireKeyCode = 32 canvasName = "canvas4"</code></pre> The canvas name is the same name as defined in the outer html where the canvas is located. <h2 id="startup-and-key-events">Startup and key events</h2> As said earlier, we step the main wire on every key event. But besides that the key event and startup functions look very similar to the <a href="https://jshaskell.blogspot.de/2012/09/breakout.html">last post</a>. Also the drawing function has been extended to draw bullets and fading blocks. To produce the game state to draw, the wire is step with "Update". See <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/6_BreakoutImproved/code/BreakoutImproved.hs">here</a> if you want to see the code. <h2 id="key-events">Key events</h2> In netwire an Event is a Wire that behaves as the identity wire when the event occurs and inhibits when the event does not occure. There are many functions to create events in <a href="https://hackage.haskell.org/packages/archive/netwire/4.0.5/doc/html/Control-Wire-Prefab-Event.html">netwire</a>. Most require the inhibition type of the wire to be a monoid. That is very useful for switching on events. For now just accept that, you will see later. So we create events that produce when the input event is a certain key down or release event: <pre class="sourceCode haskell"><code class="sourceCode haskell">keyPress :: (Monad m, Monoid e) => Int -> Event e m InputEvent keyPress code = when (==KeyDown code) keyRelease :: (Monad m, Monoid e) => Int -> Event e m InputEvent keyRelease code = when (==KeyUp code)</code></pre> now we can write a wire that returns a different value depending on if a key is pressed: <pre class="sourceCode haskell"><code class="sourceCode haskell">import qualified Data.Function as F valueFromKeyDown :: (Monad m, Monoid e) => Int -> a -> a -> Wire e m InputEvent a valueFromKeyDown code upValue downValue = F.fix (\start -> pure upValue . notE (keyPress code) --> pure downValue . notE (keyRelease code) --> start)</code></pre> <ul> <li>The "-->" operator is the infix version of "andThen". It takes two wires and behaves like the first until that inhibits. After that it behaves like the second.</li> <li>pure takes a value and makes a constant wire from it</li> <li>if you do not know fix, read <a href="https://en.wikibooks.org/wiki/Haskell/Fix_and_recursion">here</a>. Here it is used to loop back the chain of wires to the beginnig.</li> </ul> <h2 id="the-paddle">The paddle</h2> The speed of the paddle is direct transformation of the input state while the paddle wire integrates the paddle speed bounding it the the limits of the screen. <pre class="sourceCode haskell"><code class="sourceCode haskell">paddleWire :: (Monad m, Monoid e) => Wire e m InputEvent Paddle paddleWire = Paddle <$> (integralLim1_ bound initPaddleXPos <<< (paddleSpeedWire &&& pure ())) where bound _ _ pos = max 0.0 $ min (screenWidth-paddleWidth) pos paddleSpeedWire :: (Monad m, Monoid e) => Wire e m InputEvent Double paddleSpeedWire = (valueFromKeyDown leftKeyCode 0.0 (-paddleSpeed)) + (valueFromKeyDown rightKeyCode 0.0 paddleSpeed)</code></pre> <h2 id="the-ball">The ball</h2> Similar as in the <a href="https://jshaskell.blogspot.de/2012/09/breakout.html">last Post</a>, the ball moves with constant speed and reacts to collision events. <pre class="sourceCode haskell"><code class="sourceCode haskell">accum1Fold :: (Monad m) => (b -> a -> b) -> b -> Wire e m [a] b accum1Fold f init = accum1 step init where step last as = foldl' f last as ballSpeedWire :: (Monad m) => Wire e m [Collision] Vector ballSpeedWire = accum1Fold (collide) initBallSpeed where collide v0 (Collision n) = v0 - (2.0 * (n <.> v0)) *^ n ballWire :: (Monad m) => Wire e m [Collision] Ball ballWire = (Ball <$> integral1_ initBallPos) . ballSpeedWire <*> ballSpeedWire</code></pre> Notice the use of accum1. In difference to accum, accum1 does not delay its output by one invocation. accum1Fold does the same as accum1 but takes a list as input over which it folds. Here it is used to fold over the incomming collision events. What happens when the ball collides with an object? Assuming the collision is fully elastic, the velocity along the collision normal is inverted. The velocity (v0) along the collision normal (n) is <n,v0> (the scalar product of n and v0). Expressed with vector space, this is n <.> v0. To invert this part of v0, we have to substract this twice from v0. This gives us: v0 - (2.0 * (n <.> v0)) *^ n. <h2 id="blocks">Blocks</h2> A block behaves as its initial state, removing a live whenever it is hit (its input is not Nothing). When the lives are out, the block changes into the Dying state. And fades out in 30.0 "time units". Afterwards the block wire inhibts (so it is removed from the set). <pre class="sourceCode haskell"><code class="sourceCode haskell">blockWire :: (Monad m, Monoid e) => Block -> Wire e m (Maybe Collision) Block blockWire init = while blockAlive . accum1 update init --> Block (blockType init) (blockPos init) <$> (Dying <$> (pure 1.0) - (time / (pure 30.0))) . for 30.0 where update old Nothing = old update old@(Block _ _ (Alive l)) _ = old { blockState = Alive (l - 1) } blockAlive (Block _ _ (Alive l)) = l > 0</code></pre> Notice the expression "(pure 1.0) - (time / (pure 30.0)))" for the fading level. We can use "-" and "/" because wires are members of the Fractional and Num type classes. We could even leave out the "pure" and write "(1.0) - (time / (30.0)))". At present this does not work with haste because "framRational" needs some not yet supported primOps (see <a href="https://github.com/valderman/haste-compiler/issues/32">here</a>). When a "PowerBlock" is destroyed, the player is supposed to gain ammo. Therefore there is a blockAmmoWire that returns the number of ammo the player should gain. For a normal block it returns always 0. For a PowerBlock it returns 0 except the moment the block is destoryed (the input is not Nothing). <pre class="sourceCode haskell"><code class="sourceCode haskell">blockAmmoWire :: (Monad m, Monoid e) => Block -> Wire e m (Maybe Collision) Int blockAmmoWire (Block PowerBlock _ _) = (pure 0) . while (isNothing) --> once . (pure 1) --> pure 0 blockAmmoWire _ = (pure 0) blockWithAmmoWire :: (Monad m, Monoid e) => Block -> Wire e m (Maybe Collision) (Int,Block) blockWithAmmoWire b = blockAmmoWire b &&& blockWire b</code></pre> Isn't it nice how easily this can be expressed with "-->"? Now we create a set of blocks using "shrinkingMap": <pre class="sourceCode haskell"><code class="sourceCode haskell">blocksWire :: (Monad m, Monoid e) => Wire e m (M.Map Int Collision) (Int,[(Int,Block)]) blocksWire = (shrinkingMap $ map blockWithAmmoWire initBlocks) >>> (arr reorder) where reorder as = (sum $ map (fst . snd) as, map (\j -> (fst j, snd $ snd j)) as)</code></pre> The output of "(shrinkingMap $ map blockWithAmmoWire initBlocks)" is [(id,(ammo,block))] where "id" is the id of the corresponding block, "ammo" the ammo given by the block and "block" its state. But what we want is (sumAmmo, [(id,block)]) with sumAmmo being the sum over all ammo. That is what reaorder takes car of. <h2 id="bullets">Bullets</h2> Bullets simply move up while <ul> <li>They do not collide</li> <li>They are not out of the screen</li> </ul> <pre class="sourceCode haskell"><code class="sourceCode haskell">bulletWire :: (Monad m, Monoid e) => Bullet -> Wire e m (Maybe Collision) Bullet bulletWire (Bullet init) = while bulletAlive . (Bullet <$> (pure bulletSpeed >>> integral1_ init)) . while (isNothing) where bulletAlive (Bullet (x,y)) = y > 0.0 bulletsWire :: (Monad m, Monoid e) => Wire e m (M.Map Int Collision,[Bullet]) [(Int,Bullet)] bulletsWire = dynamicSetMap bulletWire []</code></pre> <h2 id="gun">Gun</h2> The gun gets a set of bullets as input (these are the fire requests) and an integer with the amount of new ammo. It outputs the bullets that really have been fired and the gun state <pre class="sourceCode haskell"><code class="sourceCode haskell">gunWire :: (MonadFix m) => Wire e m ([Bullet],Int) ([Bullet],Gun) gunWire = proc (bs,new) -> do rec let fires = take ammo bs ammo <- accum (+) (ammo initGun) -< new - (length fires) returnA -< (fires,Gun ammo)</code></pre> <h2 id="collecting-collision-information">Collecting collision information</h2> We define some helper functions for collecting collisions betwen the ball, the paddle, the walls, blocks and bullets: <pre class="sourceCode haskell"><code class="sourceCode haskell">fromMaybeList :: Ord a => [(a,Maybe b)] -> M.Map a b fromMaybeList [] = M.empty fromMaybeList ((k,Nothing):xs) = fromMaybeList xs fromMaybeList ((k,Just v):xs) = M.insert k v (fromMaybeList xs) calcBallBlockColls :: Ball -> [(Int,Block)] -> M.Map Int Collision calcBallBlockColls ball = fromMaybeList . map (\(id,block) -> (id,circleRoundedRectCollision ball block)) calcBallWallColls :: Ball -> [Collision] calcBallWallColls (Ball (bx,by) _) = map snd $ filter (fst) $ [ (bx <= 0 , Collision (1.0 , 0.0)), (bx >= screenWidth, Collision (-1.0, 0.0)), (by <= 0 , Collision (0.0 , 1.0)) ] calcBallPaddleColls :: Ball -> Paddle -> [Collision] calcBallPaddleColls b p = maybeToList $ circleRoundedRectCollision b p pairUp :: [a] -> [b] -> [(a,b)] pairUp as bs = [(a,b) | a <- as, b <- bs] calcBlockBulletColls :: [(Int,Block)] -> [(Int,Bullet)] -> (M.Map Int Collision,M.Map Int Collision) calcBlockBulletColls blocks bullets = foldl' buildColls (M.empty, M.empty) $ pairUp blocks bullets where buildColls (blList, buList) ((blId,block), (buId, bullet)) = case circleRoundedRectCollision bullet block of Nothing -> (blList, buList) Just c -> (M.insert blId c blList, M.insert buId c buList)</code></pre> <h1 id="putting-it-all-together-the-main-wire">Putting it all together, the main wire</h1> <h2 id="switching-game-state">Switching game state</h2> Let's first look at the outer wire, that manages when the game starts and when to show the start screen. It should behave like this: <ul> <li>In the beginnig it shows "Press Enter to start (click canvas to focus)". When the user pressed enter the game is started.</li> <li>When the player looses, is shows "Sorry, you loose! Press Enter to restart." and lets the user press enter to restart.</li> <li>Similar when the player wins, with the message "Congratulations, you won! Press Enter to restart."</li> </ul> So when the game ends we need to switch differently depending on if the game was lost or won. Remember that the inhibition if wires can be used to switch wires (for example with "-->"). If we want to have different wire we have to encode this in the inhibition Type (see also this <a href="https://www.haskell.org/pipermail/beginners/2012-November/010941.html">thread</a>): <pre class="sourceCode haskell"><code class="sourceCode haskell">data GameEnd = Win | Loose | None instance Monoid GameEnd where mempty = None mappend x None = x mappend None x = x mappend _ Win = Win mappend Win _ = Win mappend _ _ = Loose type MainWireType = Wire GameEnd Identity InputEvent (Maybe GameState)</code></pre> The inhibition value must be a Monoid, because that is what most switches and events require. Now we can use this with switchBy: <pre class="sourceCode haskell"><code class="sourceCode haskell">mainWire = switchBy start (start None) where start None = startScreenWire "Press Enter to start (click canvas to focus)" --> mainGameWire start Win = startScreenWire "Congratulations, you won! Press Enter to restart." --> mainGameWire start Loose = startScreenWire "Sorry, you loose! Press Enter to restart." --> mainGameWire</code></pre> Now the mainGameWire only has to inhibit when the game is lost, or won. This is done with these wires: <pre class="sourceCode haskell"><code class="sourceCode haskell">looseWire :: (Monad m) => Wire GameEnd m Ball Ball looseWire = unless ballOut --> inhibit Loose where ballOut (Ball (x,y) _) = y > screenHeight winWire :: (Monad m) => Wire GameEnd m [Block] [Block] winWire = (once --> unless null) --> inhibit Win</code></pre> The "once" in the win wire is necessary because in the first invocation of the main wire there are no blocks. <h2 id="the-main-game">The main game</h2> This is the only place, where we use arrow syntax: <pre class="sourceCode haskell"><code class="sourceCode haskell">mainGameWire :: MainWireType mainGameWire = proc input -> do paddle <- paddleWire -< input let newFR old | input == Update = [] | input == KeyDown fireKeyCode = (createBullet paddle):old | otherwise = old fireRequests <- accum (flip ($)) [] -< newFR if input == Update then do rec let validCollDir (Collision n) = n <.> ballSpeed oldBall < 0.0 ballBlockColls = M.filter validCollDir $ calcBallBlockColls oldBall oldBlocks ballWallColls = calcBallWallColls oldBall ballPaddleColls = filter validCollDir $ calcBallPaddleColls oldBall paddle (blockBulletColls,bulletBlockColls) = calcBlockBulletColls oldBlocks oldBullets ball <- ballWire -< ballWallColls ++ ballPaddleColls ++ (M.elems ballBlockColls) oldBall <- delay initBall -< ball _ <- looseWire -< oldBall (newAmmo,blocks) <- blocksWire -< ballBlockColls `M.union` blockBulletColls oldBlocks <- delay $ [] -< blocks _ <- winWire -< (map snd oldBlocks) (newBullets,gun) <- gunWire -< (fireRequests,newAmmo) bullets <- bulletsWire -< (bulletBlockColls,newBullets) oldBullets <- delay $ [] -< bullets returnA -< Just $ GameState paddle gun ball (map snd blocks) (map snd bullets) else returnA -< Nothing</code></pre> First the paddle is updated using the input. The fireRequests are build by accumulating all presses of the fireing key. These are later filtered in the gun, so that no more bullets are fired than there is ammo. When an Update event is issued the queue is purged. Remember that accum delays by one, so that when the input event is "Update", fireRequests is purged one invocation later. The rest of the wire is only invoked when the input event is "Update" (otherwise Nothing is returned). Note that we can use "if" to invoke a different wire depending on some condition. Creating the collision data is done using the functions introduced earlier. Note the filter with "validCollDir". Due to the rounded edges, it can happen that the ball collides with a block in a way that the ball is not outside the block the next frame. To prevent "double collisions" all those collision events, that are not directed against the moving direction of the ball are filtered. If we would have used "accum" instead of "accum1" in a couple of places, the output of all the game objects would be delayed by 1 and we would not need the "old..." objects. This is personal preference, I find the use of the "old.." objects more transparent to what is happening. <h1 id="conclusion">Conclusion</h1> I am getting more confortable with haskell and its getting easier for me to read haskell code. Netwire seems to be a nice library, but I feel like I have so far only scratched its surface. I wonder what cool things one could do if one would use the inner monad. Also I wonder how Arrowrized FRP compares with FRP without arrows. Unfortantly <a href="https://www.haskell.org/haskellwiki/Reactive-banana">reactive banana</a> does not yet work with haste. I had a quick peek at <a href="https://hackage.haskell.org/package/elerea">elerea</a> but it also needs some PrimOps not supported by haste. Again: I encourage you to comment if you think something could be done better. For a lot of things I might not use a better alternative because I am simply not aware of it. After all I am still a haskell beginner. <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by/3.0/de/88x31.png" /></a> Writing JavaScript games in Haskell by <a xmlns:cc="https://creativecommons.org/ns#" href="https://jshaskell.blogspot.de/" property="cc:attributionName" rel="cc:attributionURL">Nathan Hüsken</a> is licensed under a <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US">Creative Commons Attribution 3.0 Germany License</a>.Nathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.com9tag:blogger.com,1999:blog-6355249120999252418.post-74189436276490724332012-09-18T07:27:00.001-07:002013-08-21T23:08:14.808-07:00BreakoutHi, welcome to the 5th article of this blog. I am very exited! In the <a href="https://jshaskell.blogspot.de/2012/09/pong.html">last Post</a> we wrote a Pong like ... well ... let's call it javascript application. In this post I have expanded it by the following properties: <ul> <li>The game does not start until you hit enter.</li> <li>There are blocks that can be hit by the ball and disappear.</li> <li>There are even blocks with 2 lives (dark blue) that turn into normal blocks on the first hit.</li> <li>The game stops when the ball leaves the canvas downward.</li> </ul> This means, there is a goal and there is a game over situation. So at this point one could actually call it a game. And it even has a start screen ... did I mention that I am exitied? /,anma But, now, as always, here is a preview. As always you have to click the canvas to get input focus. If you are not viewing this blog article on blogspot and the application does not work, try the original <a href="https://jshaskell.blogspot.de/2012/09/breakout.html">article page</a>. Note: This currently only works if you are viewing this article only (not in the flow of the complete blog). I am working on the problem ... <script src="https://rawgithub.com/RudolfVonKrugstein/jshaskell-blog/master/5_Breakout/code/compiled/Breakout.js" type="text/javascript"></script> <canvas height="400" id="canvas3" style="background-color: white;" width="600" tabindex="1"></canvas> But let me tell you how I did it :). By the way, this post assumes that you have read the <a href="https://jshaskell.blogspot.de/2012/09/pong.html">last Post</a>. <h1 id="more-coroutine-helpers">More Coroutine helpers</h1> There are two aspects of this game (yes, game!) <ul> <li>The blocks are a dynamic set of objects, that disappear as the game progresses</li> <li>There are different "game states" (the start screen and the actual game)</li> </ul> So this has been added to <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/Coroutine.hs">Coroutine.hs</a> <pre class="sourceCode haskell"><code class="sourceCode haskell">-- manages a set of coroutines which are deletet when returning Nothing manager :: [Coroutine a (Maybe b)] -> Coroutine [a] [b] manager cos = Coroutine $ \is -> let res = map (\(co, i) -> runC co i) $ zip cos is res' = filter (isJust . fst) res (result, cos') = unzip res' in (catMaybes result, manager cos') -- switcher, starts with a specific coroutine and switches whenever a new coroutine is send via an event switch :: Coroutine a b -> Coroutine (Event (Coroutine a b), a) b switch init = Coroutine $ \(e,i) -> let init' = last $ init : e --the last coroutine sent through (o, init'') = runC init' i in (o, switch init'') -- replace the contents of an event (<$) :: Event a -> b -> Event b (<$) events content = map (\_ -> content) events</code></pre> manager: The manger is for managing the blocks. Every blocks state is produced by a coroutine, and in the beginning there is a set of blocks in the game (first parameter to manager). The manager distributes its input to all its coroutines. So the input list should have the same length. The output if each coroutines are collected in a list which is the output of the manager. Every block Coroutine returns "Nothing" when the block is destroyed, the manager than removes the block from the set. Note that at present there is no way of inserting new blocks in the manager, it is not needed in this game. switch: Switch allows us to switch between different game states, which all are described by coroutines of the same type. Initially switch behaves as the init Coroutine (its first parameter) with an extra parameter holding events with other Coroutines. Whenever one of these events occurs, switch switches to the coroutine carried in the event. <$: This is a operator. When applied to an event it replaces the contents of the event with the second parameter. We need this to replace the content of the KeyDown event with the main Coroutine when the start key is pressed. You will see! <h1 id="from-pong-to-breakout">From Pong to Breakout</h1> All very exiting, but the real excitement start now. The main source file <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/Breakout.hs">Breakout.hs</a> is based on the <a href="https://jshaskell.blogspot.de/2012/09/pong.html">last posts</a> <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Pong.hs">Pong.hs</a>. Here I will go over the differences. <h2 id="definitions">Definitions</h2> The game state needs to reflect the blocks and the start screen. It has changed to: <pre class="sourceCode haskell"><code class="sourceCode haskell">data PlayerState = PlayerState {xPos :: Double} data BallState = BallState {ballPos :: Vector} data BlockState = BlockState {blockPos :: Vector, blockLives :: Int} data GameState = GameState {player :: PlayerState, ball :: BallState, blocks :: [BlockState]} | StartScreen data BallCollision = LeftBounce | RightBounce | UpBounce | DownBounce data BlockCollision = BlockCollision data Rect = Rect { x::Double, y::Double, width ::Double, height::Double}</code></pre> The BlockState has been added, which contains the block position and the number of lives (1 or 2) of the block. The GameState has been expanded by a list of BlockStates AND can be just the start screen (when the game has not started). BlockCollision is a type for creating Events where the block collides with the ball. A type synonym to () would also work, but I choose this more verbose way. <pre class="sourceCode haskell"><code class="sourceCode haskell">blockWidth = 60.0 blockHeight = 20.0 blockColor1live = "blue" blockColor2live = "darkblue" initBlockStates = [BlockState (x,y) lives | x <- [20.0, 140.0, 240.0, 340.0, 440.0, 520.0], (y, lives) <- [(60.0,2), (100.0,1), (140.0,2), (180.0,1), (220.0,1), (260.0,1)]] restartKeyCode = 32 canvasName = "canvas3"</code></pre> The color of the blocks depend if they have 1 or 2 lives. initBlockStates describes the blocks as the game starts. They are evenly spaced, 6 in x and 6 in y directions. 2 of the y rows have 2 lives, the rest 1. The restartKeyCode is the key code of the enter bar and the canvasName is the name of the canvas in the html code of <a href="https://jshaskell.blogspot.de/2012/09/breakout.html">this</a> blog. <h2 id="drawing">Drawing</h2> <pre class="sourceCode haskell"><code class="sourceCode haskell">draw :: GameState -> IO () draw StartScreen = do ctx <- getContext2d canvasName clear ctx -- draw the text setFillColor ctx "black" fillText ctx "Press Enter to start --- (click the canvas for input focus)" (screenWidth/2.0 - 100.0) (screenHeight/2.0) draw (GameState playerState ballState blockStates) = do ctx <- getContext2d canvasName clear ctx -- draw player setFillColor ctx playerColor let pRect = playerRect playerState fillRect ctx (x pRect) (y pRect) (width pRect) (height pRect) --draw blocks mapM_ (drawBlock ctx) $ blockStates --draw ball setFillColor ctx ballColor let (x,y) = ballPos ballState fillCircle ctx x y ballRadius drawBlock :: Context2D -> BlockState -> IO () drawBlock ctx bs = do setFillColor ctx (if blockLives bs == 1 then blockColor1live else blockColor2live) let r = blockRect bs fillRect ctx (x r) (y r) (width r) (height r)</code></pre> draw pattern matches its argument, to test if it is the start screen. If so, a short message telling the player to press enter is displayed (see <a href="https://www.w3schools.com/html/html5_canvas.asp">fillText</a> in some javascript documentation). <h2 id="helpers">helpers</h2> <pre class="sourceCode haskell"><code class="sourceCode haskell">gameOver :: GameState -> Bool gameOver (GameState _ (BallState (_, by)) _) = by > screenHeight gameOver _ = False blockRect :: BlockState -> Rect blockRect (BlockState (bx,by) _) = Rect bx by blockWidth blockHeight</code></pre> gameOver is a little helper function to test if the ball has left the canvas. It returns False on the start screen. blockRect returns the rectangle occupied by a block. <h2 id="main-coroutine">Main coroutine</h2> <pre class="sourceCode haskell"><code class="sourceCode haskell">mainCoroutine :: MainCoroutineType mainCoroutine = proc inEvents -> do rec let startEvent = filter (\ke -> ke == KeyUp restartKeyCode) inEvents <$ mainGameCoroutine stopEvent = if gameOver oldState then [mainStartScreenCoroutine] else [] state <- switch mainStartScreenCoroutine -< (startEvent ++ stopEvent, inEvents) oldState <- delay StartScreen -< state returnA -< state mainStartScreenCoroutine :: MainCoroutineType mainStartScreenCoroutine = arr $ const StartScreen mainGameCoroutine :: MainCoroutineType mainGameCoroutine = proc inEvents -> do plState <- playerState -< inEvents rec let (ballBlockColls, blockColls) = ballBlocksCollisions oldBallState oldBlockStates let colls = (ballWallCollisions oldBallState) ++ (ballPlayerCollisions plState oldBallState) ++ ballBlockColls currBallState <- ballState -< colls --long names ... currBlockStates <- blockStates -< blockColls oldBallState <- delay initBallState -< currBallState oldBlockStates <- delay initBlockStates-< currBlockStates returnA -< GameState plState currBallState currBlockStates</code></pre> The original main coroutine has been renamed to mainGameCoroutine. There is a new "main coroutine" mainStartScreenCoroutine which is used while in the start screen. The new mainCoroutine switches between these two coroutine when the player pressed enter, or the game is over. Remember, the <$ operator replaces the contents of an event with its second parameter (here the mainGameCoroutine) and switch receives events containing coroutines to which it switches. mainGameCoroutine has been extended by the blocks. ballBlocksCollisions, as we will see later, returns a tuple with the ballCollisions events due to collisions with the blocks, and a list of BlockCollision events. This list has the same length as the list of blocks (in oldBlockStates). The n-th element of this list are the collisions with the n-th block. The block collisions are than passed to the blockStates arrow while the ballCollisions are added to the collisions passed to ballState. I dislike the long names like "currBallState" here. I would have called it ballState, but there is already an arrow with the same name. I wonder if there is a less clumsy way of doing this ... <h2 id="ball-block-collisions">Ball-Block collisions</h2> <pre class="sourceCode haskell"><code class="sourceCode haskell">ballBlocksCollisions :: BallState -> [BlockState] -> (Event BallCollision, [Event BlockCollision]) ballBlocksCollisions ballState blockStates = let ballR = ballRect ballState foldStep (ballC, blockC) blockState = if rectOverlap ballR (blockRect blockState) then (ballRectCollisions ballState (blockRect blockState) ++ ballC, blockC ++ [[BlockCollision]]) else (ballC, blockC ++ [[]]) in foldl' foldStep ([],[]) blockStates</code></pre> In my opinion, this is the most complicated function. It takes the ball state and the block states (as a list) and produces ball collisions events, and a list of block collision events, which has the same length as the input block state list. The foldStep function takes the next block, tests it for collision and updates the list of ball and block collisions. Here the ball collision events are only expanded when a collision happens. The list of block collision events is always expanded. By an empty event (empty list) when no collision happens, and by a BlockCollision event in case of collision. This is because the position in this list reflects the block that will receive it. <h2 id="updating-the-block-state">Updating the block state</h2> <pre class="sourceCode haskell"><code class="sourceCode haskell">blockState :: BlockState -> Coroutine (Event BlockCollision) (Maybe BlockState) blockState initState = scanE update (Just initState) where update :: Maybe BlockState -> BlockCollision -> Maybe BlockState update Nothing _ = Nothing update (Just bs) _ = if (blockLives bs == 1) then Nothing else Just $ bs{blockLives=1} blockStates :: Coroutine ([Event BlockCollision]) ([BlockState]) blockStates = manager $ map blockState initBlockStates</code></pre> Every block has its own coroutine, which receives block collision events. In case of such an event, the number of lives is reduced or the block is removed (if there are no lives left). The coroutines return a Maybe data type, because they are inserted into the manager. Nothing is returned if the block should be deleted. blockStates uses the manager to manage all "living" blocks. <h1 id="compiling">Compiling</h1> The compilation is the same as for Pong int the <a href="https://jshaskell.blogspot.de/2012/09/pong.html">last post</a>. <h2 id="haste">Haste</h2> For haste make sure the <a href="https://github.com/valderman/haste-compiler">newest version</a> is installed. Because we use vector-space we need to install it for haste. vector space is needed, see the <a href="https://jshaskell.blogspot.de/2012/09/pong.html">last post</a>. Now put <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/Breakout.hs">Breakout.hs</a>, <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/Coroutine.hs">Coroutine.hs</a>, the haste version of <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/haste/JavaScript.hs">JavaScript.hs</a> and the javascript helper functions <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/haste/helpers.js">helpers.js</a> in a directory and compile with <pre class="sourceCode bash"><code class="sourceCode bash">hastec Breakout.hs --start=asap --with-js=helpers.js</code></pre> You should receive a file "Breakout.js" which can be included in a html file, like this one: <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/indexHaste.html">haste html</a> <h2 id="uhc">UHC</h2> With UHC it is a little bit more work. UHC does not support arrow syntax, so we must translate the haskell file with arrowp: <pre class="sourceCode bash"><code class="sourceCode bash">cabal install arrowp arrowp Breakout.hs > BreakoutNA.hs</code></pre> I choose the name BreakoutNA.hs for "Breakout no arrows". For some reason I also can not get vector space to compile with UHC. Luckily we have not used much of vector space, only the + operator. So edit PongNA.hs and replace the line <pre class="sourceCode haskell"><code class="sourceCode haskell">import Data.VectorSpace</code></pre> with <pre class="sourceCode haskell"><code class="sourceCode haskell">(^+^) :: Num a => (a,a) -> (a,a) -> (a,a) (^+^) (a1,a2) (b1,b2) = (a1+b1, a2+b2)</code></pre> Now copy <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/Coroutine.hs">Coroutine.hs</a> and <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/5_Breakout/code/uhc/JavaScript.hs">JavaScript.hs</a> (the UHC version) into the directory and compile with <pre class="sourceCode bash"><code class="sourceCode bash">uhc -tjs BreakoutNA.hs -iuhc </code></pre> The canvas needs to be added to the generated html file, so add <pre class="sourceCode html"><code class="sourceCode html"><canvas height="400" id="canvas3" style="background-color: white;" width="600" tabindex="1"></canvas></code></pre> Since we do not need any additional javascript functions, the generated html page should work! <h1 id="conclusion">Conclusion</h1> Well that is it. At places I find it a bit clumpsy and I wonder if another FRP library like <a href="https://www.haskell.org/haskellwiki/Reactive-banana" title="Reactive Banana on Haskell wiki">Reactive Banana</a> or <a href="https://hackage.haskell.org/package/elerea">elerea</a> would help. I will look into these! <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by/3.0/de/88x31.png" /></a> Writing JavaScript games in Haskell by <a xmlns:cc="https://creativecommons.org/ns#" href="https://jshaskell.blogspot.de/" property="cc:attributionName" rel="cc:attributionURL">Nathan Hüsken</a> is licensed under a <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US">Creative Commons Attribution 3.0 Germany License</a>.Nathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.com11tag:blogger.com,1999:blog-6355249120999252418.post-42989956603788119292012-09-17T05:19:00.000-07:002013-08-21T23:07:16.800-07:00PongIn the <a href="https://jshaskell.blogspot.de/2012/07/first-interactive-application.html" title="Last blog entry">last Post</a> we wrote the first interactive javascript application in haskell where a paddle on the bottom of the canvas could be moved via keyboard input. In this next step we will add ball (a moving circle) that can bounce of the paddle and the walls. Here is a preview (again, click on the canvas to get input focus). If you are not viewing this blog article on blogspot and the application does not work, try the original <a href="https://jshaskell.blogspot.de/" title="Original location of this article">article page</a>. ** Note: ** This currently only works if you are viewing this article only (not in the flow of the complete blog). I am working on the problem ... <script src="https://rawgithub.com/RudolfVonKrugstein/jshaskell-blog/master/4_Pong/code/compiled/Pong.js" type="text/javascript"></script> <canvas height="400" id="canvas2" style="background-color: white;" tabindex="1" width="600"></canvas> But first we will need some perquisites. I will utilize Functional Reactive Programming (FRP) using the functions defined here: <a href="https://github.com/leonidas/codeblog/blob/master/2012/2012-01-17-declarative-game-logic-afrp.md" title="Purely Functional, Declarative Game Logic Using Reactive Programming">Purely Functional, Declarative Game Logic Using Reactive Programming</a>. I take the terminus "coroutine" from that blog article. I like to think of a coroutine as "state full function". The output of the coroutine does not only depend on its input but also on the input passed to it in previous calls. So make sure you read and understand that blog article. The resulting code can be found here: <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Coroutine.hs" title="Coroutine source file">Coroutine.hs</a>. So, let us get started! <h1 id="imports-and-definitions"> Imports and definitions</h1> I follow the source file <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Pong.hs" title="Main pong source file">Pong.hs</a> and therefor start with the imports and some definitions used later in the game. <pre class="sourceCode haskell"><code class="sourceCode haskell">{-# LANGUAGE Arrows #-} module Main where import JavaScript import Coroutine import Data.IORef import Control.Arrow import Data.VectorSpace -- input data data Input = KeyUp Int | KeyDown Int deriving (Eq) -- Game data type Vector = (Double, Double) data PlayerState = PlayerState {xPos :: Double} data BallState = BallState {pos :: Vector2D} data GameState = GameState {player :: PlayerState, ball :: BallState} data BallCollision = LeftBounce | RightBounce | UpBounce | DownBounce data Rect = Rect { x::Double, y::Double, width ::Double, height::Double}</code></pre> We will use Arrow Syntax and tell the compiler that we do. Actually UHC does not support Arrow Syntax (yet?), but more about that later. We import Data.VectorSpace allowing us to use some basic vector operation with tuples of Doubles. Here we only need addition, but if we need more VectorSpace is handy. The input data will be a series of Keyboard up and down events with corresponding key codes. BallCollision describes a collision of the ball with the wall or the paddle in a certain direction. The rest is types we need in the game and should be self explaining. Next we will declare some values defining subtleties of the game. <pre class="sourceCode haskell"><code class="sourceCode haskell">-- game values screenWidth = 600.0 screenHeight = 400.0 playerColor = "black" ballColor = "red" playerYPos = screenHeight - playerHeight playerHeight = 15.0 playerWidth = 40.0 ballRadius = 5.0 initBallState = BallState ((screenWidth / 2.0), (screenHeight - 50.0)) initBallSpeed = (3.0, -3.0) initPlayerState = PlayerState ((screenWidth - playerWidth) / 2.0) playerSpeed = 5.0 -- technical values leftKeyCode = 37 rightKeyCode = 39 canvasName = "canvas2"</code></pre> Again, these should be relatively self explaining. Keycode 37 and 39 correspond to the arrow keys. canvas2 is the name of the canvas defined in the html code of this blog. <h1 id="entry-point-and-callbacks"> Entry point and callbacks</h1> In difference to the last blog article we will not use a javascript function to save and store global objects. Instead the objects will be stored in IORefs which are passed to the callbacks. <pre class="sourceCode haskell"><code class="sourceCode haskell">-- entry point main = setOnLoad initilize initilize = do state <- newIORef mainCoroutine input <- newIORef ([] :: [Input]) setOnKeyDown canvasName (onKeyDown input) setOnKeyUp canvasName (onKeyUp input) setInterval 20.0 (update state input) -- input onKeyDown :: IORef [Input] -> Int-> IO () onKeyDown input keyCode = do i <- readIORef input let i' = i ++ [KeyDown keyCode] writeIORef input i' onKeyUp :: IORef [Input] -> Int-> IO () onKeyUp input keyCode = do i <- readIORef input let i' = i ++ [KeyUp keyCode] writeIORef input i'</code></pre> So main sets the initilize function to be called then the window is loaded. initilize creates 2 IORefs, one for the main coroutine (which will be defined later) and one for the input stream, which is a list of input events. The main coroutine is the place where the game logic happens. The output of the main coroutine is the current game state. Because the current main coroutine depends on the previous calls to it, it must be stored between game updates. onKeyDown and onKeyUp are called when a key is pressed or released and expand the input stream. update is set to be called every 20 milliseconds with the state and input IORefs passed to it. <h1 id="updating-and-drawing-the-game-sate"> Updating and drawing the game sate</h1> Next we will draw the game state (the output of the main coroutine). This is basicly the same as what we did in the last blog article, only that now we also need to draw a circle for the ball. <pre class="sourceCode haskell"><code class="sourceCode haskell">-- draw a gamestate draw :: GameState -> IO () draw gs = do ctx <- getContext2d canvasName clear ctx -- draw player setFillColor ctx playerColor let pRect = playerRect . player $ gs fillRect ctx (x pRect) (y pRect) (width pRect) (height pRect) --draw ball setFillColor ctx ballColor let (x,y) = pos . ball $ gs fillCircle ctx x y ballRadius -- update function update :: IORef MainCoroutineType -> IORef (Event Input) -> IO () update state input = do co <- readIORef state i <- readIORef input writeIORef input ([] :: [Input]) let (gs, co') = runC co i draw gs writeIORef state co'</code></pre> The draw function should be self explaining. If not, read my last blog articles. Some javascript functions have been added, but they all follow the same principle as in the last blog article. The update function reads the current main coroutine and input stream. The coroutine is updated and the new game state is obtained by calling the coroutine with the current input stream. Finally the game state is drawn and the new coroutine is saved. <h1 id="some-helper-functions"> Some helper functions</h1> Before the main game logic a few helper functions are defined. <pre class="sourceCode haskell"><code class="sourceCode haskell">-- helper functions keyDown :: Int -> Coroutine (Event Input) Bool keyDown code = scanE step False where step old input | input == KeyUp code = False | input == KeyDown code = True | otherwise = old rectOverlap :: Rect -> Rect -> Bool rectOverlap r1 r2 | x r1 >= x r2 + width r2 = False | x r2 >= x r1 + width r1 = False | y r1 >= y r2 + height r2 = False | y r2 >= y r1 + height r1 = False | otherwise = True playerRect :: PlayerState -> Rect playerRect (PlayerState px) = Rect px playerYPos playerWidth playerHeight ballRect :: BallState -> Rect ballRect (BallState (bx,by)) = Rect (bx - ballRadius) (by - ballRadius) (2.0 * ballRadius) (2.0 * ballRadius)</code></pre> keyDown takes a keycode and outputs a coroutine indicating at all times if the given key is down given the input stream (The Event type comes from <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Coroutine.hs" title="Coroutine source file">Coroutine.hs</a>). We will need this because the paddle is supposed to be moving as long as an arrow key is pressed. Note that this is a little different that what we did in the <a href="https://jshaskell.blogspot.de/2012/07/first-interactive-application.html" title="Last blog entry">last post</a>. Actually there it only worked because javascript fires continuous "keyDown" events when a key is hold down, but that is a platform dependent behavior and we do not want to rely on it. Also this firing of key down events does not immediately start when a key is pressed. There is a short break. If you <a href="https://jshaskell.blogspot.de/2012/07/first-interactive-application.html" title="Last blog entry">go back</a> on that post and try the application, you will note that the paddle does not start moving immediately, but there is a short delay after pressing a key. rectOverlap tests two rectangles if they overlap (used for collision detection). playerRect and ballRect return the rectangle occupied by the paddle and ball respectively. <h1 id="the-main-coroutine"> The main Coroutine</h1> The main coroutine takes input events as input and outputs the game state. The type synonym MainCoroutineType is introduced for verbosity. Earlier it allowed us to create the IORef for the main coroutine in a more readable way (in my opinion). <pre class="sourceCode haskell"><code class="sourceCode haskell">-- Game logic type MainCoroutineType = Coroutine (Event Input) GameState mainCoroutine :: MainCoroutineType mainCoroutine = proc inEvents -> do plState <- playerState -< inEvents rec let colls = (ballWallCollisions oldBlState) ++ (ballPlayerCollisions plState oldBlState) blState <- ballState -< colls oldBlState <- delay initBallState -< blState returnA -< GameState plState blState</code></pre> The player state is computed with the input events. The collisions of the ball with player and wall solely depend on the previous ball state. ballWallCollisions and ballPlayerCollisions can therefore be pure functions and not coroutines. That is why "colls" is defined in a let expression. The new ballState is calculated using this collisions information. The construct with "rec" and "delay" is needed because the ball state from the last frame is required. This construct is explained in <a href="https://github.com/leonidas/codeblog/blob/master/2012/2012-01-17-declarative-game-logic-afrp.md" title="Purely Functional, Declarative Game Logic Using Reactive Programming">Purely Functional, Declarative Game Logic Using Reactive Programming</a>. <h1 id="the-player"> The Player</h1> The player is moved with the arrow keys without crossing the bounding of the game. <pre class="sourceCode haskell"><code class="sourceCode haskell">playerState :: Coroutine (Event Input) PlayerState playerState = proc inEvents -> do vel <- playerVelocity -< inEvents xPos <- boundedIntegrate (0.0,screenWidth-playerWidth) (xPos initPlayerState) -< vel returnA -< PlayerState xPos playerVelocity :: Coroutine (Event Input) Double playerVelocity = proc inEvents -> do leftDown <- keyDown leftKeyCode -< inEvents rightDown <- keyDown rightKeyCode -< inEvents returnA -< if leftDown then -playerSpeed else (if rightDown then playerSpeed else 0.0)</code></pre> boundedIntegrate is a coroutine defined in <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Coroutine.hs" title="Coroutine source file">Coroutine.hs</a> which integrates the input and clips it to a given range. <h1 id="the-ball-state"> The Ball state</h1> <h2 id="collisions"> Collisions</h2> The ball state needs the collision events as input (see the main coroutine). <pre class="sourceCode haskell"><code class="sourceCode haskell">ballWallCollisions :: BallState -> (Event BallCollision) ballWallCollisions (BallState (bx,by)) = map snd . filter fst $ [(bx < ballRadius, LeftBounce), (bx > screenWidth - ballRadius, RightBounce), (by < ballRadius, UpBounce)] ballRectCollisions :: BallState -> Rect -> (Event BallCollision) ballRectCollisions (BallState (bx, by)) (Rect rx ry rw rh) = map snd . filter fst $ [(bx <= rx, RightBounce), (bx >= rx + rw, LeftBounce), (by <= ry, DownBounce), (by >= ry + rh, UpBounce)] ballPlayerCollisions :: PlayerState -> BallState -> (Event BallCollision) ballPlayerCollisions playerState ballState = if rectOverlap (playerRect playerState) (ballRect ballState) then ballRectCollisions ballState (playerRect playerState) else []</code></pre> <h2 id="updating-the-ball-state"> Updating the ball state</h2> Using this collisions events the ball is updated by moving and bouncing according to the collision events. <pre class="sourceCode haskell"><code class="sourceCode haskell">ballState :: Coroutine (Event BallCollision) BallState ballState = proc collEvents -> do vel <- ballVelocity -< collEvents pos <- scan (^+^) (pos initBallState) -< vel returnA -< BallState pos ballVelocity :: Coroutine (Event BallCollision) Vector2D ballVelocity = scanE bounce initBallSpeed where bounce :: Vector2D -> BallCollision -> Vector2D bounce (vx,vy) coll = case coll of LeftBounce -> (abs(vx), vy) RightBounce -> (-abs(vx), vy) UpBounce -> (vx, abs(vy)) DownBounce -> (vx, -abs(vy))</code></pre> The + operator is defined in the vector space package and adds two vectors (in our case tuples of doubles). <h1 id="compiling"> Compiling</h1> That it. Now we need to compile ... <h2 id="haste"> haste</h2> For haste make sure the <a href="https://github.com/valderman/haste-compiler">newest version</a> is installed. Because we use vector-space we need to install it for haste. First install vector space via cabal: <pre class="sourceCode bash"><code class="sourceCode bash">cabal install vector-space</code></pre> Now unpack vector-space with cabal, and install AdditiveGroup.jsmod. <pre><code>cabal unpack vector-space cd vector-space-0.8.2/src hastec --libinstall -O2 Data.VectorSpace Data.AdditiveGroup</code></pre> That it! Now put <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Pong.hs" title="Main pong source file">Pong.hs</a>, <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Coroutine.hs" title="Coroutine source file">Coroutine.hs</a>, the haste version of <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/haste/JavaScript.hs">JavaScript.hs</a> and the javascript helper functions <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/haste/helpers.js">helpers.js</a> in a directory and compile with <pre class="sourceCode bash"><code class="sourceCode bash">hastec Pong.hs --start=asap --with-js=helpers.js</code></pre> You should receive a file "Pong.js" which can be included in a html file, like this one: <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/indexHaste.html">haste html</a> <h2 id="uhc"> UHC</h2> With UHC it is a little bit more work. UHC does not support arrow syntax, so we must translate the haskell file with arrowp: <pre class="sourceCode bash"><code class="sourceCode bash">cabal install arrowp arrowp Pong.hs > PongNA.hs</code></pre> I choose the name PongNA.hs for "Pong no arrows". For some reason I also can not get vector space to compile with UHC. Luckily we have not used much of vector space, only the + operator. So edit PongNA.hs and replace the line <pre class="sourceCode haskell"><code class="sourceCode haskell">import Data.VectorSpace</code></pre> with <pre class="sourceCode haskell"><code class="sourceCode haskell">(^+^) :: Num a => (a,a) -> (a,a) -> (a,a) (^+^) (a1,a2) (b1,b2) = (a1+b1, a2+b2)</code></pre> Now copy <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/Coroutine.hs" title="Coroutine source file">Coroutine.hs</a> and <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/4_Pong/code/uhc/JavaScript.hs">JavaScript.hs</a> (the UHC version) into the directory and compile with <pre class="sourceCode bash"><code class="sourceCode bash">uhc -tjs PongNA.hs -iuhc </code></pre> The canvas needs to be added to the generated html file, so add <pre class="sourceCode html"><code class="sourceCode html"><canvas height="400" id="canvas2" style="background-color: white;" width="600" tabindex="1"></canvas></code></pre> Since we do not need any additional javascript functions, the generated html page should work! <h1 id="conclusion"> Conclusion</h1> I have little experience with FRP (this blog article is my first attempt to write a FRP application). I would have liked to use <a href="https://www.haskell.org/haskellwiki/Reactive-banana" title="Reactive Banana on Haskell wiki">Reactive Banana</a> for this, but at present I am unable to compile Reactive Banana with UHC or haste. According to <a href="https://github.com/HeinrichApfelmus/reactive-banana/issues/30">this</a> Reactive Banana has been compiled with UHC, but in the new version, support for UHC will be <a href="https://apfelmus.nfshost.com/blog/2012/08/26-frp-banana-0-7.html">dropped</a>. haste failed to compile Reactive Banana because of missing PrimOps. According to the maintainer of haste, that is a solvable problem and will be fixed in the future. In the next article, we will add "blocks" that can collide with the ball and disappear to have a breakout like game. <a href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US" rel="license"><img alt="Creative Commons License" src="https://i.creativecommons.org/l/by/3.0/de/88x31.png" style="border-width: 0;" /></a> Writing JavaScript games in Haskell by <a href="https://jshaskell.blogspot.de/" property="cc:attributionName" rel="cc:attributionURL" xmlns:cc="https://creativecommons.org/ns#">Nathan Hüsken</a> is licensed under a <a href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US" rel="license">Creative Commons Attribution 3.0 Germany License</a>.Nathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.com8tag:blogger.com,1999:blog-6355249120999252418.post-62430641768581798732012-07-14T11:43:00.001-07:002013-08-30T10:08:34.039-07:00The first interactive applicationIn the <a href="https://jshaskell.blogspot.de/2012/07/hello-world.html">last Post</a> we wrote the first "Hello, World!" application. We saw how to import javascript functions in UHC and haste. We now want to do something more game like. Out goal over the next few post will be to write a breackout clone in haskell, running in the browser! But first there are still a few things we need. To explore this we will write a little application displaying the paddle that can be moved with the arrow keys. Here is a preview (you have to click on it so that it gains focus): <script src="https://rawgithub.com/RudolfVonKrugstein/jshaskell-blog/master/3_FirstInteractive/code/compiled/Main.js" type="text/javascript"> </script> <canvas height="400" id="canvas1" style="background-color: white;" width="600" tabindex="0"></canvas> Update: This should now also work in firefox. For this we need to learn how to: <ul> <li>Set callbacks</li> <li>Let different callback communicate</li> <li>Draw on the canvas</li> </ul> <h1 id="gameloop-in-javascript">GameLoop in JavaScript</h1> Before we want to start our game, we have to allow the browser to load the full page and its elements. Otherwise we can not access e.g. the canvas (the drawing area we will use). The browser tells us, that it is done with loading by invoking the callback window.onLoad. Depending on how we compile with haste, our main will already be set to the window.onLoad (the option --start==asap prevents this), but in UHC we have to set a callback by hand. We will use the --start=asap option in haste so that our main code can be the same for haste and UHC. As can be read at several places (e. g. <a href="https://nokarma.org/2011/02/02/javascript-game-development-the-game-loop/index.html">here</a> or <a href="https://www.playmycode.com/blog/2011/08/building-a-game-mainloop-in-javascript/">here</a>) we can not just write an infinite loop for our GameLoop in javascript because it would block the browser. The contents of the canvas will only be updated when our code returns. So we need a function that is called in intervals. Javascript allows us to set the interval with window.setInterval. <h1 id="setting-callbacks">Setting callbacks</h1> We need to set haskell functions as callbacks to be invoked from javascript code. <h2 id="uhc">UHC</h2> In UHC we import a special function which converts haskell functions to callbacks that can be called from javascript (see <a href="https://www.norm2782.com/improving-uhc-js-report.pdf">Improving UHC js</a>). <pre class="sourceCode haskell"><code class="sourceCode haskell">import UHC.Ptr foreign import js "wrapper" mkCb :: IO () -> IO (FunPtr (IO ()))</code></pre> This converts an IO action to a function pointer that can be passed to javascript. If we want our callback to have different or more arguments, we have to import wrapper with a different signature. Here we create callbacks that we can pass as key event handlers. <pre class="sourceCode haskell"><code class="sourceCode haskell">data JSKeyEvent foreign import js "wrapper" mkKeyEventCb :: (JSKeyEvent -> IO ()) -> IO (FunPtr (JSKeyEvent -> IO ()))</code></pre> We now need to import the functions with which we set the callbacks. The interval function is set with "setInterval" while "onLoad" and the key event callbacks can be set with "addEventListener" which must be called on an element of the webpage. This element can be retrieved with "getElementById". We define simplified versions that take care of creating the callback for us. <pre class="sourceCode haskell"><code class="sourceCode haskell">data Element foreign import js "document.getElementById(%1)" jsGetElementById :: JSString -> IO Element getElementById = jsGetElementById . toJS foreign import js "%1.keyCode" keyCode :: JSKeyEvent -> IO Int foreign import js "%1.addEventListener('keydown',%2,true)" jsSetOnKeyDown :: Element -> FunPtr (JSKeyEvent -> IO ()) -> IO () setOnKeyDown :: String -> (Int -> IO ()) -> IO () setOnKeyDown elemName fp = do cb <- mkKeyEventCb fp' el <- getElementById elemName jsSetOnKeyDown el cb where fp' event = keyCode event >>= fp foreign import js "%1.addEventListener('keyup',%2,true)" jsSetOnKeyUp :: Element -> FunPtr (JSKeyEvent -> IO ()) -> IO () setOnKeyUp :: String -> (Int -> IO ()) -> IO () setOnKeyUp elemName fp = do cb <- mkKeyEventCb fp' el <- getElementById elemName jsSetOnKeyUp el cb where fp' event = keyCode event >>= fp foreign import js "window.addEventListener('load', %1, 'false')" jsSetOnLoad :: FunPtr (IO ()) -> IO () setOnLoad :: IO () -> IO () setOnLoad fp = mkCb fp >>= jsSetOnLoad foreign import js "setInterval(%1,%2)" jsSetInterval :: FunPtr (IO ()) -> Double -> IO () setInterval :: Double -> IO () -> IO () setInterval time fp = do cb <- mkCb fp jsSetInterval cb time</code></pre> Remember that the >>= operator chains monadic actions. "setOnKeyDown" and "setOnKeyUp" set the event listener on an element defined by the given name. They define wrapper functions that extract the keycode and passes it to our callback functions. This is convenient because the keycode is the information we are really interested in. We will follow the convention, that functions taking javascript specific parameters (such as JSString) will be prefixed by "js" and have corresponding functions without the "js" prefix. <h2 id="haste">Haste</h2> <blockquote> Update: The way FFI functions have to writting with haste has changed since the blog post has original been written. At that time returning values from javascript to haskell was a little bit more cumbersome. I have updated this blog post to reflect the new way of doing it. I hope I did not forget something in the process. So if you find an error, please comment. </blockquote> Setting callbacks in haste is a little different. For every callback function a javascript function has to be created which invokes the special function "A()" with the callback. This function can than be used for the callback. Read the section "Callbacks" of <a href="https://github.com/valderman/haste-compiler/blob/master/doc/js-externals.txt">js-externls.txt</a> in the doc subdirectory of the <a href="https://github.com/valderman/haste-compiler">haste github repository</a>. The arguments for the haskell function are the second argument of "A()" and have to be passed as a list similar to the required return value of javascript function included by the FFI. Again, this is explained in <a href="https://github.com/valderman/haste-compiler/blob/master/doc/js-externals.txt">js-externals.txt</a>. <pre class="sourceCode javascript"><code class="sourceCode javascript">function jsSetInterval(msecs, cb) { window.setInterval(function() {A(cb,[0]);}, msecs); return; } function jsSetOnLoad(cb) { window.addEventListener('load', function() {A(cb,[0]);}, false); return; }</code></pre> For "setOnKeyUp" and "setOnKeyDown" we do not need to define any haskell function, because we can set them using the haste library in haskell. On the haskell side callbacks have to be created with "mkCallback" and have the Type "JSFun a". <pre class="sourceCode haskell"><code class="sourceCode haskell">foreign import ccall jsSetInterval :: Double -> JSFun (IO ()) -> IO () setInterval :: Double -> IO () -> IO () setInterval time cb = jsSetInterval time (mkCallback $! cb) foreign import ccall jsSetOnLoad :: JSFun (IO ()) -> IO () setOnLoad cb = jsSetOnLoad (mkCallback $! cb) setOnKeyDown :: String -> (Int -> IO ()) -> IO Bool setOnKeyDown elementName cb = withElem elementName $ \e -> setCallback e OnKeyDown cb setOnKeyUp :: String -> (Int -> IO ()) -> IO Bool setOnKeyUp elementName cb = withElem elementName $ \e -> setCallback e OnKeyUp cb</code></pre> The "withElem" functions is defined in the haste library and executes an action with a webpage element defined by the provided name. <h1 id="letting-callbacks-communicate">Letting callbacks communicate</h1> <h2 id="uhc-1">UHC</h2> In a javascript program we would let the onKeyUp, onKeyDown and Interval functions communicate through global variables. In haskell we do not have a mechanism such as global variables (at least non that I am aware of). In a normal situation we do not need it, because the only moment when main exits is when the program ends. To store global variables we write a few helper functions in javascript: <pre class="sourceCode javascript"><code class="sourceCode javascript">var allObjects = {} function jsSaveGlobalObject(name, obj) { allObjects[name] = obj; } function jsLoadGlobalObject(name) { return allObjects[name]; }</code></pre> And include them from haskell: <pre class="sourceCode haskell"><code class="sourceCode haskell">foreign import ccall jsSaveGlobalObject :: JSString -> a -> IO () foreign import ccall jsLoadGlobalObject :: JSString -> IO a saveGlobalObject :: String -> a -> IO () saveGlobalObject name obj = jsSaveGlobalObject (toJS name) obj loadGlobalObject :: String -> IO a loadGlobalObject name = do ptr <- jsLoadGlobalObject (toJS name) return $ ptr</code></pre> We can now load the current state with <pre class="sourceCode haskell"><code class="sourceCode haskell">state <- jsLoadGlobalObject "state" :: IO State</code></pre> When we enter one of our callback functions and save it with a corresponding call to "saveGlobalObject". <h2 id="haste-1">Haste</h2> For haste the mechanism works the same way, only that the javascript helper functions have to format their return values the way haste needs them: <pre class="sourceCode javascript"><code class="sourceCode javascript">var allObjects = {} function jsSaveGlobalObject(name, obj) { allObjects[name] = obj; return; } function jsLoadGlobalObject(name) { return allObjects[name]; }</code></pre> To be able to pass arbitrary objects to the FFI, they have to be converted to a pointer via "fromPtr" and "toPtr". <pre class="sourceCode haskell"><code class="sourceCode haskell">foreign import ccall jsSaveGlobalObject :: JSString -> Ptr a -> IO () foreign import ccall jsLoadGlobalObject :: JSString -> IO (Ptr a) saveGlobalObject :: String -> a -> IO () saveGlobalObject name obj = jsSaveGlobalObject (toJSStr name) (toPtr obj) loadGlobalObject :: String -> IO a loadGlobalObject name = do ptr <- jsLoadGlobalObject (toJSStr name) return $ fromPtr ptr</code></pre> <h1 id="drawing-on-the-canvas">Drawing on the canvas</h1> Example code for drawing on the canvas in javascript looks like this: <pre class="sourceCode javascript"><code class="sourceCode javascript">context = document.getElementById("canvas").getContext("2d"); context.clearRect(0.0, 0.0, context.canvas.width, context.canvas.height) context.setFillColor("green"); context.fillRect(10.0,10.0,100.0,100.0);</code></pre> Basically all we have to do is import these functions via the FFI. <h2 id="uhc-2">UHC</h2> Getting the context needs several steps: <ul> <li>Get the canvas via getElementById</li> <li>Get the context via getContext</li> </ul> So this is what we do: <pre class="sourceCode haskell"><code class="sourceCode haskell">data Context2D foreign import js "%1.getContext('2d')" getContext2dFromCanvas :: Element -> IO Context2D getContext2d :: String -> IO Context2D getContext2d canvasName = do c <- getElementById canvasName getContext2dFromCanvas c</code></pre> Importing the rest of the functions is straight forward: <pre class="sourceCode haskell"><code class="sourceCode haskell">foreign import js "%1.fillRect(%*)" fillRect :: Context2D -> Double -> Double -> Double -> Double -> IO () foreign import js "jsSetFillColor(%*)" jsSetFillColor :: Context2D -> JSString -> IO () setFillColor ctx = jsSetFillColor ctx . toJS foreign import js "%1.clearRect(%2, %3, %4, %5)" clearRect :: Context2D -> Double -> Double -> Double -> Double -> IO () foreign import js "%1.canvas.width" canvasWidth :: Context2D -> IO Double foreign import js "%1.canvas.height" canvasHeight :: Context2D -> IO Double clear :: Context2D -> IO () clear ctx = do w <- canvasWidth ctx h <- canvasHeight ctx clearRect ctx 0.0 0.0 w h</code></pre> We have defined "clear" for convenience. It clears the whole canvas. ** Note: ** For some reason, "context.setFillColor" does not work on firefox. Therefor a helper function is defined setting the color via fillStyle. <pre class="sourceCode JavaScript"><code class="sourceCode javascript">function jsSetFillColor(context, color) { context.fillStyle = color; }</code></pre> <h2 id="haste-2">Haste</h2> Again, for haste we have to write javascript functions with the correct return type: <pre class="sourceCode javascript"><code class="sourceCode javascript">function jsGetContext2d(canvas) { return canvas.getContext("2d"); } function jsFillRect(context, x, y, width, height) { context.fillRect(x,y,width,height); return; } function jsSetFillColor(context, color) { context.fillStyle = color; return; } function jsClear(context) { context.clearRect(0.0, 0.0, context.canvas.width, context.canvas.height); return; }</code></pre> And here the haskell part: <pre class="sourceCode haskell"><code class="sourceCode haskell">import Haste.Prim import Haste.DOM newtype Context2D = Context2D JSAny foreign import ccall "jsGetContext2D" jsGetContext2d :: Elem -> IO Context2D getContext2d name = withElem name getContext2D foreign import ccall "jsFillRect" fillRect :: Context2D -> Double -> Double -> Double -> Double -> IO () foreign import ccall jsSetFillColor :: Context2D -> JSString -> IO () setFillColor ctx = jsSetFillColor ctx . toJSStr foreign import ccall "jsClear" clear :: Context2D -> IO ()</code></pre> Again we use "withElem" function from Haskell.DOM which executes an action with the element specified by the provided name. <h1 id="putting-it-all-together">Putting it all together</h1> All imported functions are named, so that the main code is the same for UHC and haste. The folloging code should explain itself through the comments: <pre class="sourceCode haskell numberlines"><code class="sourceCode haskell">module Main where import JavaScript canvasName = "canvas1" playerY = 380.0 playerWidth = 60.0 playerHeight = 20.0 playerSpeed = 3.0 playerColor = "green" data State = State {x :: Double} initState = State 300.0 main = setOnLoad initilize initilize :: IO () initilize = do saveGlobalObject "state" initState setInterval 30.0 update setOnKeyDown canvasName onKeyDown return () onKeyDown :: Int -> IO () onKeyDown code = do s <- loadGlobalObject "state" :: IO State let s' = case code of 39 -> s {x = (x s) + playerSpeed} 37 -> s {x = (x s) - playerSpeed} _ -> s saveGlobalObject "state" s' update :: IO () update = do s <- loadGlobalObject "state" :: IO State ctx <- getContext2d canvasName clear ctx setFillColor ctx playerColor fillRect ctx (x s) playerY playerWidth playerHeight</code></pre> To compile with UHC you need <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/3_FirstInteractive/code/uhc/JavaScript.hs">JavaScript.hs</a> and <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/3_FirstInteractive/code/uhc/helpers.js">helpers.js</a>. Than run: <pre class="sourceCode bash"><code class="sourceCode bash">uhc -tjs Main.hs</code></pre> Edit the resulting HTML page and add <pre class="sourceCode html"><code class="sourceCode html"><script type="text/javascript" src="helpers.js"></script></code></pre> into the head and <pre class="sourceCode html"><code class="sourceCode html"><canvas id="canvas1" width=600 height=500 tabindex="0"></canvas></code></pre> to the body. For haste you need this <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/3_FirstInteractive/code/haste/JavaScript.hs">JavaScript.hs</a> und <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/3_FirstInteractive/code/haste/helpers.js">helpers.js</a> and compile it with: <pre class="sourceCode bash"><code class="sourceCode bash">hastec --with-js=helpers.js Main.hs --start=asap</code></pre> The "--start=asap" parameter is necessary because we set the onLoad function ourself. Than embed it in this HTML page: <pre class="sourceCode html"><code class="sourceCode html"><!DOCTYPE html><html><head><title>Main</title> <script type="text/javascript" src="Main.js"></script> </head> <body> <canvas id="canvas1" height="400" width="600" tabindex="0">Your browser des not support canvas</canvas> </body> </html></code></pre> The running example can be seen at the beginning of this post. <h2 id="summary">Summary</h2> This has been a rather long post, but we have learned a lot. With the tools at hand we can now update out game with an callback function we set via "setInterval" and receive keyboard events. The next post will be another step towards our goal of a breakout clone, we will implement the ball and let it bounce on the paddle and the walls. <a href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US" rel="license"><img alt="Creative Commons License" src="https://i.creativecommons.org/l/by/3.0/de/88x31.png" style="border-width: 0;" /></a> Writing JavaScript games in Haskell by <a href="https://jshaskell.blogspot.de/" property="cc:attributionName" rel="cc:attributionURL" xmlns:cc="https://creativecommons.org/ns#">Nathan Hüsken</a> is licensed under a <a href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US" rel="license">Creative Commons Attribution 3.0 Germany License</a>.Nathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.com12tag:blogger.com,1999:blog-6355249120999252418.post-67089990462008438542012-07-10T14:08:00.003-07:002013-08-30T10:02:45.964-07:00Hello, WorldThe first thing we need on our journey is a compiler that translates out haskell to javascript. On this page: <a href="https://www.haskell.org/haskellwiki/The_JavaScript_Problem">The JavaScript Problem</a> you can find a list of compilers that are able to do that. I will focus on UHC and haste. GHCJS also seems promising, and I might try it later. So we want to write a little hello world program. The equivalent in javascript would be <pre class="sourceCode Javascript"><code class="sourceCode javascript">document.write("Hello, World!");</code></pre> which replaces the contents of the document with "Hello, World!". Let us get started. <h1 id="uhc">UHC</h1> The <a href="https://www.cs.uu.nl/wiki/UHC/">Utrecht Haskell Compiler</a> has a backend allowing to compile haskell to javascript. This page links all the information about the JavaScript backend: <a href="https://uu-computerscience.github.com/uhc-js/">UHC-JS</a> <h2 id="installing-uhc">Installing UHC</h2> First we have to install UHC. You can find the code for UHC here <a href="https://github.com/UU-ComputerScience/uhc">UHC GitHub</a>. The build instructions can be found in the EHC sub directory. But first some dependencies are needed. On ubuntu linux I install them with apt-get: <pre class="sourceCode bash"><code class="sourceCode bash">apt-get install ghc cabal-install build-essentials libtool uuagc</code></pre> We also need to install a few haskell packages via cabal: <pre class="sourceCode bash"><code class="sourceCode bash">cabal update cabal install network uulib syb fgl</code></pre> To install UHC, first clone the repository and change into the EHC directory. Then build and install UHC. <pre class="sourceCode bash"><code class="sourceCode bash">git clone git://github.com/UU-ComputerScience/uhc.git cd uhc/EHC ./configure make sudo make install</code></pre> In blogs it is common to suggesting getting a cup of coffee at a moment like this, because the make command may take a while. So get a cup of coffee! If everthing worked out, UHC should be installed and you can compile to javascript via <pre class="sourceCode bash"><code class="sourceCode bash">uhc -tjs Main.hs</code></pre> (Or however your haskell file is called). <h2 id="hello-world-with-uhc">Hello World with UHC</h2> We need to do two things: <ul> <li>Get the document.</li> <li>Call write on the document with "Hello, World!" as parameter.</li> </ul> The FFI (ForeignFunctionInterface) of the js backend of UHC is described here <a href="https://www.norm2782.com/improving-uhc-js-report.pdf">Improving UHC js</a> For our purposes, it works like this: <pre class="sourceCode haskell"><code class="sourceCode haskell">foreign import js "jscommand" haskellName :: Type</code></pre> Where "jscommand" is the command in javascript, "haskellName" the name of the haskell function we want to define and "Type" the type of the haskell function. "jscommand" may contain "%N" where N is a number refering to the N-th parameter of the haskell function. So to get the document we first define a type for it and then import a corresponding javascript command <pre class="sourceCode haskell"><code class="sourceCode haskell">data Document foreign import js "document" getDocument :: IO Document</code></pre> To get the document we just have to call "document" in javascript. This returns us the document in the IO monad. The document is in the IO monad because we a calling a foreign function which might have side effects. Now we want to call "write" on a document. <pre class="sourceCode haskell"><code class="sourceCode haskell">foreign import js "%1.write(%2)" write :: Document -> JSString -> IO ()</code></pre> Because the "%1" is in front of the ".write", the first argument to haskell function "write" (which is the document) is the object write is called on (this can all be found in <a href="https://www.norm2782.com/improving-uhc-js-report.pdf">Improving UHC js</a>. Note that the second argument is of type JSString and not of String. This is because a string in haskell is not the same as a string in javascript. We have to convert a haskell string to a javascript string <pre class="sourceCode haskell"><code class="sourceCode haskell">type JSString = PackedString foreign import prim "primStringToPackedString" toJS :: String -> JSString</code></pre> Now we are ready to write our hello world: <pre class="sourceCode haskell"><code class="sourceCode haskell">type JSString = PackedString foreign import prim "primStringToPackedString" toJS :: String -> JSString data Document foreign import js "document" getDocument :: IO Document foreign import js "%1.write(%2)" write :: Document -> JSString -> IO () main = do doc <- getDocument write doc $ toJS "Hello, World!"</code></pre> <h1 id="haste">Haste</h1> <h2 id="installing-haste">Installing haste</h2> Haste can be found here: <a href="https://github.com/valderman/haste-compiler">Haste GitHub</a>. Instructions for installation can also be found on that page (just read the Building section). It requires installation of fursuit, which can be found here: <a href="https://github.com/valderman/fursuit">Fursuit GitHub</a>. <h2 id="hello-world-with-haste">Hello World with haste</h2> Again, we need a way to import a function to get the document and to write into the contents of the document. Information on how to import javascript functions can be found in <a href="https://github.com/valderman/haste-compiler/blob/master/doc/js-externals.txt">the doc subdirectory</a> of the haste repository. <blockquote> Update: The way FFI functions have to writting with haste has changed since the blog post has original been written. At that time returning values from javascript to haskell was a little bit more cumbersome. I have updated this blog post to reflect the new way of doing it. I hope I did not forget something in the process. So if you find an error, please comment. </blockquote> Haste is not as flexible as UHC when importing JavaScript functions. It does not allow placing the parameters of the haskell function in the javascript code with "%N". It also does not allow the custom type "Document" to be used as a parameter or return type. Instead "JSAny" must be used. So we create a file "helpers.hs" with out Javascript helper functions: <pre class="sourceCode javascript"><code class="sourceCode javascript">function objWrite(obj, text) { obj.write(text); // Call the method return; // Return () } function getDocument() { return document; }</code></pre> This now allows us to write hello world in Haste: <pre class="sourceCode haskell"><code class="sourceCode haskell">import Haste import Haste.Prim type Document = JSAny foreign import ccall "objWrite" write :: Document -> JSString -> IO () foreign import ccall "getDocument" getDocument :: IO Document main = do doc <- getDocument write doc $ toJSStr "Hello World!"</code></pre> Compile this with: <pre class="sourceCode bash"><code class="sourceCode bash">hastec Main.hs --with-js=helpers.js</code></pre> Now all we need to do is embed this file in a html page: <pre class="sourceCode html"><code class="sourceCode html"><!DOCTYPE html><html><head><title>Main</title> <script type="text/javascript" src="Main.js"></script> </head> <body> </body> </html></code></pre> Open this with a browser of your choice (I only tried chromium) and it should work. <h1 id="edit-trying-it-out">Edit: Trying it out</h1> As suggested in a comment, I have uploaded the compiled javascript file (the haste version because the UHC version has several dependencies) here: <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/2_HelloWorld/HelloWorld.js">Hello, World!</a> Download it and <a href="https://github.com/RudolfVonKrugstein/jshaskell-blog/blob/master/2_HelloWorld/HelloWorld.html">this</a> html file into the same directory. Than open the html with a browser of your choice (tested on ubuntu linux, chromium). Edit: Rewrote with pandoc <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by/3.0/de/88x31.png" /></a> Writing JavaScript games in Haskell by <a xmlns:cc="https://creativecommons.org/ns#" href="https://jshaskell.blogspot.de/" property="cc:attributionName" rel="cc:attributionURL">Nathan Hüsken</a> is licensed under a <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US">Creative Commons Attribution 3.0 Germany License</a>.Nathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.com5tag:blogger.com,1999:blog-6355249120999252418.post-42735145642441330052012-07-10T06:06:00.003-07:002012-07-17T05:33:21.507-07:00About this blogThis blog will be about my experience with attempting to write javascript games in haskell. So far I have very little experience in javascript and in haskell. From my first attempts in haskell I can already tell that this will not be easy, as haskell has a complete different approach to programming than languages like C++ (with which I have much more experience). <h1 id="why-javascript-and-why-haskell">Why JavaScript and why Haskell?</h1> I am not attempting to write huge games, I want to write small games which are fun to play. An javascript enabled browser seems to be the perfect platform. Games running in the browser need no extra installation and are accessible from almost every computer. This way it is convenient for the audience to reach the games. But why Haskell? A while ago I encountered haskell for the first time and I was fascinated. The mathematical approach, the functional programming and the lazy evaluation intrigue me. I tend to have no big difficulties in picking up new programming languages, but with haskell this is a different sroty. Also I have read already quite a lot about haskell, there is still a lot of concepts I do not yet understand. Or when I understand them in principle I have no Idea how they would be implemented. Now it seems that these would be reasons to abandon haskell, and focus on another language that is more comfortable to learn (javascript for example). But I like the challenge and I feel like there will be a big benefit from learning haskell. What I have already seen (and understood) from haskell I like. There is a lot of opinions and explanations of why one should use haskell in the internet. Just google <a href="www.google.com/search?q=why+haskell">Why Haskell</a> or look here: <a href="https://www.haskell.org/haskellwiki/Why_Haskell_matters">Why Haskell matters</a> <h1 id="the-intention-of-the-blog">The intention of the blog</h1> Because I am not an experienced haskell programmer, this blog will not present much of my own ideas (at least not in the beginning). Instead I will document my experience with the attempt to write JavaScript games in haskell. All of the information (or at least most if it) I found in the internet or by asking people mailing-lists. I will try to always mark the places where I gather my information. The intent of this blog will be to make it easier for other with the same goal to get started with javascript games written in haskell. It is an attempt of me to give back to the community. I will try to make the posts very tutorial style. Sometimes I will redirect to other pages when I find it unnecessary to repeat the information here that can be found there. Edit1: Rewrote with pandoc <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by/3.0/de/88x31.png" /></a> Writing JavaScript games in Haskell by <a xmlns:cc="https://creativecommons.org/ns#" href="https://jshaskell.blogspot.de/" property="cc:attributionName" rel="cc:attributionURL">Nathan Hüsken</a> is licensed under a <a rel="license" href="https://creativecommons.org/licenses/by/3.0/de/deed.en_US">Creative Commons Attribution 3.0 Germany License</a>.Nathan Hüskenhttps://www.blogger.com/profile/09614845657227846437noreply@blogger.com2

Original Source | Taken Source