MeshSketch: send camera matrix to pipeline code.

1 files changed, 31 insertions, 3 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 30d14b7..45e5710 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -8,18 +8,22 @@ import qualified Data.Aeson as JSON
 import qualified Data.ByteString as SB
 import Data.Coerce
 import Data.Functor
+import qualified Data.Map as Map
 import Data.IORef
 import Foreign.C.Types
 import GI.Gdk
 import GI.GObject.Functions
 import GI.Gtk hiding (IsWindow,windowFullscreen,windowUnfullscreen)
-import Numeric.LinearAlgebra
+import Numeric.LinearAlgebra hiding ((<>))
 import LambdaCube.GL as LC
+-- import LambdaCube.GL.Type as LC
 import LambdaCube.IR
 import System.IO.Error
 
-import LambdaCube.Gtk
 import CubeMap
+import LambdaCube.GL.HMatrix ()
+import LambdaCube.Gtk
+import Matrix
 
 data MeshMaker = MeshMaker
     { mmWidget   :: GLArea
@@ -33,6 +37,7 @@ data Camera = Camera
     , camDistance      :: Float
     , camWidth         :: Float
     , camHeight        :: Float
+    , camUp            :: Vector Float
     , camWorldToScreen :: Maybe (Matrix Float)
     , camScreenToWorld :: Maybe (Matrix Float)
     }
@@ -56,10 +61,22 @@ initCamera = Camera
     , camDistance    = 10
     , camWidth       = 0
     , camHeight      = 0
+    , camUp          = fromList [0,1,0]
     , camWorldToScreen = Nothing
     , camScreenToWorld = Nothing
     }
 
+viewProjection :: Camera -> (Camera,Matrix Float)
+viewProjection c
+    | Just m <- camWorldToScreen c = (c,m)
+    | otherwise                    = (c { camWorldToScreen = Just m' }, m')
+ 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)
+
+
 new :: IO GLArea
 new = do
     w <- gLAreaNew
@@ -80,6 +97,9 @@ loadPipeline = do
     let inputSchema = makeSchema $ do
           defObjectArray "skypoints" Points $ do
             "position"  @: Attribute_V3F
+          defUniforms $ do
+            "Cam"    @: M44F
+            "Skybox" @: FTextureCube
     return $ (,) inputSchema <$> pipelineDesc
 
 
@@ -144,8 +164,16 @@ onUnrealize (MeshMaker w ref) = do
 onRender :: w -> State -> GLContext -> IO Bool
 onRender w st gl = do
     putStrLn "render"
+    mat_vp <- atomicModifyIORef' (stCamera st) viewProjection
     r <- fixupRenderTarget (stRenderer st)
-    --  lcSetUniforms lc gl s x
+    {-
+    let ks = Map.keys $ uniformSetup (stStorage st)
+        us = uniforms (stSchema st)
+    print (us,ks)
+    -}
+    LC.updateUniforms (stStorage st) $ do
+      "Cam" @= return mat_vp
+    -- todo Skybox texture
     LC.renderFrame r
     return True