diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs index 4f888cc..80a1c51 100644 --- a/src/Affection/MessageBus/Class.hs +++ b/src/Affection/MessageBus/Class.hs @@ -5,11 +5,11 @@ module Affection.MessageBus.Class where import Affection.MessageBus.Message import Affection.Types -class (Message msg) => Participant prt msg where - partChannel :: prt -> Channel msg +class Participant prt m where + partChannel :: prt -> Channel m - partInit :: Affection sd msg prt + partInit :: Affection sd m prt - partListen :: prt -> IO (Maybe msg) + partListen :: prt -> IO (Maybe m) - partEmit :: prt -> msg -> IO () + partEmit :: prt -> m -> IO () diff --git a/src/Affection/MessageBus/Message.hs b/src/Affection/MessageBus/Message.hs index bedf10c..b96419d 100644 --- a/src/Affection/MessageBus/Message.hs +++ b/src/Affection/MessageBus/Message.hs @@ -11,12 +11,12 @@ import Linear (V2(..)) class Message msg where msgTime :: msg -> Word32 -data SystemMessage m - = MsgUserMessage - { msgUMWhen :: Word32 - , msgUMPayload :: m - } -- ^ Generic user defined message with custom payload - | MsgEngineReady Word32 +data SystemMessage + -- = MsgUserMessage + -- { msgUMWhen :: Word32 + -- , msgUMPayload :: m + -- } -- ^ Generic user defined message with custom payload + = MsgEngineReady Word32 | MsgWindowShown { msgWSWhen :: Word32 , msgWSWindow :: SDL.Window @@ -76,8 +76,8 @@ data SystemMessage m , msgWCWindow :: SDL.Window } -instance Message (SystemMessage m) where - msgTime (MsgUserMessage t _) = t +instance Message SystemMessage where + -- msgTime (MsgUserMessage t _) = t msgTime (MsgEngineReady t) = t msgTime (MsgWindowShown t _) = t msgTime (MsgWindowHidden t _) = t diff --git a/src/Affection/Subsystems/AffectionWindow.hs b/src/Affection/Subsystems/AffectionWindow.hs index 805047e..2954ee5 100644 --- a/src/Affection/Subsystems/AffectionWindow.hs +++ b/src/Affection/Subsystems/AffectionWindow.hs @@ -7,21 +7,21 @@ import Affection.MessageBus import Affection.Subsystems.Class import Affection.Types -import Control.Monad.State.Class (get) +import Control.Monad.State.Class (gets) import Control.Monad.IO.Class (liftIO) import qualified SDL -data AffectionWindow msg = AffectionWindow - { windowChannel :: Channel msg +data AffectionWindow m = AffectionWindow + { windowChannel :: Channel m } -instance Participant (AffectionWindow (SystemMessage m)) (SystemMessage m) where +instance (Message m) => Participant (AffectionWindow m) m where partChannel = windowChannel partInit = do - ad <- get - nchan <- liftIO $ dupChannel $ messageChannel ad + chan <- gets messageChannel :: Affection sd m (Channel m) + nchan <- liftIO $ dupChannel $ chan return $ AffectionWindow { windowChannel = nchan } @@ -31,11 +31,11 @@ instance Participant (AffectionWindow (SystemMessage m)) (SystemMessage m) where mmsg <- tryPeekChannel chan return mmsg - partEmit p m = do + partEmit p message = do let chan = partChannel p - writeChannel chan m + writeChannel chan message -instance Subsystem (AffectionWindow (SystemMessage m)) (SystemMessage m) where +instance Subsystem (AffectionWindow SystemMessage) SystemMessage where consumeEvents aw evs = doConsume evs where doConsume (e:es) = case SDL.eventPayload e of