diff --git a/examples/example01/Main.hs b/examples/example01/Main.hs index 28a5dd9..8864712 100644 --- a/examples/example01/Main.hs +++ b/examples/example01/Main.hs @@ -8,6 +8,7 @@ import qualified SDL import qualified Graphics.Rendering.OpenGL as GL import Control.Concurrent.STM +import Control.Concurrent.MVar import Control.Monad.IO.Class (liftIO) import Control.Monad (when) import Control.DeepSeq (deepseq) @@ -28,6 +29,15 @@ import Foreign.C.Types (CInt(..)) 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" glewInit :: IO CInt @@ -47,16 +57,9 @@ main = do , SDL.windowInitialSize = SDL.V2 600 600 , SDL.windowResizable = True } + , SDL.Windowed ) ] - , initScreenMode = SDL.Windowed - , canvasSize = Nothing - , loadState = load - , preLoop = pre - , eventLoop = handle - , updateLoop = update - , drawLoop = draw - , cleanUp = clean } withAffection conf @@ -71,23 +74,28 @@ load = do nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) let fullMatrix = fromList 60 60 randList -- logIO A.Debug $ prettyMatrix fullMatrix - empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection UserData ())]) - empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection UserData ())]) - return $ UserData + empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection ())]) + empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection ())]) + step <- NewMVar True + (\life food time -> UserData { subsystems = Subsystems (Window empty1) (Keyboard empty3) - , lifeMat = fullMatrix - , foodMat = fromList 60 60 (repeat 10) - , timeMat = M.zero 60 60 + , lifeMat = life + , foodMat = food + , timeMat = time , nano = nanoCtx + , doNextStep = step } + ) + <$> newMVar fullMatrix + <*> (newMVar (fromList 60 60 (repeat 10))) + <*> (newMVar (M.zero 60 60)) -pre :: Affection UserData () -pre = do - sd <- getAffection - _ <- partSubscribe (subKeyboard $ subsystems sd) exitOnEsc - _ <- partSubscribe (subKeyboard $ subsystems sd) reloadOnR +pre :: UserData -> Affection () +pre ud = do + _ <- partSubscribe (subKeyboard $ subsystems sd) (exitOnEsc (doNextStep ud)) + _ <- partSubscribe (subKeyboard $ subsystems sd) (reloadOnR ud) _ <- partSubscribe (subKeyboard $ subsystems sd) showFPS _ <- partSubscribe (subKeyboard $ subsystems sd) toggleFullScreen _ <- partSubscribe (subWindow $ subsystems sd) exitOnWindowClose diff --git a/src/Affection.hs b/src/Affection.hs index c589c36..3acbcb1 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -127,12 +127,12 @@ withAffection AffectionConfig{..} = do -- actual displaying of newly drawn frame mapM_ (SDL.glSwapWindow . (\(_,y,_) -> y)) windows -- -- save new time - -- ad3 <- get - -- when (sysTime ad == sysTime ad3) ( - -- put ad3 - -- { sysTime = now - -- } - -- ) + ad3 <- get + when (sysTime ad == sysTime ad3) ( + put ad3 + { sysTime = now + } + ) ) ) ) initContainer