Windows working

ghengin-core/ghengin-core.cabal

@@ -143,7 +143,7 @@ executable planets-core
         ghengin-vulkan,
         ghengin-core-indep,
         mtl, vector, hsnoise, containers, random, linear-base,
-        derive-storable, geomancy, vulkan
+        derive-storable, geomancy, vulkan, time
 
     ghc-options: -dcmm-lint -dstg-lint -dasm-lint -g2 -rtsopts -debug -Wno-partial-type-signatures
     cpp-options: -DDEBUG

ghengin-core/ghengin-core/Ghengin/Core/Renderer.hsig

@@ -33,3 +33,7 @@ withCurrentFramePresent :: Int -- ^ Current frame index
                            )
                          ⊸ Renderer a
 
+-- A bit GLFW-centric, but passable...
+shouldCloseWindow :: Renderer Bool
+pollWindowEvents :: Renderer ()
+

ghengin-core/planets-core/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE PostfixOperators #-}
@@ -27,13 +28,15 @@ The main function
 module Main where
 
 import qualified Prelude
+import Data.Time
 import Data.Coerce
 import Foreign.Storable
 import Ghengin.Core.Prelude as Linear
 import Ghengin.Core.Render.Packet
 import Ghengin.Core.Render.Property
 import Ghengin.Core.Render
 import Ghengin.Core.Shader (StructVec3(..), StructMat4(..))
+import Ghengin.Core.Log
 import Ghengin.Core
 import Geomancy.Mat4
 import Geomancy.Vec4
@@ -82,9 +85,31 @@ makeMainPipeline = Linear.do
     :## GHNil                       )
 
 main :: Prelude.IO ()
-main = withLinearIO $
+main = do
+ currTime <- getCurrentTime
+ withLinearIO $
   runCore Linear.do
     pipeline <- (makeMainPipeline ↑)
+    gameLoop currTime
     (destroyRenderPipeline pipeline ↑)
     return (Ur ())
 
+gameLoop :: UTCTime -> Core ()
+gameLoop currentTime = Linear.do
+ logT "New frame" 
+ should_close <- (shouldCloseWindow ↑)
+ if should_close then return () else Linear.do
+  (pollWindowEvents ↑)
+
+  Ur newTime <- liftSystemIOU getCurrentTime
+
+  -- Fix Your Timestep: A Very Hard Thing To Get Right. For now, the simplest approach:
+  let frameTime = diffUTCTime newTime currentTime
+      deltaTime = Prelude.min MAX_FRAME_TIME $ realToFrac frameTime
+
+  -- Loop!
+  gameLoop newTime
+
+
+pattern MAX_FRAME_TIME :: Float
+pattern MAX_FRAME_TIME = 0.5

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer.hs

@@ -61,7 +61,7 @@ import Ghengin.Vulkan.Renderer.Device
 import Ghengin.Vulkan.Renderer.SwapChain
 import Ghengin.Vulkan.Renderer.Command
 import Ghengin.Vulkan.Renderer.Frame
-import Ghengin.Vulkan.Renderer.GLFW.Window
+import Ghengin.Vulkan.Renderer.GLFW.Window as GLFW
 import Ghengin.Vulkan.Renderer.ImmediateSubmit
 import Ghengin.Vulkan.Renderer.Kernel
 import qualified System.IO.Linear as Linear
@@ -301,6 +301,14 @@ rateFn surface d = do
         isSuitablePresent :: Int -> Prelude.IO Bool
         isSuitablePresent  i = Vk.getPhysicalDeviceSurfaceSupportKHR pd (Prelude.fromIntegral i) sr
 
+shouldCloseWindow :: Renderer Bool
+shouldCloseWindow = renderer $ Unsafe.toLinear $ \renv@(REnv{..}) -> Linear.do
+  b <- liftSystemIO (GLFW.windowShouldClose _vulkanWindow._window)
+  pure $ (b, renv)
+
+pollWindowEvents :: Renderer ()
+pollWindowEvents = liftSystemIO $ GLFW.pollEvents
+
 
 -- :| Utils |:
 

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/GLFW/Window.hs

@@ -9,8 +9,8 @@
 -- | TODO: One day, abstract over window API too
 module Ghengin.Vulkan.Renderer.GLFW.Window
   (VulkanWindow(..), createVulkanWindow, destroyVulkanWindow, loopUntilClosedOr
-  , initGLFW, terminateGLFW
-  , GLFWToken
+  , GLFW.windowShouldClose, GLFW.pollEvents
+  , initGLFW, terminateGLFW , GLFWToken
   ) where
 
 import GHC.Int (Int32)
@@ -90,15 +90,15 @@ loopUntilClosedOr = loopUntilClosedOr' False
   loopUntilClosedOr' shouldClose win (Ur s) action =
     if shouldClose then pure (win,Ur s)
     else Linear.do
-      windowShouldClose win >>= \case
+      wShouldClose win >>= \case
         (True , win') -> pure (win', Ur s)
         (False, win') -> Linear.do
           liftSystemIO GLFW.pollEvents
           (shouldClose',Ur s') <- action (Ur s)
           loopUntilClosedOr' shouldClose' win' (Ur s') action
       where
-        windowShouldClose :: GLFW.Window ⊸ m (Bool, GLFW.Window)
-        windowShouldClose = Unsafe.toLinear \w -> (,w) <$> liftSystemIO (GLFW.windowShouldClose w)
+        wShouldClose :: GLFW.Window ⊸ m (Bool, GLFW.Window)
+        wShouldClose = Unsafe.toLinear \w -> (,w) <$> liftSystemIO (GLFW.windowShouldClose w)
 
 data GLFWToken = GLFWToken