preparing some classes

This commit is contained in:
nek0 2017-11-26 13:59:59 +01:00
parent c6066e3e08
commit 8c2f85be94
3 changed files with 23 additions and 2 deletions

View File

@ -45,6 +45,7 @@ library
-- , Affection.Actor
-- , Affection.Animation
, Affection.Util
, Affection.MessageBus
default-extensions: OverloadedStrings
-- Modules included in this library but not exported.
@ -73,6 +74,7 @@ library
, glib
, bytestring
, OpenGL
, stm
-- , sdl2-image
-- executable example00

View File

@ -41,6 +41,7 @@ import Affection.MouseInteractable as A
-- import Affection.Actor as A
-- import Affection.Animation as A
import Affection.Util as A
import Affection.MessageBus as A
import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))

View File

@ -1,4 +1,22 @@
module Affection.MessageBus where
class MessageBus a where
import Control.Concurrent.STM as STM
import Data.IORef
class Message msg where
msgPayload :: msg -> Maybe a
type Channel msg = TChan msg
class Participant prt where
partChannel :: (Message msg) => prt -> IORef (Channel msg)
partConnectChannel :: (Message msg) => prt -> (Channel msg) -> IO ()
partListen :: (Message msg) => prt -> IO msg
partBroadcast :: (Message msg) => prt -> msg -> IO ()
newBroadcastChannel :: IO (Channel msg)
newBroadcastChannel = atomically $ newBroadcastTChan