time management

This commit is contained in:
nek0 2019-02-07 15:45:45 +01:00
parent 5b398dea23
commit 12c074f442
2 changed files with 15 additions and 2 deletions

View File

@ -19,6 +19,7 @@ import Options.Applicative
import Control.Monad import Control.Monad
import Control.Monad.Loops import Control.Monad.Loops
import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar import Control.Concurrent.MVar
import qualified Data.Text as T import qualified Data.Text as T
@ -31,6 +32,8 @@ import Data.Maybe
import Data.Time.Clock import Data.Time.Clock
import Data.Word (Word32(..))
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Foreign.C.String import Foreign.C.String
@ -98,13 +101,14 @@ main = do
vebo <- initGL vebo <- initGL
program <- GU.simpleShaderProgramBS vertexShader fragmentShader program <- GU.simpleShaderProgramBS vertexShader fragmentShader
verb opts "Initializing state" verb opts "Initializing state"
time <- getCurrentTime time <- SDL.ticks
state <- newMVar ( state <- newMVar (
State State
1 1
(optFile opts) (optFile opts)
(last $ map fst wins) (last $ map fst wins)
time time
time
wins wins
program program
vebo vebo
@ -121,6 +125,12 @@ main = do
draw state ident draw state ident
SDL.glSwapWindow window SDL.glSwapWindow window
) wins ) wins
st <- readMVar state
now <- SDL.ticks
-- let dt = now - (stLastTime st)
-- verb opts ("dt: " ++ show dt)
-- threadDelay (fromIntegral $ (max 0 ((1000 `div` 30) - dt)))
modifyMVar_ state (\st -> return st { stLastTime = now })
) )
verb opts "Deleting context" verb opts "Deleting context"
SDL.glDeleteContext context SDL.glDeleteContext context

View File

@ -8,6 +8,8 @@ import qualified Graphics.GLUtil as GU
import qualified Data.Text as T import qualified Data.Text as T
import Data.Word (Word32)
import Data.Time.Clock import Data.Time.Clock
data Options = Options data Options = Options
@ -22,7 +24,8 @@ data State = State
{ stCurrentPage :: Word { stCurrentPage :: Word
, stFilename :: T.Text , stFilename :: T.Text
, stPresentationWindow :: Word , stPresentationWindow :: Word
, stStartTime :: UTCTime , stStartTime :: Word32
, stLastTime :: Word32
, stWindows :: [(Word, SDL.Window)] , stWindows :: [(Word, SDL.Window)]
, stProgram :: GU.ShaderProgram , stProgram :: GU.ShaderProgram
, stVEBO :: GLvebo , stVEBO :: GLvebo