port module Types.UserData
This commit is contained in:
parent
7a5e30c6ed
commit
55f688e9be
1 changed files with 28 additions and 28 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue