mainObj.hs: Slower animation, more straight-forward grid calculation.

3 files changed, 31 insertions, 16 deletions

diff --git a/InfinitePlane.hs b/InfinitePlane.hs
index 9dd3a59..f353932 100644
--- a/InfinitePlane.hs
+++ b/InfinitePlane.hs
@@ -32,6 +32,9 @@ xyplane_inf = Mesh
         ]
     }
 
+times1000 (V4 a b c d) = V4 (f a) (f b) (f c) d where f = (* 10000.0)
+
+
 -- | This represents the xy-plane as a large triangle.  This makes it easier
 -- to interpolate 3d world coordinates in the fragment.
 xyplane :: LambdaCubeGL.Mesh
@@ -45,5 +48,18 @@ xyplane = Mesh
         [ 0, 1, 2
         ]
     }
-    where times1000 (V4 a b c d) = V4 (f a) (f b) (f c) d where f = (* 10000.0)
+
+-- | This represents the xz-plane as a large triangle.  This makes it easier
+-- to interpolate 3d world coordinates in the fragment.
+xzplane :: LambdaCubeGL.Mesh
+xzplane = Mesh
+    { mAttributes = Map.singleton "position" $ A_V4F $ V.fromList $ map times1000
+        [ V4             0 0             1 1
+        , V4    (1/sqrt 2) 0 ((-1)/sqrt 2) 1
+        , V4 ((-1)/sqrt 2) 0 ((-1)/sqrt 2) 1
+        ]
+    , mPrimitive = P_TrianglesI $ V.fromList
+        [ 0, 1, 2
+        ]
+    }
 
diff --git a/hello_obj2.lc b/hello_obj2.lc
index 5a95ad7..d0fc35b 100644
--- a/hello_obj2.lc
+++ b/hello_obj2.lc
@@ -7,7 +7,8 @@ blendplane = -- NoBlending -- BlendLogicOp Xor
           ((OneBF,SrcAlpha),(DstAlpha,DstAlpha))
           (V4 0 0 0 0)
 
-makeFrame (cam ::  Mat 4 4 Float)
+makeFrame (cameraPosition :: Vec 3 Float)
+          (cam ::  Mat 4 4 Float)
           (color :: Vec 4 Float)
           (texture :: Texture)
           (prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
@@ -22,21 +23,17 @@ makeFrame (cam ::  Mat 4 4 Float)
     & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
   `overlay`
       plane
-    & mapPrimitives (\((p)) -> (coordmap cam p, p%xy ))
+    & mapPrimitives (\((p)) -> let p' = coordmap cam p in (p', p%xz))
     & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth))
-    -- & mapFragments (\((uv)) -> ((texture2D (Sampler PointFilter MirroredRepeat texture) uv )))
-    -- & mapFragments (\((uv)) -> ((V4 uv%x uv%y 0 1))) -- ((rgb 1 0 0)))
-    & mapFragments (\((uv)) -> let k=cos(g *! (8 * pi / 4))
-                                   g=uv -- *! (1 + sqrt (abs (t%x * t%y)))
-                                   t=normalize uv
-                                   c=k -- *! ( t%x * t%y) -- /! ((k%x + k%y) / k%x)
-                                   r = V4 1 1 1 0 *! smoothstepS 0.99 1.0 (max c%x c%y)
+    & mapFragments (\((uv)) -> let c = mixB zero one (fract uv >= (one *! (0.95::Float)))
+                                   r = V4 1 1 1 0 *! (max c%x c%y)
                                 in ((r + V4 0 0 0 (0.8))))
     & accumulateWith (DepthOp Less True, ColorOp blendplane (V4 True True True True))
 
 
 main = renderFrame $
-   makeFrame (Uniform "cam")
+   makeFrame (Uniform "CameraPosition")
+             (Uniform "ViewProjection")
              (Uniform "diffuseColor")
              (Texture2DSlot "diffuseTexture")
              (fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw"))
diff --git a/mainObj.hs b/mainObj.hs
index 0d53a26..970f94c 100644
--- a/mainObj.hs
+++ b/mainObj.hs
@@ -59,7 +59,7 @@ uploadState obj glarea storage = do
     -- add OBJ to pipeline input
     addOBJToObjectArray storage "objects" objMesh gpuMtlLib
     -- grid plane
-    uploadMeshToGPU xyplane >>= addMeshToObjectArray storage "plane" []
+    uploadMeshToGPU xzplane >>= addMeshToObjectArray storage "plane" []
 
     -- setup FrameClock
     tm <- newTimeKeeper
@@ -79,10 +79,10 @@ deg30 = pi/6
 
 setUniforms :: glctx -> GLStorage -> State -> IO ()
 setUniforms gl storage st = do
-    t <- getSeconds $ stTimeKeeper st
+    t <- (/ 10.0) <$> getSeconds (stTimeKeeper st)
     let tf = realToFrac t :: Float
         rot = rotMatrixZ (-tf) <> rotMatrixX (-tf)
-        pos = rot #> fromList [0,0,10]
+        pos = rot #> fromList [2,2,10]
         up = rot #> fromList [0,1,0]
         cam = lookat pos 0 up
         aspect = 1
@@ -90,7 +90,8 @@ setUniforms gl storage st = do
         mvp = proj <> cam
 
     LC.updateUniforms storage $ do
-      "cam" @= return (mvp :: Matrix Float)
+      "CameraPosition" @= return (pos :: Vector Float)
+      "ViewProjection" @= return (mvp :: Matrix Float)
 
 main :: IO ()
 main = do
@@ -105,7 +106,8 @@ main = do
           defObjectArray "plane" Triangles $ do
             "position"  @: Attribute_V4F
           defUniforms $ do
-            "cam"             @: M44F
+            "CameraPosition"  @: V3F
+            "ViewProjection"  @: M44F
             "diffuseTexture"  @: FTexture2D
             "diffuseColor"    @: V4F
         return $ (,) <$> mobj <*> mpipeline