Merge branch 'master' of github.com:nek0/affection
This commit is contained in:
commit
5feaa00dae
4 changed files with 35 additions and 1 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
|
||||||
|
|
9
notes/TODO.md
Normal file
9
notes/TODO.md
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
# TODO
|
||||||
|
|
||||||
|
Implement following things in approximately this Order:
|
||||||
|
|
||||||
|
* Message bus
|
||||||
|
* Console
|
||||||
|
* GUI
|
||||||
|
* Framework
|
||||||
|
* Everything else
|
|
@ -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(..))
|
||||||
|
|
||||||
|
@ -158,7 +159,7 @@ withAffection AffectionConfig{..} = do
|
||||||
-- handle all new draw requests
|
-- handle all new draw requests
|
||||||
ad2 <- get
|
ad2 <- get
|
||||||
-- clear <- catMaybes <$>
|
-- clear <- catMaybes <$>
|
||||||
-- MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
|
-- mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
|
||||||
-- -- save all draw requests to clear in next run
|
-- -- save all draw requests to clear in next run
|
||||||
-- put $ ad2
|
-- put $ ad2
|
||||||
-- { drawStack = clear }
|
-- { drawStack = clear }
|
||||||
|
|
22
src/Affection/MessageBus.hs
Normal file
22
src/Affection/MessageBus.hs
Normal file
|
@ -0,0 +1,22 @@
|
||||||
|
module Affection.MessageBus 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