diff options
-rw-r--r-- | Spear/Scene/GameObject.hs | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs new file mode 100644 index 0000000..be1c050 --- /dev/null +++ b/Spear/Scene/GameObject.hs | |||
@@ -0,0 +1,90 @@ | |||
1 | module Spear.Scene.GameObject | ||
2 | ( | ||
3 | GameObject | ||
4 | , CollideGO | ||
5 | , UpdateGO | ||
6 | -- * Construction | ||
7 | , goNew | ||
8 | -- * Accessors | ||
9 | , goData | ||
10 | -- * Manipulation | ||
11 | , goUpdate | ||
12 | , withGO | ||
13 | -- * Rendering | ||
14 | , goRender | ||
15 | ) | ||
16 | where | ||
17 | |||
18 | |||
19 | import Spear.Collision.Collision | ||
20 | import Spear.Collision.Collisioner | ||
21 | import Spear.Math.AABB | ||
22 | import Spear.Render.AnimatedModel as AM | ||
23 | import Spear.Render.Program | ||
24 | import Spear.Render.StaticModel as SM | ||
25 | |||
26 | import Data.List (foldl') | ||
27 | |||
28 | |||
29 | -- | Collide a game object. | ||
30 | type CollideGO a | ||
31 | = GameObject a -- ^ Collider | ||
32 | -> GameObject a -- ^ Old game object | ||
33 | -> GameObject a -- ^ New game object | ||
34 | |||
35 | -- | Update a game object. | ||
36 | type UpdateGO a = Float -> GameObject a -> GameObject a | ||
37 | |||
38 | |||
39 | -- | An object in the game scene. | ||
40 | data GameObject a = GameObject | ||
41 | { renderer :: !(Either StaticModelRenderer AnimatedModelRenderer) | ||
42 | , collisioner :: !Collisioner | ||
43 | , goData :: !a | ||
44 | , goUpdt :: UpdateGO a | ||
45 | , goCol :: CollideGO a | ||
46 | } | ||
47 | |||
48 | |||
49 | -- | Create a new game object. | ||
50 | goNew :: Either StaticModelResource AnimatedModelResource | ||
51 | -> Collisioner -> a -> UpdateGO a -> CollideGO a -> GameObject a | ||
52 | |||
53 | goNew (Left smr) = GameObject (Left $ staticModelRenderer smr) | ||
54 | goNew (Right amr) = GameObject (Right $ animatedModelRenderer amr) | ||
55 | |||
56 | |||
57 | -- | Render the game object. | ||
58 | goRender :: StaticProgramUniforms -> AnimatedProgramUniforms -> GameObject a -> IO () | ||
59 | goRender spu apu go = | ||
60 | case renderer go of | ||
61 | Left smr -> SM.render spu smr | ||
62 | Right amr -> AM.render apu amr | ||
63 | |||
64 | |||
65 | -- | Update the game object. | ||
66 | goUpdate :: Float -> GameObject a -> GameObject a | ||
67 | goUpdate dt go = | ||
68 | case renderer go of | ||
69 | Left smr -> goUpdt go dt $ go | ||
70 | Right amr -> goUpdt go dt $ go { renderer = Right $ AM.update dt amr } | ||
71 | |||
72 | |||
73 | -- | Apply the given function to the game object's data. | ||
74 | withGO :: GameObject a -> (a -> a) -> GameObject a | ||
75 | withGO go f = go { goData = f $ goData go } | ||
76 | |||
77 | |||
78 | -- | Collide the game object with the given list of game objects. | ||
79 | goCollide :: [GameObject a] -> GameObject a -> GameObject a | ||
80 | goCollide gos go = foldl' collide' go gos | ||
81 | where | ||
82 | collide' go1 go2 = goCol go1 go2 go1 | ||
83 | |||
84 | |||
85 | -- | Get the object's bounding box. | ||
86 | goAABB :: GameObject a -> AABB | ||
87 | goAABB go = | ||
88 | case collisioner go of | ||
89 | (AABBCol box) -> box | ||
90 | (CircleCol circle) -> aabbFromCircle circle | ||