diff --git a/src/Types/Drawable.hs b/src/Types/Drawable.hs index 999c87a..2779821 100644 --- a/src/Types/Drawable.hs +++ b/src/Types/Drawable.hs @@ -4,6 +4,8 @@ module Types.Drawable where import qualified Data.Map.Strict as Map +import Control.Concurrent.MVar + import NanoVG import Foreign.C.Types (CFloat(..)) @@ -30,7 +32,7 @@ instance NanoDrawable UserData Image where instance NanoDrawable UserData AnimState where draw us x y w h alpha as = do - let anims = assetAnimations us - a = anims Map.! asId as + anims <- readMVar (assetAnimations us) + let a = anims Map.! asId as img = (animSprites a !! asCurrentFrame as) :: Image draw us x y w h alpha img diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index bf45139..8df7708 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -24,18 +24,18 @@ import Types.Animation import Types.Entity data UserData = UserData - { state :: State + { state :: MVar State , subsystems :: Subsystems - , assetIcons :: M.Map IconId Image - , assetImages :: M.Map ImgId Image - , assetFonts :: M.Map FontId T.Text - , assetAnimations :: M.Map AnimId Animation - , controls :: Controller -- Maybe SDL.Joystick - , translation :: Translation + , assetIcons :: MVar (M.Map IconId Image) + , assetImages :: MVar (M.Map ImgId Image) + , assetFonts :: MVar (M.Map FontId T.Text) + , assetAnimations :: MVar (M.Map AnimId Animation) + , controls :: Controller + , translation :: MVar Translation , nano :: Context - , uuid :: [UUID] + , uuid :: MVar [UUID] , worldState :: SystemState Entity (AffectionState AffectionData IO) - , stateData :: StateData + , stateData :: MVar StateData , stateMVar :: MVar ( SystemState Entity (AffectionState AffectionData IO) , StateData @@ -43,8 +43,8 @@ data UserData = UserData , stateProgress :: MVar (Float, T.Text) , threadContext :: Maybe SDL.GLContext , window :: Maybe SDL.Window - , joyCache :: [JoystickMessage] - , joyUUID :: UUID + , joyCache :: MVar [JoystickMessage] + , joyUUID :: MVar UUID } data Controller diff --git a/src/Util.hs b/src/Util.hs index 019e6d7..e4fbffa 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -304,14 +304,14 @@ rotVec (V2 x y) deg = V2 nx ny dtor :: (Num a, Floating a) => a -> a dtor = (pi / 180 *) -cacheJoypad :: JoystickMessage -> Affection UserData () +cacheJoypad :: JoystickMessage -> Affection () cacheJoypad msg = do ud <- getAffection putAffection ud { joyCache = msg : joyCache ud } -emitJoyActionMessage :: JoystickMessage -> Affection UserData () +emitJoyActionMessage :: JoystickMessage -> Affection () emitJoyActionMessage (MsgJoystickAxis time _ axis val) = do ud <- getAffection case translation ud of @@ -340,7 +340,7 @@ emitJoyActionMessage (MsgJoystickButton time _ but SDL.JoyButtonPressed) = do _ -> return () emitJoyActionMessage _ = return () -emitKbdActionMessage :: KeyboardMessage -> Affection UserData () +emitKbdActionMessage :: KeyboardMessage -> Affection () emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do ud <- getAffection let Subsystems _ _ _ _ t = subsystems ud @@ -357,7 +357,7 @@ emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do _ -> return () emitKbdActionMessage _ = return () -fullClean :: Affection UserData () +fullClean :: Affection () fullClean = do ud <- getAffection let Subsystems w m k j t = subsystems ud