bump UserData object and Util

This commit is contained in:
nek0 2020-05-05 01:12:53 +02:00
parent 83b3bbcd9b
commit adf5eefcdc
3 changed files with 19 additions and 17 deletions

View file

@ -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

View file

@ -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

View file

@ -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