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