bump UserData object and Util

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
+    anims <- readMVar (assetAnimations us)
-        a = anims Map.! asId as
+    let a = anims Map.! asId as
         img = (animSprites a !! asCurrentFrame as) :: Image
     draw us x y w h alpha img

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
+  , assetIcons      :: MVar (M.Map IconId Image)
-  , assetImages     :: M.Map ImgId Image
+  , assetImages     :: MVar (M.Map ImgId Image)
-  , assetFonts      :: M.Map FontId T.Text
+  , assetFonts      :: MVar (M.Map FontId T.Text)
-  , assetAnimations :: M.Map AnimId Animation
+  , assetAnimations :: MVar (M.Map AnimId Animation)
-  , controls        :: Controller -- Maybe SDL.Joystick
+  , controls        :: Controller
-  , translation     :: Translation
+  , 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]
+  , joyCache        :: MVar [JoystickMessage]
-  , joyUUID         :: UUID
+  , joyUUID         :: MVar UUID
   }
 
 data Controller

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