136 lines
4.2 KiB
Haskell
136 lines
4.2 KiB
Haskell
{-# 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
|