diff --git a/affection.cabal b/affection.cabal index b7ca0f8..84e6563 100644 --- a/affection.cabal +++ b/affection.cabal @@ -45,6 +45,7 @@ library -- , Affection.Actor -- , Affection.Animation , Affection.Util + , Affection.MessageBus default-extensions: OverloadedStrings -- Modules included in this library but not exported. @@ -60,7 +61,7 @@ library default-language: Haskell2010 ghc-options: -Wall -- Other library packages from which modules are imported. - build-depends: base >=4.9 + build-depends: base >=4.9 && <4.11 , sdl2 , text , mtl @@ -73,6 +74,7 @@ library , glib , bytestring , OpenGL + , stm -- , sdl2-image -- executable example00 diff --git a/notes/TODO.md b/notes/TODO.md new file mode 100644 index 0000000..db88493 --- /dev/null +++ b/notes/TODO.md @@ -0,0 +1,9 @@ +# TODO + +Implement following things in approximately this Order: + +* Message bus +* Console +* GUI +* Framework +* Everything else diff --git a/src/Affection.hs b/src/Affection.hs index b760c22..5c22a32 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -8,6 +8,8 @@ module Affection -- , withWindow -- , withDefaultWindow , delaySec + , get + , put , module A ) where @@ -23,7 +25,6 @@ import Data.IORef import System.Clock import Control.Monad.Loops -import qualified Control.Monad.Parallel as MP import Control.Monad.State import Foreign.C.Types (CInt(..)) @@ -40,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(..)) @@ -133,8 +135,8 @@ withAffection AffectionConfig{..} = do -- Measure time difference form last run now <- liftIO $ getTime Monotonic let lastTime = sysTime ad - -- -- clean draw requests from last run - -- MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) + -- clean draw requests from last run + -- mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) -- clean the renderer form last time -- SDL.clear renderer -- compute dt and update elapsedTime @@ -157,7 +159,7 @@ withAffection AffectionConfig{..} = do -- handle all new draw requests ad2 <- get -- 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 -- put $ ad2 -- { drawStack = clear } diff --git a/src/Affection/MessageBus.hs b/src/Affection/MessageBus.hs new file mode 100644 index 0000000..2fcbaf8 --- /dev/null +++ b/src/Affection/MessageBus.hs @@ -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