Camera object.

1 files changed, 58 insertions, 3 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 9c6c457..675c388 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -43,8 +43,46 @@ import Matrix
 data State = State
     { stTimeKeeper   :: TimeKeeper
     , stTickCallback :: TickCallbackHandle
+    , stCamera       :: IORef Camera
     }
 
+data Camera = Camera
+    { camHeightAngle   :: Float
+    , camTarget        :: Vector Float
+    , camDirection     :: Vector Float
+    , camDistance      :: Float
+    , camWidth         :: Float
+    , camHeight        :: Float
+    , camUp            :: Vector Float
+    , camWorldToScreen :: Maybe (Matrix Float)
+    , camScreenToWorld :: Maybe (Matrix Float)
+    }
+
+initCamera :: Camera
+initCamera = Camera
+    { camHeightAngle = pi/6
+    , camTarget      = fromList [0,0,0]
+    , camDirection   = scale (1/d) $ fromList [-2,-2,-10]
+    , camDistance    = d
+    , camWidth       = 700
+    , camHeight      = 700
+    , camUp          = fromList [0,1,0]
+    , camWorldToScreen = Nothing
+    , camScreenToWorld = Nothing
+    }
+    where d = realToFrac $ norm_2 $ fromList [2::Float,2,10]
+
+viewProjection :: Camera -> (Camera,(Matrix Float,Vector Float))
+viewProjection c
+    | Just m <- camWorldToScreen c = (c,(m,pos))
+    | otherwise                    = (c { camWorldToScreen = Just m' }, (m',pos))
+ where
+    m' = proj <> cam
+    cam = lookat pos (camTarget c) (camUp c)
+    pos = camTarget c - scale (camDistance c) (camDirection c)
+    proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c)
+
+
 addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object]
 addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do
   obj <- LC.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] mesh
@@ -70,11 +108,13 @@ uploadState obj glarea storage = do
 
     -- setup FrameClock
     tm <- newTimeKeeper
+    cam <- newIORef initCamera
     tickcb <- widgetAddTickCallback glarea (tick tm)
 
     return State
         { stTimeKeeper   = tm
         , stTickCallback = tickcb
+        , stCamera       = cam
         }
 
 destroyState :: GLArea -> State -> IO ()
@@ -89,12 +129,23 @@ setUniforms gl storage st = do
     t <- (/ 10.0) <$> getSeconds (stTimeKeeper st)
     let tf = realToFrac t :: Float
         rot = rotMatrixZ (-tf) <> rotMatrixX (-tf)
-        pos = rot #> fromList [2,2,10]
+    modifyIORef (stCamera st) $ \cam -> cam
+                            { camUp            = rot #> fromList [0,1,0]
+                            , camDirection     = (scale (1/camDistance cam) $ fromList [-2,-2,-10]) <# rot
+                            , camWorldToScreen = Nothing
+                            , camScreenToWorld = Nothing
+                            }
+
+    (mvp,pos) <- atomicModifyIORef' (stCamera st) viewProjection
+
+    {-
+    let pos = rot #> fromList [2,2,10]
         up = rot #> fromList [0,1,0]
-        cam = lookat pos 0 up
+        view = lookat pos 0 up
         aspect = 1
         proj = perspective 0.1 100 deg30 aspect
-        mvp = proj <> cam
+        mvp = proj <> view
+    -}
 
     LC.updateUniforms storage $ do
       "CameraPosition" @= return (pos :: Vector Float)
@@ -187,4 +238,8 @@ onResize glarea realized w h = do
         (wd,ht) <- do wd <- windowGetWidth win
                       ht <- windowGetHeight win
                       return (fromIntegral wd,fromIntegral ht)
+        modifyIORef' (stCamera $ stState realized)
+                  $ \c -> c { camWidth  = fromIntegral wd
+                            , camHeight = fromIntegral ht
+                            }
         LC.setScreenSize (stStorage realized) wd ht)