implement FPS meter in Console output
This commit is contained in:
parent
1b6a6392ba
commit
def6e56d1f
2 changed files with 25 additions and 0 deletions
24
src/Main.hs
24
src/Main.hs
|
@ -11,9 +11,12 @@ import Control.Monad.Loops
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
import Data.ByteString.Char8
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
|
import Data.Time.Clock
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified SDL hiding (V2)
|
import qualified SDL hiding (V2)
|
||||||
|
import System.IO (stdout)
|
||||||
import System.Mem
|
import System.Mem
|
||||||
import qualified Vulkan as Vk
|
import qualified Vulkan as Vk
|
||||||
import qualified Vulkan.Zero as Vk
|
import qualified Vulkan.Zero as Vk
|
||||||
|
@ -44,6 +47,8 @@ main = do
|
||||||
|
|
||||||
-- create abort condition for upcoming lop
|
-- create abort condition for upcoming lop
|
||||||
quit <- liftIO $ STM.newTMVarIO True
|
quit <- liftIO $ STM.newTMVarIO True
|
||||||
|
time <- liftIO $ STM.newTMVarIO =<< getCurrentTime
|
||||||
|
average <- liftIO $ STM.newTMVarIO 0
|
||||||
|
|
||||||
-- main loop
|
-- main loop
|
||||||
whileM_
|
whileM_
|
||||||
|
@ -51,11 +56,24 @@ main = do
|
||||||
)
|
)
|
||||||
( do
|
( do
|
||||||
liftIO performMajorGC
|
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 <- liftIO $ STM.atomically $ do
|
||||||
number <- STM.readTMVar frameNumber
|
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)
|
void $ STM.swapTMVar frameNumber (succ number)
|
||||||
return number
|
return number
|
||||||
-- draw
|
-- draw
|
||||||
|
-- liftIO $ putStr $ show (recip $ nominalDiffTimeToSeconds timeDiff) <> "\r"
|
||||||
drawFrame engineData number
|
drawFrame engineData number
|
||||||
-- poll events
|
-- poll events
|
||||||
evs <- liftIO SDL.pollEvents
|
evs <- liftIO SDL.pollEvents
|
||||||
|
@ -69,6 +87,12 @@ main = do
|
||||||
evs
|
evs
|
||||||
)
|
)
|
||||||
|
|
||||||
|
fps <- liftIO $ STM.atomically $ STM.readTMVar average
|
||||||
|
|
||||||
|
liftIO $ hPutStr stdout $
|
||||||
|
"\n" <>
|
||||||
|
"Average FPS: " <> pack (show fps) <> "\n"
|
||||||
|
|
||||||
Vk.deviceWaitIdle $ engineLogicalDevice engineData
|
Vk.deviceWaitIdle $ engineLogicalDevice engineData
|
||||||
|
|
||||||
createBufferView
|
createBufferView
|
||||||
|
|
|
@ -50,6 +50,7 @@ executable vulkan-tutorial
|
||||||
, linear
|
, linear
|
||||||
, monad-loops
|
, monad-loops
|
||||||
, stm
|
, stm
|
||||||
|
, time
|
||||||
, bytestring
|
, bytestring
|
||||||
, text
|
, text
|
||||||
, vector
|
, vector
|
||||||
|
|
Loading…
Add table
Reference in a new issue