new subsystem

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)

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]