packages feed

keid-core 0.1.9.1 → 0.1.10.0

raw patch · 11 files changed

+79/−35 lines, 11 files

Files

ChangeLog.md view
@@ -1,6 +1,13 @@ # Changelog for keid-core -## TBA+## 0.1.10.0++- Added `ghWindowSize` to replace `ghScreenVar` - a unified var to track window and framebuffer sizes, and their relative scale.+  (So you can use "pixel" sizes when running under scaled rendering a la MacOS.)+- Added `Engine.Setup.Window.Size` and `getSize` to collect that information.+  - A related helper: `askWindowSize` to tie both.++## 0.1.9.1  - Addded new wrappers to `Engine.App``   * `withDataDir` to change directory so the `data` directory will match `./data`.
keid-core.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack  name:           keid-core-version:        0.1.9.1+version:        0.1.10.0 synopsis:       Core parts of Keid engine. category:       Game Engine homepage:       https://keid.haskell-game.dev
src/Engine/Camera.hs view
@@ -27,7 +27,7 @@  import RIO -import Geomancy (Transform(..), Vec3, vec2, vec3)+import Geomancy (Transform(..), Vec3, vec3) import Geomancy.Layout.Box (Box(..)) import Geomancy.Quaternion qualified as Quaternion import Geomancy.Transform qualified as Transform@@ -39,6 +39,7 @@ import Vulkan.Core10 qualified as Vk import Vulkan.NamedType ((:::)) +import Engine.Setup.Window qualified as Window (Size(..)) import Engine.Types qualified as Engine import Engine.Worker qualified as Worker @@ -157,15 +158,14 @@      )   => m (Worker.Merge Box) trackOrthoPixelsCentered = do-  screen <- Engine.askScreenVar-  Worker.spawnMerge1 mkBox screen+  size <- Engine.askWindowSize+  Worker.spawnMerge1 mkBox size   where-    mkBox Vk.Extent2D{width, height} = Box+    mkBox Window.Size{framebuffer} = Box       { position =           -- XXX: Assuming projection uses center of the screen as origin.           0-      , size =-          vec2 (fromIntegral width) (fromIntegral height)+      , size = framebuffer       }
src/Engine/Frame.hs view
@@ -59,7 +59,6 @@         oldSwapchain         windowSize         ghSurface-        ghScreenVar     Just old ->       pure old @@ -186,8 +185,8 @@   where     getNext Frame{..} = do       if needsNewSwapchain then do-        windowSize <- liftIO $ Window.getExtent2D fWindow-        newResources <- recreateSwapchainResources fPresent fMSAA windowSize fSwapchainResources+        framebufferExtent <- liftIO $ Window.getExtent2D fWindow+        newResources <- recreateSwapchainResources fPresent fMSAA framebufferExtent fSwapchainResources          let           formatMatch =
src/Engine/Run.hs view
@@ -6,17 +6,18 @@  import RIO +import GHC.Clock (getMonotonicTimeNSec) import Graphics.UI.GLFW qualified as GLFW import RIO.App (App(..), appEnv) import RIO.State (get, put) import UnliftIO.Resource (ReleaseKey, release) import Vulkan.Core10 qualified as Vk-import GHC.Clock (getMonotonicTimeNSec)  import Engine.DataRecycler (DataRecycler(..)) import Engine.DataRecycler qualified as DataRecycler import Engine.Frame qualified as Frame import Engine.Render (renderFrame)+import Engine.Setup.Window qualified as Window import Engine.StageSwitch (getNextStage) import Engine.Types (Frame, NextStage(..), RecycledResources, StageStack, StackStage(..), Stage(..), StageRIO) import Engine.Types qualified as Engine@@ -24,6 +25,7 @@ import Engine.Types.RefCounted (releaseRefCounted) import Engine.Vulkan.Swapchain (SwapchainResources(srRelease), threwSwapchainError) import Engine.Vulkan.Types (RenderPass, getDevice)+import Engine.Worker qualified as Worker  runStack :: StageStack -> StageRIO (Maybe SwapchainResources) () runStack = \case@@ -147,33 +149,34 @@   -> Maybe Int   -> Frame rp p rr   -> StageRIO st (LoopAction (Frame rp p rr))-step stKey stage@Stage{..} DataRecycler{..} maxFPSM frame = do+step stKey stage@Stage{..} DataRecycler{..} maxFPS_ frame = do   startTime <- liftIO getMonotonicTimeNSec-  liftIO GLFW.pollEvents+  liftIO GLFW.pollEvents -- XXX: runs callback processing on a frame budget    -- XXX: hard unwind all the stages, rendering nothing   quit <- liftIO $ GLFW.windowShouldClose (Frame.fWindow frame)-   if quit then     pure LoopQuit   else     getNextStage >>= \case       Nothing -> do+        Engine.GlobalHandles{ghOptions, ghScreenVar, ghWindow, ghWindowSize} <- asks appEnv         needsNewSwapchain <- threwSwapchainError do-          Engine.GlobalHandles{ghOptions} <- asks appEnv           let recyclerWait = optionsRecyclerWait ghOptions           rs <- get           Frame.run drDump recyclerWait (renderFrame (sUpdateBuffers rs) sRecordCommands) frame         nextFrame <- Frame.advance drWait frame needsNewSwapchain--        for_ maxFPSM \maxFPS -> do+        when needsNewSwapchain do+          newSize <- liftIO (Window.getSize ghWindow)+          Worker.pushInput ghScreenVar $ const newSize.framebufferExtent+          Worker.pushInput ghWindowSize $ const newSize+        for_ maxFPS_ \maxFPS -> do           -- Wait until the end of allocated time.           endTime <- liftIO getMonotonicTimeNSec-          let elapsedUS = (fromEnum $ endTime - startTime) `div` 1e3 :: Int-              fpsCapUS = 1e6 `div` maxFPS-              waitUS = fpsCapUS - min fpsCapUS elapsedUS-          threadDelay waitUS-+          let+            elapsedUS = fromIntegral (endTime - startTime) `div` 1e3+            fpsCapUS = 1e6 `div` maxFPS+          threadDelay $ fpsCapUS - min fpsCapUS elapsedUS         pure $ LoopNextFrame nextFrame       Just Finish ->         -- XXX: finish the stage and proceed with the remaining stack
src/Engine/Setup.hs view
@@ -116,6 +116,8 @@    screen <- liftIO $ Window.getExtent2D ghWindow   ghScreenVar <- Worker.newVar screen+  size <- liftIO (Window.getSize ghWindow)+  ghWindowSize <- Worker.newVar size    ghStageSwitch <- newStageSwitchVar
src/Engine/Setup/Device.hs view
@@ -220,6 +220,8 @@       PhysicalDeviceTimelineSemaphoreFeatures.timelineSemaphore     |]     [Utils.reqs|+      VK_KHR_portability_subset+       PhysicalDeviceFeatures.samplerAnisotropy       PhysicalDeviceFeatures.sampleRateShading     |]
src/Engine/Setup/Window.hs view
@@ -12,6 +12,8 @@   , createSurface    , getExtent2D+  , Size(..)+  , getSize    , GLFWError   , GLFW.Error@@ -21,6 +23,7 @@  import Data.List.NonEmpty qualified as NonEmpty import Foreign qualified+import Geomancy (Vec2, vec2) import Graphics.UI.GLFW qualified as GLFW import RIO.ByteString qualified as BS import RIO.Text qualified as Text@@ -204,3 +207,19 @@ getExtent2D window = do   (width, height) <- GLFW.getFramebufferSize window   pure $ Vk.Extent2D (fromIntegral width) (fromIntegral height)++data Size = Size+  { framebuffer :: Vec2+  , framebufferExtent :: Vk.Extent2D+  , window :: Vec2+  , scale :: Vec2+  } deriving (Eq, Show)++getSize :: GLFW.Window -> IO Size+getSize window' = do+  (display_w, display_h) <- GLFW.getFramebufferSize  window'+  let framebuffer = vec2 (fromIntegral display_w) (fromIntegral display_h)+  let framebufferExtent = Vk.Extent2D (fromIntegral display_w) (fromIntegral display_h)+  (w, h) <- GLFW.getWindowSize window'+  let window = vec2 (fromIntegral w) (fromIntegral h)+  pure Size{scale=framebuffer / window, ..}
src/Engine/Types.hs view
@@ -17,6 +17,7 @@ import VulkanMemoryAllocator qualified as VMA  import Engine.Setup.Window (Window)+import Engine.Setup.Window qualified as Window import Engine.Types.Options (Options) import Engine.Types.RefCounted (RefCounted) import Engine.Vulkan.Swapchain (SwapchainResources(..))@@ -38,6 +39,7 @@   , ghAllocator          :: VMA.Allocator   , ghQueues             :: Vulkan.Queues (QueueFamilyIndex, Vk.Queue)   , ghScreenVar          :: Worker.Var Vk.Extent2D+  , ghWindowSize         :: Worker.Var Window.Size   , ghStageSwitch        :: StageSwitchVar   , ghMonotonicStart     :: Word64   }@@ -47,6 +49,12 @@   :: MonadReader (App GlobalHandles st) m   => m (Worker.Var Vk.Extent2D) askScreenVar = asks $ ghScreenVar . appEnv++{-# INLINE askWindowSize #-}+askWindowSize+  :: MonadReader (App GlobalHandles st) m+  => m (Worker.Var Window.Size)+askWindowSize = asks $ ghWindowSize . appEnv  instance HasVulkan GlobalHandles where   getInstance           = ghInstance
src/Engine/Vulkan/Swapchain.hs view
@@ -31,14 +31,12 @@  import Engine.Types.RefCounted (RefCounted, newRefCounted, releaseRefCounted) import Engine.Vulkan.Types (MonadVulkan, HasVulkan(..), HasSwapchain(..), pdiProperties)-import Engine.Worker qualified as Worker  data SwapchainResources = SwapchainResources   { srInfo       :: SwapchainInfo   , srImageViews :: Vector Vk.ImageView   , srImages     :: Vector Vk.Image   , srRelease    :: RefCounted-  , srScreenVar  :: Worker.Var Vk.Extent2D   }  data SwapchainInfo = SwapchainInfo@@ -78,10 +76,8 @@   -> Vk.Extent2D   -- ^ If the swapchain size determines the surface size, use this size   -> Khr.SurfaceKHR-  -> Worker.Var Vk.Extent2D   -> RIO env SwapchainResources-  -- -> ResourceT (RIO env) SwapchainResources-allocSwapchainResources present msaa oldSwapchain windowSize surface screenVar = do+allocSwapchainResources present msaa oldSwapchain windowSize surface = do   logDebug "Allocating swapchain resources"    device <- asks getDevice@@ -100,14 +96,11 @@     traverse_ release imageViewKeys     release siSwapchainReleaseKey -  Worker.pushInput screenVar $ const windowSize-   pure SwapchainResources     { srInfo       = info     , srImageViews = imageViews     , srImages     = swapchainImages     , srRelease    = releaseResources-    , srScreenVar  = screenVar     }  recreateSwapchainResources@@ -128,7 +121,6 @@     (siSwapchain $ srInfo oldResources)     windowSize     (siSurface $ srInfo oldResources)-    (srScreenVar oldResources)   releaseRefCounted (srRelease oldResources)   pure sr
src/Resource/Collection.hs view
@@ -1,5 +1,6 @@ module Resource.Collection   ( enumerate+  , vectorRanges   , size   , toVector   , toVectorStorable@@ -12,18 +13,29 @@  import Data.List qualified as List import Data.Traversable (mapAccumL)+import Data.Vector qualified as Vector+import Data.Vector.Generic qualified as VectorGeneric+import Data.Vector.Storable qualified as VectorStorable import GHC.Generics (Generic1, Generically1(..))-import RIO.Vector qualified as Vector-import RIO.Vector.Storable qualified as VectorStorable  {-# INLINE size #-} size :: (Foldable t, Num size) => t a -> size size = List.genericLength . toList +{-# INLINE enumerate #-} enumerate :: (Traversable t, Num ix) => t a -> t (ix, a) enumerate = snd . mapAccumL f 0   where     f a b = (a + 1, (a, b))++{-# INLINE vectorRanges #-}+-- | Get collection of (offset, size) from a collection of vectors.+vectorRanges :: (Traversable t, Num ix, VectorGeneric.Vector v a) => t (v a) -> t (ix, ix)+vectorRanges = snd . mapAccumL f 0+  where+    f off b = (off + sz, (off, sz))+      where+        sz = fromIntegral (VectorGeneric.length b)  {-# INLINE toVector #-} toVector :: Foldable collection => collection a -> Vector a