{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} module Main where import qualified Control.Concurrent.STM as STM import Control.Monad import Control.Monad.Loops import Control.Monad.IO.Class import Control.Monad.Trans.Resource import Data.Bits import qualified Data.Map.Strict as M import qualified Data.Vector as V import Data.Word import qualified SDL hiding (V2) import System.Mem import qualified Vulkan as Vk import qualified Vulkan.Zero as Vk -- internal imports import Init import Draw (drawFrame) import Types main :: IO () main = do renderablesContainer <- STM.newTMVarIO (V.empty) meshMap <- STM.newTMVarIO (M.empty) materialMap <- STM.newTMVarIO (M.empty) frameNumber <- STM.newTMVarIO 0 let initState = ReadState { renderables = renderablesContainer , meshLibrary = meshMap , materialLibrary = materialMap } runRender initState $ do engineData <- initEngine SDL.showWindow $ engineWindow engineData -- create abort condition for upcoming lop quit <- liftIO $ STM.newTMVarIO True -- main loop whileM_ (liftIO $ STM.atomically $ STM.readTMVar quit ) ( do liftIO performMajorGC number <- liftIO $ STM.atomically $ do number <- STM.readTMVar frameNumber void $ STM.swapTMVar frameNumber (succ number) return number -- draw drawFrame engineData number -- poll events evs <- liftIO SDL.pollEvents -- flip abort condition on window close mapM_ (\e -> case SDL.eventPayload e of SDL.WindowClosedEvent _ -> void $ liftIO $ STM.atomically $ STM.swapTMVar quit False _ -> return () ) evs ) Vk.deviceWaitIdle $ engineLogicalDevice engineData createBufferView :: (MonadResource m) => Vk.Device -> m (ReleaseKey, Vk.BufferView) createBufferView logicalDevice = do let bufferCreateInfo = Vk.zero { Vk.size = 1024 , Vk.usage = Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT .|. Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT , Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE } buffer <- snd <$> (Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate) let bufferViewCreateInfo = Vk.zero { Vk.buffer = buffer , Vk.format = Vk.FORMAT_R32G32B32_SFLOAT , Vk.offset = 0 , Vk.range = Vk.WHOLE_SIZE } Vk.withBufferView logicalDevice bufferViewCreateInfo Nothing allocate allocateMemory :: (MonadResource m) => Vk.Device -> Vk.Buffer -> m (ReleaseKey, Vk.DeviceMemory) allocateMemory logicalDevice buffer = do memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer let memoryAllocateInfo = Vk.zero { Vk.allocationSize = (Vk.size :: Vk.MemoryRequirements -> Word64) memoryRequirements , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String) } Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate