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 qualified Data.Map.Strict as Map
import Control.Concurrent.MVar
import NanoVG import NanoVG
import Foreign.C.Types (CFloat(..)) import Foreign.C.Types (CFloat(..))
@ -30,7 +32,7 @@ instance NanoDrawable UserData Image where
instance NanoDrawable UserData AnimState where instance NanoDrawable UserData AnimState where
draw us x y w h alpha as = do 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 img = (animSprites a !! asCurrentFrame as) :: Image
draw us x y w h alpha img draw us x y w h alpha img

View file

@ -24,18 +24,18 @@ import Types.Animation
import Types.Entity import Types.Entity
data UserData = UserData data UserData = UserData
{ state :: State { state :: MVar State
, subsystems :: Subsystems , 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 , nano :: Context
, uuid :: [UUID] , uuid :: MVar [UUID]
, worldState :: SystemState Entity (AffectionState AffectionData IO) , worldState :: SystemState Entity (AffectionState AffectionData IO)
, stateData :: StateData , stateData :: MVar StateData
, stateMVar :: MVar , stateMVar :: MVar
( SystemState Entity (AffectionState AffectionData IO) ( SystemState Entity (AffectionState AffectionData IO)
, StateData , StateData
@ -43,8 +43,8 @@ data UserData = UserData
, stateProgress :: MVar (Float, T.Text) , stateProgress :: MVar (Float, T.Text)
, threadContext :: Maybe SDL.GLContext , threadContext :: Maybe SDL.GLContext
, window :: Maybe SDL.Window , window :: Maybe SDL.Window
, joyCache :: [JoystickMessage] , joyCache :: MVar [JoystickMessage]
, joyUUID :: UUID , joyUUID :: MVar UUID
} }
data Controller data Controller

View file

@ -304,14 +304,14 @@ rotVec (V2 x y) deg = V2 nx ny
dtor :: (Num a, Floating a) => a -> a dtor :: (Num a, Floating a) => a -> a
dtor = (pi / 180 *) dtor = (pi / 180 *)
cacheJoypad :: JoystickMessage -> Affection UserData () cacheJoypad :: JoystickMessage -> Affection ()
cacheJoypad msg = do cacheJoypad msg = do
ud <- getAffection ud <- getAffection
putAffection ud putAffection ud
{ joyCache = msg : joyCache ud { joyCache = msg : joyCache ud
} }
emitJoyActionMessage :: JoystickMessage -> Affection UserData () emitJoyActionMessage :: JoystickMessage -> Affection ()
emitJoyActionMessage (MsgJoystickAxis time _ axis val) = do emitJoyActionMessage (MsgJoystickAxis time _ axis val) = do
ud <- getAffection ud <- getAffection
case translation ud of case translation ud of
@ -340,7 +340,7 @@ emitJoyActionMessage (MsgJoystickButton time _ but SDL.JoyButtonPressed) = do
_ -> return () _ -> return ()
emitJoyActionMessage _ = return () emitJoyActionMessage _ = return ()
emitKbdActionMessage :: KeyboardMessage -> Affection UserData () emitKbdActionMessage :: KeyboardMessage -> Affection ()
emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do
ud <- getAffection ud <- getAffection
let Subsystems _ _ _ _ t = subsystems ud let Subsystems _ _ _ _ t = subsystems ud
@ -357,7 +357,7 @@ emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do
_ -> return () _ -> return ()
emitKbdActionMessage _ = return () emitKbdActionMessage _ = return ()
fullClean :: Affection UserData () fullClean :: Affection ()
fullClean = do fullClean = do
ud <- getAffection ud <- getAffection
let Subsystems w m k j t = subsystems ud let Subsystems w m k j t = subsystems ud