From 7f691d48a462364c76edd302f797482cdc42820f Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Mon, 3 Sep 2012 19:02:57 +0200 Subject: Added 2d bounding box functions --- Spear.lkshs | 8 ++++---- Spear.lkshw | 2 +- Spear/Collision.hs | 47 +++++++++++++++++++++++++++++++------------ Spear/Render/AnimatedModel.hs | 30 ++++++++++++++++++++++++++- Spear/Render/StaticModel.hs | 14 ++++++++++++- 5 files changed, 81 insertions(+), 20 deletions(-) diff --git a/Spear.lkshs b/Spear.lkshs index 9d57ffa..92719f1 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,14 +1,14 @@ Version of session file format: 1 Time of storage: - "Mon Sep 3 00:01:24 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 4, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 346) 184),("Debug",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) 265)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 688) 954 -Population: [(Just (BreakpointsSt BreakpointsState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/GameObject.hs" 217)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject.hs" 2615)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/MatrixUtils.hs" 1873)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Player.hs" 858)),[SplitP LeftP]),(Just (SearchSt (SearchState {searchString = "putStrLn", searchScope = PackageScope False, searchMode = Prefix {caseSense = False}})),[SplitP RightP,SplitP TopP]),(Just (TraceSt TraceState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Utils.hs" 471)),[SplitP LeftP]),(Just (VariablesSt VariablesState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferStateTrans "_Eval.hs" "\n" 0)),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 4657)),[SplitP LeftP])] + "Mon Sep 3 14:06:47 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 344) 159),("Debug",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) 245)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 643) 954 +Population: [(Just (BreakpointsSt BreakpointsState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/GameObject.hs" 5628)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject.hs" 2636)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/MatrixUtils.hs" 615)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Player.hs" 4488)),[SplitP LeftP]),(Just (SearchSt (SearchState {searchString = "putStrLn", searchScope = PackageScope False, searchMode = Prefix {caseSense = False}})),[SplitP RightP,SplitP TopP]),(Just (TraceSt TraceState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Utils.hs" 1454)),[SplitP LeftP]),(Just (VariablesSt VariablesState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferStateTrans "_Eval.hs" "\n" 0)),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 4562)),[SplitP LeftP])] Window size: (1820,944) Completion size: (750,399) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "Utils.hs" +Active pane: Just "GameObject.hs(1)" Toolbar visible: True FindbarState: (False,FindState {entryStr = "asdad", entryHist = ["asdad","m[15]","m[14]","m[1]","m[13]","m[12]","m[11]","m[10]","m[9]","m[8]","m[7]","m[6]"], replaceStr = "a01", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) diff --git a/Spear.lkshw b/Spear.lkshw index fce08ab..ba05db3 100644 --- a/Spear.lkshw +++ b/Spear.lkshw @@ -1,7 +1,7 @@ Version of workspace file format: 1 Time of storage: - "Mon Sep 3 11:26:24 CEST 2012" + "Mon Sep 3 18:57:03 CEST 2012" Name of the workspace: "Spear" File paths of contained packages: diff --git a/Spear/Collision.hs b/Spear/Collision.hs index fb8f11e..f0f5814 100644 --- a/Spear/Collision.hs +++ b/Spear/Collision.hs @@ -7,8 +7,10 @@ module Spear.Collision , Collisioner(..) -- ** Construction , aabbCollisioner -, sphereCollisioner +, circleCollisioner +, boxFromCircle , buildAABB +, mkCols -- ** Collision test , collide -- ** Manipulation @@ -19,10 +21,13 @@ module Spear.Collision where +import Spear.Assets.Model import Spear.Math.AABB import Spear.Math.Circle +import qualified Spear.Math.Matrix4 as M4 import Spear.Math.Plane import Spear.Math.Vector2 +import qualified Spear.Math.Vector3 as V3 -- | Encodes several collision situations. @@ -48,12 +53,12 @@ instance Collisionable AABB where | box2 `aabbpt` min1 && box2 `aabbpt` max1 = FullyContainedBy | otherwise = Collision - collideCircle sphere@(Circle c r) aabb@(AABB min max) + collideCircle circle@(Circle c r) aabb@(AABB min max) | test == FullyContains || test == FullyContainedBy = test | normSq (c - boxC) > (l + r)^2 = NoCollision | otherwise = Collision where - test = aabb `collideBox` aabbFromCircle sphere + test = aabb `collideBox` aabbFromCircle circle boxC = min + (max-min)/2 l = norm $ min + (vec2 (x boxC) (y min)) - min @@ -64,7 +69,7 @@ instance Collisionable AABB where instance Collisionable Circle where - collideBox box sphere = case collideCircle sphere box of + collideBox box circle = case collideCircle circle box of FullyContains -> FullyContainedBy FullyContainedBy -> FullyContains x -> x @@ -117,7 +122,7 @@ aabbPoints (AABB min max) = [p1,p2,p3,p4,p5,p6,p7,p8] data Collisioner -- | An axis-aligned bounding box. = AABBCol {-# UNPACK #-} !AABB - -- | A bounding sphere. + -- | A bounding circle. | CircleCol {-# UNPACK #-} !Circle @@ -127,18 +132,18 @@ aabbCollisioner = AABBCol -- | Create a collisioner from the specified circle. -sphereCollisioner :: Circle -> Collisioner -sphereCollisioner = CircleCol +circleCollisioner :: Circle -> Collisioner +circleCollisioner = CircleCol + + +-- | Create the minimal AABB collisioner fully containing the specified circle. +boxFromCircle :: Circle -> Collisioner +boxFromCircle = AABBCol . aabbFromCircle -- | Create the minimal AABB fully containing the specified collisioners. buildAABB :: [Collisioner] -> AABB -buildAABB cols = aabb $ generatePoints cols - - --- | Create the minimal AABB collisioner fully containing the specified circle. -boxFromSphere :: Circle -> Collisioner -boxFromSphere = AABBCol . aabbFromCircle +buildAABB cols = aabb $ generatePoints cols generatePoints :: [Collisioner] -> [Vector2] @@ -161,6 +166,22 @@ generatePoints = foldr generate [] p2 = c - unitx * (vec2 r r) p3 = c + unity * (vec2 r r) p4 = c - unity * (vec2 r r) + + +-- | Compute collisioners in view space from the given 3D AABB. +mkCols :: M4.Matrix4 -- ^ Modelview matrix + -> Box + -> [Collisioner] +mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) = + let + toVec2 v = vec2 (V3.x v) (V3.y v) + p1 = toVec2 $ modelview `M4.mulp` V3.vec3 xmin ymin zmax + p2 = toVec2 $ modelview `M4.mulp` V3.vec3 xmax ymin zmin + p3 = toVec2 $ modelview `M4.mulp` V3.vec3 xmax ymax zmin + col1 = AABBCol $ AABB p1 p2 + col2 = AABBCol $ AABB p1 p3 + in + [col1, col2] -- | Collide the given collisioners. diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs index 3fe12fd..ae86cfe 100644 --- a/Spear/Render/AnimatedModel.hs +++ b/Spear/Render/AnimatedModel.hs @@ -23,16 +23,21 @@ module Spear.Render.AnimatedModel -- * Rendering , bind , render + -- * Collisions +, mkColsFromAnimated ) where import Spear.Assets.Model -import Spear.Render.Model +import Spear.Collision import Spear.GLSL import Spear.Math.AABB +import Spear.Math.Matrix4 (Matrix4) import Spear.Math.Vector2 (vec2) +import Spear.Math.Vector3 (vec3, x, y, z, scale) import Spear.Render.Material +import Spear.Render.Model import Spear.Render.Program import Spear.Setup as Setup @@ -230,3 +235,26 @@ render uniforms (AnimatedModelRenderer model _ _ _ curFrame fp _) = glUniform1f (shiLoc uniforms) $ unsafeCoerce shi glUniform1f (fpLoc uniforms) (unsafeCoerce fp) drawArrays gl_TRIANGLES (n*curFrame) n + + +-- | Compute collisioners in 2d virtual space. +mkColsFromAnimated + :: Int -- ^ Source frame + -> Int -- ^ Dest frame + -> Float -- ^ Frame progress + -> Matrix4 -- ^ Modelview matrix + -> AnimatedModelResource + -> [Collisioner] +mkColsFromAnimated f1 f2 fp modelview modelRes = + let + (Box (Vec3 xmin1 ymin1 zmin1) (Vec3 xmax1 ymax1 zmax1)) = box f1 modelRes + (Box (Vec3 xmin2 ymin2 zmin2) (Vec3 xmax2 ymax2 zmax2)) = box f2 modelRes + min1 = vec3 xmin1 ymin1 zmin1 + max1 = vec3 xmax1 ymax1 zmax1 + min2 = vec3 xmin2 ymin2 zmin2 + max2 = vec3 xmax2 ymax2 zmax2 + min = min1 + scale fp (min2 - min1) + max = max1 + scale fp (max2 - max1) + in + mkCols modelview + $ Box (Vec3 (x min) (y min) (z min)) (Vec3 (x max) (y max) (z max)) diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs index 31acaa2..b4ad20e 100644 --- a/Spear/Render/StaticModel.hs +++ b/Spear/Render/StaticModel.hs @@ -13,16 +13,20 @@ module Spear.Render.StaticModel -- * Rendering , bind , render + -- * Collision +, mkColsFromStatic ) where import Spear.Assets.Model -import Spear.Render.Model +import Spear.Collision import Spear.GLSL import Spear.Math.AABB +import Spear.Math.Matrix4 (Matrix4) import Spear.Math.Vector2 (vec2) import Spear.Render.Material +import Spear.Render.Model import Spear.Render.Program import Spear.Setup as Setup @@ -142,3 +146,11 @@ render uniforms (StaticModelRenderer model) = uniformVec4 (ksLoc uniforms) ks glUniform1f (shiLoc uniforms) $ unsafeCoerce shi drawArrays gl_TRIANGLES 0 $ nVertices model + + +-- | Compute collisioners in 2d virtual space. +mkColsFromStatic + :: Matrix4 -- ^ Modelview matrix + -> StaticModelResource + -> [Collisioner] +mkColsFromStatic modelview modelRes = mkCols modelview (box 0 modelRes) -- cgit v1.2.3