Added Obj3

6 files changed, 176 insertions, 113 deletions

diff --git a/Spear/App/Input.hs b/Spear/App/Input.hs
index 0207147..9fa140a 100644
--- a/Spear/App/Input.hs
+++ b/Spear/App/Input.hs
@@ -27,14 +27,12 @@ module Spear.App.Input
 )
 where
 
-
 import Data.Char (ord)
 import qualified Data.Vector.Unboxed as V
 import qualified Graphics.UI.GLFW as GLFW
 import Graphics.Rendering.OpenGL.GL.CoordTrans
 import Data.StateVar
 
-
 data Key
     = KEY_A | KEY_B | KEY_C | KEY_D | KEY_E | KEY_F | KEY_G | KEY_H
     | KEY_I | KEY_J | KEY_K | KEY_L | KEY_M | KEY_N | KEY_O | KEY_P
@@ -42,33 +40,28 @@ data Key
     | KEY_Y | KEY_Z | KEY_0 | KEY_1 | KEY_2 | KEY_3 | KEY_4 | KEY_5
     | KEY_6 | KEY_7 | KEY_8 | KEY_9 | KEY_F1 | KEY_F2 | KEY_F3
     | KEY_F4 | KEY_F5 | KEY_F6 | KEY_F7 | KEY_F8 | KEY_F9 | KEY_F10
-    | KEY_F11 | KEY_F12 | KEY_ESC | KEY_SPACE
+    | KEY_F11 | KEY_F12 | KEY_ESC | KEY_SPACE | KEY_UP | KEY_DOWN
+    | KEY_LEFT | KEY_RIGHT
     deriving (Enum, Bounded)
 
-
 type Keyboard = Key -> Bool
 
-
 data MouseButton = LMB | RMB | MMB
     deriving (Enum, Bounded)
 
-
 data MouseProp = MouseX | MouseY | MouseDX | MouseDY
     deriving Enum
 
-
 data Mouse = Mouse
     { button   :: MouseButton -> Bool
     , property :: MouseProp -> Float
     }
 
-
 data Input = Input
     { keyboard :: Keyboard
     , mouse    :: Mouse
     }
 
-
 -- | Return a new dummy keyboard.
 --
 -- This function should be called to get an initial keyboard.
@@ -79,7 +72,6 @@ data Input = Input
 newKeyboard :: Keyboard
 newKeyboard = const False
 
-
 -- | Get the keyboard.
 getKeyboard :: IO Keyboard
 getKeyboard =
@@ -90,7 +82,6 @@ getKeyboard =
         (fmap (V.fromList . fmap ((==) GLFW.Press)) . mapM GLFW.getKey . fmap toGLFWkey $ keys)
             >>= return . keyboard'
 
-
 -- | Return a new dummy mouse.
 --
 -- This function should be called to get an initial mouse.
@@ -101,7 +92,6 @@ getKeyboard =
 newMouse :: Mouse
 newMouse = Mouse (const False) (const 0)
 
-
 -- | Get the mouse.
 --
 -- The previous mouse state is required to compute position deltas.
@@ -109,21 +99,21 @@ getMouse :: Mouse -> IO Mouse
 getMouse oldMouse =
     let getButton :: V.Vector Bool -> MouseButton -> Bool
         getButton mousestate button = mousestate V.! fromEnum button
-        
+
         getProp :: V.Vector Float -> MouseProp -> Float
         getProp props prop = props V.! fromEnum prop
-        
+
         props xpos ypos = V.fromList
             [ xpos, ypos
             , xpos - property oldMouse MouseX
             , ypos - property oldMouse MouseY
             ]
-        
+
         getButtonState =
             fmap (V.fromList . fmap ((==) GLFW.Press)) .
             mapM GLFW.getMouseButton .
             fmap toGLFWbutton $ buttons
-        
+
         buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)]
     in do
         Position xpos ypos <- get GLFW.mousePos
@@ -133,12 +123,10 @@ getMouse oldMouse =
             , property = getProp $ props (fromIntegral xpos) (fromIntegral ypos)
             }
 
-
 -- | Return a new dummy input.
 newInput :: Input
 newInput = Input newKeyboard newMouse
 
-
 -- | Get input devices.
 getInput :: Input -> IO Input
 getInput (Input _ oldMouse) = do
@@ -146,12 +134,10 @@ getInput (Input _ oldMouse) = do
     mouse    <- getMouse oldMouse
     return $ Input keyboard mouse
 
-
 -- | Poll input devices.
 pollInput :: IO ()
 pollInput = GLFW.pollEvents
 
-
 -- | Return a mouse that reacts to button toggles.
 toggledMouse :: Mouse -- ^ Previous mouse state.
              -> Mouse -- ^ Current mouse state.
@@ -159,7 +145,6 @@ toggledMouse :: Mouse -- ^ Previous mouse state.
 
 toggledMouse prev cur = cur { button = \bt -> button cur bt && not (button prev bt) }
 
-
 -- | Return a keyboard that reacts to key toggles.
 toggledKeyboard :: Keyboard -- ^ Previous keyboard state.
                 -> Keyboard -- ^ Current keyboard state.
@@ -167,9 +152,6 @@ toggledKeyboard :: Keyboard -- ^ Previous keyboard state.
 
 toggledKeyboard prev cur key = cur key && not (prev key)
 
-
-
-
 -- | Delay configuration for each mouse button.
 type ButtonDelay = MouseButton -> Float
 
@@ -181,13 +163,11 @@ data DelayedMouse = DelayedMouse
     , accum :: V.Vector Float
     }
 
-
 newDM :: ButtonDelay -- ^ Delay configuration for each button.
       -> DelayedMouse
 newDM delay = DelayedMouse newMouse delay $
     V.replicate (fromEnum (maxBound :: MouseButton)) 0
 
-
 updateDM :: DelayedMouse -- ^ Current mouse state.
          -> Float -- ^ Time elapsed since last udpate.
          -> DelayedMouse
@@ -199,13 +179,11 @@ updateDM (DelayedMouse mouse delay accum) dt =
         button' b  = active b && button mouse b
         accum'     = accum V.// fmap newDelay [0 .. fromEnum (maxBound :: MouseButton)]
         newDelay x = let b = toEnum x
-                     in (x, if button' b then 0 else time b) 
+                     in (x, if button' b then 0 else time b)
     in
         DelayedMouse mouse { button = button' } delay accum'
 
 
-
-
 toGLFWkey :: Key -> Int
 toGLFWkey KEY_A   = ord 'A'
 toGLFWkey KEY_B   = ord 'B'
@@ -257,6 +235,10 @@ toGLFWkey KEY_F11 = fromEnum GLFW.F11
 toGLFWkey KEY_F12 = fromEnum GLFW.F12
 toGLFWkey KEY_ESC = fromEnum GLFW.ESC
 toGLFWkey KEY_SPACE = ord ' '
+toGLFWkey KEY_UP    = fromEnum GLFW.UP
+toGLFWkey KEY_DOWN  = fromEnum GLFW.DOWN
+toGLFWkey KEY_LEFT  = fromEnum GLFW.LEFT
+toGLFWkey KEY_RIGHT = fromEnum GLFW.RIGHT
 
 
 toGLFWbutton :: MouseButton -> GLFW.MouseButton
diff --git a/Spear/GL.hs b/Spear/GL.hs
index 6792d35..af96da4 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -452,7 +452,8 @@ attribVAOPointer
     -> Int     -- ^ Offset to the first component in the array.
     -> IO ()
 attribVAOPointer idx ncomp dattype normalise stride off =
-    glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off)
+    glVertexAttribPointer idx ncomp dattype normalise' stride (unsafeCoerce off)
+                          where normalise' = if normalise then 1 else 0
 
 -- | Draw the bound vao.
 drawArrays
diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs
index a86d5f5..9484bef 100644
--- a/Spear/Math/Camera.hs
+++ b/Spear/Math/Camera.hs
@@ -1,71 +1,89 @@
 module Spear.Math.Camera
+(
+    Camera
+,   Fovy
+,   Aspect
+,   Near
+,   Far
+,   Left
+,   Right
+,   Bottom
+,   Top
+,   projection
+)
 where
 
 
 import qualified Spear.Math.Matrix4 as M
-import qualified Spear.Math.Spatial3 as S
+import Spear.Math.Spatial3
 import Spear.Math.Vector
 
 
 data Camera = Camera
-    { projection :: M.Matrix4
-    , transform  :: M.Matrix4
+    { projection :: M.Matrix4 -- ^ Get the camera's projection.
+    , spatial    :: Obj3
     }
 
+type Fovy = Float
+type Aspect = Float
+type Near = Float
+type Far = Float
+type Left = Float
+type Right = Float
+type Bottom = Float
+type Top = Float
 
 -- | Build a perspective camera.
-perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees.
-            -> Float -- ^ Aspect ratio.
-            -> Float -- ^ Near clip.
-            -> Float -- ^ Far clip.
-            -> Vector3 -- ^ Right vector.
-            -> Vector3 -- ^ Up vector.
-            -> Vector3 -- ^ Forward vector.
-            -> Vector3 -- ^ Position vector.
+perspective :: Fovy      -- ^ Fovy - Vertical field of view angle in degrees.
+            -> Aspect    -- ^ Aspect ratio.
+            -> Near      -- ^ Near clip.
+            -> Far       -- ^ Far clip.
+            -> Right3    -- ^ Right vector.
+            -> Up3       -- ^ Up vector.
+            -> Forward3  -- ^ Forward vector.
+            -> Position3 -- ^ Position vector.
             -> Camera
 
 perspective fovy r n f right up fwd pos =
     Camera
     { projection = M.perspective fovy r n f
-    , transform  = M.transform right up (neg fwd) pos
+    , spatial    = fromVectors right up fwd pos
     }
 
 
 -- | Build an orthogonal camera.
-ortho :: Float   -- ^ Left.
-      -> Float   -- ^ Right.
-      -> Float   -- ^ Bottom.
-      -> Float   -- ^ Top.
-      -> Float   -- ^ Near clip.
-      -> Float   -- ^ Far clip.
-      -> Vector3 -- ^ Right vector.
-      -> Vector3 -- ^ Up vector.
-      -> Vector3 -- ^ Forward vector.
-      -> Vector3 -- ^ Position vector.
+ortho :: Left      -- ^ Left.
+      -> Right     -- ^ Right.
+      -> Bottom    -- ^ Bottom.
+      -> Top       -- ^ Top.
+      -> Near      -- ^ Near clip.
+      -> Far       -- ^ Far clip.
+      -> Right3    -- ^ Right vector.
+      -> Up3       -- ^ Up vector.
+      -> Forward3  -- ^ Forward vector.
+      -> Position3 -- ^ Position vector.
       -> Camera
 
 ortho l r b t n f right up fwd pos =
     Camera
     { projection = M.ortho l r b t n f
-    , transform  = M.transform right up (neg fwd) pos
+    , spatial    = fromVectors right up fwd pos
     }
 
 
-instance S.Spatial3 Camera where
-    move        v cam = cam { transform = M.translv v * transform cam }
-    moveFwd     f cam = cam { transform = M.translv (scale f $ S.fwd cam) * transform cam }
-    moveBack    f cam = cam { transform = M.translv (scale (-f) $ S.fwd cam) * transform cam }
-    strafeLeft  f cam = cam { transform = M.translv (scale (-f) $ S.right cam) * transform cam }
-    strafeRight f cam = cam { transform = M.translv (scale f $ S.right cam) * transform cam }
-    pitch       a cam = cam { transform = transform cam * M.axisAngle (S.right cam) a }
-    yaw         a cam = cam { transform = transform cam * M.axisAngle (S.up cam)    a }
-    roll        a cam = cam { transform = transform cam * M.axisAngle (S.fwd cam)   a }
-    pos   = M.position . transform
-    fwd   = M.forward  . transform
-    up    = M.up       . transform
-    right = M.right    . transform
-    transform (Camera _ t) = t
-    setTransform t (Camera proj _) = Camera proj t
-    setPos pos (Camera proj t) = Camera proj $
-        M.transform (M.right t) (M.up t) (M.forward t) pos
-
+instance Spatial3 Camera where
+    move         v cam = cam { spatial = move v        $ spatial cam }
+    moveFwd      s cam = cam { spatial = moveFwd s     $ spatial cam }
+    moveBack     s cam = cam { spatial = moveBack s    $ spatial cam }
+    strafeLeft   s cam = cam { spatial = strafeLeft s  $ spatial cam }
+    strafeRight  s cam = cam { spatial = strafeRight s $ spatial cam }
+    pitch        a cam = cam { spatial = pitch a       $ spatial cam }
+    yaw          a cam = cam { spatial = yaw a         $ spatial cam }
+    roll         a cam = cam { spatial = roll a        $ spatial cam }
+    pos            cam = pos   $ spatial cam
+    fwd            cam = fwd   $ spatial cam
+    up             cam = up    $ spatial cam
+    right          cam = right $ spatial cam
+    transform      cam = transform $ spatial cam
+    setTransform m cam = cam { spatial = setTransform m $ spatial cam }
+    setPos       p cam = cam { spatial = setPos p $ spatial cam }
diff --git a/Spear/Math/MatrixUtils.hs b/Spear/Math/MatrixUtils.hs
index 79bd049..e4273a1 100644
--- a/Spear/Math/MatrixUtils.hs
+++ b/Spear/Math/MatrixUtils.hs
@@ -15,6 +15,7 @@ where
 import Spear.Math.Camera as Cam
 import Spear.Math.Matrix3 as M3
 import Spear.Math.Matrix4 as M4
+import Spear.Math.Spatial3 as S
 import Spear.Math.Vector as V
 
 
@@ -112,7 +113,7 @@ pltTransform mat =
 
 
 -- | Map an object's transform in world space to view space.
--- 
+--
 -- The XY plane in 2D translates to the X(-Z) plane in 3D.
 --
 -- Use this in games such as RPGs and RTSs.
@@ -130,9 +131,9 @@ rpgInverse h a axis pos viewI =
 -- | Map an object's transform in world space to view space.
 --
 -- This function maps an object's transform in 2D to the object's inverse in 3D.
--- 
+--
 -- The XY plane in 2D translates to the XY plane in 3D.
--- 
+--
 -- Use this in games like platformers and space invaders style games.
 pltInverse :: Matrix3 -> Matrix4
 pltInverse = M4.inverseTransform . pltTransform
@@ -142,7 +143,7 @@ pltInverse = M4.inverseTransform . pltTransform
 objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2
 objToClip cam model p =
     let
-        view = M4.inverseTransform $ Cam.transform cam
+        view = M4.inverseTransform $ S.transform cam
         proj = Cam.projection cam
         p' = (proj * view * model) `M4.mulp` p
     in
diff --git a/Spear/Math/Spatial3.hs b/Spear/Math/Spatial3.hs
index 6db3853..2bc772e 100644
--- a/Spear/Math/Spatial3.hs
+++ b/Spear/Math/Spatial3.hs
@@ -1,58 +1,62 @@
 module Spear.Math.Spatial3
+(
+    Spatial3(..)
+,   Obj3
+,   fromVectors
+,   fromTransform
+)
 where
 
-
 import Spear.Math.Vector
-import Spear.Math.Matrix4 as M
-
+import Spear.Math.Matrix4 as M hiding (scale)
 
 class Spatial3 s where
-    -- | Move the 'Spatial'.
+    -- | Move the spatial.
     move :: Vector3 -> s -> s
-    
-    -- | Move the 'Spatial' forwards.
+
+    -- | Move the spatial forwards.
     moveFwd :: Float -> s -> s
-    
-    -- | Move the 'Spatial' backwards.
+
+    -- | Move the spatial backwards.
     moveBack :: Float -> s -> s
-    
-    -- | Make the 'Spatial' strafe left.
+
+    -- | Make the spatial strafe left.
     strafeLeft :: Float -> s -> s
-    
-    -- | Make the 'Spatial' Strafe right.
+
+    -- | Make the spatial Strafe right.
     strafeRight :: Float -> s -> s
-    
-    -- | Rotate the 'Spatial' about its local X axis.
+
+    -- | Rotate the spatial about its local X axis.
     pitch :: Float -> s -> s
-    
-    -- | Rotate the 'Spatial' about its local Y axis.
+
+    -- | Rotate the spatial about its local Y axis.
     yaw :: Float -> s -> s
-    
-    -- | Rotate the 'Spatial' about its local Z axis.
+
+    -- | Rotate the spatial about its local Z axis.
     roll :: Float -> s -> s
-    
-    -- | Get the 'Spatial''s position.
+
+    -- | Get the spatial's position.
     pos :: s -> Vector3
-    
-    -- | Get the 'Spatial''s forward vector.
+
+    -- | Get the spatial's forward vector.
     fwd :: s -> Vector3
-    
-    -- | Get the 'Spatial''s up vector.
+
+    -- | Get the spatial's up vector.
     up :: s -> Vector3
-    
-    -- | Get the 'Spatial''s right vector.
+
+    -- | Get the spatial's right vector.
     right :: s -> Vector3
-    
-    -- | Get the 'Spatial''s transform.
+
+    -- | Get the spatial's transform.
     transform :: s -> Matrix4
-    
-    -- | Set the 'Spatial''s transform.
+
+    -- | Set the spatial's transform.
     setTransform :: Matrix4 -> s -> s
-    
-    -- | Set the 'Spatial''s position.
+
+    -- | Set the spatial's position.
     setPos :: Vector3 -> s -> s
-    
-    -- | Make the 'Spatial' look at the given point.
+
+    -- | Make the spatial look at the given point.
     lookAt :: Vector3 -> s -> s
     lookAt pt s =
         let position = pos s
@@ -61,15 +65,15 @@ class Spatial3 s where
             u        = r `cross` fwd
         in
             setTransform (M.transform r u (-fwd) position) s
-    
-    -- | Make the 'Spatial' orbit around the given point
+
+    -- | Make the spatial orbit around the given point
     orbit :: Vector3 -- ^ Target point
           -> Float   -- ^ Horizontal angle
           -> Float   -- ^ Vertical angle
           -> Float   -- ^ Orbit radius.
           -> s
           -> s
-    
+
     orbit pt anglex angley radius s =
         let ax = anglex * pi / 180
             ay = angley * pi / 180
@@ -82,3 +86,59 @@ class Spatial3 s where
             pz = (z pt) + radius*cx*cy
         in
             setPos (vec3 px py pz) s
+
+-- | An object in 3D space.
+data Obj3 = Obj3
+     { r :: Vector3
+     , u :: Vector3
+     , f :: Vector3
+     , p :: Vector3
+     } deriving Show
+
+instance Spatial3 Obj3 where
+         move        d o = o { p = p o + d }
+         moveFwd     s o = o { p = p o + scale (-s) (f o) }
+         moveBack    s o = o { p = p o + scale s (f o) }
+         strafeLeft  s o = o { p = p o + scale (-s) (r o) }
+         strafeRight s o = o { p = p o + scale s (r o) }
+         pitch       a o =
+                     let a' = toRAD a
+                         sa = sin a'
+                         ca = cos a'
+                         r' = normalise $ scale ca (r o) + scale sa (f o)
+                         f' = normalise $ r' `cross` u o
+                     in  o { r = r', f = f' }
+         yaw         a o =
+                     let a' = toRAD a
+                         sa = sin a'
+                         ca = cos a'
+                         f' = normalise $ scale ca (f o) + scale sa (u o)
+                         u' = normalise $ r o `cross` f'
+                     in  o { u = u', f = f' }
+         roll        a o =
+                     let a' = toRAD a
+                         sa = sin a'
+                         ca = cos a'
+                         u' = normalise $ scale ca (u o) - scale sa (r o)
+                         f' = normalise $ f o `cross` u'
+                     in  o { u = u', f = f' }
+         pos   = p
+         fwd   = f
+         up    = u
+         right = r
+         transform o = M.transform (r o) (u o) (f o) (p o)
+         setTransform t o = Obj3
+                      { r = M.right t
+                      , u = M.up t
+                      , f = M.forward t
+                      , p = M.position t
+                      }
+         setPos pos o = o { p = pos }
+
+fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3
+fromVectors = Obj3
+
+fromTransform :: Matrix4 -> Obj3
+fromTransform m = Obj3 (M.right m) (M.up m) (M.forward m) (M.position m)
+
+toRAD = (*pi) . (/180)
diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs
index ecbe7a1..30211f4 100644
--- a/Spear/Scene/GameObject.hs
+++ b/Spear/Scene/GameObject.hs
@@ -39,6 +39,7 @@ 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 qualified Spear.Math.Spatial3 as S3
 import Spear.Math.Utils
 import Spear.Math.Vector
 import qualified Spear.Render.AnimatedModel as AM
@@ -264,7 +265,7 @@ goRender sprog aprog cam go =
         axis'  = axis go
         a      = angle go
         proj   = Cam.projection cam
-        view   = M4.inverseTransform $ Cam.transform cam
+        view   = M4.inverseTransform $ S3.transform cam
         transf = S2.transform go
         normal = fastNormalMatrix modelview
         modelview = case style of