HGE2D 0.1.8.0 → 0.1.9.0

raw patch · 8 files changed

+163/−44 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• HGE2D.cabal +2/−1
• src/HGE2D/AABBTree.hs +87/−0
• src/HGE2D/Datas.hs +6/−4
• src/HGE2D/Geometry.hs +19/−23
• src/HGE2D/Instances.hs +1/−1
• src/HGE2D/Math.hs +2/−0
• src/HGE2D/QuadTree.hs +41/−15
• src/HGE2D/Types.hs +5/−0

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                HGE2D-version:             0.1.8.0+version:             0.1.9.0 synopsis:            2D game engine written in Haskell description:         See README and examples/ for further information license:             MIT@@ -37,6 +37,7 @@     HGE2D.Collision     HGE2D.Physical     HGE2D.QuadTree+    HGE2D.AABBTree     HGE2D.Settings   -- other-modules:   -- other-extensions:

@@ -0,0 +1,87 @@+-- |+-- Module      :  HGE2D.AABBTree+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing the definition and functions for an axis aligned bounding box tree++module HGE2D.AABBTree where++import HGE2D.Types+import HGE2D.Datas+import HGE2D.Classes+import HGE2D.Instances+import HGE2D.Geometry+import HGE2D.Collision++import Data.Maybe++--------------------------------------------------------------------------------++-- | A bounding box tree for fast collision detection+data (HasBoundingBox a) => AABBTree a = AABBTreeEmpty+                                      | AABBTreeLeaf [a] BoundingBox+                                      | AABBTreeBranch (AABBTree a) (AABBTree a) BoundingBox++---TODO fmap+---TODO fmapRebuild++--------------------------------------------------------------------------------++-- | Builds an AABBTree from a list of elements with bounding boxes.+aaBBTreeBuild :: (HasBoundingBox a) => MaxDepth -> [a] -> AABBTree a+aaBBTreeBuild maxDepth xs = aaBBTreeBuildRec False 0 maxDepth xs+  where+    aaBBTreeBuildRec _ _ _ []                = AABBTreeEmpty+    aaBBTreeBuildRec _ _ _ [x]               = AABBTreeLeaf [x] (getBB x)+    aaBBTreeBuildRec compX depth maxDepth xs | done         = AABBTreeLeaf xs mergedBB+                                             | otherwise    = AABBTreeBranch (aaBBTreeBuildRec (not compX) (depth+1) maxDepth left)+                                                                             (aaBBTreeBuildRec (not compX) (depth+1) maxDepth right)+                                                                             mergedBB+      where+        done        = depth >= maxDepth+        mergedBB    = mconcat bbs+        bbs         = map getBB xs+        left        = filter (isLeft . getBB) xs+        right       = filter (isRight . getBB) xs+        splitPos    = centerBB mergedBB+        isLeft bb   = (dim $ bbMin bb) < dim splitPos+        isRight bb  = (dim $ bbMax bb) >= dim splitPos+        dim         | compX     = fst+                    | otherwise = snd++--------------------------------------------------------------------------------++-- | Finds all items of the tree which collide with the search item.+aaBBTreeCollisions :: (HasBoundingBox a, HasBoundingBox b) => b -> AABBTree a -> [a]+aaBBTreeCollisions _ AABBTreeEmpty                = []+aaBBTreeCollisions search (AABBTreeLeaf xs _)     = filter (doCollide search) xs+aaBBTreeCollisions search (AABBTreeBranch l r _)  = (nodeResult l) ++ (nodeResult r)+  where+    nodeResult n | collides  = aaBBTreeCollisions search n+                 | otherwise = []+      where+        collides = fromMaybe False mayCollide+        mayCollide = fmap (doCollide search) mayBB+        mayBB = case n of+            AABBTreeEmpty           -> Nothing+            (AABBTreeLeaf _ x)      -> Just x+            (AABBTreeBranch _ _ x)  -> Just x++--------------------------------------------------------------------------------++-- | Puts the elements of an AABBTree into a list.+aaBBTreeToList :: (HasBoundingBox a) => AABBTree a -> [a]+aaBBTreeToList AABBTreeEmpty          = []+aaBBTreeToList (AABBTreeLeaf xs _)    = xs+aaBBTreeToList (AABBTreeBranch l r _) = (aaBBTreeToList l) ++ (aaBBTreeToList r)++---TODO rebuild+---TODO filter+---TODO add+---TODO remove+{-+quadRebuild :: (Positioned a) => QuadTree a -> QuadTree a++quadFilter :: (Positioned a) => (a -> Bool) -> QuadTree a -> QuadTree a+-}

@@ -33,10 +33,12 @@     } deriving (Show, Read, Eq)  -- | 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, Eq)+data BoundingBox = BBEmpty+                 | BoundingBox+                    { bbMin     :: RealPosition -- lower left corner of bb+                    , bbMax     :: RealPosition -- upper right corner of bb+                    }+                 deriving (Show, Read, Eq)  -- | A position defined in number of tiles in x and y direction data TilePosition = TilePosition

@@ -142,8 +142,8 @@  -- | Calculates the bounding box of multiple positions bbFromList :: (Positioned a) => [a] -> BoundingBox-bbFromList []  = nullBB-bbFromList [x] = nullBB+bbFromList []  = BBEmpty+bbFromList [_] = BBEmpty bbFromList xs  = BoundingBox (minX, minY) (maxX, maxY)   where     minX = minimum $ map getX xs@@ -151,35 +151,31 @@     maxX = maximum $ map getX xs     maxY = maximum $ map getY xs --- | 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 | isNullBB bb1 = bb2-                | isNullBB bb2 = bb1-                | otherwise    = BoundingBox newMin newMax+mergeBB BBEmpty bb2 = bb2+mergeBB bb1 BBEmpty = bb1+mergeBB bb1 bb2     = BoundingBox newMin newMax   where-    newMin = mergeMin (bbMin bb1) (bbMin bb2)-    newMax = mergeMax (bbMax bb1) (bbMax bb2)+    newMin = mergeMin poss+    newMax = mergeMax poss+    poss = [bbMin bb1, bbMin bb2, bbMax bb1, bbMax bb2] -    mergeMin :: RealPosition -> RealPosition -> RealPosition-    mergeMin pos1 pos2 = (x, y)+    mergeMin :: [RealPosition]-> RealPosition+    mergeMin poss = (x, y)       where-       x = min (fst pos1) (fst pos2)-       y = min (snd pos1) (snd pos2)+       x = fst $ minimumBy compareX poss+       y = snd $ minimumBy compareY poss -    mergeMax :: RealPosition -> RealPosition -> RealPosition-    mergeMax pos1 pos2 = (x, y)+    mergeMax :: [RealPosition] -> RealPosition+    mergeMax poss = (x, y)       where-       x = max (fst pos1) (fst pos2)-       y = max (snd pos1) (snd pos2)+       x = fst $ maximumBy compareX poss+       y = snd $ maximumBy compareY poss++    compareX a b = compare (fst a) (fst b)+    compareY a b = compare (snd a) (snd b)  {- see above tilePosToBB :: TilePosition -> BoundingBox

@@ -19,7 +19,7 @@  -- | Instance of Monoid for BoundingBox instance Monoid BoundingBox where-    mempty = nullBB+    mempty = BBEmpty     mappend = mergeBB  --------------------------------------------------------------------------------

@@ -7,6 +7,8 @@  module HGE2D.Math where +---TODO return maybe instead of 0 0+ -- | 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)

@@ -1,3 +1,10 @@+-- |+-- Module      :  HGE2D.QuadTree+-- Copyright   :  (c) 2016 Martin Buck+-- License     :  see LICENSE+--+-- Containing the definition and functions for a quad tree+ module HGE2D.QuadTree where  import HGE2D.Datas@@ -7,6 +14,8 @@  import Data.List +--------------------------------------------------------------------------------+ -- | A QuadTree for faster search queries data (Positioned a) => QuadTree a = QuadEmpty   -- empty node                                    | QuadLeaf a -- node with one position@@ -17,25 +26,36 @@  -------------------------------------------------------------------------------- ----TODO can drop bb param?+-- | Mapping function for the QuadTree. Do not use with functions which change the position of items,+--   since they would invalidate the search structure (use fmapQuadRebuild instead)+fmapQuad :: (Positioned a, Positioned b) => (a -> b) -> QuadTree a -> QuadTree b+fmapQuad f QuadEmpty                    = QuadEmpty+fmapQuad f (QuadLeaf x)                 = (QuadLeaf (f x))+fmapQuad f (QuadBranch nn np pn pp bb)  = (QuadBranch (fmapQuad f nn) (fmapQuad f np) (fmapQuad f pn) (fmapQuad f pp) bb) --- | Builds a QuadTree from a list of elements with positions---   The BoundingBox should be the BoundingBox of the elements-buildQuadTree :: (Positioned a) => BoundingBox -> [a] -> QuadTree a-buildQuadTree _ []    = QuadEmpty-buildQuadTree _ [x]   = QuadLeaf x-buildQuadTree bb xs   = QuadBranch nn np pn pp bb+-- | Mapping function for the QuadTree. This rebuilds the entire tree, but allows the usage of+--   position changing functions. Use this only for positioned changing functions, and fmapQuad otherwise,+--   since it is faster+fmapQuadRebuild :: (Positioned a, Positioned b) => (a -> b) -> QuadTree a -> QuadTree b+fmapQuadRebuild f old = buildQuadTree newXs   where-    nn = buildQuadTree bbnn $ filter isnn xs-    np = buildQuadTree bbnp $ filter isnp xs-    pn = buildQuadTree bbpn $ filter ispn xs-    pp = buildQuadTree bbpp $ filter ispp xs+    newXs = map f $ quadTreeToList old -    bbnn = bbFromList [center, (bbMin bb)]-    bbnp = bbFromList [center, (fst $ bbMin bb, snd $ bbMax bb)]-    bbpn = bbFromList [center, (fst $ bbMax bb, snd $ bbMin bb)]-    bbpp = bbFromList [center, (bbMax bb)]+-------------------------------------------------------------------------------- +-- | Builds a QuadTree from a list of elements with positions.+buildQuadTree :: (Positioned a) => [a] -> QuadTree a+buildQuadTree []  = QuadEmpty+buildQuadTree [x] = QuadLeaf x+buildQuadTree xs  = QuadBranch nn np pn pp bb+  where+    bb = bbFromList xs++    nn = buildQuadTree $ filter isnn xs+    np = buildQuadTree $ filter isnp xs+    pn = buildQuadTree $ filter ispn xs+    pp = buildQuadTree $ filter ispp xs+     center = centerBB bb      isnn x = getX x <= getX center  && getY x <= getY center@@ -96,3 +116,9 @@ quadTreeToList QuadEmpty = [] quadTreeToList (QuadLeaf x) = [x] quadTreeToList (QuadBranch nn np pn pp _) = (quadTreeToList nn) ++ (quadTreeToList np) ++ (quadTreeToList pn) ++ (quadTreeToList pp)++{-+quadRebuild :: (Positioned a) => QuadTree a -> QuadTree a++quadFilter :: (Positioned a) => (a -> Bool) -> QuadTree a -> QuadTree a+-}

@@ -19,6 +19,11 @@  -------------------------------------------------------------------------------- +-- | Maximum depth of a tree+type MaxDepth = Int++--------------------------------------------------------------------------------+ -- | Angle in degrees type Degree         = Double