{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedRecordDot #-} 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 Data.ByteString.Char8 import qualified Data.Map.Strict as M import Data.Time.Clock import qualified Data.Vector as V import qualified SDL hiding (V2) import System.IO (stdout) 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) textureMap <- STM.newTMVarIO (M.empty) frameNumber <- STM.newTMVarIO 0 let initState = ReadState { renderables = renderablesContainer , meshLibrary = meshMap , materialLibrary = materialMap , textureLibrary = textureMap } runRender initState $ do engineData <- initEngine SDL.showWindow $ engineWindow engineData -- create abort condition for upcoming lop quit <- liftIO $ STM.newTMVarIO True time <- liftIO $ STM.newTMVarIO =<< getCurrentTime average <- liftIO $ STM.newTMVarIO 0 -- main loop whileM_ (liftIO $ STM.atomically $ STM.readTMVar quit ) ( do liftIO performMajorGC now <- liftIO getCurrentTime before <- liftIO $ STM.atomically $ STM.swapTMVar time now let timeDiff = diffUTCTime now before fps = recip $ nominalDiffTimeToSeconds timeDiff liftIO $ hPutStr stdout $ pack $ "Current FPS: " <> show (floor fps) <> " \r" number <- liftIO $ STM.atomically $ do number <- STM.readTMVar frameNumber if number == 0 then void $ STM.swapTMVar average fps else do oldAverage <- STM.readTMVar average let newAverage = (oldAverage * fromIntegral number + fps) / frameCount frameCount = fromIntegral number + 1 void $ STM.swapTMVar average newAverage void $ STM.swapTMVar frameNumber (succ number) return number -- draw -- liftIO $ putStr $ show (recip $ nominalDiffTimeToSeconds timeDiff) <> "\r" 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 ) fps <- liftIO $ STM.atomically $ STM.readTMVar average liftIO $ hPutStr stdout $ "\n" <> "Average FPS: " <> pack (show fps) <> "\n" 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 = memoryRequirements.size , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String) } Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate