Added 2d bounding box functions

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)