added some helper-functions for handling gamestate

This commit is contained in:
Nicole Dresselhaus 2014-05-17 23:19:34 +02:00
parent 35364b50aa
commit aa6a5c060f
No known key found for this signature in database
GPG Key ID: BC16D887851A1A80

View File

@ -1,7 +1,7 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Types where module Types where
import Control.Concurrent.STM (TQueue, TVar) import Control.Concurrent.STM (TQueue, TVar, readTVar, writeTVar, atomically)
import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.Rendering.OpenGL.GL as GL
import Graphics.UI.SDL as SDL (Event, Window) import Graphics.UI.SDL as SDL (Event, Window)
import Foreign.C (CFloat) import Foreign.C (CFloat)
@ -9,7 +9,8 @@ import qualified Data.HashMap.Strict as Map
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Linear.Matrix (M44) import Linear.Matrix (M44)
import Linear (V3) import Linear (V3)
import Control.Monad.RWS.Strict (RWST) import Control.Monad.RWS.Strict (RWST, liftIO, get)
import Control.Monad (when)
import Control.Lens import Control.Lens
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
import Render.Types import Render.Types
@ -188,3 +189,18 @@ $(makeLenses ''Position)
$(makeLenses ''Env) $(makeLenses ''Env)
$(makeLenses ''UIState) $(makeLenses ''UIState)
-- helper-functions for types
-- | atomically change gamestate on condition
changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers ()
changeIfGamestate cond f = do
state <- get
liftIO $ atomically $ do
game' <- readTVar (state ^. game)
when (cond game') (writeTVar (state ^. game) (f game'))
-- | atomically change gamestate
changeGamestate :: (GameState -> GameState) -> Pioneers ()
changeGamestate = changeIfGamestate (const True)