fix dt computation

This commit is contained in:
nek0 2020-05-04 08:23:03 +02:00
parent 7df3bb8cf6
commit 9ac25d5fca
2 changed files with 33 additions and 25 deletions

View file

@ -8,6 +8,7 @@ import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.MVar
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad (when) import Control.Monad (when)
import Control.DeepSeq (deepseq) import Control.DeepSeq (deepseq)
@ -28,6 +29,15 @@ import Foreign.C.Types (CInt(..))
import Types import Types
instance Affectionate UserData where
loadState = load
preLoop = pre
handleEvents = handle
update = Main.update
draw = Main.draw
cleanUp = clean
hasNextStep = liftIO . readMVar . doNextStep
foreign import ccall unsafe "glewInit" foreign import ccall unsafe "glewInit"
glewInit :: IO CInt glewInit :: IO CInt
@ -47,16 +57,9 @@ main = do
, SDL.windowInitialSize = SDL.V2 600 600 , SDL.windowInitialSize = SDL.V2 600 600
, SDL.windowResizable = True , SDL.windowResizable = True
} }
, SDL.Windowed
) )
] ]
, initScreenMode = SDL.Windowed
, canvasSize = Nothing
, loadState = load
, preLoop = pre
, eventLoop = handle
, updateLoop = update
, drawLoop = draw
, cleanUp = clean
} }
withAffection conf withAffection conf
@ -71,23 +74,28 @@ load = do
nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug])
let fullMatrix = fromList 60 60 randList let fullMatrix = fromList 60 60 randList
-- logIO A.Debug $ prettyMatrix fullMatrix -- logIO A.Debug $ prettyMatrix fullMatrix
empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection UserData ())]) empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection ())])
empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection UserData ())]) empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection ())])
return $ UserData step <- NewMVar True
(\life food time -> UserData
{ subsystems = Subsystems { subsystems = Subsystems
(Window empty1) (Window empty1)
(Keyboard empty3) (Keyboard empty3)
, lifeMat = fullMatrix , lifeMat = life
, foodMat = fromList 60 60 (repeat 10) , foodMat = food
, timeMat = M.zero 60 60 , timeMat = time
, nano = nanoCtx , nano = nanoCtx
, doNextStep = step
} }
)
<$> newMVar fullMatrix
<*> (newMVar (fromList 60 60 (repeat 10)))
<*> (newMVar (M.zero 60 60))
pre :: Affection UserData () pre :: UserData -> Affection ()
pre = do pre ud = do
sd <- getAffection _ <- partSubscribe (subKeyboard $ subsystems sd) (exitOnEsc (doNextStep ud))
_ <- partSubscribe (subKeyboard $ subsystems sd) exitOnEsc _ <- partSubscribe (subKeyboard $ subsystems sd) (reloadOnR ud)
_ <- partSubscribe (subKeyboard $ subsystems sd) reloadOnR
_ <- partSubscribe (subKeyboard $ subsystems sd) showFPS _ <- partSubscribe (subKeyboard $ subsystems sd) showFPS
_ <- partSubscribe (subKeyboard $ subsystems sd) toggleFullScreen _ <- partSubscribe (subKeyboard $ subsystems sd) toggleFullScreen
_ <- partSubscribe (subWindow $ subsystems sd) exitOnWindowClose _ <- partSubscribe (subWindow $ subsystems sd) exitOnWindowClose

View file

@ -127,12 +127,12 @@ withAffection AffectionConfig{..} = do
-- actual displaying of newly drawn frame -- actual displaying of newly drawn frame
mapM_ (SDL.glSwapWindow . (\(_,y,_) -> y)) windows mapM_ (SDL.glSwapWindow . (\(_,y,_) -> y)) windows
-- -- save new time -- -- save new time
-- ad3 <- get ad3 <- get
-- when (sysTime ad == sysTime ad3) ( when (sysTime ad == sysTime ad3) (
-- put ad3 put ad3
-- { sysTime = now { sysTime = now
-- } }
-- ) )
) )
) )
) initContainer ) initContainer