HGE2D 0.1.6.5 → 0.1.7.1
raw patch · 4 files changed
+43/−21 lines, 4 filesdep +deepseqdep +safe
Dependencies added: deepseq, safe
Files
- HGE2D.cabal +4/−2
- src/HGE2D/Engine.hs +14/−13
- src/HGE2D/Geometry.hs +18/−6
- src/HGE2D/Instances.hs +7/−0
HGE2D.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: HGE2D-version: 0.1.6.5+version: 0.1.7.1 synopsis: 2D game engine written in Haskell description: See README and examples/ for further information license: MIT@@ -43,7 +43,9 @@ base >= 4.9.0.0 && < 5.0, OpenGL >=3.0 && < 3.1, GLUT >= 2.7 && < 2.8,- time >= 1.5.0.1 && < 1.7+ time >= 1.5.0.1 && < 1.7,+ safe == 0.3.9,+ deepseq == 1.4.2.0 hs-source-dirs: src default-language: Haskell2010 ghc-options: -O2 -W -fwarn-incomplete-patterns
src/HGE2D/Engine.hs view
@@ -12,7 +12,8 @@ import HGE2D.Time import HGE2D.Render () -import Control.Concurrent (newMVar, readMVar, takeMVar, putMVar, MVar)+import Control.Concurrent (newMVar, readMVar, takeMVar, putMVar, swapMVar, MVar)+import Control.DeepSeq import Graphics.UI.GLUT --------------------------------------------------------------------------------@@ -85,7 +86,7 @@ -- | 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+ gs <- readMVar mvarGs ---TODO rename let w = fst $ getSize es gs h = snd $ getSize es gs@@ -93,7 +94,7 @@ correctedY = (realToFrac y) * (snd $ getSize es gs) / h newState = hover es correctedX correctedY gs - putMVar mvarGs newState+ swapMVar mvarGs newState return () @@ -110,7 +111,7 @@ -- | MouseDown interaction with the engine mouseDown :: EngineState a -> MVar (a) -> GLint -> GLint -> IO () mouseDown es mvarGs x y = do- gs <- takeMVar mvarGs ---TODO rename+ gs <- readMVar mvarGs ---TODO rename ---TODO define method for corrections since used here and in hover let w = fst $ getSize es gs@@ -119,13 +120,13 @@ correctedY = (realToFrac y) * (snd $ getSize es gs) / h newState = click es correctedX correctedY gs - putMVar mvarGs newState+ swapMVar 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+ gs <- readMVar mvarGs ---TODO rename ---TODO define method for corrections since used here and in hover let w = fst $ getSize es gs@@ -134,7 +135,7 @@ correctedY = (realToFrac y) * (snd $ getSize es gs) / h newState = mUp es correctedX correctedY gs - putMVar mvarGs newState+ swapMVar mvarGs newState return () --------------------------------------------------------------------------------@@ -142,7 +143,7 @@ -- | 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+ gs <- readMVar mvarGs ---TODO rename ---TODO define method for corrections since used here and in hover let w = fst $ getSize es gs@@ -151,13 +152,13 @@ correctedY = (realToFrac y) * (snd $ getSize es gs) / h newState = kDown es correctedX correctedY c gs - putMVar mvarGs newState+ swapMVar 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+ gs <- readMVar mvarGs ---TODO rename ---TODO define method for corrections since used here and in hover let w = fst $ getSize es gs@@ -166,7 +167,7 @@ correctedY = (realToFrac y) * (snd $ getSize es gs) / h newState = kUp es correctedX correctedY c gs - putMVar mvarGs newState+ swapMVar mvarGs newState return () --------------------------------------------------------------------------------@@ -174,12 +175,12 @@ -- | 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+ gs <- readMVar 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+ deepseq newState (swapMVar mvarGs newState) postRedisplay Nothing
src/HGE2D/Geometry.hs view
@@ -14,6 +14,8 @@ import HGE2D.Datas import HGE2D.Classes +import Safe+ ---TODO rewrite most / all functions to use classes ---TODO use typedefs @@ -60,12 +62,12 @@ 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+closest :: (Positioned a, Positioned b) => a -> [b] -> Maybe b+closest a bs = minimumByMay ( \ 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+furthest :: (Positioned a, Positioned b) => a -> [b] -> Maybe b+furthest a bs = minimumByMay ( \ 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)@@ -121,11 +123,21 @@ newY = (snd $ bbMin bb) + (height / 2) (width, height) = sizeBB bb ----TODO make monoid +-- | Testing whether a BoundingBox has the same min and max values+isNullBB :: BoundingBox -> Bool+isNullBB bb = (bbMin bb) == (bbMax bb)++-- | A BoundingBox which counts as null, having the same min and max position+nullBB :: BoundingBox+nullBB = BoundingBox (0,0) (0,0)+ -- | Merges two bounding boxes, creating a new one which wraps around the inputs+-- In case a nullBB is passed as one parameter, the other BoundingBox is returned mergeBB :: BoundingBox -> BoundingBox -> BoundingBox-mergeBB bb1 bb2 = BoundingBox newMin newMax+mergeBB bb1 bb2 | isNullBB bb1 = bb2+ | isNullBB bb2 = bb1+ | otherwise = BoundingBox newMin newMax where newMin = mergeMin (bbMin bb1) (bbMin bb2) newMax = mergeMax (bbMax bb1) (bbMax bb2)
src/HGE2D/Instances.hs view
@@ -17,6 +17,13 @@ -------------------------------------------------------------------------------- +-- | Instance of Monoid for BoundingBox+instance Monoid BoundingBox where+ mempty = nullBB+ mappend = mergeBB++--------------------------------------------------------------------------------+ -- | Instance of HasBoundingBox for BoundingBox instance HasBoundingBox BoundingBox where getBB = id