preparing some classes
This commit is contained in:
parent
c6066e3e08
commit
8c2f85be94
3 changed files with 23 additions and 2 deletions
|
@ -45,6 +45,7 @@ library
|
||||||
-- , Affection.Actor
|
-- , Affection.Actor
|
||||||
-- , Affection.Animation
|
-- , Affection.Animation
|
||||||
, Affection.Util
|
, Affection.Util
|
||||||
|
, Affection.MessageBus
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
|
|
||||||
-- Modules included in this library but not exported.
|
-- Modules included in this library but not exported.
|
||||||
|
@ -73,6 +74,7 @@ library
|
||||||
, glib
|
, glib
|
||||||
, bytestring
|
, bytestring
|
||||||
, OpenGL
|
, OpenGL
|
||||||
|
, stm
|
||||||
-- , sdl2-image
|
-- , sdl2-image
|
||||||
|
|
||||||
-- executable example00
|
-- executable example00
|
||||||
|
|
|
@ -41,6 +41,7 @@ import Affection.MouseInteractable as A
|
||||||
-- import Affection.Actor as A
|
-- import Affection.Actor as A
|
||||||
-- import Affection.Animation as A
|
-- import Affection.Animation as A
|
||||||
import Affection.Util as A
|
import Affection.Util as A
|
||||||
|
import Affection.MessageBus as A
|
||||||
|
|
||||||
import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
|
import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,22 @@
|
||||||
module Affection.MessageBus where
|
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
|
||||||
|
|
Loading…
Reference in a new issue