diff --git a/affection.cabal b/affection.cabal index cf45d46..5f4a95e 100644 --- a/affection.cabal +++ b/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 diff --git a/src/Affection.hs b/src/Affection.hs index 3dbb127..fd564ad 100644 --- a/src/Affection.hs +++ b/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.Message as A -import Affection.MessageBus.Engine as A -import Affection.MessageBus.Util as A +import Affection.MessageBus 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 diff --git a/src/Affection/MessageBus.hs b/src/Affection/MessageBus.hs new file mode 100644 index 0000000..ea372ec --- /dev/null +++ b/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 diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs index c02687e..880abac 100644 --- a/src/Affection/MessageBus/Class.hs +++ b/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 () diff --git a/src/Affection/MessageBus/Engine.hs b/src/Affection/MessageBus/Engine.hs deleted file mode 100644 index 9990a94..0000000 --- a/src/Affection/MessageBus/Engine.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Affection.MessageBus.Engine where - -import Affection.MessageBus.Class diff --git a/src/Affection/MessageBus/Message.hs b/src/Affection/MessageBus/Message.hs index 8fe92fe..8b108ee 100644 --- a/src/Affection/MessageBus/Message.hs +++ b/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