wiered camera

src/Main.hs

@@ -24,7 +24,7 @@ import qualified Data.Vector.Storable as V
 
 import Map.Map
 import Render.Render (initShader)
-import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum, checkError)
+import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum, checkError, lookAt)
 
 --------------------------------------------------------------------------------
 
@@ -233,7 +233,7 @@ run = do
     processEvents
 
     -- update State
-    {-
+    
     state <- get
     if stateDragging state
       then do
@@ -244,10 +244,19 @@ run = do
           (x, y) <- liftIO $ GLFW.getCursorPos win
           let myrot = (x - sodx) / 2
               mxrot = (y - sody) / 2
+              newXAngle = if newXAngle' > pi then pi else
+                            if newXAngle' < 0 then 0 else
+                                newXAngle'
+              newXAngle' = sodxa - mxrot/100
+              newYAngle = if newYAngle' > 2*pi then newYAngle'-2*pi else
+                            if newYAngle' < 0 then newYAngle'+2*pi else
+                                newYAngle'
+              newYAngle' = sodya - myrot/100
           put $ state
-            { stateXAngle = sodxa + mxrot
+            { stateXAngle = newXAngle
-            , stateYAngle = sodya + myrot
+            , stateYAngle = newYAngle
             }
+          liftIO $ putStrLn $ unwords $ map show $ [newXAngle, newYAngle]
       else do
           (kxrot, kyrot) <- liftIO $ getCursorKeyDirections win
           (jxrot, jyrot) <- liftIO $ getJoystickDirections GLFW.Joystick'1
@@ -255,7 +264,7 @@ run = do
             { stateXAngle = stateXAngle state + (2 * kxrot) + (2 * jxrot)
             , stateYAngle = stateYAngle state + (2 * kyrot) + (2 * jyrot)
             }
-    -}
+
     {-
     --modify the state with all that happened in mt time. 
     mt <- liftIO GLFW.getTime
@@ -383,8 +392,8 @@ draw :: Pioneer ()
 draw = do
     env   <- ask
     state <- get
-    let xa = stateXAngle state
+    let xa = fromRational $ toRational $ stateXAngle state
-        ya = stateYAngle state
+        ya = fromRational $ toRational $ stateYAngle state
         za = stateZAngle state
         (GL.UniformLocation proj)  = shdrProjMatIndex state
         (GL.UniformLocation mmat)  = shdrModelMatIndex state
@@ -405,8 +414,8 @@ draw = do
 
         let perspective = V4 (V4 s 0        0           0)
                              (V4 0 s        0           0)
-                             (V4 0 0 (-(f/(f - n)))  (-1))
+                             (V4 0 0 (-((f+n)/(f-n)))  (-((2*f*n)/(f-n))))
-                             (V4 0 0 (-((f*n)/(f-n)))   1)
+                             (V4 0 0      (-1)          0)
                          !*!
                           V4 (V4 1 0 0 0)
                              (V4 0 0 1 0)
@@ -415,15 +424,25 @@ draw = do
         with (distribute $ perspective) $ \ptr ->
               GL.glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
         --V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
-        let cam     = crot !*! ctrans
+        let cam     = lookAt (V3 5 0 5) (crot' !* cdist') up
-            ctrans  = (eye4 & translation .~ V3 (-5) (-10) (-10)) :: M44 CFloat
+                        --cdist !*! crot !*! camat
+            camat   = (eye4 & translation .~ V3 (-0.5) (0) (-0.5)) :: M44 CFloat
+            cdist   = (eye4 & translation .~ V3 (0) (0) (-10)) :: M44 CFloat
             crot    = (m33_to_m44 $
                             (fromQuaternion $
-                                axisAngle (V3 1 0 0) (pi/4))
+                                axisAngle (V3 1 0 0) (xa::CFloat))
                             !*!
                             (fromQuaternion $
-                                axisAngle (V3 0 1 0) (pi/16))
+                                axisAngle (V3 0 1 0) (ya::CFloat))
                                 ) :: M44 CFloat
+            cdist'   = V3 (0) (0) (-10)
+            crot'    = (
+                            (fromQuaternion $
+                                axisAngle (V3 1 0 0) (xa::CFloat))
+                            !*!
+                            (fromQuaternion $
+                                axisAngle (V3 0 1 0) (ya::CFloat))
+                                ) :: M33 CFloat
         --V.unsafeWith model $ \ptr -> GL.glUniformMatrix4fv mmat 1 0 ptr
         with (distribute $ cam) $ \ptr ->
               GL.glUniformMatrix4fv mmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))

src/Render/Misc.hs

@@ -4,16 +4,17 @@ import           Control.Monad
 import qualified Data.ByteString                            as B (ByteString)
 import           Foreign.Marshal.Array                      (allocaArray,
                                                              pokeArray)
+import Foreign.C (CFloat)
 import           Graphics.Rendering.OpenGL.GL.Shaders
 import           Graphics.Rendering.OpenGL.GL.StateVar
 import           Graphics.Rendering.OpenGL.GL.StringQueries
 import           Graphics.Rendering.OpenGL.GLU.Errors
 import           Graphics.Rendering.OpenGL.Raw.Core31
 import           System.IO                                  (hPutStrLn, stderr)
+import Linear
 
-
+up :: V3 CFloat
-up :: (Double, Double, Double)
+up = V3 0 1 0
-up = (0.0, 1.0, 1.0)
 
 checkError :: String -> IO ()
 checkError functionName = get errors >>= mapM_ reportError
@@ -126,9 +127,28 @@ infixl 5 ><
                 ]
 _ >< _ = error "non-conformat matrix-multiplication"
 
+
+lookAt :: V3 CFloat -> V3 CFloat -> V3 CFloat -> M44 CFloat
+lookAt at eye@(V3 ex ey ez) up =
+        V4
+         (V4 xx yx zx 0)
+         (V4 xy yy zy 0)
+         (V4 xz yz zz 0)
+         (V4 0 0 0 1)
+        !*!
+        V4
+         (V4 1 0 0 (-ex))
+         (V4 0 1 0 (-ey))
+         (V4 0 0 1 (-ez))
+         (V4 0 0 0 1)
+        where
+                z@(V3 zx zy zz) = normalize (eye ^-^ at)
+                x@(V3 xx xy xz) = normalize (cross up z)
+                y@(V3 yx yy yz) = cross z x
+
 -- generates 4x4-Projection-Matrix
-lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
+lookAt_ :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
-lookAt at eye up =
+lookAt_ at eye up =
         map (fromRational . toRational) [
          xx, yx, zx, 0,
          xy, yy, zy, 0,