new subsystem

This commit is contained in:
nek0 2017-11-27 05:27:34 +01:00
parent 6e11ff9b1e
commit d8d29ec7df
2 changed files with 78 additions and 0 deletions

View file

@ -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)

View file

@ -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]