it compiles now. messagebus will have multiple channels

This commit is contained in:
nek0 2017-11-29 08:29:44 +01:00
parent 4ae117aa48
commit c40cd04d99
3 changed files with 22 additions and 22 deletions

View File

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

View File

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

View File

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