Fixed rotation

3 files changed, 53 insertions, 115 deletions

diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs
index 86d6f9e..e7062ab 100644
--- a/Spear/Math/Camera.hs
+++ b/Spear/Math/Camera.hs
@@ -15,17 +15,19 @@ module Spear.Math.Camera
 )
 where
 
-
 import qualified Spear.Math.Matrix4 as M
 import Spear.Math.Spatial3
 import Spear.Math.Vector
 
-
 data Camera = Camera
     { projection :: M.Matrix4 -- ^ Get the camera's projection.
     , spatial    :: Obj3
     }
 
+instance Spatial3 Camera where
+    getObj3 = spatial
+    setObj3 cam o = cam { spatial = o }
+
 type Fovy = Float
 type Aspect = Float
 type Near = Float
@@ -71,21 +73,3 @@ ortho l r b t n f right up fwd pos =
     { projection = M.ortho l r b t n f
     , spatial    = fromVectors right up fwd 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/Spatial3.hs b/Spear/Math/Spatial3.hs
index 2bc772e..7d0420a 100644
--- a/Spear/Math/Spatial3.hs
+++ b/Spear/Math/Spatial3.hs
@@ -11,50 +11,99 @@ import Spear.Math.Vector
 import Spear.Math.Matrix4 as M hiding (scale)
 
 class Spatial3 s where
+    -- | Gets the spatial's internal Obj3.
+    getObj3 :: s -> Obj3
+
+    -- | Set the spatial's internal Obj3.
+    setObj3 :: s -> Obj3 -> s
+
     -- | Move the spatial.
     move :: Vector3 -> s -> s
+    move d s = let o = getObj3 s in setObj3 s $ o { p = p o + d }
 
     -- | Move the spatial forwards.
     moveFwd :: Float -> s -> s
+    moveFwd a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (f o) }
 
     -- | Move the spatial backwards.
     moveBack :: Float -> s -> s
+    moveBack a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (f o) }
 
     -- | Make the spatial strafe left.
     strafeLeft :: Float -> s -> s
+    strafeLeft a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (r o) }
 
     -- | Make the spatial Strafe right.
     strafeRight :: Float -> s -> s
+    strafeRight a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (r o) }
 
     -- | Rotate the spatial about its local X axis.
     pitch :: Float -> s -> s
+    pitch a s =
+          let o  = getObj3 s
+              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  setObj3 s $ o { u = u', f = f' }
 
     -- | Rotate the spatial about its local Y axis.
     yaw :: Float -> s -> s
+    yaw a s =
+        let o  = getObj3 s
+            a' = toRAD a
+            sa = sin a'
+            ca = cos a'
+            r' = normalise $ scale ca (r o) + scale sa (f o)
+            f' = normalise $ u o `cross` r'
+        in  setObj3 s $ o { r = r', f = f' }
 
     -- | Rotate the spatial about its local Z axis.
     roll :: Float -> s -> s
+    roll a s =
+         let o  = getObj3 s
+             a' = toRAD a
+             sa = sin a'
+             ca = cos a'
+             u' = normalise $ scale ca (u o) - scale sa (r o)
+             r' = normalise $ f o `cross` u'
+         in  setObj3 s $ o { r = r', u = u' }
 
     -- | Get the spatial's position.
     pos :: s -> Vector3
+    pos = p . getObj3
 
     -- | Get the spatial's forward vector.
     fwd :: s -> Vector3
+    fwd = f . getObj3
 
     -- | Get the spatial's up vector.
     up :: s -> Vector3
+    up = u . getObj3
 
     -- | Get the spatial's right vector.
     right :: s -> Vector3
+    right = r . getObj3
 
     -- | Get the spatial's transform.
     transform :: s -> Matrix4
+    transform s = let o = getObj3 s in M.transform (r o) (u o) (scale (-1) $ f o) (p o)
 
     -- | Set the spatial's transform.
     setTransform :: Matrix4 -> s -> s
+    setTransform t s =
+                 let o = Obj3
+                       { r = M.right t
+                       , u = M.up t
+                       , f = scale (-1) $ M.forward t
+                       , p = M.position t
+                       }
+                 in setObj3 s o
 
     -- | Set the spatial's position.
     setPos :: Vector3 -> s -> s
+    setPos pos s = setObj3 s $ (getObj3 s) { p = pos }
 
     -- | Make the spatial look at the given point.
     lookAt :: Vector3 -> s -> s
@@ -95,46 +144,6 @@ data Obj3 = Obj3
      , 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
 
diff --git a/Spear/Scene/Light.hs b/Spear/Scene/Light.hs
index 5f43b19..f63b91d 100644
--- a/Spear/Scene/Light.hs
+++ b/Spear/Scene/Light.hs
@@ -29,58 +29,3 @@ data Light
     , specular  :: Vector3
     , transform :: M.Matrix4
     }
-
-
-instance S.Spatial3 Light where
-    move _ l@DirectionalLight {} = l
-    move v l = l { transform = M.translv v * transform l}
-    
-    moveFwd _ l@DirectionalLight {} = l
-    moveFwd f l = l { transform = M.translv (scale f $ S.fwd l) * transform l }
-    
-    moveBack _ l@DirectionalLight {} = l
-    moveBack f l = l { transform = M.translv (scale (-f) $ S.fwd l) * transform l }
-    
-    strafeLeft _ l@DirectionalLight {} = l
-    strafeLeft f l = l { transform = M.translv (scale (-f) $ S.right l) * transform l }
-    
-    strafeRight _ l@DirectionalLight {} = l
-    strafeRight f l = l { transform = M.translv (scale f $ S.right l) * transform l }
-    
-    pitch _ l@DirectionalLight {} = l
-    pitch a l = l { transform = transform l * M.axisAngle (S.right l) a }
-    
-    yaw _ l@DirectionalLight {} = l
-    yaw a l = l { transform = transform l * M.axisAngle (S.up l) a }
-    
-    roll _ l@DirectionalLight {} = l
-    roll a l = l { transform = transform l * M.axisAngle (S.fwd l) a }
-    
-    pos l@DirectionalLight {} = vec3 0 0 0
-    pos l = M.position . transform $ l
-    
-    fwd (DirectionalLight _ _ _ f) = f
-    fwd l = M.forward . transform $ l
-    
-    up l@DirectionalLight {} = vec3 0 1 0
-    up l = M.up . transform $ l
-    
-    right l@DirectionalLight {} = vec3 1 0 0
-    right l = M.right . transform $ l
-    
-    transform (PointLight _ _ _ transf) = transf
-    transform (DirectionalLight _ _ _ fwd) =
-        let up'   = vec3 0 1 0
-            right = up `cross` fwd
-            up    = fwd `cross` right
-        in
-            M.transform up right fwd (vec3 0 0 0)
-    transform (SpotLight _ _ _ transf) = transf
-    
-    setTransform _ l@DirectionalLight {} = l
-    setTransform t l = l { Spear.Scene.Light.transform = t }
-    
-    setPos _ l@DirectionalLight {} = l
-    setPos pos l =
-        let t = Spear.Scene.Light.transform l
-        in l { transform = M.transform (M.right t) (M.up t) (M.forward t) pos }