Added 'up' to Spatial2

· GameObject no longer generic.

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 @@
 Version of workspace file format:
                1
 Time of storage:
-               "Tue Aug 28 22:48:22 CEST 2012"
+               "Wed Aug 29 11:39:26 CEST 2012"
 Name of the workspace:
                "Spear"
 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
 ,   aabbCollisioner

 ,   sphereCollisioner

 ,   buildAABB

-,   collide

+,   collide
+,   move

 )

 where

 

@@ -20,9 +21,9 @@ import Spear.Math.Vector2
 -- | A collisioner component.

 data Collisioner

     -- | An axis-aligned bounding box.

-    = AABBCol { getBox :: !AABB }

+    = AABBCol { getBox :: {-# UNPACK #-} !AABB }

     -- | A bounding sphere.

-    | CircleCol { getSphere :: !Circle }

+    | CircleCol { getCircle :: {-# UNPACK #-} !Circle }

 

 

 -- | Create a 'Collisioner' from the specified box.  

@@ -42,7 +43,7 @@ buildAABB cols = aabb $ generatePoints cols
 

 -- | Create the minimal 'AABB' collisioner fully containing the specified circle.

 boxFromSphere :: Circle -> Collisioner

-boxFromSphere = AABBCol . aabbFromCircle

+boxFromSphere = AABBCol . aabbFromCircle
 

 

 generatePoints :: [Collisioner] -> [Vector2]

@@ -73,3 +74,9 @@ collide (AABBCol box1) (AABBCol box2)    = collideBox    box1 box2
 collide (CircleCol s1) (CircleCol s2)    = collideSphere s1 s2

 collide (AABBCol box) (CircleCol sphere) = collideBox    box sphere

 collide (CircleCol sphere) (AABBCol box) = collideSphere sphere box

+
+
+-- | Move the collisioner.
+move :: Vector2 -> Collisioner -> Collisioner
+move v (AABBCol (AABB min max)) = AABBCol (AABB (min+v) (max+v))
+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
     rotate      a ent = ent { transform = transform ent * M.rot a }
     pos   = M.position . transform
     fwd   = M.forward  . transform
+    up    = M.up       . transform
     right = M.right    . transform
     transform (Entity t) = t
     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
     
     -- | Get the spatial's forward vector.
     fwd :: s -> Vector2
-        
+    
+    -- | Get the spatial's up vector.
+    up :: s -> Vector2
+    
     -- | Get the spatial's right vector.
     right :: s -> Vector2
     
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
     
     fwd _ = unity
     
+    up _ = unity
+    
     right _ = unitx
     
     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 @@
 module Spear.Scene.GameObject
 (
     GameObject
-,   CollideGO
-,   UpdateGO
     -- * Construction
 ,   goNew
-        -- * Accessors
-,   goData
     -- * Manipulation
 ,   goUpdate
-,   withGO
+,   goAABB
     -- * Rendering
 ,   goRender
+    -- * Collision
+,   goCollide
 )
 where
 
 
 import Spear.Collision.Collision
-import Spear.Collision.Collisioner
+import Spear.Collision.Collisioner as Col
+import Spear.GLSL.Uniform
 import Spear.Math.AABB
+import qualified Spear.Math.Camera as Cam
+import qualified Spear.Math.Matrix3 as M3
+import qualified Spear.Math.Matrix4 as M4
+import Spear.Math.MatrixUtils
+import qualified Spear.Math.Spatial2 as S2
+import Spear.Math.Vector2 as V2
+import Spear.Math.Vector3 as V3
 import Spear.Render.AnimatedModel as AM
 import Spear.Render.Program
 import Spear.Render.StaticModel as SM
@@ -26,64 +32,161 @@ import Spear.Render.StaticModel as SM
 import Data.List (foldl')
 
 
--- | Collide a game object.
-type CollideGO a
-    =  GameObject a -- ^ Collider
-    -> GameObject a -- ^ Old game object
-    -> GameObject a -- ^ New game object
-
--- | Update a game object.
-type UpdateGO a = Float -> GameObject a -> GameObject a
+-- | Game style.
+data GameStyle
+    = RPG -- ^ RPG or RTS style game.
+    | PLT -- ^ Platformer or space invaders style game.
 
 
 -- | An object in the game scene.
-data GameObject a = GameObject
-    { renderer    :: !(Either StaticModelRenderer AnimatedModelRenderer)
+data GameObject = GameObject
+    { gameStyle   :: GameStyle
+    , renderer    :: !(Either StaticModelRenderer AnimatedModelRenderer)
     , collisioner :: !Collisioner
-    , goData      :: !a
-    , goUpdt      :: UpdateGO a
-    , goCol       :: CollideGO a
+    , transform   :: M3.Matrix3
+    , goUpdate    :: Float -> GameObject
     }
 
 
--- | Create a new game object.
-goNew :: Either StaticModelResource AnimatedModelResource
-      -> Collisioner -> a -> UpdateGO a -> CollideGO a -> GameObject a
-
-goNew (Left  smr) = GameObject (Left  $ staticModelRenderer smr)
-goNew (Right amr) = GameObject (Right $ animatedModelRenderer amr)
-
-
--- | Render the game object.
-goRender :: StaticProgramUniforms -> AnimatedProgramUniforms -> GameObject a -> IO ()
-goRender spu apu go =
-    case renderer go of
-        Left smr  -> SM.render spu smr
-        Right amr -> AM.render apu amr
+instance S2.Spatial2 GameObject where
+    
+    move v go = go
+        { collisioner = Col.move v $ collisioner go
+        , transform  = M3.translv v * transform go
+        }
+    
+    moveFwd s go =
+        let m = transform go
+            v = V2.scale s $ M3.forward m
+        in go
+            { collisioner = Col.move v $ collisioner go
+            , transform = M3.translv v * m
+            }
+    
+    moveBack s go =
+        let m = transform go
+            v = V2.scale (-s) $ M3.forward m
+        in go
+            { collisioner = Col.move v $ collisioner go
+            , transform = M3.translv v * m
+            }
+    
+    strafeLeft s go =
+        let m = transform go
+            v = V2.scale (-s) $ M3.right m
+        in go
+            { collisioner = Col.move v $ collisioner go
+            , transform = M3.translv v * m
+            }
+    
+    strafeRight s go =
+        let m = transform go
+            v = V2.scale s $ M3.right m
+        in go
+            { collisioner = Col.move v $ collisioner go
+            , transform = M3.translv v * m
+            }
+    
+    rotate angle go = go { transform = transform go * M3.rot angle }
+    
+    pos go = M3.position . transform $ go
+    
+    fwd go = M3.forward . transform $ go
+    
+    up go = M3.up . transform $ go
+    
+    right go = M3.right . transform $ go
+    
+    transform go = Spear.Scene.GameObject.transform go
+    
+    setTransform mat go = go { transform = mat }
+    
+    setPos pos go =
+        let m = transform go
+        in go { transform = M3.transform (M3.right m) (M3.forward m) pos }
 
 
--- | Update the game object.
-goUpdate :: Float -> GameObject a -> GameObject a
-goUpdate dt go =
-    case renderer go of
-        Left smr  -> goUpdt go dt $ go
-        Right amr -> goUpdt go dt $ go { renderer = Right $ AM.update dt amr }
+-- | Create a new game object.
+goNew :: GameStyle
+      -> Either StaticModelResource AnimatedModelResource
+      -> Collisioner
+      -> GameObject
+
+goNew style (Left smr)  col =
+    goUpdate' style (Left  $ SM.staticModelRenderer smr)   col M3.id 0
+
+goNew style (Right amr) col =
+    goUpdate' style (Right $ AM.animatedModelRenderer amr) col M3.id 0
+
+
+goUpdate' :: GameStyle
+          -> Either StaticModelRenderer AnimatedModelRenderer
+          -> Collisioner
+          -> M3.Matrix3
+          -> Float
+          -> GameObject
+goUpdate' style rend col mat dt =
+    let rend' = case rend of
+            Left _  -> rend
+            Right amr -> Right $ AM.update dt amr
+    in
+        GameObject
+        { gameStyle = style
+        , renderer = rend
+        , collisioner = col
+        , transform = mat
+        , goUpdate = goUpdate' style rend' col mat
+        }
 
 
--- | Apply the given function to the game object's data.
-withGO :: GameObject a -> (a -> a) -> GameObject a
-withGO go f = go { goData = f $ goData go }
+-- | Render the game object.
+goRender :: StaticProgram -> AnimatedProgram -> Cam.Camera -> GameObject -> IO ()
+goRender sprog aprog cam go =
+    let spu = staticProgramUniforms sprog
+        apu = animatedProgramUniforms aprog
+        mat = S2.transform go
+        style = gameStyle go
+    in case renderer go of
+        Left smr  -> goRender' style spu mat cam (SM.bind spu smr) (SM.render spu smr)
+        Right amr -> goRender' style apu mat cam (AM.bind apu amr) (AM.render apu amr)
+
+
+type Bind = IO ()
+
+type Render = IO ()
+
+
+goRender' :: ProgramUniforms u
+          => GameStyle
+          -> u
+          -> M3.Matrix3
+          -> Cam.Camera
+          -> Bind
+          -> Render
+          -> IO ()
+goRender' style uniforms model cam bindRenderer render =
+    let view  = M4.inverseTransform $ Cam.transform cam
+        modelview = case style of
+            RPG -> view * rpgTransform 0 model
+            PLT -> view * pltTransform model
+        normalmat = fastNormalMatrix modelview
+    in do
+        uniformMat4 (projLoc uniforms) $ Cam.projection cam
+        uniformMat4 (modelviewLoc uniforms) modelview
+        uniformMat3 (normalmatLoc uniforms) normalmat
+        bindRenderer
+        render
 
 
 -- | Collide the game object with the given list of game objects.
-goCollide :: [GameObject a] -> GameObject a -> GameObject a
-goCollide gos go = foldl' collide' go gos
+goCollide :: [GameObject] -> GameObject -> [GameObject]
+goCollide gos go = foldl' collide' [] gos
     where
-        collide' go1 go2 = goCol go1 go2 go1
+        collide' gos target = target:gos
 
 
--- | Get the object's bounding box.
-goAABB :: GameObject a -> AABB
+-- | Get the game object's bounding box.
+goAABB :: GameObject -> AABB
 goAABB go =
     case collisioner go of
         (AABBCol box) -> box