From 4fc6917741d646e395c7b7ee0fbe27ee773a505d Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Fri, 26 Feb 2021 00:05:27 +0100
Subject: [PATCH] Couple loop with preload to allow for time "profiling"

---
 shader/circle.vert     | 20 +-------------------
 shader/fadeCircle.geom |  9 ---------
 src/Loop.hs            | 24 +++++++++++++++++++-----
 src/Picture/Render.hs  |  7 +++++++
 4 files changed, 27 insertions(+), 33 deletions(-)

diff --git a/shader/circle.vert b/shader/circle.vert
index 471579c43..29925a3c7 100644
--- a/shader/circle.vert
+++ b/shader/circle.vert
@@ -11,27 +11,9 @@ uniform vec2 translation;
 uniform float rotation;
 uniform mat4 worldMat;
 
-mat4 tranMat = mat4
-    ( 1.0, 0.0, 0.0, 0.0
-    , 0.0, 1.0, 0.0, 0.0
-    , 0.0, 0.0, 1.0, 0.0
-    , -translation.x, -translation.y, 0.0, 1.0
-    )   ;
-mat4 rotMat = mat4
-    ( cos(rotation), sin(-rotation), 0.0, 0.0
-    , sin(rotation), cos(rotation), 0.0, 0.0
-    , 0.0, 0.0, 1.0, 0.0
-    , 0.0, 0.0, 0.0, 1.0
-    )   ;
-mat4 scalMat = mat4
-    ( 2*zoom/winSize.x, 0.0, 0.0, 0.0
-    , 0.0, 2*zoom/winSize.y, 0.0, 0.0
-    , 0.0, 0.0, 1.0, 0.0
-    , 0.0, 0.0, 0.0, 1.0
-    )   ;
 void main()
 {
-  gl_Position = scalMat * rotMat * tranMat * vec4(position.xyz,1);
+  gl_Position = worldMat * vec4(position.xyz,1);
   vColor = color;
   vRad = rad;
 }
diff --git a/shader/fadeCircle.geom b/shader/fadeCircle.geom
index 2063f32f2..1f1122440 100644
--- a/shader/fadeCircle.geom
+++ b/shader/fadeCircle.geom
@@ -26,14 +26,5 @@ void main()
   gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, 0.9 , 1);
   EmitVertex();
 
-//  gl_Position = vec4 (0.5,0.5,0 , 1);
-//  EmitVertex();
-//  gl_Position = vec4 (0,0.5,0 , 1);
-//  EmitVertex();
-//  gl_Position = vec4 (0.5,0,0 , 1);
-//  EmitVertex();
-//  gl_Position = vec4 (0,0,0 , 1);
-//  EmitVertex();
-
   EndPrimitive();
 }
diff --git a/src/Loop.hs b/src/Loop.hs
index 158c3fcfb..c0d825797 100644
--- a/src/Loop.hs
+++ b/src/Loop.hs
@@ -12,6 +12,10 @@ import System.Mem
 import Foreign.C
 import Geometry
 
+import Preload
+
+import Control.Lens ((.~),(&))
+
 winConfig x y = defaultWindow 
     { windowGraphicsContext
         = OpenGLContext (defaultOpenGL { glProfile = Core Normal 4 3
@@ -22,13 +26,23 @@ winConfig x y = defaultWindow
     , windowResizable =True
     }
 
+--setupLoop :: String
+--        -> CInt
+--        -> CInt
+--        -> IO setupParams
+--        -> (setupParams -> IO ())
+--        -> world
+--        -> (setupParams -> world -> IO setupParams)
+--        -> (world -> Event -> Maybe world)
+--        -> (world -> Maybe world)
+--        -> IO ()
 setupLoop :: String
         -> CInt
         -> CInt
-        -> IO setupParams
-        -> (setupParams -> IO ())
+        -> IO (PreloadData a)
+        -> (PreloadData a -> IO ())
         -> world
-        -> (setupParams -> world -> IO setupParams)
+        -> (PreloadData a -> world -> IO (PreloadData a))
         -> (world -> Event -> Maybe world)
         -> (world -> Maybe world)
         -> IO ()
@@ -62,11 +76,11 @@ doLoop setup window startWorld
         eventFn 
         worldUpdate 
   = do
+    startLoopTicks <- ticks
     GL.clear [GL.ColorBuffer,GL.DepthBuffer]
-    newParams <- worldSideEffects setup startWorld
+    newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
     glSwapWindow window
     --worldSideEffects setup updatedWorld
-    startLoopTicks <- ticks
     events <- pollEvents
     --let-- maybeUpdatedWorld :: Maybe (WorldView world0)
     --    maybeUpdatedWorld = applyEvents eventFn startWorld events worldUpdate
diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs
index 763f7b5e6..44a211b6f 100644
--- a/src/Picture/Render.hs
+++ b/src/Picture/Render.hs
@@ -398,6 +398,12 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
     renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 2 pic
 -- reset uniforms (hacky for now)
+    idmat <- (newMatrix RowMajor [1,0,0,0
+                                 ,0,1,0,0
+                                 ,0,0,1,0
+                                 ,0,0,0,1
+                                 ]
+             ) :: IO (GLmatrix GLfloat)
     forM_ [_basicShader      pdata
           ,_textShader       pdata
           ,_circShader       pdata
@@ -411,6 +417,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         uniform (snd shad !! 1)  $= (1::Float)
         uniform (snd shad !! 2)  $= (0::Float)
         uniform (snd shad !! 3)  $= Vector2 (0::Float) 0
+        uniform (snd shad !! 4)  $= idmat
     
 
 bufferOffset :: Integral a => a -> Ptr b