packages feed

HGE2D (empty) → 0.1.6.0

raw patch · 21 files changed

+1550/−0 lines, 21 filesdep +GLUTdep +HGE2Ddep +OpenGLsetup-changed

Dependencies added: GLUT, HGE2D, OpenGL, base, time

Files

+ HGE2D.cabal view
@@ -0,0 +1,76 @@+-- Initial HGE2D.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/++name:                HGE2D+version:             0.1.6.0+synopsis:            2D game engine written in Haskell+description:         See README and examples/ for further information+license:             MIT+license-file:        LICENSE+author:              Martin Buck <buckmartin@buckmartin.de>+maintainer:          Martin Buck <buckmartin@buckmartin.de>+copyright:           Martin Buck <buckmartin@buckmartin.de>+homepage:            https://github.com/I3ck/HGE2D+bug-reports:         https://github.com/I3ck/HGE2D/issues+category:            Game+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10+source-repository head+    type:     git+    location: https://github.com/I3ck/HGE2D.git++library+  exposed-modules:+    HGE2D.Shapes+    HGE2D.Render+    HGE2D.Colors+    HGE2D.Datas+    HGE2D.Types+    HGE2D.Classes+    HGE2D.Instances+    HGE2D.Engine+    HGE2D.GlFunctions+    HGE2D.Time+    HGE2D.Math+    HGE2D.Geometry+    HGE2D.Collision+    HGE2D.Physical+  -- other-modules:+  -- other-extensions:+  build-depends:+      base >= 4.8 && < 4.9,+      OpenGL >=3.0 && < 3.1,+      GLUT >= 2.7 && < 2.8,+      time >= 1.5.0.1 && < 1.7+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -O2 -W -fwarn-incomplete-patterns++executable example1+  default-language:    Haskell2010+  main-is:             Example1.hs+  build-depends:       base >= 4.8 && < 4.9, HGE2D+  hs-source-dirs:      src/examples+  ghc-options:         -O2 -W -fwarn-incomplete-patterns++executable example2+  default-language:    Haskell2010+  main-is:             Example2.hs+  build-depends:       base >= 4.8 && < 4.9, HGE2D+  hs-source-dirs:      src/examples+  ghc-options:         -O2 -W -fwarn-incomplete-patterns++executable example3+  default-language:    Haskell2010+  main-is:             Example3.hs+  build-depends:       base >= 4.8 && < 4.9, HGE2D+  hs-source-dirs:      src/examples+  ghc-options:         -O2 -W -fwarn-incomplete-patterns++executable example4+  default-language:    Haskell2010+  main-is:             Example4.hs+  build-depends:       base >= 4.8 && < 4.9, HGE2D+  hs-source-dirs:      src/examples+  ghc-options:         -O2 -W -fwarn-incomplete-patterns
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Martin Buck++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/HGE2D/Classes.hs view
@@ -0,0 +1,67 @@+-- |+-- Module      :  HGE2D.Classes+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing class definitions used within HGE2D++{-# LANGUAGE ConstraintKinds #-}++module HGE2D.Classes where++import HGE2D.Types+import HGE2D.Datas++--------------------------------------------------------------------------------++-- | For types which are affected by time+class Dynamic a where+    moveInTime :: Millisecond -> a -> a++--------------------------------------------------------------------------------++-- | For types than can be directly rendered to GL (only required by the engine)+--   Use GlInstructable to define your rendereble types+class GlRender a where+    glRender :: a -> IO ()++--------------------------------------------------------------------------------++-- | For types which can be turned into render instructions to be rendered by the engine+class GlInstructable a where+    toGlInstruction :: a -> RenderInstruction++--------------------------------------------------------------------------------++-- | For types which have a bounding box+class HasBoundingBox a where+    getBB :: a -> BoundingBox++--------------------------------------------------------------------------------++-- | For types which have / are a physical object+class IsPhysicalObject a where+    getPhys :: a -> PhysicalObject+    setPhys :: PhysicalObject -> a -> a++--------------------------------------------------------------------------------++-- | For types which are positioned in space+class Positioned a where+    getPos :: a -> RealPosition+    getX   :: a -> Double+    getY   :: a -> Double++--------------------------------------------------------------------------------++-- | For types which can be moved in space+class Moveable a where+    moveBy :: RealPosition -> a -> a+    moveTo :: RealPosition -> a -> a++--------------------------------------------------------------------------------++-- | For types which can be accelerated+class Acceleratable a where+    accBy :: Velocity -> a -> a+    accTo :: Velocity -> a -> a
+ src/HGE2D/Collision.hs view
@@ -0,0 +1,66 @@+-- |+-- Module      :  HGE2D.Collision+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing functions for collision detection++module HGE2D.Collision where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Classes++--------------------------------------------------------------------------------++-- | Tests whether two objects collide (overlap in any way)+doCollide :: (HasBoundingBox a, HasBoundingBox b) => a -> b -> Bool+doCollide hasBB1 hasBB2 = 2.0 * xcenterthis - xcenterother < (xsizethis + xsizeother)+                       && 2.0 * ycenterthis - ycenterother < (ysizethis + ysizeother)+    where+      (bb1, bb2)                    = (getBB hasBB1, getBB hasBB2)+      (minthis, maxthis)            = (bbMin bb1, bbMax bb1)+      (minother, maxother)          = (bbMin bb2, bbMax bb2)+      (xsizethis, ysizethis)        = (abs $ (fst minthis) - (fst maxthis),    abs $ (snd minthis) - (snd maxthis))+      (xsizeother, ysizeother)      = (abs $ (fst minother) - (fst maxother),    abs $ (snd minother) - (snd maxother))+      (xcenterthis, ycenterthis)    = ((fst minthis) + (fst maxthis) / 2.0,    (snd minthis) + (snd maxthis) / 2.0)+      (xcenterother, ycenterother)  = ((fst minother) + (fst maxother) / 2.0,    (snd minother) + (snd maxother) / 2.0)++--------------------------------------------------------------------------------++-- | Tests whether either of the two objects fully contain the other+doContain :: (HasBoundingBox a, HasBoundingBox b) => a -> b -> Bool+doContain hasBB1 hasBB2 =   (isInside hasBB1 hasBB2)+                         || (isInside hasBB2 hasBB1)++--------------------------------------------------------------------------------++-- | Tests whether the first is fully in the second+isInside :: (HasBoundingBox a, HasBoundingBox b) => a -> b -> Bool+isInside hasBBIn hasBBOut =  (fst minIn) > (fst minOut)+                          && (snd minIn) > (snd minOut)+                          && (fst maxIn) < (fst maxOut)+                          && (snd maxIn) < (snd maxOut)+  where+    (bbIn, bbOut)       = (getBB hasBBIn, getBB hasBBOut)+    (minIn, maxIn)      = (bbMin bbIn, bbMax bbIn)+    (minOut, maxOut)    = (bbMin bbOut, bbMax bbOut)++--------------------------------------------------------------------------------++---TODO use HasPosition?++-- | Tests whether a position is within the bounding box+isInsideRP :: (HasBoundingBox a) => RealPosition -> a -> Bool+isInsideRP pos hasBB =  (posX > bbLeft)+                     && (posX < bbRight)+                     && (posY > bbTop)+                     && (posY < bbBottom)+  where+    posX     = fst pos+    posY     = snd pos+    bbTop    = snd $ bbMin bb+    bbRight  = fst $ bbMax bb+    bbBottom = snd $ bbMax bb+    bbLeft   = fst $ bbMin bb+    bb       = getBB hasBB
+ src/HGE2D/Colors.hs view
@@ -0,0 +1,48 @@+-- |+-- Module      :  HGE2D.Colors+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing color definitions to have easy access to basic colors++module HGE2D.Colors where++import HGE2D.Types++--------------------------------------------------------------------------------++colorBlack :: GlColorRGB+colorBlack = (0, 0, 0)++colorWhite :: GlColorRGB+colorWhite = (1, 1, 1)++colorIce :: GlColorRGB+colorIce = (0.45, 0.73, 0.98)++colorMetal :: GlColorRGB+colorMetal = (0.73, 0.73, 0.73)++colorWater :: GlColorRGB+colorWater = (0, 0, 1)++colorGrass :: GlColorRGB+colorGrass = (0.3, 0.74, 0.2)++colorForest :: GlColorRGB+colorForest = (0.13, 0.55, 0.13)++colorGreen :: GlColorRGB+colorGreen = (0, 1, 0)++colorRed :: GlColorRGB+colorRed = (1, 0, 0)++colorPath :: GlColorRGB+colorPath = (0.16, 0.17, 0.16)++colorRock :: GlColorRGB+colorRock = (0.73, 0.73, 0.73)++colorLaser :: GlColorRGB+colorLaser = (0, 1, 0)
+ src/HGE2D/Datas.hs view
@@ -0,0 +1,81 @@+-- |+-- Module      :  HGE2D.Datas+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing data definitions used within HGE2D++module HGE2D.Datas where++import HGE2D.Types++import qualified Graphics.Rendering.OpenGL as GL++-- | A physical object with position, sizes, velocities, accelerations, mass, drag etc.+data PhysicalObject = PhysicalObject+    { physicalPos               :: RealPosition+    , physicalVel               :: Velocity+    , physicalAcc               :: Acceleration+    , physicalBB                :: BoundingBox+    , physicalRot               :: Radian+    , physicalRotSpeed          :: RotationSpeed ---TODO rename to ..Vel+    , physicalRotAcceleration   :: RotationAcceleration ---TODO rename to Acc+    , physicalMass              :: Mass+    , physicalDrag              :: Drag+    , physicalRotDrag           :: Drag ---TODO RotDrag?+    } deriving (Show, Read)++-- | A rigidbody defined by position, size and velocity+data RigidBody = RigidBody+    { rigidPos  :: RealPosition -- current position+    , rigidVel  :: Velocity     -- current velocity+    , rigidBB   :: BoundingBox  -- bounding box+    } deriving (Show, Read)++-- | A bounding box defined by two positions in space+data BoundingBox = BoundingBox+    { bbMin     :: RealPosition -- lower left corner of bb+    , bbMax     :: RealPosition -- upper right corner of bb+    } deriving (Show, Read)++-- | A position defined in number of tiles in x and y direction+data TilePosition = TilePosition+    { tileX     :: Int -- position in number of tiles from left starting with 0+    , tileY     :: Int -- position in number of tiles from top starting with 0+    } deriving (Show, Read, Eq)++--------------------------------------------------------------------------------++-- | The enginestate which defines multiple callbacks required by the engine to interact with the gamestate+data EngineState a = EngineState+    { click           :: PosX -> PosY -> a -> a -- how your game should change when clicked+    , mUp             :: PosX -> PosY -> a -> a -- how your game should change when mouse up happens+    , hover           :: PosX -> PosY -> a -> a -- how your game should change when hovered+    , drag            :: PosX -> PosY -> a -> a -- how your game should change when dragged+    , kDown           :: PosX -> PosY -> Char -> a -> a -- how your game should change when a keyDown happened+    , kUp             :: PosX -> PosY -> Char -> a -> a -- how your game should change when a keyUp happened+    , resize          :: (Width, Height) -> a -> a -- how to resize your game+    , getSize         :: a -> (Width, Height) -- how to get the size of your game+    , moveTime        :: Millisecond -> a -> a -- how your game should change over time+    , getTime         :: a -> Millisecond -- how to get the current time of your game+    , setTime         :: Millisecond -> a -> a -- how to set the time of your game+    , getTitle        :: a -> String -- how to get the title of your game+    , toGlInstr       :: a -> RenderInstruction -- how to receive a render instruction to display your game+    }++--------------------------------------------------------------------------------++-- | The instructions used to render the game+data RenderInstruction = RenderNothing                                                       -- do nothing+                       | RenderWithCamera GlPosX GlPosY GlScaleX GlScaleY RenderInstruction  -- render with a given camera view+                       | RenderText String                                                   -- render a string+                       | RenderLineStrip GlShape GL.GLfloat                                  -- render as line strip+                       | RenderTriangle GlShape                                              -- render as triangles / faces+                       | RenderLineLoop GlShape GL.GLfloat                                   -- render as line which connects first and last+                       | RenderScale GlScaleX GlScaleY                                       -- change scale+                       | RenderTranslate GlPosX GlPosY                                       -- translate / move following instructions+                       | RenderRotate Double                                                 -- rotate following instructions+                       | RenderColorize GlColorRGB                                           -- colorize following instructions+                       | RenderColorizeAlpha GlColorRGBA                                     -- colorize following instructions with alpha setting+                       | RenderPreserve RenderInstruction                                    -- render instruction while preserving rotation / translation+                       | RenderMany [RenderInstruction]                                      -- render multiple other instructions
+ src/HGE2D/Engine.hs view
@@ -0,0 +1,185 @@+-- |+-- Module      :  HGE2D.Engine+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing functions for the engine, mostly to interact with GLUT and OpenGL++module HGE2D.Engine where++import HGE2D.Datas+import HGE2D.Classes+import HGE2D.Time+import HGE2D.Render ()++import Control.Concurrent (newMVar, readMVar, takeMVar, putMVar, MVar)+import Graphics.UI.GLUT++--------------------------------------------------------------------------------++-- | Main function to run the engine+runEngine :: EngineState a -> a -> IO ()+runEngine es impl = do+    secs <- getSeconds+    let ms = toMilliSeconds secs++    state <- newMVar $ setTime es ms impl++    (_progName, _args)    <- getArgsAndInitialize+    initialDisplayMode    $= [DoubleBuffered]+    initialWindowSize     $= Size (round $ fst $ getSize es impl) (round $ snd $ getSize es impl)+    _window               <- createWindow $ getTitle es impl+    keyboardMouseCallback $= Just (keyboardMouse es state)+    motionCallback        $= Just (mouseGrab es state)+    passiveMotionCallback $= Just (mouseHover es state)+    blend $= Enabled+    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)+    displayCallback       $= display es state+    reshapeCallback       $= Just (reshape es state)+    idleCallback          $= Just (idle es state)+    mainLoop++--------------------------------------------------------------------------------++-- | Function to render the current state of the engine+display :: EngineState a -> MVar (a) -> IO ()+display es mvarGs = do+  clear [ColorBuffer]+  gs <- readMVar mvarGs+  glRender $ toGlInstr es gs+  swapBuffers++--------------------------------------------------------------------------------++-- | Function to react to changes of the window size+reshape :: EngineState a -> MVar (a) -> Size -> IO ()+reshape es mvarGs (Size width height) = do+    gs <- takeMVar mvarGs++    let newState = resize es (realToFrac width, realToFrac height) gs++    putMVar mvarGs newState++    viewport $= (Position 0 0, Size width height)+    postRedisplay Nothing+++--------------------------------------------------------------------------------++---TODO here named grab, but engine method named drag, name both the same++-- | Mouse grab interactions with the engine+mouseGrab :: EngineState a -> MVar (a) -> Position -> IO ()+mouseGrab es mvarGs (Position x y) = do+    gs <- takeMVar mvarGs ---TODO rename++    let w          = fst $ getSize es gs+        h          = snd $ getSize es gs+        correctedX = (realToFrac x) * (fst $ getSize es gs) / w+        correctedY = (realToFrac y) * (snd $ getSize es gs) / h+        newState   = drag es correctedX correctedY gs++    putMVar mvarGs newState+    return ()++-- | Mouse hover interactions with the engine+mouseHover :: EngineState a -> MVar (a) -> Position -> IO ()+mouseHover es mvarGs (Position x y) = do+    gs <- takeMVar mvarGs ---TODO rename++    let w          = fst $ getSize es gs+        h          = snd $ getSize es gs+        correctedX = (realToFrac x) * (fst $ getSize es gs) / w+        correctedY = (realToFrac y) * (snd $ getSize es gs) / h+        newState   = hover es correctedX correctedY gs++    putMVar mvarGs newState+    return ()+++-- | Keyboard and mouse interactions with the engine+keyboardMouse :: EngineState a -> MVar (a) -> Key -> KeyState -> Modifiers -> Position -> IO ()+keyboardMouse es mvarGs (MouseButton LeftButton) Down _modifiers (Position x y) = mouseDown es mvarGs x y+keyboardMouse es mvarGs (MouseButton LeftButton) Up   _modifiers (Position x y) = mouseUp   es mvarGs x y+keyboardMouse es mvarGs (Char        c)          Down _modifiers (Position x y) = keyDown   es mvarGs x y c+keyboardMouse es mvarGs (Char        c)          Up   _modifiers (Position x y) = keyUp     es mvarGs x y c+keyboardMouse _ _ _ _ _ _ =  return ()++--------------------------------------------------------------------------------++-- | MouseDown interaction with the engine+mouseDown :: EngineState a -> MVar (a) -> GLint -> GLint -> IO ()+mouseDown es mvarGs x y = do+    gs <- takeMVar mvarGs ---TODO rename++    ---TODO define method for corrections since used here and in hover+    let w          = fst $ getSize es gs+        h          = snd $ getSize es gs+        correctedX = (realToFrac x) * (fst $ getSize es gs) / w+        correctedY = (realToFrac y) * (snd $ getSize es gs) / h+        newState   = click es correctedX correctedY gs++    putMVar mvarGs newState+    return ()++-- | MouseUp interaction with the engine+mouseUp :: EngineState a -> MVar (a) -> GLint -> GLint -> IO ()+mouseUp es mvarGs x y = do+    gs <- takeMVar mvarGs ---TODO rename++    ---TODO define method for corrections since used here and in hover+    let w          = fst $ getSize es gs+        h          = snd $ getSize es gs+        correctedX = (realToFrac x) * (fst $ getSize es gs) / w+        correctedY = (realToFrac y) * (snd $ getSize es gs) / h+        newState   = mUp es correctedX correctedY gs++    putMVar mvarGs newState+    return ()++--------------------------------------------------------------------------------++-- | KeyPress interaction with the engine+keyDown :: EngineState a -> MVar (a) -> GLint -> GLint -> Char -> IO ()+keyDown es mvarGs x y c = do+    gs <- takeMVar mvarGs ---TODO rename++    ---TODO define method for corrections since used here and in hover+    let w          = fst $ getSize es gs+        h          = snd $ getSize es gs+        correctedX = (realToFrac x) * (fst $ getSize es gs) / w+        correctedY = (realToFrac y) * (snd $ getSize es gs) / h+        newState   = kDown es correctedX correctedY c gs++    putMVar mvarGs newState+    return ()++-- | KeyRelease interaction with the engine+keyUp :: EngineState a -> MVar (a) -> GLint -> GLint -> Char -> IO ()+keyUp es mvarGs x y c = do+    gs <- takeMVar mvarGs ---TODO rename++    ---TODO define method for corrections since used here and in hover+    let w          = fst $ getSize es gs+        h          = snd $ getSize es gs+        correctedX = (realToFrac x) * (fst $ getSize es gs) / w+        correctedY = (realToFrac y) * (snd $ getSize es gs) / h+        newState   = kUp es correctedX correctedY c gs++    putMVar mvarGs newState+    return ()++--------------------------------------------------------------------------------++-- | Idle function of the engine. Used to e.g. apply changes in time to the game state+idle :: EngineState a -> MVar (a) -> IdleCallback+idle es mvarGs = do+  gs   <- takeMVar mvarGs+  secs <- getSeconds++  let ms       = toMilliSeconds secs+      deltaMs  = ms - (getTime es gs)+      newState = moveTime es deltaMs (setTime es ms gs) ---TODO currently bot setting the time AND transforming++  putMVar mvarGs newState+  postRedisplay Nothing
+ src/HGE2D/Geometry.hs view
@@ -0,0 +1,168 @@+-- |+-- Module      :  HGE2D.Geometry+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing geometrical functions++module HGE2D.Geometry where++import Data.List++import HGE2D.Math+import HGE2D.Types+import HGE2D.Datas+import HGE2D.Classes++---TODO rewrite most / all functions to use classes+---TODO use typedefs++-- | Transform an angle in radians to an angle in degrees+rad2deg :: Double -> Double+rad2deg rad = rad * 180 / pi++-- | Transform an angle in degrees to an angle in radians+deg2rad :: Double -> Double+deg2rad deg = deg * pi / 180++-- | Calculate angle in radians between two positions in space, from the first to the secind+radRealPos :: RealPosition -> RealPosition -> Radian+radRealPos p1 p2 = atan2 dY dX+  where+    dX = (fst p2) - (fst p1)+    dY = (snd p2) - (snd p1)+++-- | Calculate angle of a velocity+velAngle :: Velocity -> Radian+velAngle v = atan2 (fst v) (snd v)++-- | Distance between two positions+distance :: (Positioned a, Positioned b) => a -> b -> Double+distance x y = sqrt $ distanceSqr x y++-- | Squared distance between two positions+--   Faster than calculating the distance. Can be used to e.g. compare distances cheaply+distanceSqr :: (Positioned a, Positioned b) => a -> b -> Double+distanceSqr x y = (fst p1 - fst p2)**2 + (snd p1 - snd p2)**2+  where+    p1 = getPos x+    p2 = getPos y++-- | Calculate the direction vector between two positions+direction :: (Positioned a, Positioned b) => a -> b -> RealPosition+direction x y = (newX, newY)+  where+    newX = ((fst p2) - (fst p1)) / l+    newY = ((snd p2) - (snd p1)) / l+    l = distance x y+    p1 = getPos x+    p2 = getPos y++-- | Find the closest in [b] to a+closest :: (Positioned a, Positioned b) => a -> [b] -> b+closest a bs = minimumBy (  \ x y -> compare (distanceSqr a x) (distanceSqr a y)  ) bs++-- | Find the furthest in [b] to a+furthest :: (Positioned a, Positioned b) => a -> [b] -> b+furthest a bs = maximumBy (  \ x y -> compare (distanceSqr a x) (distanceSqr a y)  ) bs++-- | Given a position and projectile speed of a gun / turret and an object defined by its current position and velocity+--   Calculates the position where both will intercept. (useful for pre-aiming)+interceptionPos :: (RealPosition, Double) -> (RealPosition, Velocity) -> RealPosition+interceptionPos (p1, v) (p2, v2) = (newX, newY)+  where+    tx = (fst p2) - (fst p1)+    ty = (snd p2) - (snd p1)+    tvx = fst v2+    tvy = snd v2++    a = tvx*tvx + tvy*tvy - v*v :: Double+    b = 2 * (tvx * tx + tvy * ty) :: Double+    c = tx*tx + ty*ty :: Double++    ts = quadraticEquation a b c+    t0 = fst ts+    t1 = snd ts+    temp = min t0 t1+    t | temp > 0 = temp+      | otherwise = max t0 t1++    newX = (fst p2) + (fst v2) * t+    newY = (snd p2) + (snd v2) * t++-- | Builder for a rigidbody+makeRB :: RealPosition -> Velocity -> Pixel -> Pixel -> RigidBody+makeRB center vel width height = RigidBody { rigidPos = center, rigidVel = vel, rigidBB = sizedBB center width height }++-- | Builder to get a BoundingBox from its center position and sizes+sizedBB :: RealPosition -> Pixel -> Pixel -> BoundingBox+sizedBB center width height = BoundingBox posMin posMax+  where+    posMin = (minX, minY)+    posMax = (maxX, maxY)+    minX = (fst center) - width / 2+    minY = (snd center) - height / 2+    maxX = (fst center) + width / 2+    maxY = (snd center) + height / 2++-- | Calculates the size of a BoundingBox+sizeBB :: BoundingBox -> (Pixel, Pixel)+sizeBB bb = (width, height)+  where+    width  = (fst $ bbMax bb) - (fst $ bbMin bb)+    height = (snd $ bbMax bb) - (snd $ bbMin bb)++-- | Calculates the center of a BoundingBox+centerBB :: BoundingBox -> RealPosition+centerBB bb = (newX, newY)+  where+    newX = (fst $ bbMin bb) + (width / 2)+    newY = (snd $ bbMin bb) + (height / 2)+    (width, height) = sizeBB bb++---TODO make monoid++-- | Merges two bounding boxes, creating a new one which wraps around the inputs+mergeBB :: BoundingBox -> BoundingBox -> BoundingBox+mergeBB bb1 bb2 = BoundingBox newMin newMax+  where+    newMin = mergeMin (bbMin bb1) (bbMin bb2)+    newMax = mergeMax (bbMax bb1) (bbMax bb2)++    mergeMin :: RealPosition -> RealPosition -> RealPosition+    mergeMin pos1 pos2 = (x, y)+      where+       x = min (fst pos1) (fst pos2)+       y = min (snd pos1) (snd pos2)++    mergeMax :: RealPosition -> RealPosition -> RealPosition+    mergeMax pos1 pos2 = (x, y)+      where+       x = max (fst pos1) (fst pos2)+       y = max (snd pos1) (snd pos2)++{- see above+tilePosToBB :: TilePosition -> BoundingBox+tilePosToBB pos = BoundingBox minPos maxPos+  where+    minPos = toRealPos $ pos+    maxPos = RealPosition maxX maxY+    maxX = (fst minPos) + tileSize+    maxY = (snd minPos) + tileSize+-}++---TODO sizedBB and makeBB are duplicates++-- | Builds a BoundingBox+makeBB :: RealPosition -> Pixel -> Pixel -> BoundingBox+makeBB center width height = BoundingBox newMin newMax+  where+    newMin = ((fst center - width / 2), (snd center - height / 2))+    newMax = ((fst center + width / 2), (snd center + height / 2))++-- | Given a position, time and veilocty it calculates the position where the moving object would be+applyVelocity :: RealPosition -> Velocity -> Millisecond -> RealPosition+applyVelocity oldPos vel time =+    (((fst oldPos) + (fromIntegral time) * (fst vel)),+    ((snd oldPos) + (fromIntegral time) * (snd vel)))
+ src/HGE2D/GlFunctions.hs view
@@ -0,0 +1,73 @@+-- |+-- Module      :  HGE2D.GlFunctions+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing functions used to interact with OpenGL++module HGE2D.GlFunctions where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Geometry++import qualified Graphics.Rendering.OpenGL as GL++--------------------------------------------------------------------------------++-- | Renders a RGB color+colorRGB :: GlColorRGB -> IO ()+colorRGB (r, g, b) = GL.color $ col3 r g b+  where+    col3 :: GL.GLfloat -> GL.GLfloat -> GL.GLfloat -> GL.Color3 GL.GLfloat+    col3 f1 f2 f3 = GL.Color3 f1 f2 f3++-- | Renders a RGBA color+colorRGBA :: GlColorRGBA -> IO ()+colorRGBA (r, g, b, a) = GL.color $ col4 r g b a+  where+    col4 :: GL.GLfloat -> GL.GLfloat -> GL.GLfloat -> GL.GLfloat -> GL.Color4 GL.GLfloat+    col4 f1 f2 f3 f4 = GL.Color4 f1 f2 f3 f4++-- | Adds an alpha value to a RGB color, turning it into a RGBA color+addAlpha :: GL.GLfloat -> GlColorRGB -> GlColorRGBA+addAlpha a (r, g, b) = (r, g, b, a)++--------------------------------------------------------------------------------++-- | Sends a translation instruction to OpenGL+translate2 :: GlPosX -> GlPosY -> IO ()+translate2 x y = GL.translate $ point3 x y 0.0++-- | Sends a scale instruction to OpenGL+scale2 :: GlScaleX -> GlScaleY -> IO ()+scale2 x y = GL.scale x y 1.0++--------------------------------------------------------------------------------++-- | Transforms a string to a RenderInstruction+text :: String -> RenderInstruction+text str = RenderText str++--------------------------------------------------------------------------------++-- | Sends a rotation instruction to OpenGL+rotate2 :: Double -> IO ()+rotate2 rad = rotTmp (realToFrac $ rad2deg rad)+  where+    rotTmp :: GL.GLfloat -> IO ()+    rotTmp deg = GL.rotate deg $ GL.Vector3 0 0 1++--------------------------------------------------------------------------------++-- | Builds a GLPoint2+point2 :: GlPosX -> GlPosY -> GlPoint2+point2 f1 f2 = GL.Vertex2 f1 f2++-- | Builds a GLPoint3+point3 :: GlPosX -> GlPosY -> GlPosZ -> GlPoint3+point3 f1 f2 f3 = GL.Vector3 f1 f2 f3++-- | Builds a GLVer3+vertex3 :: GlPosX -> GlPosY -> GlPosZ -> GlVer3+vertex3 f1 f2 f3 = GL.Vertex3 f1 f2 f3
+ src/HGE2D/Instances.hs view
@@ -0,0 +1,117 @@+-- |+-- Module      :  HGE2D.Instances+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing instance definitions for the classes / types of HGE2D++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module HGE2D.Instances where++import HGE2D.Geometry+import HGE2D.Types+import HGE2D.Datas+import HGE2D.Classes++--------------------------------------------------------------------------------++-- | Instance of HasBoundingBox for BoundingBox+instance HasBoundingBox BoundingBox where+    getBB = id++-- | Instance of HasBoundingBox for RigidBody+instance HasBoundingBox RigidBody where+    getBB = rigidBB++-- | Instance of HasBoundingBox for PhysicalObject+instance HasBoundingBox PhysicalObject where+    getBB = physicalBB++--------------------------------------------------------------------------------++-- | Instance of Positioned for RealPosition+instance Positioned RealPosition where+    getPos = id+    getX = fst+    getY = snd++-- | Instance of Positioned for RigidBody+instance Positioned RigidBody where+    getPos = getPos . rigidPos+    getX = getX . rigidPos+    getY = getY . rigidPos++--------------------------------------------------------------------------------++-- | Instance of Moveable for RealPosition+instance Moveable RealPosition where+    moveBy by pos = (newX, newY)+      where+        newX = fst pos + fst by+        newY = snd pos + snd by+    moveTo to _ = ((fst to), (snd to))++-- | Instance of Moveable for BoundingBox+instance Moveable BoundingBox where+    moveBy by bb = BoundingBox { bbMin = newMinPos, bbMax = newMaxPos }+      where+        newMinPos = moveBy by $ bbMin bb+        newMaxPos = moveBy by $ bbMax bb++    moveTo by bb = BoundingBox { bbMin = newMinPos, bbMax = newMaxPos }+      where+        newMinPos = moveTo by $ bbMin bb+        newMaxPos = moveTo by $ bbMax bb++-- | Instance of Moveable for RigidBody+instance Moveable RigidBody where+    moveBy by rb = rb { rigidPos = newPos , rigidBB = newBB }+      where+        newBB = moveBy by (rigidBB rb)+        newPos = moveBy by (rigidPos rb)+    moveTo to rb = rb { rigidPos = newPos, rigidBB = newBB }+      where+        newBB = moveTo to (rigidBB rb)+        newPos = moveTo to $ rigidPos rb++-- | Instance of Moveable for PhysicalObject+instance Moveable PhysicalObject where+    moveBy by po = po { physicalPos = newPos, physicalBB = newBB }+      where+        newBB = moveBy by (physicalBB po)+        newPos = moveBy by (physicalPos po)+    moveTo to po = po { physicalPos = newPos, physicalBB = newBB }+      where+        newBB = moveTo to (physicalBB po)+        newPos = moveTo to (physicalPos po)++--------------------------------------------------------------------------------++-- | Instance of Acceleratable for RigidBody+instance Acceleratable RigidBody where+    accBy by rb = rb { rigidVel = newVel }+      where+        newVel = ((fst oldVel) + (fst by) , (snd oldVel) + (snd by))+        oldVel = rigidVel rb+    accTo to rb = rb { rigidVel = to }++-- | Instance of Acceleratable for PhysicalObject+instance Acceleratable PhysicalObject where+    accBy by po = po { physicalVel = newVel }+      where+        newVel = ((fst oldVel) + (fst by) , (snd oldVel) + (snd by))+        oldVel = physicalVel po+    accTo to po = po { physicalVel = to }++--------------------------------------------------------------------------------++-- | Instance of Dynamic for RigidBody+instance Dynamic RigidBody where+    moveInTime time rb = rb { rigidPos = newPos , rigidBB = newBB }+      where+        newBB = (rigidBB rb) { bbMin = newMinPos, bbMax = newMaxPos}+        newPos = applyVelocity (rigidPos rb) (rigidVel rb) time+        newMinPos = applyVelocity (bbMin $ rigidBB rb) (rigidVel rb) time+        newMaxPos = applyVelocity (bbMax $ rigidBB rb) (rigidVel rb) time
+ src/HGE2D/Math.hs view
@@ -0,0 +1,17 @@+-- |+-- Module      :  HGE2D.Math+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing basic math functions++module HGE2D.Math where++-- | Calculate the two minima of the quadratic equation+quadraticEquation :: Double -> Double -> Double -> (Double, Double)+quadraticEquation a b c = if d < 0 then (0, 0) else (x, y)+                        where+                          x = e + sqrt d / (2 * a)+                          y = e - sqrt d / (2 * a)+                          d = b * b - 4 * a * c+                          e = - b / (2 * a)
+ src/HGE2D/Physical.hs view
@@ -0,0 +1,51 @@+-- |+-- Module      :  HGE2D.Physical+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing functions for PhysicalObjects++module HGE2D.Physical where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Classes+import HGE2D.Instances++--------------------------------------------------------------------------------++---TODO not fully implemented+---TODO rename+---TODO rename class to HasPhysicalObject++-- | Applies physics to a physical object. E.g. velocity changing position, acceleration changing velocity ...+applyPhysics :: (IsPhysicalObject a) => Millisecond -> a -> a+applyPhysics ms x = setPhys newPo x+  where+    newPo = (applyVel . applyAcc . applyRotVel . applyRotAcc . applyDrag . applyRotDrag) (getPhys x) ---TODO more consistent order acc > vel > abs++    applyVel po = moveBy (dX, dY) po ---TODO define more general for reuse+      where+        dX = (fromIntegral ms) * (fst $ physicalVel po)+        dY = (fromIntegral ms) * (snd $ physicalVel po)++    applyAcc po = po { physicalVel = (vX, vY) } ---TODO see above+      where+        vX = (fst $ physicalVel po) + (fromIntegral ms) * (fst $ physicalAcc po)+        vY = (snd $ physicalVel po) + (fromIntegral ms) * (snd $ physicalAcc po)++    applyRotVel po = po { physicalRot = fixedRot } ---TODO see above+      where+        fixedRot | newRot > 2.0 * pi = newRot - 2.0 * pi+                 | newRot < 0        = newRot + 2.0 * pi+                 | otherwise         = newRot+        newRot = (physicalRot po)  + dRot+        dRot = (fromIntegral ms) * (physicalRotSpeed po)++    applyRotAcc po = po { physicalRotSpeed = newRotSpeed } ---TODO see above+      where+        newRotSpeed = (physicalRotAcceleration po) + dRotSpeed+        dRotSpeed = (fromIntegral ms) * (physicalRotAcceleration po)++    applyDrag = id ---TODO+    applyRotDrag = id ---TODO
+ src/HGE2D/Render.hs view
@@ -0,0 +1,49 @@+-- |+-- Module      :  HGE2D.Render+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing the instance of GlRender for a RenderInstruction++module HGE2D.Render where++import HGE2D.Datas+import HGE2D.Classes+import HGE2D.GlFunctions++import Graphics.Rendering.OpenGL as GL+import Graphics.UI.GLUT++--------------------------------------------------------------------------------++-- | Instance of GLRender for a RenderInstruction+--   Makes it possible to render the RenderInstruction primitives+instance GlRender RenderInstruction where+    glRender renderInstruction = case renderInstruction of+        RenderNothing                     -> return ()+        RenderWithCamera w h sX sY instrs -> glRender $ RenderPreserve $ RenderMany ([RenderTranslate w h, RenderScale sX sY] ++ [instrs])+        RenderText text                   -> do currentRasterPosition $= Vertex4 0 0 0 1+                                                renderString TimesRoman24 text++        RenderLineStrip shape w           -> do lineWidth $= w+                                                (renderPrimitive LineStrip $ mapM_ vertex shape)++        RenderTriangle shape              -> renderPrimitive Triangles $ mapM_ vertex shape+        RenderLineLoop shape w            -> do lineWidth $= w+                                                (renderPrimitive LineLoop $ mapM_ vertex shape)+        RenderScale sX sY                 -> scale2 sX sY+        RenderTranslate w h               -> translate2 w h+        RenderRotate rad                  -> rotate2 rad+        RenderColorize rgb                -> colorRGB rgb+        RenderColorizeAlpha rgba          -> colorRGBA rgba+        RenderPreserve instrs             -> preservingMatrix $ glRender instrs+        RenderMany instrs                 -> mapM_ glRender instrs++--------------------------------------------------------------------------------++---TODO move definition somewhere else?+---TODO several version with different origin points++-- | Adding a default camera instruction to a given RenderInstruction+withCamera :: EngineState a -> a -> RenderInstruction -> RenderInstruction+withCamera es impl = RenderWithCamera (-1.0) (1.0) (realToFrac $ 2.0 / (fst $ getSize es impl)) (negate $ realToFrac $ 2.0 / (snd $ getSize es impl))
+ src/HGE2D/Shapes.hs view
@@ -0,0 +1,96 @@+-- |+-- Module      :  HGE2D.Shapes+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing basic shapes which can be used to define more complex ones through combination++module HGE2D.Shapes where++import HGE2D.Settings+import HGE2D.Types+import HGE2D.Datas+import HGE2D.GlFunctions++import qualified Graphics.Rendering.OpenGL as GL++--------------------------------------------------------------------------------++-- | A bordered rectangle define by width, height, thickness and two colors+borderedRectangle :: GlWidth -> GlHeight -> GlThickness -> GlColorRGB -> GlColorRGBA -> RenderInstruction+borderedRectangle w h t colorInner colorBorder = RenderMany+    [ RenderColorize colorInner+    , rectangle w h+    , RenderColorizeAlpha colorBorder+    , wireFrame w h t+    ]++-- | A line defined by its start and end points and a thickness+line :: GlPoint2 -> GlPoint2 -> GlThickness -> RenderInstruction+line start end w = RenderLineStrip [start, end] w++-- | A wireframe defined by width heigh and thickness (the borders of a box)+wireFrame :: GlWidth -> GlHeight -> GlThickness -> RenderInstruction+wireFrame w h t = RenderLineLoop [ll, lr, ur, ul] t+  where+    ll = point2 xMin yMin+    lr = point2 xMax yMin+    ur = point2 xMax yMax+    ul = point2 xMin yMax++    xMin = - (w/2)+    xMax =   (w/2)+    yMin = - (h/2)+    yMax =   (h/2)++-- | A rectangle defined by width and height+rectangle :: GlWidth -> GlHeight -> RenderInstruction+rectangle w h = RenderTriangle [ll, lr, ur, ur, ul, ll]+  where+    ll = point2 xMin yMin+    lr = point2 xMax yMin+    ur = point2 xMax yMax+    ul = point2 xMin yMax++    xMin = - (w/2)+    xMax =   (w/2)+    yMin = - (h/2)+    yMax =   (h/2)++-- | A ring defined by its radius and thickness+ring :: GlRadius -> GlThickness -> RenderInstruction+ring r w = RenderLineLoop (buildRing 0 []) w+  where+    buildRing :: Int -> GlShape -> GlShape+    buildRing nVertex prevShape+      | nVertex >= nFacesCircle = prevShape+      | otherwise = buildRing (nVertex+1) (prevShape ++ [vertex])+        where+          vertex = pointOnCircle nVertex++          pointOnCircle :: Int -> GlPoint2 ---TODO defined twice, move somewhere else+          pointOnCircle i = GL.Vertex2 x y+            where+              x = r * cos phi+              y = r * sin phi+              phi = 2.0 * pi * (fromIntegral i / fromIntegral nFacesCircle)++-- | A circle defined by its radius+circle :: GlRadius -> RenderInstruction+circle r = RenderTriangle (buildCircle 0 [])+  where+    buildCircle :: Int -> GlShape -> GlShape+    buildCircle nFace prevShape+      | nFace >= nFacesCircle = prevShape+      | otherwise = buildCircle (nFace+1) (prevShape ++ face)+        where+          face   = [(GL.Vertex2 0 0), first, second]+          first  = pointOnCircle nFace+          second = pointOnCircle (nFace+1)++          pointOnCircle :: Int -> GlPoint2+          pointOnCircle i = GL.Vertex2 x y+            where+              x = r * cos phi+              y = r * sin phi+              phi = 2.0 * pi * (fromIntegral i / fromIntegral nFacesCircle)
+ src/HGE2D/Time.hs view
@@ -0,0 +1,24 @@+-- |+-- Module      :  HGE2D.Time+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing functions to get the current time or transform times++module HGE2D.Time where++import HGE2D.Types++import Data.Time.Clock++--------------------------------------------------------------------------------++-- | Get the current time in seconds+getSeconds :: IO Double+getSeconds = getCurrentTime >>= return . fromRational . toRational . utctDayTime++--------------------------------------------------------------------------------++-- | Transform seconds to milliseconds+toMilliSeconds :: Double -> Millisecond+toMilliSeconds secs = floor $ 1000 * secs
+ src/HGE2D/Types.hs view
@@ -0,0 +1,122 @@+-- |+-- Module      :  HGE2D.Types+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing type definitions used within HGE2D++module HGE2D.Types where++import qualified Graphics.Rendering.OpenGL as GL++--------------------------------------------------------------------------------++-- | Time in seconds+type Second         = Int++-- | Time in milliseconds+type Millisecond    = Int++--------------------------------------------------------------------------------++-- | Angle in degrees+type Degree         = Double++-- | The drag of an object+type Drag           = Double++-- | The mass of an object in kg+type Mass           = Double++-- | Distance in meters+type Meter          = Double++-- | Velocity in meters per millisecond+type MeterPmsec     = Double++-- | Acceleration in meters per millisecond squared+type MeterPmsecSqr  = Double++-- | Distance or size in pixels+type Pixel          = Double++-- | Angle in radians+type Radian         = Double++-- | Rotation acceleration in radians per millisecond squared+type RotationAcceleration = Radian++-- | Rotation speed in radians per millisecond+type RotationSpeed  = Radian++--------------------------------------------------------------------------------++-- | Width of an object+type Width  = Double++-- | Height of an object+type Height = Double++-- | Position in x-direction of an oject+type PosX   = Double++-- | Position in y-direction of an object+type PosY   = Double++--------------------------------------------------------------------------------++-- | Acceleration split in x and y component+type Acceleration   = (MeterPmsecSqr, MeterPmsecSqr)++-- | Position of an object split in x and y component+type RealPosition   = (Meter, Meter)++-- | Velocity of an object split in x and y component+type Velocity       = (MeterPmsec, MeterPmsec)++--------------------------------------------------------------------------------++-- | Point in 2D defined by GLfloat values+type GlPoint2    = GL.Vertex2 GL.GLfloat++-- | Point in 3D defined by GLfloat values+type GlPoint3    = GL.Vector3 GL.GLfloat++-- | Vertex in 3D defined by GLfloat values+type GlVer3      = GL.Vertex3 GL.GLfloat++-- | Position in x-direction defined by GLfloat value+type GlPosX      = GL.GLfloat++-- | Position in y-direction defined by GLfloat value+type GlPosY      = GL.GLfloat++-- | Position in z-direction defined by GLfloat value+type GlPosZ      = GL.GLfloat++-- | Width of an object defined by GLfloat value+type GlWidth     = GL.GLfloat++-- | Height of an object defined by GLfloat value+type GlHeight    = GL.GLfloat++-- | Scale in x-direction of an object defined by GLfloat value+type GlScaleX    = GL.GLfloat++-- | Scale in y-direction of an object defined by GLfloat value+type GlScaleY    = GL.GLfloat++-- | Thickness of e.g. a line defined by GLfloat value+type GlThickness = GL.GLfloat++-- | Radius of e.g. a circle defined by GLfloat value+type GlRadius    = GL.GLfloat++-- | RGB color defined by 3 GLfloat values+type GlColorRGB  = (GL.GLfloat, GL.GLfloat, GL.GLfloat)++-- | RGBA color defined by 4 GLfloat values+type GlColorRGBA = (GL.GLfloat, GL.GLfloat, GL.GLfloat, GL.GLfloat)++-- | A shape defined by several points in 2D space+type GlShape     = [GlPoint2]
+ src/examples/Example1.hs view
@@ -0,0 +1,57 @@+module Main where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Colors+import HGE2D.Shapes+import HGE2D.Engine++{- Very basic example showing a "Hello World" -}+--------------------------------------------------------------------------------++--in here we are going to store all data of the game+data GameState = GameState+    { gsSize :: (Double, Double) -- current size of the entire game in pixels+    , time   :: Millisecond      -- current time of the game+    }++--define our initial state+gs1 = GameState { time = 0, gsSize = (0, 0) }++--define all functions of the engine for usage of our state+es1 = EngineState+    { getTitle = myGetTitle+    , getTime = myGetTime+    , setTime = mySetTime+    , moveTime = myMoveTime+    , click = myClick+    , mUp = myMouseUp+    , hover = myHover+    , drag = myDrag+    , kDown = myKeyDown+    , kUp = myKeyUp+    , resize = myResize+    , getSize = myGetSize+    , toGlInstr = myToGlInstr+    } :: EngineState GameState+  where+      myGetTitle _ = "Welcome to Example1" --title of the games window+      myGetTime = time -- how to retrieve the games time+      mySetTime ms gs = gs { time = ms } -- how to set the games time+      myMoveTime _ = id -- our game won't react to time changes+      myClick _ _ = id -- nor clicks+      myMouseUp _ _ = id --nor mouse up+      myHover _ _ = id -- nor hovering+      myDrag _ _ = id -- nor draging+      myKeyDown _ _ _ = id -- nor key presses+      myKeyUp _ _ _ = id --nor key releases+      myResize (w, h) gs = gs { gsSize = (realToFrac w, realToFrac h) } -- how to resize our game+      myGetSize = gsSize -- and get its size+      myToGlInstr _ = RenderMany -- render our game by using multiple instructions+          [ RenderColorize colorWhite -- rendering a white+          , rectangle 0.3 0.3 -- rectangle+          , RenderColorize colorRed -- and a red+          , RenderText "Hello World" -- "Hello World"+          ]+--------------------------------------------------------------------------------+main = runEngine es1 gs1
+ src/examples/Example2.hs view
@@ -0,0 +1,70 @@+module Main where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Colors+import HGE2D.Classes+import HGE2D.Instances ()+import HGE2D.Shapes+import HGE2D.Render+import HGE2D.Engine++{- Example showing mouse interactions with the game state -}+--------------------------------------------------------------------------------++--in here we are going to store all data of the game+data GameState = GameState+    { gsSize    :: (Double, Double) -- current size of the entire game in pixels+    , time      :: Millisecond      -- current time of the game+    , isClicked :: Bool             -- whether the rectangle has been clicked+    , pos       :: RealPosition     -- the position of the rectangle+    }++--define our initial state+gs2 = GameState+   { time = 0+   , gsSize = (0, 0)+   , pos = (0, 0)+   , isClicked = False+   }++--define all functions of the engine for usage of our state+es2 = EngineState+    { getTitle = myGetTitle+    , getTime = myGetTime+    , setTime = mySetTime+    , moveTime = myMoveTime+    , click = myClick+    , mUp = myMouseUp+    , hover = myHover+    , drag = myDrag+    , kDown = myKeyDown+    , kUp = myKeyUp+    , resize = myResize+    , getSize = myGetSize+    , toGlInstr = myToGlInstr+    } :: EngineState GameState+  where+      myGetTitle _ = "Welcome to Example2" --title of the games window+      myGetTime = time -- how to retrieve the games time+      mySetTime ms gs = gs { time = ms } -- how to set the games time+      myMoveTime _ = id -- our game won't react to time changes+      myClick _ _ gs = gs { isClicked = not $ isClicked gs } -- toggle the isClicked Bool on click+      myMouseUp _ _ gs = gs { isClicked = not $ isClicked gs } --also toggle it on release again+      myHover x y gs = gs { pos = (x, y) } -- store the hover position+      myDrag _ _ gs = gs -- don't react to draging+      myKeyDown _ _ _ gs = gs { isClicked = not $ isClicked gs } -- also toggle clicked with a key press+      myKeyUp _ _ _ gs = gs { isClicked = not $ isClicked gs } --also toggle clicked with key release+      myResize (w, h) gs = gs { gsSize = (realToFrac w, realToFrac h) } -- how to resize our game+      myGetSize = gsSize -- and get its size+      myToGlInstr gs = withCamera es2 gs $ RenderPreserve $ RenderMany -- render with a camera and while preserving changes+          [ RenderColorize color -- a colored+          , RenderTranslate (realToFrac $ getX $ pos gs) (realToFrac $ getY $ pos gs) -- moved to pos+          , rectangle 30 30 -- rectangle of 30px with and height+          ]+        where -- the color of the rectangle depends on the click state+          color | isClicked gs = colorWhite+                | otherwise    = colorGreen++--------------------------------------------------------------------------------+main = runEngine es2 gs2
+ src/examples/Example3.hs view
@@ -0,0 +1,81 @@+module Main where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Colors+import HGE2D.Classes+import HGE2D.Instances ()+import HGE2D.Shapes+import HGE2D.Render+import HGE2D.Engine++{- Example showing dynamic changes by moving the rectanlge -}+--------------------------------------------------------------------------------++--in here we are going to store all data of the game+data GameState = GameState+    { gsSize    :: (Double, Double) -- current size of the entire game in pixels+    , time      :: Millisecond      -- current time of the game+    , isClicked :: Bool             -- whether the rectangle has been clicked+    , moveUp    :: Bool             -- whether the rectangle is moving up+    , pos       :: RealPosition     -- the position of the rectangle+    }++--define our initial state+gs3 = GameState+   { time = 0+   , gsSize = (0, 0)+   , pos = (0, 0)+   , isClicked = False+   , moveUp = False+   }++--define all functions of the engine for usage of our state+es3 = EngineState+    { getTitle = myGetTitle+    , getTime = myGetTime+    , setTime = mySetTime+    , moveTime = myMoveTime+    , click = myClick+    , mUp = myMouseUp+    , hover = myHover+    , drag = myDrag+    , kDown = myKeyDown+    , kUp = myKeyUp+    , resize = myResize+    , getSize = myGetSize+    , toGlInstr = myToGlInstr+    } :: EngineState GameState+  where+      myGetTitle _ = "Welcome to Example3" --title of the games window+      myGetTime = time -- how to retrieve the games time+      mySetTime ms gs = gs { time = ms } -- how to set the games time+      myMoveTime ms gs = gs { pos = newPos, moveUp = newMoveUp } -- react to changes in time by moving the position+        where+          newMoveUp | snd oldPos < 1                 && moveUp gs         = False+                    | snd oldPos > (snd $ gsSize gs) && (not (moveUp gs)) = True+                    | otherwise = moveUp gs++          newPos | moveUp gs  = ((fst oldPos), (snd oldPos - realToFrac ms / 30))+                 | otherwise  = ((fst oldPos), (snd oldPos + realToFrac ms / 10))++          oldPos = pos gs+      myClick _ _ gs = gs { isClicked = not $ isClicked gs } -- toggle the isClicked Bool on click+      myMouseUp _ _ = id --nor mouse up+      myHover x y gs = gs { pos = (x, y) } -- store the hover position+      myDrag _ _ gs = gs -- don't react to draging+      myKeyDown _ _ _ = id -- nor key presses+      myKeyUp _ _ _ = id --nor key releases+      myResize (w, h) gs = gs { gsSize = (realToFrac w, realToFrac h) } -- how to resize our game+      myGetSize = gsSize -- and get its size+      myToGlInstr gs = withCamera es3 gs $ RenderPreserve $ RenderMany -- render with a camera and while preserving changes+          [ RenderColorize color -- a colored+          , RenderTranslate (realToFrac $ getX $ pos gs) (realToFrac $ getY $ pos gs) -- moved to pos+          , rectangle 30 30 -- rectangle of 30px with and height+          ]+        where -- the color of the rectangle depends on the click state+          color | isClicked gs = colorWhite+                | otherwise    = colorGreen++--------------------------------------------------------------------------------+main = runEngine es3 gs3
+ src/examples/Example4.hs view
@@ -0,0 +1,80 @@+module Main where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Colors+import HGE2D.Shapes+import HGE2D.Engine+import HGE2D.Render++{- Example showing more advanced rendering -}+--------------------------------------------------------------------------------++--in here we are going to store all data of the game+data GameState = GameState+    { gsSize :: (Double, Double) -- current size of the entire game in pixels+    , time   :: Millisecond      -- current time of the game+    }++--in here we are going to store all data of the game+gs4 = GameState { time = 0, gsSize = (0, 0) }++--define our initial state+es4 = EngineState+    { getTitle = myGetTitle+    , getTime = myGetTime+    , setTime = mySetTime+    , moveTime = myMoveTime+    , click = myClick+    , mUp = myMouseUp+    , hover = myHover+    , drag = myDrag+    , kDown = myKeyDown+    , kUp = myKeyUp+    , resize = myResize+    , getSize = myGetSize+    , toGlInstr = myToGlInstr+    } :: EngineState GameState+  where+      myGetTitle _ = "Welcome to Example4" --title of the games window+      myGetTime = time -- how to retrieve the games time+      mySetTime ms gs = gs { time = ms } -- how to set the games time+      myMoveTime _ = id -- our game won't react to time changes+      myClick _ _ = id -- nor clicks+      myMouseUp _ _ = id --nor mouse up+      myHover _ _ = id -- nor hovering+      myDrag _ _ = id -- nor draging+      myKeyDown _ _ _ = id -- nor key presses+      myKeyUp _ _ _ = id --nor key releases+      myResize (w, h) gs = gs { gsSize = (realToFrac w, realToFrac h) } -- how to resize our game+      myGetSize = gsSize -- and get its size+      myToGlInstr gs = withCamera es4 gs $ RenderMany -- render with a camera and while preserving changes+          [ circleNextToRectangle -- render our circle next to the rectangle+          , whiteRectangle -- as well as the white rectangle+          , allMoved -- and the moved group+          ]+        where++          -- move them all by 100px in x and y direction+          allMoved :: RenderInstruction+          allMoved = RenderPreserve $ RenderMany [RenderTranslate 100 100, circleNextToRectangle]++          -- group the moved circle and the white rectangle+          circleNextToRectangle :: RenderInstruction+          circleNextToRectangle = RenderMany [movedCircle, whiteRectangle]++          -- the circle moved+          movedCircle :: RenderInstruction+          movedCircle = RenderPreserve $ RenderMany [RenderTranslate 50 0, redCircle]++          -- a white rectangle+          whiteRectangle :: RenderInstruction+          whiteRectangle = RenderMany [RenderColorize colorWhite, rectangle 30 30]++          -- a red circle+          redCircle :: RenderInstruction+          redCircle = RenderMany [RenderColorize colorRed, circle 30]++--------------------------------------------------------------------------------++main = runEngine es4 gs4