aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear.lkshs8
-rw-r--r--Spear.lkshw2
-rw-r--r--Spear/Collision.hs47
-rw-r--r--Spear/Render/AnimatedModel.hs30
-rw-r--r--Spear/Render/StaticModel.hs14
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 @@
1Version of session file format: 1Version of session file format:
2 1 2 1
3Time of storage: 3Time of storage:
4 "Mon Sep 3 00:01:24 CEST 2012" 4 "Mon Sep 3 14:06:47 CEST 2012"
5Layout: 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 5Layout: 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
6Population: [(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])] 6Population: [(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])]
7Window size: (1820,944) 7Window size: (1820,944)
8Completion size: 8Completion size:
9 (750,399) 9 (750,399)
10Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" 10Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw"
11Active pane: Just "Utils.hs" 11Active pane: Just "GameObject.hs(1)"
12Toolbar visible: 12Toolbar visible:
13 True 13 True
14FindbarState: (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}) 14FindbarState: (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 @@
1Version of workspace file format: 1Version of workspace file format:
2 1 2 1
3Time of storage: 3Time of storage:
4 "Mon Sep 3 11:26:24 CEST 2012" 4 "Mon Sep 3 18:57:03 CEST 2012"
5Name of the workspace: 5Name of the workspace:
6 "Spear" 6 "Spear"
7File paths of contained packages: 7File 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
7, Collisioner(..) 7, Collisioner(..)
8 -- ** Construction 8 -- ** Construction
9, aabbCollisioner 9, aabbCollisioner
10, sphereCollisioner 10, circleCollisioner
11, boxFromCircle
11, buildAABB 12, buildAABB
13, mkCols
12 -- ** Collision test 14 -- ** Collision test
13, collide 15, collide
14 -- ** Manipulation 16 -- ** Manipulation
@@ -19,10 +21,13 @@ module Spear.Collision
19where 21where
20 22
21 23
24import Spear.Assets.Model
22import Spear.Math.AABB 25import Spear.Math.AABB
23import Spear.Math.Circle 26import Spear.Math.Circle
27import qualified Spear.Math.Matrix4 as M4
24import Spear.Math.Plane 28import Spear.Math.Plane
25import Spear.Math.Vector2 29import Spear.Math.Vector2
30import qualified Spear.Math.Vector3 as V3
26 31
27 32
28-- | Encodes several collision situations. 33-- | Encodes several collision situations.
@@ -48,12 +53,12 @@ instance Collisionable AABB where
48 | box2 `aabbpt` min1 && box2 `aabbpt` max1 = FullyContainedBy 53 | box2 `aabbpt` min1 && box2 `aabbpt` max1 = FullyContainedBy
49 | otherwise = Collision 54 | otherwise = Collision
50 55
51 collideCircle sphere@(Circle c r) aabb@(AABB min max) 56 collideCircle circle@(Circle c r) aabb@(AABB min max)
52 | test == FullyContains || test == FullyContainedBy = test 57 | test == FullyContains || test == FullyContainedBy = test
53 | normSq (c - boxC) > (l + r)^2 = NoCollision 58 | normSq (c - boxC) > (l + r)^2 = NoCollision
54 | otherwise = Collision 59 | otherwise = Collision
55 where 60 where
56 test = aabb `collideBox` aabbFromCircle sphere 61 test = aabb `collideBox` aabbFromCircle circle
57 boxC = min + (max-min)/2 62 boxC = min + (max-min)/2
58 l = norm $ min + (vec2 (x boxC) (y min)) - min 63 l = norm $ min + (vec2 (x boxC) (y min)) - min
59 64
@@ -64,7 +69,7 @@ instance Collisionable AABB where
64 69
65instance Collisionable Circle where 70instance Collisionable Circle where
66 71
67 collideBox box sphere = case collideCircle sphere box of 72 collideBox box circle = case collideCircle circle box of
68 FullyContains -> FullyContainedBy 73 FullyContains -> FullyContainedBy
69 FullyContainedBy -> FullyContains 74 FullyContainedBy -> FullyContains
70 x -> x 75 x -> x
@@ -117,7 +122,7 @@ aabbPoints (AABB min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
117data Collisioner 122data Collisioner
118 -- | An axis-aligned bounding box. 123 -- | An axis-aligned bounding box.
119 = AABBCol {-# UNPACK #-} !AABB 124 = AABBCol {-# UNPACK #-} !AABB
120 -- | A bounding sphere. 125 -- | A bounding circle.
121 | CircleCol {-# UNPACK #-} !Circle 126 | CircleCol {-# UNPACK #-} !Circle
122 127
123 128
@@ -127,18 +132,18 @@ aabbCollisioner = AABBCol
127 132
128 133
129-- | Create a collisioner from the specified circle. 134-- | Create a collisioner from the specified circle.
130sphereCollisioner :: Circle -> Collisioner 135circleCollisioner :: Circle -> Collisioner
131sphereCollisioner = CircleCol 136circleCollisioner = CircleCol
137
138
139-- | Create the minimal AABB collisioner fully containing the specified circle.
140boxFromCircle :: Circle -> Collisioner
141boxFromCircle = AABBCol . aabbFromCircle
132 142
133 143
134-- | Create the minimal AABB fully containing the specified collisioners. 144-- | Create the minimal AABB fully containing the specified collisioners.
135buildAABB :: [Collisioner] -> AABB 145buildAABB :: [Collisioner] -> AABB
136buildAABB cols = aabb $ generatePoints cols 146buildAABB cols = aabb $ generatePoints cols
137
138
139-- | Create the minimal AABB collisioner fully containing the specified circle.
140boxFromSphere :: Circle -> Collisioner
141boxFromSphere = AABBCol . aabbFromCircle
142 147
143 148
144generatePoints :: [Collisioner] -> [Vector2] 149generatePoints :: [Collisioner] -> [Vector2]
@@ -161,6 +166,22 @@ generatePoints = foldr generate []
161 p2 = c - unitx * (vec2 r r) 166 p2 = c - unitx * (vec2 r r)
162 p3 = c + unity * (vec2 r r) 167 p3 = c + unity * (vec2 r r)
163 p4 = c - unity * (vec2 r r) 168 p4 = c - unity * (vec2 r r)
169
170
171-- | Compute collisioners in view space from the given 3D AABB.
172mkCols :: M4.Matrix4 -- ^ Modelview matrix
173 -> Box
174 -> [Collisioner]
175mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =
176 let
177 toVec2 v = vec2 (V3.x v) (V3.y v)
178 p1 = toVec2 $ modelview `M4.mulp` V3.vec3 xmin ymin zmax
179 p2 = toVec2 $ modelview `M4.mulp` V3.vec3 xmax ymin zmin
180 p3 = toVec2 $ modelview `M4.mulp` V3.vec3 xmax ymax zmin
181 col1 = AABBCol $ AABB p1 p2
182 col2 = AABBCol $ AABB p1 p3
183 in
184 [col1, col2]
164 185
165 186
166-- | Collide the given collisioners. 187-- | 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
23 -- * Rendering 23 -- * Rendering
24, bind 24, bind
25, render 25, render
26 -- * Collisions
27, mkColsFromAnimated
26) 28)
27where 29where
28 30
29 31
30import Spear.Assets.Model 32import Spear.Assets.Model
31import Spear.Render.Model 33import Spear.Collision
32import Spear.GLSL 34import Spear.GLSL
33import Spear.Math.AABB 35import Spear.Math.AABB
36import Spear.Math.Matrix4 (Matrix4)
34import Spear.Math.Vector2 (vec2) 37import Spear.Math.Vector2 (vec2)
38import Spear.Math.Vector3 (vec3, x, y, z, scale)
35import Spear.Render.Material 39import Spear.Render.Material
40import Spear.Render.Model
36import Spear.Render.Program 41import Spear.Render.Program
37import Spear.Setup as Setup 42import Spear.Setup as Setup
38 43
@@ -230,3 +235,26 @@ render uniforms (AnimatedModelRenderer model _ _ _ curFrame fp _) =
230 glUniform1f (shiLoc uniforms) $ unsafeCoerce shi 235 glUniform1f (shiLoc uniforms) $ unsafeCoerce shi
231 glUniform1f (fpLoc uniforms) (unsafeCoerce fp) 236 glUniform1f (fpLoc uniforms) (unsafeCoerce fp)
232 drawArrays gl_TRIANGLES (n*curFrame) n 237 drawArrays gl_TRIANGLES (n*curFrame) n
238
239
240-- | Compute collisioners in 2d virtual space.
241mkColsFromAnimated
242 :: Int -- ^ Source frame
243 -> Int -- ^ Dest frame
244 -> Float -- ^ Frame progress
245 -> Matrix4 -- ^ Modelview matrix
246 -> AnimatedModelResource
247 -> [Collisioner]
248mkColsFromAnimated f1 f2 fp modelview modelRes =
249 let
250 (Box (Vec3 xmin1 ymin1 zmin1) (Vec3 xmax1 ymax1 zmax1)) = box f1 modelRes
251 (Box (Vec3 xmin2 ymin2 zmin2) (Vec3 xmax2 ymax2 zmax2)) = box f2 modelRes
252 min1 = vec3 xmin1 ymin1 zmin1
253 max1 = vec3 xmax1 ymax1 zmax1
254 min2 = vec3 xmin2 ymin2 zmin2
255 max2 = vec3 xmax2 ymax2 zmax2
256 min = min1 + scale fp (min2 - min1)
257 max = max1 + scale fp (max2 - max1)
258 in
259 mkCols modelview
260 $ 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
13 -- * Rendering 13 -- * Rendering
14, bind 14, bind
15, render 15, render
16 -- * Collision
17, mkColsFromStatic
16) 18)
17where 19where
18 20
19 21
20import Spear.Assets.Model 22import Spear.Assets.Model
21import Spear.Render.Model 23import Spear.Collision
22import Spear.GLSL 24import Spear.GLSL
23import Spear.Math.AABB 25import Spear.Math.AABB
26import Spear.Math.Matrix4 (Matrix4)
24import Spear.Math.Vector2 (vec2) 27import Spear.Math.Vector2 (vec2)
25import Spear.Render.Material 28import Spear.Render.Material
29import Spear.Render.Model
26import Spear.Render.Program 30import Spear.Render.Program
27import Spear.Setup as Setup 31import Spear.Setup as Setup
28 32
@@ -142,3 +146,11 @@ render uniforms (StaticModelRenderer model) =
142 uniformVec4 (ksLoc uniforms) ks 146 uniformVec4 (ksLoc uniforms) ks
143 glUniform1f (shiLoc uniforms) $ unsafeCoerce shi 147 glUniform1f (shiLoc uniforms) $ unsafeCoerce shi
144 drawArrays gl_TRIANGLES 0 $ nVertices model 148 drawArrays gl_TRIANGLES 0 $ nVertices model
149
150
151-- | Compute collisioners in 2d virtual space.
152mkColsFromStatic
153 :: Matrix4 -- ^ Modelview matrix
154 -> StaticModelResource
155 -> [Collisioner]
156mkColsFromStatic modelview modelRes = mkCols modelview (box 0 modelRes)