diff --git a/src/Affection/Subsystems/AffectionWindow.hs b/src/Affection/Subsystems/AffectionWindow.hs new file mode 100644 index 0000000..fd0882f --- /dev/null +++ b/src/Affection/Subsystems/AffectionWindow.hs @@ -0,0 +1,70 @@ +module Affection.Subsystem.AffectionWindow where + +import Affection.MessageBus +import Affection.Subsystems.Class + +import qualified SDL + +data AffectionWindow = AffectionWindow + { windowChannel :: Channel msg + } + +instance Participant AffectionWindow where + partChannel = windowChannel + + partListen p = do + let chan = partChannel p + mmsg <- tryPeekChannel chan + return mmsg + + partEmit p m = do + let chan = partChannel p + writeChannel chan m + +instance Subsystem AffectionWindow where + consumeEvents aw evs = doConsume evs + where + doConsume (e:es) = case SDL.eventPayload e of + SDL.WindowShownEvent (SDL.WindowShownEventData window) = do + partEmit aw (MsgWindowShown (SDL.eventTiemstamp e) window) + doConsume es + SDL.WindowHiddenEvent (SDL.WindowHiddenEventData window) = do + partEmit aw (MsgWindowHidden (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowExposedEvent (SDL.WindowExposedEventData window) = do + partEmit aw (MsgWindowExposed (SDL.eventTimestamp e) window) + doConsume es + SDL.WindowMovedEvent (SDL.WindowMovedEventData window (SDL.P newPos)) = do + partEmit aw (MsgWindowMoved (SDL.EventTimestamp e) window newPos) + doConsume es + SDL.WindowResizedEvent (SDL.WindowResizedEventData window newSize) = do + partEmit aw (MsgWindowResized (SDL.EventTimestamp e) window newSize) + doConsume es + SDL.WindowSizeChangedEvent (SDL.WindowSizeChangedEventData window) = do + partEmit aw (MsgWindowSizeChanged (SDL.EventTimestamp e) window) + doConsume es + SDL.WindowMinimizedEvent (SDL.WindowMinimizedEventData window) = do + partEmit aw (MsgWindowMinimized (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowMaximizedEvent (SDL.WindowMaximizedEventData window) = do + partEmit aw (MsgWindowMaximized (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowRestoredEvent (SDL.WindowRestoredEventData window) = do + partEmit aw (MsgWindowRestored (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowGainedMouseFocusEvent (SDL.WindowGainedMouseFocusEventData window) = do + partEmit aw (MsgWindowGainedMouseFocus (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowLostMouseFocusEvent (SDL.WindowLostMouseFocusEventData window) = do + partEmit aw (MsgWindowLostMouseFocus (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowGainedKeyboardFocusEvent (SDL.WindowGainedKeyboardFocusEventData window) = do + partEmit aw (MsgWindowGainedKeyboardFocus (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowLostKeyboardFocusEvent (SDL.WindowLostKeyboardFocusEventData window) = do + partEmit aw (MsgWindowLostKeyboardFocus (SDL.eventTimestemp e) window) + doConsume es + SDL.WindowClosed (SDL.WindowClosedEventData window) = do + partEmit aw (MsgWindowClosed (SDL.eventTimestemp e) window) + doConsume es + _ = fmap (e :) (doConsume es) diff --git a/src/Affection/Subsystems/Class.hs b/src/Affection/Subsystems/Class.hs new file mode 100644 index 0000000..7caea9f --- /dev/null +++ b/src/Affection/Subsystems/Class.hs @@ -0,0 +1,8 @@ +module Affection.Subsystems.Class where + +import Affection.MessageBus.Class + +import qualified SDL + +class (Participant s) => Subsystem s where + consumeEvents :: s -> [SDL.Event] -> IO [SDL.Event]