From 4594dc58e022541da192b64fad52369275621484 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 4 Nov 2017 12:57:56 +0100 Subject: [PATCH 1/7] pushing upper bound --- affection.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/affection.cabal b/affection.cabal index 7d65f3b..251ce66 100644 --- a/affection.cabal +++ b/affection.cabal @@ -60,7 +60,7 @@ library default-language: Haskell2010 ghc-options: -Wall -- Other library packages from which modules are imported. - build-depends: base >=4.9 && <4.10 + build-depends: base >=4.9 && <4.11 , sdl2 , text , mtl From 2a9f7ffebc90b41cc3d47f34500eadd5c3871c8d Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 4 Nov 2017 18:35:09 +0100 Subject: [PATCH 2/7] export get and put --- src/Affection.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Affection.hs b/src/Affection.hs index e3f9d4a..9c1ad4c 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -7,6 +7,8 @@ module Affection -- , withWindow -- , withDefaultWindow , delaySec + , get + , put , module A ) where From 2c731bea9789418a8bf9a2e49780ae17b3c9ba76 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 4 Nov 2017 20:37:49 +0100 Subject: [PATCH 3/7] de-parallelize --- src/Affection.hs | 5 ++--- src/Affection/Particle.hs | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Affection.hs b/src/Affection.hs index 9c1ad4c..6d49ada 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -23,7 +23,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(..)) @@ -129,7 +128,7 @@ withAffection AffectionConfig{..} = do now <- liftIO $ getTime Monotonic let lastTime = sysTime ad -- clean draw requests from last run - MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) + mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) -- clean the renderer form last time -- SDL.clear renderer -- compute dt and update elapsedTime @@ -150,7 +149,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/Particle.hs b/src/Affection/Particle.hs index 0518cd3..637709f 100644 --- a/src/Affection/Particle.hs +++ b/src/Affection/Particle.hs @@ -13,7 +13,6 @@ import Affection.Types import Control.Monad import Control.Monad.State (get) -import qualified Control.Monad.Parallel as MP import Data.Maybe @@ -34,7 +33,7 @@ updateParticle -> Affection us [Particle] -- ^ processed 'Particle's updateParticle time func l = - catMaybes <$> MP.mapM (\p -> do + catMaybes <$> mapM (\p -> do now <- elapsedTime <$> get if particleCreation p + particleTimeToLive p < now then do @@ -124,7 +123,7 @@ drawParticleSystem sys draw = if not (null parts) then do liftIO $ G.gegl_node_link (particleStackCont $ head parts) (partSysNode sys) - MP.mapM_ (draw (partSysBuffer sys) (partSysNode sys)) parts + mapM_ (draw (partSysBuffer sys) (partSysNode sys)) parts else do _ <- liftIO $ G.gegl_node_disconnect (partSysNode sys) "input" return () From 0a0b85139549ef18f48dd3447a63d1c3f99e9d6c Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 22 Nov 2017 22:32:50 +0100 Subject: [PATCH 4/7] add notes --- notes/TODO.md | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 notes/TODO.md 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 From b2da2d287a374eacc07ad75da14a92ae5d03b502 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 23 Nov 2017 19:37:36 +0100 Subject: [PATCH 5/7] post merge cleanup --- src/Affection.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Affection.hs b/src/Affection.hs index 636750e..60191d3 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -135,7 +135,7 @@ withAffection AffectionConfig{..} = do now <- liftIO $ getTime Monotonic let lastTime = sysTime ad -- clean draw requests from last run - mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) + -- mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) -- clean the renderer form last time -- SDL.clear renderer -- compute dt and update elapsedTime @@ -157,11 +157,11 @@ withAffection AffectionConfig{..} = do liftIO $ flush -- handle all new draw requests ad2 <- get - clear <- catMaybes <$> - mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2) - -- save all draw requests to clear in next run - put $ ad2 - { drawStack = clear } + -- clear <- catMaybes <$> + -- mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2) + -- -- save all draw requests to clear in next run + -- put $ ad2 + -- { drawStack = clear } -- actual drawing SDL.glSwapWindow window -- SDL.present (windowRenderer ad2) From c6066e3e08b92042ab4395320af39126e196669f Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 25 Nov 2017 09:05:04 +0100 Subject: [PATCH 6/7] starting messagebus --- src/Affection/MessageBus.hs | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 src/Affection/MessageBus.hs diff --git a/src/Affection/MessageBus.hs b/src/Affection/MessageBus.hs new file mode 100644 index 0000000..1966643 --- /dev/null +++ b/src/Affection/MessageBus.hs @@ -0,0 +1,4 @@ +module Affection.MessageBus where + +class MessageBus a where + From 8c2f85be94ed769412eee39445ac2b734e5c6eb5 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Nov 2017 13:59:59 +0100 Subject: [PATCH 7/7] preparing some classes --- affection.cabal | 2 ++ src/Affection.hs | 1 + src/Affection/MessageBus.hs | 22 ++++++++++++++++++++-- 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/affection.cabal b/affection.cabal index 698a187..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. @@ -73,6 +74,7 @@ library , glib , bytestring , OpenGL + , stm -- , sdl2-image -- executable example00 diff --git a/src/Affection.hs b/src/Affection.hs index 60191d3..5c22a32 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -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(..)) diff --git a/src/Affection/MessageBus.hs b/src/Affection/MessageBus.hs index 1966643..2fcbaf8 100644 --- a/src/Affection/MessageBus.hs +++ b/src/Affection/MessageBus.hs @@ -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