diff --git a/src/Main.hs b/src/Main.hs index 85a671f..aba5627 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -11,9 +11,12 @@ 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 @@ -44,6 +47,8 @@ main = do -- create abort condition for upcoming lop quit <- liftIO $ STM.newTMVarIO True + time <- liftIO $ STM.newTMVarIO =<< getCurrentTime + average <- liftIO $ STM.newTMVarIO 0 -- main loop whileM_ @@ -51,11 +56,24 @@ main = do ) ( 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 @@ -69,6 +87,12 @@ main = do evs ) + fps <- liftIO $ STM.atomically $ STM.readTMVar average + + liftIO $ hPutStr stdout $ + "\n" <> + "Average FPS: " <> pack (show fps) <> "\n" + Vk.deviceWaitIdle $ engineLogicalDevice engineData createBufferView diff --git a/vulkan-tutorial.cabal b/vulkan-tutorial.cabal index 0a4ac44..6b82e7f 100644 --- a/vulkan-tutorial.cabal +++ b/vulkan-tutorial.cabal @@ -50,6 +50,7 @@ executable vulkan-tutorial , linear , monad-loops , stm + , time , bytestring , text , vector