port module Types.UserData

This commit is contained in:
nek0 2020-05-05 00:52:24 +02:00
parent 7a5e30c6ed
commit 55f688e9be

View file

@ -34,10 +34,10 @@ data UserData = UserData
, translation :: Translation , translation :: Translation
, nano :: Context , nano :: Context
, uuid :: [UUID] , uuid :: [UUID]
, worldState :: SystemState Entity (AffectionState (AffectionData UserData) IO) , worldState :: SystemState Entity (AffectionState AffectionData IO)
, stateData :: StateData , stateData :: StateData
, stateMVar :: MVar , stateMVar :: MVar
( SystemState Entity (AffectionState (AffectionData UserData) IO) ( SystemState Entity (AffectionState AffectionData IO)
, StateData , StateData
) )
, stateProgress :: MVar (Float, T.Text) , stateProgress :: MVar (Float, T.Text)
@ -133,14 +133,14 @@ data ActionMessage = ActionMessage
instance Message ActionMessage where instance Message ActionMessage where
msgTime (ActionMessage _ t) = t msgTime (ActionMessage _ t) = t
newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData())]) newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection())])
newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())]) newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection ())])
newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())]) newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection ())])
newtype SubJoypad = SubJoypad (TVar [(UUID, JoystickMessage -> Affection UserData ())]) newtype SubJoypad = SubJoypad (TVar [(UUID, JoystickMessage -> Affection ())])
newtype SubTranslator = SubTranslator (TVar [(UUID, ActionMessage -> Affection UserData ())]) newtype SubTranslator = SubTranslator (TVar [(UUID, ActionMessage -> Affection ())])
instance Participant SubWindow UserData where instance Participant SubWindow where
type Mesg SubWindow UserData = WindowMessage type Mesg SubWindow = WindowMessage
partSubscribers (SubWindow t) = generalSubscribers t partSubscribers (SubWindow t) = generalSubscribers t
@ -148,11 +148,11 @@ instance Participant SubWindow UserData where
partUnSubscribe (SubWindow t) = generalUnSubscribe t partUnSubscribe (SubWindow t) = generalUnSubscribe t
instance SDLSubsystem SubWindow UserData where instance SDLSubsystem SubWindow where
consumeSDLEvents = consumeSDLWindowEvents consumeSDLEvents = consumeSDLWindowEvents
instance Participant SubMouse UserData where instance Participant SubMouse where
type Mesg SubMouse UserData = MouseMessage type Mesg SubMouse = MouseMessage
partSubscribers (SubMouse t) = generalSubscribers t partSubscribers (SubMouse t) = generalSubscribers t
@ -160,11 +160,11 @@ instance Participant SubMouse UserData where
partUnSubscribe (SubMouse t) = generalUnSubscribe t partUnSubscribe (SubMouse t) = generalUnSubscribe t
instance SDLSubsystem SubMouse UserData where instance SDLSubsystem SubMouse where
consumeSDLEvents = consumeSDLMouseEvents consumeSDLEvents = consumeSDLMouseEvents
instance Participant SubKeyboard UserData where instance Participant SubKeyboard where
type Mesg SubKeyboard UserData = KeyboardMessage type Mesg SubKeyboard = KeyboardMessage
partSubscribers (SubKeyboard t) = generalSubscribers t partSubscribers (SubKeyboard t) = generalSubscribers t
@ -172,11 +172,11 @@ instance Participant SubKeyboard UserData where
partUnSubscribe (SubKeyboard t) = generalUnSubscribe t partUnSubscribe (SubKeyboard t) = generalUnSubscribe t
instance SDLSubsystem SubKeyboard UserData where instance SDLSubsystem SubKeyboard where
consumeSDLEvents = consumeSDLKeyboardEvents consumeSDLEvents = consumeSDLKeyboardEvents
instance Participant SubJoypad UserData where instance Participant SubJoypad where
type Mesg SubJoypad UserData = JoystickMessage type Mesg SubJoypad = JoystickMessage
partSubscribers (SubJoypad t) = generalSubscribers t partSubscribers (SubJoypad t) = generalSubscribers t
@ -184,11 +184,11 @@ instance Participant SubJoypad UserData where
partUnSubscribe (SubJoypad t) = generalUnSubscribe t partUnSubscribe (SubJoypad t) = generalUnSubscribe t
instance SDLSubsystem SubJoypad UserData where instance SDLSubsystem SubJoypad where
consumeSDLEvents = consumeSDLJoystickEvents consumeSDLEvents = consumeSDLJoystickEvents
instance Participant SubTranslator UserData where instance Participant SubTranslator where
type Mesg SubTranslator UserData = ActionMessage type Mesg SubTranslator = ActionMessage
partSubscribers (SubTranslator t) = generalSubscribers t partSubscribers (SubTranslator t) = generalSubscribers t
@ -197,25 +197,25 @@ instance Participant SubTranslator UserData where
partUnSubscribe (SubTranslator t) = generalUnSubscribe t partUnSubscribe (SubTranslator t) = generalUnSubscribe t
generalSubscribers generalSubscribers
:: TVar [(UUID, msg -> Affection UserData ())] :: TVar [(UUID, msg -> Affection ())]
-> Affection UserData [(msg -> Affection UserData ())] -> Affection [(msg -> Affection ())]
generalSubscribers t = do generalSubscribers t = do
subTups <- liftIO $ readTVarIO t subTups <- liftIO $ readTVarIO t
return $ map snd subTups return $ map snd subTups
generalSubscribe generalSubscribe
:: TVar [(UUID, msg -> Affection UserData ())] :: TVar [(UUID, msg -> Affection ())]
-> (msg -> Affection UserData ()) -> (msg -> Affection ())
-> Affection UserData UUID -> Affection UUID
generalSubscribe t funct = do generalSubscribe t funct = do
uu <- genUUID uu <- genUUID
liftIO $ atomically $ modifyTVar' t ((uu, funct) :) liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
return uu return uu
generalUnSubscribe generalUnSubscribe
:: TVar [(UUID, msg -> Affection UserData ())] :: TVar [(UUID, msg -> Affection ())]
-> UUID -> UUID
-> Affection UserData () -> Affection ()
generalUnSubscribe t uu = generalUnSubscribe t uu =
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu)) liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
where where