diff --git a/src/Affection/MessageBus/Message.hs b/src/Affection/MessageBus/Message.hs index b1d0d46..6712571 100644 --- a/src/Affection/MessageBus/Message.hs +++ b/src/Affection/MessageBus/Message.hs @@ -4,3 +4,4 @@ module Affection.MessageBus.Message import Affection.MessageBus.Message.Class as M import Affection.MessageBus.Message.WindowMessage as M +import Affection.MessageBus.Message.KeyboardMessage as M diff --git a/src/Affection/MessageBus/Message/WindowMessage.hs b/src/Affection/MessageBus/Message/WindowMessage.hs index b9e3727..d410b2e 100644 --- a/src/Affection/MessageBus/Message/WindowMessage.hs +++ b/src/Affection/MessageBus/Message/WindowMessage.hs @@ -11,79 +11,79 @@ import qualified SDL import Linear (V2(..)) data WindowMessage - = MsgEngineReady Word32 - | MsgWindowShown + -- = MsgEngineReady Word32 + = MsgWindowShow { msgWSWhen :: Word32 , msgWSWindow :: SDL.Window } - | MsgWindowHidden + | MsgWindowHide { msgWHWhen :: Word32 , msgWHWindow :: SDL.Window } - | MsgWindowExposed + | MsgWindowExpose { msgWEWhen :: Word32 , msgWEWindow :: SDL.Window } - | MsgWindowMoved + | MsgWindowMove { msgWMWhen :: Word32 , msgWMWindow :: SDL.Window , msgWMNewPos :: V2 Int32 } - | MsgWindowResized + | MsgWindowResize { msgWRWhen :: Word32 , msgWRWindow :: SDL.Window , msgWRNewSize :: V2 Int32 } - | MsgWindowSizeChanged + | MsgWindowSizeChange { msgWSCWhen :: Word32 , msgWSCWindow :: SDL.Window } - | MsgWindowMinimized + | MsgWindowMinimize { msgWMinWhen :: Word32 , msgWMinWindow :: SDL.Window } - | MsgWindowMaximized + | MsgWindowMaximize { msgWMaxWhen :: Word32 , msgWMaxWindow :: SDL.Window } - | MsgWindowRestored + | MsgWindowRestore { msgWRestWhen :: Word32 , msgWRestWindow :: SDL.Window } - | MsgWindowGainedMouseFocus + | MsgWindowGainMouseFocus { msgWGMFWhen :: Word32 , msgWGMFWindow :: SDL.Window } - | MsgWindowLostMouseFocus + | MsgWindowLoseMouseFocus { msgWLMFWhen :: Word32 , msgWLMFWindow :: SDL.Window } - | MsgWindowGainedKeyboardFocus + | MsgWindowGainKeyboardFocus { msgWGKFWhen :: Word32 , msgWGKFWindow :: SDL.Window } - | MsgWindowLostKeyboardFocus + | MsgWindowLoseKeyboardFocus { msgWLKFWhen :: Word32 , msgWLKFWindow :: SDL.Window } - | MsgWindowClosed + | MsgWindowClose { msgWCWhen :: Word32 , msgWCWindow :: SDL.Window } instance Message WindowMessage where - msgTime (MsgEngineReady t) = t - msgTime (MsgWindowShown t _) = t - msgTime (MsgWindowHidden t _) = t - msgTime (MsgWindowExposed t _) = t - msgTime (MsgWindowMoved t _ _) = t - msgTime (MsgWindowResized t _ _) = t - msgTime (MsgWindowSizeChanged t _) = t - msgTime (MsgWindowMinimized t _) = t - msgTime (MsgWindowMaximized t _) = t - msgTime (MsgWindowRestored t _) = t - msgTime (MsgWindowGainedMouseFocus t _) = t - msgTime (MsgWindowLostMouseFocus t _) = t - msgTime (MsgWindowGainedKeyboardFocus t _) = t - msgTime (MsgWindowLostKeyboardFocus t _) = t - msgTime (MsgWindowClosed t _) = t + -- msgTime (MsgEngineReady t) = t + msgTime (MsgWindowShow t _) = t + msgTime (MsgWindowHide t _) = t + msgTime (MsgWindowExpose t _) = t + msgTime (MsgWindowMove t _ _) = t + msgTime (MsgWindowResize t _ _) = t + msgTime (MsgWindowSizeChange t _) = t + msgTime (MsgWindowMinimize t _) = t + msgTime (MsgWindowMaximize t _) = t + msgTime (MsgWindowRestore t _) = t + msgTime (MsgWindowGainMouseFocus t _) = t + msgTime (MsgWindowLoseMouseFocus t _) = t + msgTime (MsgWindowGainKeyboardFocus t _) = t + msgTime (MsgWindowLoseKeyboardFocus t _) = t + msgTime (MsgWindowClose t _) = t diff --git a/src/Affection/Subsystems/AffectionWindow.hs b/src/Affection/Subsystems/AffectionWindow.hs index 2954ee5..26eb841 100644 --- a/src/Affection/Subsystems/AffectionWindow.hs +++ b/src/Affection/Subsystems/AffectionWindow.hs @@ -1,84 +1,80 @@ -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE AllowAmbiguousTypes #-} module Affection.Subsystems.AffectionWindow where import Affection.MessageBus import Affection.Subsystems.Class import Affection.Types -import Control.Monad.State.Class (gets) import Control.Monad.IO.Class (liftIO) import qualified SDL -data AffectionWindow m = AffectionWindow - { windowChannel :: Channel m +data AffectionWindow = AffectionWindow + { windowInChannel :: Channel WindowMessage + , windowOutChannel :: Channel WindowMessage } -instance (Message m) => Participant (AffectionWindow m) m where - partChannel = windowChannel +instance Participant AffectionWindow WindowMessage where + partChannel = windowOutChannel - partInit = do - chan <- gets messageChannel :: Affection sd m (Channel m) - nchan <- liftIO $ dupChannel $ chan + partInit ichan = do + ochan <- liftIO $ newBroadcastChannel return $ AffectionWindow - { windowChannel = nchan + { windowOutChannel = ochan + , windowInChannel = ichan } - partListen p = do - let chan = partChannel p - mmsg <- tryPeekChannel chan - return mmsg + partListen p = + liftIO $ tryPeekChannel (windowInChannel p) - partEmit p message = do - let chan = partChannel p - writeChannel chan message + partEmit p message = + liftIO $ writeChannel (windowOutChannel p) message -instance Subsystem (AffectionWindow SystemMessage) SystemMessage where - consumeEvents aw evs = doConsume evs +instance SDLSubsystem AffectionWindow WindowMessage where + consumeSDLEvents aw evs = doConsume evs where + doConsume [] = return [] doConsume (e:es) = case SDL.eventPayload e of SDL.WindowShownEvent (SDL.WindowShownEventData window) -> do - partEmit aw (MsgWindowShown (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowShow (SDL.eventTimestamp e) window) doConsume es SDL.WindowHiddenEvent (SDL.WindowHiddenEventData window) -> do - partEmit aw (MsgWindowHidden (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowHide (SDL.eventTimestamp e) window) doConsume es SDL.WindowExposedEvent (SDL.WindowExposedEventData window) -> do - partEmit aw (MsgWindowExposed (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowExpose (SDL.eventTimestamp e) window) doConsume es SDL.WindowMovedEvent (SDL.WindowMovedEventData window (SDL.P newPos)) -> do - partEmit aw (MsgWindowMoved (SDL.eventTimestamp e) window newPos) + partEmit aw (MsgWindowMove (SDL.eventTimestamp e) window newPos) doConsume es SDL.WindowResizedEvent (SDL.WindowResizedEventData window newSize) -> do - partEmit aw (MsgWindowResized (SDL.eventTimestamp e) window newSize) + partEmit aw (MsgWindowResize (SDL.eventTimestamp e) window newSize) doConsume es SDL.WindowSizeChangedEvent (SDL.WindowSizeChangedEventData window) -> do - partEmit aw (MsgWindowSizeChanged (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowSizeChange (SDL.eventTimestamp e) window) doConsume es SDL.WindowMinimizedEvent (SDL.WindowMinimizedEventData window) -> do - partEmit aw (MsgWindowMinimized (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowMinimize (SDL.eventTimestamp e) window) doConsume es SDL.WindowMaximizedEvent (SDL.WindowMaximizedEventData window) -> do - partEmit aw (MsgWindowMaximized (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowMaximize (SDL.eventTimestamp e) window) doConsume es SDL.WindowRestoredEvent (SDL.WindowRestoredEventData window) -> do - partEmit aw (MsgWindowRestored (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowRestore (SDL.eventTimestamp e) window) doConsume es SDL.WindowGainedMouseFocusEvent (SDL.WindowGainedMouseFocusEventData window) -> do - partEmit aw (MsgWindowGainedMouseFocus (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowGainMouseFocus (SDL.eventTimestamp e) window) doConsume es SDL.WindowLostMouseFocusEvent (SDL.WindowLostMouseFocusEventData window) -> do - partEmit aw (MsgWindowLostMouseFocus (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowLoseMouseFocus (SDL.eventTimestamp e) window) doConsume es SDL.WindowGainedKeyboardFocusEvent (SDL.WindowGainedKeyboardFocusEventData window) -> do - partEmit aw (MsgWindowGainedKeyboardFocus (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowGainKeyboardFocus (SDL.eventTimestamp e) window) doConsume es SDL.WindowLostKeyboardFocusEvent (SDL.WindowLostKeyboardFocusEventData window) -> do - partEmit aw (MsgWindowLostKeyboardFocus (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowLoseKeyboardFocus (SDL.eventTimestamp e) window) doConsume es SDL.WindowClosedEvent (SDL.WindowClosedEventData window) -> do - partEmit aw (MsgWindowClosed (SDL.eventTimestamp e) window) + partEmit aw (MsgWindowClose (SDL.eventTimestamp e) window) doConsume es _ -> fmap (e :) (doConsume es) diff --git a/src/Affection/Subsystems/Class.hs b/src/Affection/Subsystems/Class.hs index e104640..6dc42f4 100644 --- a/src/Affection/Subsystems/Class.hs +++ b/src/Affection/Subsystems/Class.hs @@ -2,9 +2,10 @@ {-# LANGUAGE AllowAmbiguousTypes #-} module Affection.Subsystems.Class where +import Affection.Types import Affection.MessageBus import qualified SDL -class (Message m, Participant s m) => Subsystem s m where - consumeEvents :: s -> [SDL.Event] -> IO [SDL.Event] +class (Message m, Participant s m) => SDLSubsystem s m where + consumeSDLEvents :: s -> [SDL.Event] -> Affection sd [SDL.Event]