ActionKid (empty) → 0.1.0.0

raw patch · 11 files changed

+685/−0 lines, 11 filesdep +ActionKiddep +JuicyPixelsdep +JuicyPixels-repasetup-changed

Dependencies added: ActionKid, JuicyPixels, JuicyPixels-repa, OpenGL, StateVar, base, containers, gloss, gloss-juicy, hspec, lens, mtl, template-haskell

Files

• ActionKid.cabal +32/−0
• LICENSE +0/−0
• Setup.hs +2/−0
• spec/Main.hs +6/−0
• src/ActionKid.hs +8/−0
• src/ActionKid/Core.hs +220/−0
• src/ActionKid/Globals.hs +18/−0
• src/ActionKid/Internal.hs +79/−0
• src/ActionKid/Types.hs +142/−0
• src/ActionKid/Utils.hs +44/−0
• src/Main.hs +134/−0

@@ -0,0 +1,32 @@+name:                ActionKid+version:             0.1.0.0+synopsis:            An easy-to-use video game framework for Haskell.+description:         See examples and full readme on the Github page: https:\/\/github.com\/egonSchiele\/actionkid+homepage:            http://adit.io+license:             BSD3+license-file:        LICENSE+author:              Aditya Bhargava+maintainer:          bluemangroupie@gmail.com+-- copyright:+category:            Game Engine+build-type:          Simple+cabal-version:       >=1.8++executable actionkid+  build-depends:       base ==4.6.*, gloss, StateVar, lens, gloss-juicy, mtl, template-haskell, JuicyPixels ==3.1.*, JuicyPixels-repa ==0.7, containers ==0.5.0.*, OpenGL ==2.8.0.*+  hs-source-dirs:      src+  main-is: Main.hs+  ghc-options: -rtsopts -threaded "-with-rtsopts=-M500m -N"++Test-Suite test-actionkid+  type:       exitcode-stdio-1.0+  build-depends:       base ==4.6.*, hspec, ActionKid+  hs-source-dirs:      spec, src+  main-is:             Main.hs++library+  build-depends:       base ==4.6.*, gloss, StateVar, lens, gloss-juicy, mtl, template-haskell, JuicyPixels ==3.1.*, JuicyPixels-repa ==0.7, containers ==0.5.0.*, OpenGL ==2.8.0.*+  exposed-modules:     ActionKid, ActionKid.Types, ActionKid.Core, ActionKid.Utils+  hs-source-dirs:      src+  Other-modules:       ActionKid.Internal, ActionKid.Globals+  ghc-options: -rtsopts -threaded "-with-rtsopts=-M500m -N"

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,6 @@+import Test.Hspec+import ActionKid+main = hspec $ do+  describe "specs" $ do+    it "should work" $ do+      1 == 1

@@ -0,0 +1,8 @@+module ActionKid (+    module ActionKid.Types,+    module ActionKid.Core,+    module Graphics.Gloss.Interface.IO.Game+  ) where+import ActionKid.Types+import ActionKid.Core+import Graphics.Gloss.Interface.IO.Game

@@ -0,0 +1,220 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}++module ActionKid.Core where+import ActionKid.Types+import ActionKid.Utils+import Control.Applicative+import Control.Monad+import Data.List+import Data.Maybe+import Text.Printf+import Graphics.Gloss hiding (display)+import Data.Monoid ((<>), mconcat)+import Graphics.Gloss.Interface.IO.Game+import Data.Ord+import ActionKid.Globals+import Control.Lens+import qualified Debug.Trace as D+import ActionKid.Internal+import Control.Monad.State+import Language.Haskell.TH+import Data.IORef+import qualified Data.Map as M+import System.IO.Unsafe+import Graphics.Gloss.Juicy+import Control.Monad+import Control.Monad.Fix+import Control.Concurrent+import Foreign.ForeignPtr+import Graphics.Rendering.OpenGL.GL.StateVar++-- | (Currently disabled) Given a path to an audio file, plays the file.+playSound :: String -> Bool -> IO ()+playSound src loopSound = return ()+-- Needs some love...either SDL is buggy or I don't understand it...+-- playSound src loopSound = do+--   let audioRate     = 22050+--       audioFormat   = Mix.AudioS16LSB+--       audioChannels = 2+--       audioBuffers  = 4096+--       anyChannel    = (-1)++--   forkOS $ do+--     -- Don't ask why this is needed. If it isn't there, somehow+--     -- this audio thread blocks all other execution, and you can't+--     -- do anything else. But introducing it somehow prevents that.+--     -- WTF.+--     threadDelay 5000+--     SDL.init [SDL.InitAudio]+--     result <- openAudio audioRate audioFormat audioChannels audioBuffers+--     audioData <- Mix.loadWAV src+--     Mix.playChannel anyChannel audioData 0+--     fix $ \loop -> do+--       touchForeignPtr audioData+--       threadDelay 500000+--       stillPlaying <- numChannelsPlaying+--       when (stillPlaying /= 0) loop+--     Mix.closeAudio+--     SDL.quit+--     when loopSound $+--       playSound src loopSound+--     return ()+--   return ()++-- cacheImage src pic = unsafePerformIO $ do+--   modifyIORef' imageCache (\cache -> D.trace ("caching: " ++ src) $ M.insert src pic cache)+--   cache <- readIORef imageCache+--   putStrLn $ "new cache is: " ++ (show cache)+--   return pic++-- | Given a path, loads the image and returns it as a picture. It performs+-- caching, so if the same path has been given before, it will just return+-- the image from the cache.+image :: String -> Picture+image src = unsafePerformIO $ do+    pic_ <- loadJuicy src+    case pic_ of+      Nothing -> error $ "didn't find an image at " ++ src+      Just pic@(Bitmap w h _ _) -> do+        let x = fromIntegral w / 2+            y = fromIntegral h / 2+            newPic = translate x y pic+        cache <- readIORef imageCache+        case M.lookup src cache of+          Nothing -> do+            modifyIORef' imageCache (M.insert src newPic)+            return newPic+          Just cachedPic -> do+            return cachedPic++{-# NOINLINE image #-}++-- This will eventually be a function that takes a tile map png or jpg and+-- cuts it up into the individual tiles and returns them as a 2-d array.+-- http://hackage.haskell.org/package/vector-0.5/docs/Data-Vector-Unboxed.html+-- http://www.haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial#Indexing_vectors+-- http://www.haskell.org/haskellwiki/Numeric_Haskell:_A_Repa_Tutorial#Indexing_arrays+-- http://hackage.haskell.org/package/repa-3.2.3.3/docs/Data-Array-Repa.html#t:Array+-- loadTileMap :: String -> Int -> Int -> [[Picture]]+-- loadTileMap src w h =+--    where image = (fromRight . unsafePerformIO . readImage $ src) :: Img RGBA+--          vec   = toUnboxed image++-- > :t vec+-- vec :: U.Vector GHC.Word.Word8+--+-- vec U.! 14 => gives you a number (word8)+-- U.length vec == 4096 (4 channels, RGBA, so really 1024...and it's+-- a 32x32 image. 32x32 = 1024).+++-- | Convenience function to make `MovieClip` instances for your data types.+-- Suppose you have a data type like so:+--+-- > data Tile = Empty { _ea :: Attributes } | Wall  { _wa :: Attributes } | Chip  { _ca :: Attributes }+--+-- Just call:+--+-- > deriveMC ''Tile+--+-- Or you can write your instance by hand if you want. Something like this:+-- https:\/\/gist.github.com\/egonSchiele\/e692421048cbd79acb26+deriveMC :: Name -> Q [Dec]+deriveMC name = do+    TyConI (DataD _ _ _ records _) <- reify name++    -- The following answers helped a lot:+    -- http://stackoverflow.com/questions/8469044/template-haskell-with-record-field-name-as-variable+    -- http://stackoverflow.com/questions/23400203/multiple-function-definitions-with-template-haskell+    [d|instance MovieClip $(conT name) where+         attrs = lens viewer mutator+           where viewer = $(mkViewer records)+                 mutator = $(mkMutator records)|]++-- | Used internally. Generates something like \mc -> case mc of ...+mkViewer :: [Con] -> Q Exp+mkViewer records = return $ LamE [VarP mc] (CaseE (VarE mc) $ map (mkMatch mc) records)+  where mc = mkName "mc"++-- | Used internally. Generates something like \mc new -> case mc of ...+mkMutator :: [Con] -> Q Exp+mkMutator records = return $ LamE [VarP mc, VarP new] (CaseE (VarE mc) $ map (mkMutatorMatch mc new) records)+  where mc = mkName "mc"+        new = mkName "new"++-- | Used internally by the `mkViewer` function to make all the cases+mkMatch :: Name -> Con -> Match+mkMatch mc (RecC n fields) = Match (ConP n (take (length fields) $ repeat WildP)) (NormalB body) []+    where lastField = last $ map (\(name,_,_) -> name) fields+          body = AppE (VarE lastField) (VarE mc)++-- THis works with data types without names for fields, but mkMutatorMatch+-- doesn't work yet+mkMatch mc (NormalC n fields) = Match (ConP n ((take ((length fields) - 1) $ repeat WildP) ++ [VarP mcAttrs])) (NormalB $ VarE mcAttrs) []+    where mcAttrs = mkName "mcAttrs"++-- | Used internally by the `mkMutator` function to make all the cases+mkMutatorMatch :: Name -> Name -> Con -> Match+mkMutatorMatch mc new (RecC n fields) = Match (ConP n (take (length fields) $ repeat WildP)) (NormalB body) []+    where lastField = last $ map (\(name,_,_) -> name) fields+          body = RecUpdE (VarE mc) [(lastField, VarE new)]++mkMutatorMatch mc new (NormalC n fields) = Match (ConP n (take (length fields) $ repeat WildP)) (NormalB body) []+    where lastField = last $ map fst fields+          body = AppE (ConE n) (VarE new) -- NOTE: this only works for data types with only one attribute: Attributes. Like `data Color = Red Attributes`. Make it work for more than one.++-- | Given a 2d array, returns a array of movieclips that make up a+-- grid of tiles. Takes:+--+-- 1. A 2d array of ints+--+-- 2. A function that takes an int and returns the related `MovieClip`+--+-- 3. (width, height) for the tiles in pixels+renderTileMap :: MovieClip a => [[Int]] -> (Int -> a) -> (Int, Int) -> [a]+renderTileMap tileMap f (w,h) =+    concat $ forWithIndex tileMap $ \(row, j) ->+         forWithIndex row $ \(tile, i) ->+            withMC (f tile) $ do+              x .= (fromIntegral $ i*w)+              y .= (fromIntegral $ boardH - h - j*h)++    where boardH = (*h) . length $ tileMap++-- | Check if one `MovieClip` is hitting another. Example:+--+-- > when player `hits` enemy $ die+hits :: Renderable a => a -> a -> Bool+hits a b = f a `intersects` f b+    where f = boundingBox . display++-- | Call this to run your game. Takes:+--+-- 1. Window title+--+-- 2. (width, height) of window+--+-- 3. Game state (a `MovieClip`)+--+-- 4. an event handler function (for handling user input)+--+-- 5. a function that keeps getting called in a loop (the main game loop)+run :: (MovieClip a, Renderable a) => String -> (Int, Int) -> a -> (Event -> StateT a IO ()) -> (Float -> StateT a IO ()) -> IO ()+run title (w,h) state keyHandler stepFunc = do+  boardWidth $= w+  boardHeight $= h+  playIO+    (InWindow title (w,h) (1, 1))+    white+    30+    state+    draw+    (\k gs -> execStateT (keyHandler k) gs)+    (\i gs -> execStateT (stepFunc i) gs)+++-- | Convenience function. Given a list of movie clips,+-- displays all of them.+-- TODO support zindex.+displayAll :: Renderable a => [a] -> Picture+displayAll mcs = Pictures $ map display mcs

@@ -0,0 +1,18 @@+module ActionKid.Globals where+import Data.IORef+import System.IO.Unsafe+import qualified Data.Map as M+import qualified Graphics.Gloss as G+import Control.Concurrent++-- | Global variable to set board width+boardWidth :: IORef Int+boardWidth  = unsafePerformIO $ newIORef 0++-- | Global variable to set board height+boardHeight :: IORef Int+boardHeight = unsafePerformIO $ newIORef 0++-- | Global variable to cache game images+imageCache :: IORef (M.Map String G.Picture)+imageCache = unsafePerformIO $ newIORef M.empty

@@ -0,0 +1,79 @@+module ActionKid.Internal where+import ActionKid.Types+import ActionKid.Utils+import Control.Applicative+import Control.Monad+import Data.List+import Data.Maybe+import Text.Printf+import Graphics.Gloss hiding (display)+import Data.Monoid ((<>), mconcat)+import Graphics.Gloss.Interface.IO.Game+import Data.Ord+import ActionKid.Globals+import Data.StateVar+import Control.Lens+import qualified Debug.Trace as D++-- bounding box for a series of points+pathBox points =+    let minx = minimum $ map fst points+        miny = minimum $ map snd points+        maxx = maximum $ map fst points+        maxy = maximum $ map snd points+    in ((minx, miny), (maxx, maxy))++catPoints :: (Point, Point) -> [Point]+catPoints (p1, p2) = [p1, p2]++-- | Code borrowed from https://hackage.haskell.org/package/gloss-game-0.3.0.0/docs/src/Graphics-Gloss-Game.html+-- Calculate bounding boxes for various `Picture` types.+type Rect = (Point, Point)     -- ^origin & extent, where the origin is at the centre+boundingBox :: Picture -> Rect+boundingBox Blank                    = ((0, 0), (0, 0))+boundingBox (Polygon path)           = pathBox path+boundingBox (Line path)              = pathBox path+boundingBox (Circle r)               = ((0, 0), (2 * r, 2 * r))+boundingBox (ThickCircle t r)        = ((0, 0), (2 * r + t, 2 * r + t))+boundingBox (Arc _ _ _)              = error "ActionKid.Core.boundingbox: Arc not implemented yet"+boundingBox (ThickArc _ _ _ _)       = error "ActionKid.Core.boundingbox: ThickArc not implemented yet"+boundingBox (Text _)                 = error "ActionKid.Core.boundingbox: Text not implemented yet"+boundingBox (Bitmap w h _ _)         = ((0, 0), (fromIntegral w, fromIntegral h))+boundingBox (Color _ p)              = boundingBox p+boundingBox (Translate dx dy p)      = ((x1 + dx, y1 + dy), (x2 + dx, y2 + dy))+    where ((x1, y1), (x2, y2)) = boundingBox p+boundingBox (Rotate _ang _p)         = error "Graphics.Gloss.Game.boundingbox: Rotate not implemented yet"++-- TODO fix scale, this implementation is incorrect (only works if scale+-- = 1). Commented out version is incorrect too+boundingBox (Scale xf yf p)          = boundingBox p+    -- let ((x1, y1), (x2, y2)) = boundingBox p+    --     w = x2 - x1+    --     h = y2 - y1+    --     scaledW = w * xf+    --     scaledH = h * yf+    -- in ((x1, x2), (x1 + scaledW, y1 + scaledH))+boundingBox (Pictures ps) = pathBox points+    where points = concatMap (catPoints . boundingBox) ps++-- | Check if one rect is touching another.+intersects :: Rect -> Rect -> Bool+intersects ((min_ax, min_ay), (max_ax, max_ay)) ((min_bx, min_by), (max_bx, max_by))+    | max_ax < min_bx = False+    | min_ax > max_bx = False+    | min_ay > max_by = False+    | max_ay < min_by = False+    | otherwise = True++-- | For future, if I want to inject something into the step function,+-- I'll do it here. Right now I just call the step function.+onEnterFrame :: MovieClip a => (Float -> a -> IO a) -> Float -> a -> IO a+onEnterFrame stepFunc num state = stepFunc num state++-- | Called to draw the game. Translates the coordinate system.+draw :: Renderable a => a -> IO Picture+draw gs = do+  w <- get boardWidth+  h <- get boardHeight+  return $ translate (-(fromIntegral $ w // 2)) (-(fromIntegral $ h // 2)) $+           display gs

@@ -0,0 +1,142 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Each game has several objects. For example, Mario has Mario, goombas,+-- mushrooms etc. In ActionKid terminology, an object is called+-- a `MovieClip`. To use one of your data types in a game, it needs to be+-- an instance of two typeclasses `MovieClip` and `Renderable`.+--+-- The `MovieClip` class does the book-keeping for an object. What are it's+-- x and y position? scale? visibility?+--+-- The `Renderable` class defines how your object will be rendered on+-- screen.+--+-- A `MovieClip` has several `Attributes`: x and y position, x and y scale, etc. So when you create a data type, the last+-- field needs to be of type `Attributes`:+--+-- > data Player = Player { _name :: String, _attrs :: Attributes }+--+-- Then, ActionKid takes care of rendering the player on screen correctly.+-- So you can write code like this:+--+-- > player.x += 10+--+-- And that updates the x field on the player's attributes. Then ActionKid will+-- make sure the player's position gets updated on-screen.++module ActionKid.Types where+import Graphics.Gloss.Interface.IO.Game+import ActionKid.Utils+import ActionKid.Globals+import Data.StateVar+import Control.Monad hiding (join)+import Control.Lens+import System.IO.Unsafe+import qualified Debug.Trace as D++-- | Attributes that get added to each MovieClip.+-- You won't use them raw, like this. Instead, each+-- movieclip can access these attributes through lenses.+data Attributes = Attributes {+                    -- | x position+                    _ax :: Float,+                    -- | y position+                    _ay :: Float,+                    -- | scale+                    _ascaleX :: Float,+                    _ascaleY :: Float,+                    -- | visibility+                    _avisible :: Bool,+                    -- | when this gets drawn. Note: unless you use+                    -- the `displayAll` function, you have to handle+                    -- zindex yourself!+                    _azindex :: Int+} deriving (Show, Eq)++makeLenses ''Attributes++-- | default Attributes.+-- Every `MovieClip` will have `Attributes` has it's last field.+-- When you create an instance of that movieclip, use the `def` function+-- to specify default attributes. Example: suppose you have a data type+-- like so:+--+-- > data Player = Player { _name :: String, _attrs :: Attributes }+--+-- You can instantiate a player like this:+--+-- > adit = Player "adit" def+--+-- Note that you don't need to specify x or y coordinates for the player...+-- that's what the attributes are for.+def = Attributes 0.0 0.0 1.0 1.0 True 1++-- | Make your data type an instance of this class.+-- For example, suppose you have a data type like this:+--+-- > data Tile = Tile { _tileAttrs :: Attributes, _tileColor :: Color }+--+-- Before you can use Tile in a game, it needs to be an instance of+-- `MovieClip`. You can use `deriveMC` to do this automatically using+-- TemplateHaskell:+--+-- > deriveMC ''Tile+--+-- Or write it yourself: https:\/\/gist.github.com\/egonSchiele\/e692421048cbd79acb26+class MovieClip a where+    -- | your data type needs to have a field for attributes.+    -- This is a lens for that field. For example, in our above example+    -- of a player, you can get the player's attributes like this:+    --+    -- > player ^. attrs+    --+    -- You can also use the rest of the following lenses on the player:+    --+    -- Get a player's position with:+    --+    -- > player ^. x+    --+    -- Set a player's position with:+    --+    -- > x .~ 10 $ player+    --+    -- The lens library gives you all kinds of pretty syntax for this+    -- stuff.+    attrs :: Lens a a Attributes Attributes++    x :: Lens a a Float Float+    x = lens (view $ attrs . ax) (flip $ set (attrs . ax))++    y :: Lens a a Float Float+    y = lens (view $ attrs . ay) (flip $ set (attrs . ay))++    scaleX :: Lens a a Float Float+    scaleX = lens (view $ attrs . ascaleX) (flip $ set (attrs . ascaleX))++    scaleY :: Lens a a Float Float+    scaleY = lens (view $ attrs . ascaleY) (flip $ set (attrs . ascaleY))++    visible :: Lens a a Bool Bool+    visible = lens (view $ attrs . avisible) (flip $ set (attrs . avisible))++    zindex :: Lens a a Int Int+    zindex = lens (view $ attrs . azindex) (flip $ set (attrs . azindex))++-- | Before you can use your data type in a game, it also needs to be an+-- instance of `Renderable`. This class defines how your data type will+-- look on the screen.+class MovieClip a => Renderable a where+    -- | Implement this method to tell ActionKid how to render your data+    -- type. Returns an instance of Picture (from the Gloss package).+    -- Example:+    --+    -- > render tile = color blue $ circle 5+    render :: a -> Picture+    -- | This is the internal function that positions the MovieClip+    -- correctly, checks if it is visible, etc etc.+    -- DO NOT IMPLEMENT!+    display :: a -> Picture+    display mc+      | mc ^. visible = translate (mc ^. x) (mc ^. y) $+                        scale (mc ^. scaleX) (mc ^. scaleY) $+                        render mc+      | otherwise = D.trace "not rendering invisible movieclip" blank

@@ -0,0 +1,44 @@+module ActionKid.Utils where+import Data.List+import Graphics.Gloss+import Control.Monad.State++-- | Convenience function to make a box:+--+-- > box 50 50+box :: Int -> Int -> Picture+box w_ h_ = polygon [p1, p2, p3, p4]+  where+    w = fromIntegral w_+    h = fromIntegral h_+    p1 = (0, 0)+    p2 = (0, w)+    p3 = (h, w)+    p4 = (h, 0)++join elem list = concat $ intersperse elem list++for :: [a] -> (a -> b) -> [b]+for = flip map++count :: Eq a => a -> [a] -> Int+count x list = length $ filter (==x) list++indices :: [a] -> [Int]+indices arr = [0..(length arr - 1)]++(//) :: Integral a => a -> a -> a+a // b = floor $ (fromIntegral a) / (fromIntegral b)++mapWithIndex func list = map func (zip list (indices list))++forWithIndex = flip mapWithIndex++-- | convenient if you need to update a lot of attributes on a `MovieClip`.+-- Example:+--+-- > withMC person $ do+--     x .= 100+--     y .= 100+--     name .= "adit"+withMC state func = snd $ runState func state

@@ -0,0 +1,134 @@+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-full-laziness -fno-cse #-}+import ActionKid+import ActionKid.Utils+import Control.Lens+import Control.Monad.State++-- This is an example of how to use ActionKid to make games with Haskell.+-- ActionKid is inspired by Actionscript, so you will see some+-- similarities.+--+-- Every video game has some objects on the screen that interact with each+-- other. For example, in a game of Mario, you will have Mario himself,+-- goombas, mushrooms, pipes etc. These objects are called "movie clip"s in+-- ActionKid terminology. Any data type that is an instance of the+-- MovieClip class can be used in your game.++-- So first, make a data type for every object you will have in your game.+-- In this demo game, we just have a player that will move around.+--+-- Every constructor must have `Attributes` as it's last field.+data Player = Player { _pa :: Attributes }++-- Ok, you have a Player type. Now before you can use it in your game,+-- make it an instance of MovieClip. You can do this automatically with+-- `deriveMC`:+deriveMC ''Player++-- Now that the player is a MovieClip, you can write code like this:+--+-- > player.x += 10+--+-- and the player will move 10 pixels to the right!+-- More on this later.++-- You also need a data type that will be the game state.+data GameState = GameState {+                    _player :: Player,+                    _ga :: Attributes+}++-- Use this convenience function to make MovieClip instances+-- for your data types automatically.+deriveMC ''GameState++-- Next, I suggest you make lenses for all of your data types.+-- If you don't know how lenses work, check out the intro README here:+-- https://github.com/ekmett/lens+--+-- and this tutorial:+-- https://www.fpcomplete.com/school/to-infinity-and-beyond/pick-of-the-week/basic-lensing+--+-- Lenses are great for working with nested data structures, and writing+-- functional code that looks imperative. Both are big plusses for game+-- development.+-- So this step is optional, but recommended.+makeLenses ''Player+makeLenses ''GameState++-- Finally, you need to make both Player and GameState+-- instances of Renderable. This defines how they will be shown on the+-- screen.+--+-- The `render` function returns a Gloss Picture:+--+-- http://hackage.haskell.org/package/gloss-1.8.2.2/docs/Graphics-Gloss-Data-Picture.html++instance Renderable Player where+    render p = color blue $ box 50 50++-- Here we are just rendering the player as a blue box. With ActionKid,+-- you can also use an image from your computer instead:+--+-- > render p = image "images/player.png"++-- To render the game state, we just render the player.+-- To do that, use the `display` function. `display` will render+-- the player at the right x and y coordinates.+instance Renderable GameState where+    render gs = display (_player gs)++-- If the game state has multiple items, you can render them all by+-- concatenating them:+--+-- > render gs = display (_player1 gs) <> display (_player2 gs)++-- this is the default game state. The player starts at coordinates (0,0)+-- (the bottom left of the screen).+-- NOTE: For the `Attributes` field, you can just use `def`. This will set+-- the correct default attributes for an object.+--+-- So this creates the game state with a player in it. Both have default+-- attributes.+gameState = (GameState (Player def) def)++-- All of the core game logic takes place in this monad transformer stack.+-- The State is the default game state we just made.+type GameMonad a = StateT GameState IO a++--------------------------------------------------------------------------+--------------------------------------------------------------------------+-- Ok, now we are done specifying all the data types and how they should+-- look! Now it's time to implement the core game logic. There are two+-- functions you need to define:+--+-- 1. An event handler (for key presses/mouse clicks)+-- 2. A game loop.+--+-- The event handler listens for user input, and moves the player etc.+-- The game loop is where the rest of the logic happens: firing bullets,+-- hitting an enemy, animations etc etc.+--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- This is the event handler. Since we are using lenses, this logic is+-- really easy to write.+eventHandler :: Event -> GameMonad ()+eventHandler (EventKey (SpecialKey KeyLeft) Down _ _) = player.x -= 10+eventHandler (EventKey (SpecialKey KeyRight) Down _ _) = player.x += 10+eventHandler (EventKey (SpecialKey KeyUp) Down _ _) = player.y += 10+eventHandler (EventKey (SpecialKey KeyDown) Down _ _) = player.y -= 10+eventHandler _ = return ()++-- This is the main loop. It does nothing right now.+mainLoop :: Float -> GameMonad ()+mainLoop _ = return ()++-- Now lets run the game! The run function takes:+-- 1. the title for the window of the game+-- 2. the size of the window+-- 3. the initial game state+-- 4. the eventHandler function+-- 5. the main loop function+main = run "demo game" (500, 500) gameState eventHandler mainLoop