From 55f688e9beb0aa685d0b9a093921332972147087 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 5 May 2020 00:52:24 +0200 Subject: [PATCH] port module Types.UserData --- src/Types/UserData.hs | 56 +++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index 4d86b51..bf45139 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -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