diff options
-rw-r--r-- | Spear.lkshw | 2 | ||||
-rw-r--r-- | Spear/Collision/Collisioner.hs | 15 | ||||
-rw-r--r-- | Spear/Math/Entity.hs | 1 | ||||
-rw-r--r-- | Spear/Math/Spatial2.hs | 5 | ||||
-rw-r--r-- | Spear/Physics/Rigid.hs | 2 | ||||
-rw-r--r-- | Spear/Scene/GameObject.hs | 197 |
6 files changed, 169 insertions, 53 deletions
diff --git a/Spear.lkshw b/Spear.lkshw index 142cfb0..d448954 100644 --- a/Spear.lkshw +++ b/Spear.lkshw | |||
@@ -1,7 +1,7 @@ | |||
1 | Version of workspace file format: | 1 | Version of workspace file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Tue Aug 28 22:48:22 CEST 2012" | 4 | "Wed Aug 29 11:39:26 CEST 2012" |
5 | Name of the workspace: | 5 | Name of the workspace: |
6 | "Spear" | 6 | "Spear" |
7 | File paths of contained packages: | 7 | File paths of contained packages: |
diff --git a/Spear/Collision/Collisioner.hs b/Spear/Collision/Collisioner.hs index 19114e6..dd41d61 100644 --- a/Spear/Collision/Collisioner.hs +++ b/Spear/Collision/Collisioner.hs | |||
@@ -5,7 +5,8 @@ module Spear.Collision.Collisioner | |||
5 | , aabbCollisioner | 5 | , aabbCollisioner |
6 | , sphereCollisioner | 6 | , sphereCollisioner |
7 | , buildAABB | 7 | , buildAABB |
8 | , collide | 8 | , collide |
9 | , move | ||
9 | ) | 10 | ) |
10 | where | 11 | where |
11 | 12 | ||
@@ -20,9 +21,9 @@ import Spear.Math.Vector2 | |||
20 | -- | A collisioner component. | 21 | -- | A collisioner component. |
21 | data Collisioner | 22 | data Collisioner |
22 | -- | An axis-aligned bounding box. | 23 | -- | An axis-aligned bounding box. |
23 | = AABBCol { getBox :: !AABB } | 24 | = AABBCol { getBox :: {-# UNPACK #-} !AABB } |
24 | -- | A bounding sphere. | 25 | -- | A bounding sphere. |
25 | | CircleCol { getSphere :: !Circle } | 26 | | CircleCol { getCircle :: {-# UNPACK #-} !Circle } |
26 | 27 | ||
27 | 28 | ||
28 | -- | Create a 'Collisioner' from the specified box. | 29 | -- | Create a 'Collisioner' from the specified box. |
@@ -42,7 +43,7 @@ buildAABB cols = aabb $ generatePoints cols | |||
42 | 43 | ||
43 | -- | Create the minimal 'AABB' collisioner fully containing the specified circle. | 44 | -- | Create the minimal 'AABB' collisioner fully containing the specified circle. |
44 | boxFromSphere :: Circle -> Collisioner | 45 | boxFromSphere :: Circle -> Collisioner |
45 | boxFromSphere = AABBCol . aabbFromCircle | 46 | boxFromSphere = AABBCol . aabbFromCircle |
46 | 47 | ||
47 | 48 | ||
48 | generatePoints :: [Collisioner] -> [Vector2] | 49 | generatePoints :: [Collisioner] -> [Vector2] |
@@ -73,3 +74,9 @@ collide (AABBCol box1) (AABBCol box2) = collideBox box1 box2 | |||
73 | collide (CircleCol s1) (CircleCol s2) = collideSphere s1 s2 | 74 | collide (CircleCol s1) (CircleCol s2) = collideSphere s1 s2 |
74 | collide (AABBCol box) (CircleCol sphere) = collideBox box sphere | 75 | collide (AABBCol box) (CircleCol sphere) = collideBox box sphere |
75 | collide (CircleCol sphere) (AABBCol box) = collideSphere sphere box | 76 | collide (CircleCol sphere) (AABBCol box) = collideSphere sphere box |
77 | |||
78 | |||
79 | -- | Move the collisioner. | ||
80 | move :: Vector2 -> Collisioner -> Collisioner | ||
81 | move v (AABBCol (AABB min max)) = AABBCol (AABB (min+v) (max+v)) | ||
82 | move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) | ||
diff --git a/Spear/Math/Entity.hs b/Spear/Math/Entity.hs index 022868b..f4e6515 100644 --- a/Spear/Math/Entity.hs +++ b/Spear/Math/Entity.hs | |||
@@ -23,6 +23,7 @@ instance S.Spatial2 Entity where | |||
23 | rotate a ent = ent { transform = transform ent * M.rot a } | 23 | rotate a ent = ent { transform = transform ent * M.rot a } |
24 | pos = M.position . transform | 24 | pos = M.position . transform |
25 | fwd = M.forward . transform | 25 | fwd = M.forward . transform |
26 | up = M.up . transform | ||
26 | right = M.right . transform | 27 | right = M.right . transform |
27 | transform (Entity t) = t | 28 | transform (Entity t) = t |
28 | setTransform t (Entity _) = Entity t | 29 | setTransform t (Entity _) = Entity t |
diff --git a/Spear/Math/Spatial2.hs b/Spear/Math/Spatial2.hs index 3c60412..51fa050 100644 --- a/Spear/Math/Spatial2.hs +++ b/Spear/Math/Spatial2.hs | |||
@@ -32,7 +32,10 @@ class Spatial2 s where | |||
32 | 32 | ||
33 | -- | Get the spatial's forward vector. | 33 | -- | Get the spatial's forward vector. |
34 | fwd :: s -> Vector2 | 34 | fwd :: s -> Vector2 |
35 | 35 | ||
36 | -- | Get the spatial's up vector. | ||
37 | up :: s -> Vector2 | ||
38 | |||
36 | -- | Get the spatial's right vector. | 39 | -- | Get the spatial's right vector. |
37 | right :: s -> Vector2 | 40 | right :: s -> Vector2 |
38 | 41 | ||
diff --git a/Spear/Physics/Rigid.hs b/Spear/Physics/Rigid.hs index 396cae4..cc153ec 100644 --- a/Spear/Physics/Rigid.hs +++ b/Spear/Physics/Rigid.hs | |||
@@ -45,6 +45,8 @@ instance Spatial2 RigidBody where | |||
45 | 45 | ||
46 | fwd _ = unity | 46 | fwd _ = unity |
47 | 47 | ||
48 | up _ = unity | ||
49 | |||
48 | right _ = unitx | 50 | right _ = unitx |
49 | 51 | ||
50 | transform body = M3.transform unitx unity $ position body | 52 | transform body = M3.transform unitx unity $ position body |
diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs index be1c050..1d5fed2 100644 --- a/Spear/Scene/GameObject.hs +++ b/Spear/Scene/GameObject.hs | |||
@@ -1,24 +1,30 @@ | |||
1 | module Spear.Scene.GameObject | 1 | module Spear.Scene.GameObject |
2 | ( | 2 | ( |
3 | GameObject | 3 | GameObject |
4 | , CollideGO | ||
5 | , UpdateGO | ||
6 | -- * Construction | 4 | -- * Construction |
7 | , goNew | 5 | , goNew |
8 | -- * Accessors | ||
9 | , goData | ||
10 | -- * Manipulation | 6 | -- * Manipulation |
11 | , goUpdate | 7 | , goUpdate |
12 | , withGO | 8 | , goAABB |
13 | -- * Rendering | 9 | -- * Rendering |
14 | , goRender | 10 | , goRender |
11 | -- * Collision | ||
12 | , goCollide | ||
15 | ) | 13 | ) |
16 | where | 14 | where |
17 | 15 | ||
18 | 16 | ||
19 | import Spear.Collision.Collision | 17 | import Spear.Collision.Collision |
20 | import Spear.Collision.Collisioner | 18 | import Spear.Collision.Collisioner as Col |
19 | import Spear.GLSL.Uniform | ||
21 | import Spear.Math.AABB | 20 | import Spear.Math.AABB |
21 | import qualified Spear.Math.Camera as Cam | ||
22 | import qualified Spear.Math.Matrix3 as M3 | ||
23 | import qualified Spear.Math.Matrix4 as M4 | ||
24 | import Spear.Math.MatrixUtils | ||
25 | import qualified Spear.Math.Spatial2 as S2 | ||
26 | import Spear.Math.Vector2 as V2 | ||
27 | import Spear.Math.Vector3 as V3 | ||
22 | import Spear.Render.AnimatedModel as AM | 28 | import Spear.Render.AnimatedModel as AM |
23 | import Spear.Render.Program | 29 | import Spear.Render.Program |
24 | import Spear.Render.StaticModel as SM | 30 | import Spear.Render.StaticModel as SM |
@@ -26,64 +32,161 @@ import Spear.Render.StaticModel as SM | |||
26 | import Data.List (foldl') | 32 | import Data.List (foldl') |
27 | 33 | ||
28 | 34 | ||
29 | -- | Collide a game object. | 35 | -- | Game style. |
30 | type CollideGO a | 36 | data GameStyle |
31 | = GameObject a -- ^ Collider | 37 | = RPG -- ^ RPG or RTS style game. |
32 | -> GameObject a -- ^ Old game object | 38 | | PLT -- ^ Platformer or space invaders style game. |
33 | -> GameObject a -- ^ New game object | ||
34 | |||
35 | -- | Update a game object. | ||
36 | type UpdateGO a = Float -> GameObject a -> GameObject a | ||
37 | 39 | ||
38 | 40 | ||
39 | -- | An object in the game scene. | 41 | -- | An object in the game scene. |
40 | data GameObject a = GameObject | 42 | data GameObject = GameObject |
41 | { renderer :: !(Either StaticModelRenderer AnimatedModelRenderer) | 43 | { gameStyle :: GameStyle |
44 | , renderer :: !(Either StaticModelRenderer AnimatedModelRenderer) | ||
42 | , collisioner :: !Collisioner | 45 | , collisioner :: !Collisioner |
43 | , goData :: !a | 46 | , transform :: M3.Matrix3 |
44 | , goUpdt :: UpdateGO a | 47 | , goUpdate :: Float -> GameObject |
45 | , goCol :: CollideGO a | ||
46 | } | 48 | } |
47 | 49 | ||
48 | 50 | ||
49 | -- | Create a new game object. | 51 | instance S2.Spatial2 GameObject where |
50 | goNew :: Either StaticModelResource AnimatedModelResource | 52 | |
51 | -> Collisioner -> a -> UpdateGO a -> CollideGO a -> GameObject a | 53 | move v go = go |
52 | 54 | { collisioner = Col.move v $ collisioner go | |
53 | goNew (Left smr) = GameObject (Left $ staticModelRenderer smr) | 55 | , transform = M3.translv v * transform go |
54 | goNew (Right amr) = GameObject (Right $ animatedModelRenderer amr) | 56 | } |
55 | 57 | ||
56 | 58 | moveFwd s go = | |
57 | -- | Render the game object. | 59 | let m = transform go |
58 | goRender :: StaticProgramUniforms -> AnimatedProgramUniforms -> GameObject a -> IO () | 60 | v = V2.scale s $ M3.forward m |
59 | goRender spu apu go = | 61 | in go |
60 | case renderer go of | 62 | { collisioner = Col.move v $ collisioner go |
61 | Left smr -> SM.render spu smr | 63 | , transform = M3.translv v * m |
62 | Right amr -> AM.render apu amr | 64 | } |
65 | |||
66 | moveBack s go = | ||
67 | let m = transform go | ||
68 | v = V2.scale (-s) $ M3.forward m | ||
69 | in go | ||
70 | { collisioner = Col.move v $ collisioner go | ||
71 | , transform = M3.translv v * m | ||
72 | } | ||
73 | |||
74 | strafeLeft s go = | ||
75 | let m = transform go | ||
76 | v = V2.scale (-s) $ M3.right m | ||
77 | in go | ||
78 | { collisioner = Col.move v $ collisioner go | ||
79 | , transform = M3.translv v * m | ||
80 | } | ||
81 | |||
82 | strafeRight s go = | ||
83 | let m = transform go | ||
84 | v = V2.scale s $ M3.right m | ||
85 | in go | ||
86 | { collisioner = Col.move v $ collisioner go | ||
87 | , transform = M3.translv v * m | ||
88 | } | ||
89 | |||
90 | rotate angle go = go { transform = transform go * M3.rot angle } | ||
91 | |||
92 | pos go = M3.position . transform $ go | ||
93 | |||
94 | fwd go = M3.forward . transform $ go | ||
95 | |||
96 | up go = M3.up . transform $ go | ||
97 | |||
98 | right go = M3.right . transform $ go | ||
99 | |||
100 | transform go = Spear.Scene.GameObject.transform go | ||
101 | |||
102 | setTransform mat go = go { transform = mat } | ||
103 | |||
104 | setPos pos go = | ||
105 | let m = transform go | ||
106 | in go { transform = M3.transform (M3.right m) (M3.forward m) pos } | ||
63 | 107 | ||
64 | 108 | ||
65 | -- | Update the game object. | 109 | -- | Create a new game object. |
66 | goUpdate :: Float -> GameObject a -> GameObject a | 110 | goNew :: GameStyle |
67 | goUpdate dt go = | 111 | -> Either StaticModelResource AnimatedModelResource |
68 | case renderer go of | 112 | -> Collisioner |
69 | Left smr -> goUpdt go dt $ go | 113 | -> GameObject |
70 | Right amr -> goUpdt go dt $ go { renderer = Right $ AM.update dt amr } | 114 | |
115 | goNew style (Left smr) col = | ||
116 | goUpdate' style (Left $ SM.staticModelRenderer smr) col M3.id 0 | ||
117 | |||
118 | goNew style (Right amr) col = | ||
119 | goUpdate' style (Right $ AM.animatedModelRenderer amr) col M3.id 0 | ||
120 | |||
121 | |||
122 | goUpdate' :: GameStyle | ||
123 | -> Either StaticModelRenderer AnimatedModelRenderer | ||
124 | -> Collisioner | ||
125 | -> M3.Matrix3 | ||
126 | -> Float | ||
127 | -> GameObject | ||
128 | goUpdate' style rend col mat dt = | ||
129 | let rend' = case rend of | ||
130 | Left _ -> rend | ||
131 | Right amr -> Right $ AM.update dt amr | ||
132 | in | ||
133 | GameObject | ||
134 | { gameStyle = style | ||
135 | , renderer = rend | ||
136 | , collisioner = col | ||
137 | , transform = mat | ||
138 | , goUpdate = goUpdate' style rend' col mat | ||
139 | } | ||
71 | 140 | ||
72 | 141 | ||
73 | -- | Apply the given function to the game object's data. | 142 | -- | Render the game object. |
74 | withGO :: GameObject a -> (a -> a) -> GameObject a | 143 | goRender :: StaticProgram -> AnimatedProgram -> Cam.Camera -> GameObject -> IO () |
75 | withGO go f = go { goData = f $ goData go } | 144 | goRender sprog aprog cam go = |
145 | let spu = staticProgramUniforms sprog | ||
146 | apu = animatedProgramUniforms aprog | ||
147 | mat = S2.transform go | ||
148 | style = gameStyle go | ||
149 | in case renderer go of | ||
150 | Left smr -> goRender' style spu mat cam (SM.bind spu smr) (SM.render spu smr) | ||
151 | Right amr -> goRender' style apu mat cam (AM.bind apu amr) (AM.render apu amr) | ||
152 | |||
153 | |||
154 | type Bind = IO () | ||
155 | |||
156 | type Render = IO () | ||
157 | |||
158 | |||
159 | goRender' :: ProgramUniforms u | ||
160 | => GameStyle | ||
161 | -> u | ||
162 | -> M3.Matrix3 | ||
163 | -> Cam.Camera | ||
164 | -> Bind | ||
165 | -> Render | ||
166 | -> IO () | ||
167 | goRender' style uniforms model cam bindRenderer render = | ||
168 | let view = M4.inverseTransform $ Cam.transform cam | ||
169 | modelview = case style of | ||
170 | RPG -> view * rpgTransform 0 model | ||
171 | PLT -> view * pltTransform model | ||
172 | normalmat = fastNormalMatrix modelview | ||
173 | in do | ||
174 | uniformMat4 (projLoc uniforms) $ Cam.projection cam | ||
175 | uniformMat4 (modelviewLoc uniforms) modelview | ||
176 | uniformMat3 (normalmatLoc uniforms) normalmat | ||
177 | bindRenderer | ||
178 | render | ||
76 | 179 | ||
77 | 180 | ||
78 | -- | Collide the game object with the given list of game objects. | 181 | -- | Collide the game object with the given list of game objects. |
79 | goCollide :: [GameObject a] -> GameObject a -> GameObject a | 182 | goCollide :: [GameObject] -> GameObject -> [GameObject] |
80 | goCollide gos go = foldl' collide' go gos | 183 | goCollide gos go = foldl' collide' [] gos |
81 | where | 184 | where |
82 | collide' go1 go2 = goCol go1 go2 go1 | 185 | collide' gos target = target:gos |
83 | 186 | ||
84 | 187 | ||
85 | -- | Get the object's bounding box. | 188 | -- | Get the game object's bounding box. |
86 | goAABB :: GameObject a -> AABB | 189 | goAABB :: GameObject -> AABB |
87 | goAABB go = | 190 | goAABB go = |
88 | case collisioner go of | 191 | case collisioner go of |
89 | (AABBCol box) -> box | 192 | (AABBCol box) -> box |