dusting off

affection.cabal

@@ -36,18 +36,12 @@ flag examples
 
 library
   exposed-modules:     Affection
-                     -- , Affection.Draw
-                     -- , Affection.Particle
                      , Affection.Types
                      , Affection.StateMachine
                      , Affection.MouseInteractable
-                     -- , Affection.Property
-                     -- , Affection.Actor
-                     -- , Affection.Animation
                      , Affection.Util
                      , Affection.MessageBus.Util
                      , Affection.MessageBus.Class
-                     , Affection.MessageBus.Engine
                      , Affection.MessageBus.Message
   default-extensions:  OverloadedStrings
 
@@ -69,8 +63,6 @@ library
                      , text
                      , mtl
                      , time
-                     -- , gegl
-                     -- , babl
                      , monad-loops
                      , monad-parallel
                      , containers
@@ -79,7 +71,6 @@ library
                      , bytestring
                      , OpenGL
                      , stm
-                     -- , sdl2-image
 
 -- executable example00
 --   hs-source-dirs:    examples

src/Affection.hs

@@ -5,8 +5,6 @@ module Affection
     , get
     , getAffection
     , putAffection
-    -- , withWindow
-    -- , withDefaultWindow
     , delaySec
     , get
     , put
@@ -17,7 +15,6 @@ import SDL (($=))
 import qualified SDL
 import qualified SDL.Internal.Numbered as SDL (toNumber)
 import qualified SDL.Raw as Raw
--- import qualified GEGL as G
 
 import Data.Maybe
 import Data.IORef
@@ -33,22 +30,13 @@ import Foreign.Storable (peek)
 import Debug.Trace
 
 import Affection.Types as A
--- import Affection.Draw as A
--- import Affection.Particle as A
 import Affection.StateMachine as A
 import Affection.MouseInteractable as A
--- import Affection.Property as A
--- import Affection.Actor as A
--- import Affection.Animation as A
 import Affection.Util as A
-import Affection.MessageBus.Class as A
+import Affection.MessageBus as A
-import Affection.MessageBus.Message as A
-import Affection.MessageBus.Engine as A
-import Affection.MessageBus.Util as A
 
 import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
 
--- import qualified BABL as B
 
 -- | Main function which bootstraps everything else.
 withAffection
@@ -61,7 +49,6 @@ withAffection AffectionConfig{..} = do
       SDL.initializeAll
     Only is ->
       SDL.initialize is
-  -- G.gegl_init
   -- give SDL render quality
   SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
   -- just checking…
@@ -73,54 +60,23 @@ withAffection AffectionConfig{..} = do
   window <- SDL.createWindow windowTitle windowConfig
   SDL.showWindow window
   context <- SDL.glCreateContext(window)
-  -- -- create renderer
-  -- renderer <- SDL.createRenderer
-  --   window
-  --   (-1)
-  --   SDL.defaultRenderer
-  -- -- make draw texture
-  -- texture <- SDL.createTexture
-  --   renderer
-  --   SDL.ABGR8888
-  --   SDL.TextureAccessStreaming
-  --   (case canvasSize of
-  --     Just (cw, ch) -> (SDL.V2
-  --       (CInt $ fromIntegral cw)
-  --       (CInt $ fromIntegral ch)
-  --       )
-  --     Nothing ->
-  --       SDL.windowInitialSize windowConfig
-  --     )
-  -- -- make draw surface
-  -- -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
   let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfig
       (w, h) = case canvasSize of
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (fromIntegral rw, fromIntegral rh)
-  --     -- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w
-  --     bablFormat = B.PixelFormat B.RGBA B.CFu8
-  --     cpp        = B.babl_components_per_pixel bablFormat
-  --     !stride    = cpp * w
-  -- format <- B.babl_format bablFormat
-  -- get current time
   SDL.setWindowMode window initScreenMode
   SDL.swapInterval $= SDL.SynchronizedUpdates
+  -- get current time
   execTime <- getTime Monotonic
   initContainer <- (\x -> AffectionData
     { quitEvent       = False
     , userState       = x
     , drawWindow      = window
     , glContext       = context
-    -- , windowRenderer  = renderer
-    -- , drawTexture     = texture
-    -- , drawFormat      = format
     , drawDimensions  = case canvasSize of
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (w, h)
     , screenMode      = initScreenMode
-    -- , drawStride      = stride
-    -- , drawCPP         = cpp
-    -- , drawStack       = []
     , elapsedTime     = 0
     , deltaTime       = 0
     , sysTime         = execTime
@@ -138,15 +94,10 @@ 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 the renderer form last time
-        -- SDL.clear renderer
         -- compute dt and update elapsedTime
         let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9)
             !ne = elapsedTime ad + dt
         put $ ad
-          -- { drawStack = []
           { elapsedTime = ne
           , deltaTime = dt
           }
@@ -161,14 +112,8 @@ 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 }
         -- actual drawing
         SDL.glSwapWindow window
-        -- SDL.present (windowRenderer ad2)
         -- save new time
         ad3 <- get
         when (sysTime ad == sysTime ad3) (
@@ -178,7 +123,6 @@ withAffection AffectionConfig{..} = do
           )
       )
     ) initContainer
-  -- G.gegl_exit
   cleanUp $ userState nState
   SDL.destroyWindow window
   SDL.quit

src/Affection/MessageBus.hs

@@ -0,0 +1,7 @@
+module Affection.Messagebus
+  ( module M
+  ) where
+
+import Affection.MessageBus.Class as M
+import Affection.MessageBus.Message as M
+import Affection.MessageBus.Util as M

src/Affection/MessageBus/Class.hs

@@ -16,4 +16,4 @@ class (Message msg) => Participant prt msg where
 
   partListen         :: prt -> IO msg
 
-  partBroadcast      :: prt -> msg -> IO ()
+  partEmit           :: prt -> msg -> IO ()

src/Affection/MessageBus/Engine.hs

@@ -1,3 +0,0 @@
-module Affection.MessageBus.Engine where
-
-import Affection.MessageBus.Class

src/Affection/MessageBus/Message.hs

@@ -6,13 +6,13 @@ import Data.Time.Clock (UTCTime(..))
 class Message msg where
   msgTime :: msg -> UTCTime
 
-data EngineMessage m
+data SystemMessage m
   = MsgUserMessage
     { msgPayload :: m
     , msgWhen :: UTCTime
     }  -- ^ Generic user defined message with custom payload
   | MsgEngineReady UTCTime
 
-instance Message (EngineMessage m) where
+instance Message (SystemMessage m) where
   msgTime (MsgUserMessage _ t) = t
   msgTime (MsgEngineReady t)   = t