From 6ed98fae2b374cbbc107865becfa76f4984e8f2f Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 13 Nov 2016 13:39:25 +0100 Subject: [PATCH] removed old module and added cleanup function --- affection.cabal | 2 +- src/Affection.hs | 49 ++++++++++++----------- src/Affection/Render.hs | 86 ----------------------------------------- src/Affection/Types.hs | 10 +++-- 4 files changed, 32 insertions(+), 115 deletions(-) delete mode 100644 src/Affection/Render.hs diff --git a/affection.cabal b/affection.cabal index ce8a6fd..db5ea25 100644 --- a/affection.cabal +++ b/affection.cabal @@ -33,7 +33,7 @@ flag examples library exposed-modules: Affection - , Affection.Render + -- , Affection.Render , Affection.Types default-extensions: OverloadedStrings diff --git a/src/Affection.hs b/src/Affection.hs index 205bcb9..ad82c5e 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -1,12 +1,11 @@ {-# LANGUAGE RecordWildCards #-} module Affection ( withAffection - , withWindow - , withDefaultWindow + -- , withWindow + -- , withDefaultWindow , delaySec , get , put - , module Affection.Render , module Types ) where @@ -23,7 +22,6 @@ import Control.Monad.Loops import Control.Monad.State import Control.Concurrent.MVar -import Affection.Render import Affection.Types as Types -- | Main function which bootstraps everything else. @@ -48,16 +46,16 @@ withAffection AffectionConfig{..} = do , drawWindow = window , drawSurface = surface }) =<< loadState surface - (_, _) <- runStateT ( Types.runState $ + (_, nState) <- runStateT ( Types.runState $ whileM_ (do current <- get return $ not $ Types.quitEvent current ) (do - liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing now <- liftIO $ getTime Monotonic lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime drawLoop + liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9) _ <- liftIO $ swapMVar execTime $ now @@ -65,27 +63,28 @@ withAffection AffectionConfig{..} = do ) ) initContainer G.gegl_exit + cleanUp $ userState nState SDL.quit --- | DEPRECATED! --- Function for bootstraping a window. -withWindow :: Monad m => T.Text -> WindowConfig -> SDL.RendererConfig -> RenderT m a -> IO () -withWindow title wconf rconf ops = do - window <- SDL.createWindow title wconf - -- I don't need a renderer here, i need a surface - renderer <- SDL.createRenderer window (-1) rconf - surface <- SDL.getWindowSurface window - G.gegl_init - -- I think I need some AffectionT or someting similar here and not a RenderT - -- from SDL. - inRender renderer $ ops - G.gegl_exit - SDL.destroyWindow window - --- | DEPRECATED! --- Bootstrap a default window. -withDefaultWindow :: Monad m => T.Text -> (RenderT m a) -> IO () -withDefaultWindow title ops = withWindow title defaultWindow SDL.defaultRenderer ops +-- -- | DEPRECATED! +-- -- Function for bootstraping a window. +-- withWindow :: Monad m => T.Text -> WindowConfig -> SDL.RendererConfig -> RenderT m a -> IO () +-- withWindow title wconf rconf ops = do +-- window <- SDL.createWindow title wconf +-- -- I don't need a renderer here, i need a surface +-- renderer <- SDL.createRenderer window (-1) rconf +-- surface <- SDL.getWindowSurface window +-- G.gegl_init +-- -- I think I need some AffectionT or someting similar here and not a RenderT +-- -- from SDL. +-- inRender renderer $ ops +-- G.gegl_exit +-- SDL.destroyWindow window +-- +-- -- | DEPRECATED! +-- -- Bootstrap a default window. +-- withDefaultWindow :: Monad m => T.Text -> (RenderT m a) -> IO () +-- withDefaultWindow title ops = withWindow title defaultWindow SDL.defaultRenderer ops -- | block a thread for a specified amount of time delaySec diff --git a/src/Affection/Render.hs b/src/Affection/Render.hs deleted file mode 100644 index 744a17b..0000000 --- a/src/Affection/Render.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# LANGUAGE GADTs, KindSignatures, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} - -module Affection.Render - ( RenderM - , inRender - , RenderT - , liftIO - , changeColor - , clear - , present - ) where - -import Affection.Types -import qualified SDL -import Linear (V4(..)) -import Control.Monad.Trans - -data RenderM :: * -> * where - Pure :: a -> RenderM a - Bind :: RenderM a -> (a -> RenderM b) -> RenderM b - Render :: (SDL.Renderer -> IO a) -> RenderM a - -instance Functor RenderM where - fmap f m = Bind m (Pure . f) - -instance Applicative RenderM where - pure = Pure - mf <*> mx = Bind mf (\f -> Bind mx (\x -> Pure (f x))) - -instance Monad RenderM where - m >>= f = Bind m f - -inRenderM :: SDL.Renderer -> RenderM a -> IO a -inRenderM _ (Pure a) = return a -inRenderM r (Bind m f) = do - result <- inRenderM r m - inRenderM r (f result) -inRenderM r (Render f) = f r - -data RenderT :: (* -> *) -> * -> * where - TPure :: a -> RenderT m a - TBind :: RenderT m a -> (a -> RenderT m b) -> RenderT m b - -- RunRenderT :: RenderT IO a -> IO a - TLift :: (Monad m) => m a -> RenderT m a - TLiftIO :: IO a -> RenderT m a - TRender :: (SDL.Renderer -> IO a) -> RenderT RenderM a - -instance Functor (RenderT m) where - fmap f m = TBind m (TPure . f) - -instance Applicative (RenderT m) where - pure = TPure - mf <*> mx = TBind mf (\f -> TBind mx (\x -> TPure (f x))) - -instance Monad m => Monad (RenderT m) where - return = TPure - x >>= f = TBind x f - -instance MonadTrans RenderT where - lift = TLift - -instance Monad m => MonadIO (RenderT m) where - liftIO = TLiftIO - -inRender :: Monad m => SDL.Renderer -> RenderT m a -> IO a -inRender _ (TPure a) = return a -inRender r (TBind m f) = do - result <- inRender r m - inRender r (f result) --- inRender r (TLift x) = return x -inRender _ (TLiftIO x) = x -inRender r (TRender f) = f r - -changeColor :: RGBA -> RenderT RenderM () -changeColor (RGBA r g b a) = TRender $ \rend -> - SDL.rendererDrawColor rend SDL.$= V4 - (fromIntegral r) - (fromIntegral g) - (fromIntegral b) - (fromIntegral a) - -clear :: RenderT RenderM () -clear = TRender $ \r -> SDL.clear r - -present :: RenderT RenderM () -present = TRender $ \r -> SDL.present r diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index eca0baf..33618d8 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -5,13 +5,15 @@ module Affection.Types , AffectionState(..) -- , AffectionDraw(..) -- , Draw(..) - , AffectionStateInner(..) + , AffectionStateInner -- , AffectionDrawInner(..) , InitComponents(..) -- , Loop(..) , RGBA(..) , SDL.WindowConfig(..) , SDL.defaultWindow + -- | Convenience exports + , liftIO ) where import qualified SDL.Init as SDL @@ -20,9 +22,9 @@ import qualified Data.Text as T import Control.Monad.IO.Class import Control.Monad.State -import Control.Monad.Reader +-- import Control.Monad.Reader -import Control.Concurrent.MVar +-- import Control.Concurrent.MVar -- | Configuration for the aplication. needed at startup. data AffectionConfig us = AffectionConfig @@ -38,6 +40,8 @@ data AffectionConfig us = AffectionConfig -- ^ Main update function. Takes fractions of a second as input. , loadState :: SDL.Surface -> IO us -- ^ Provide your own load function to create this data. + , cleanUp :: us -> IO () + -- ^ Provide your own finisher function to clean your data. } -- | Main type for defining the look, feel and action of the whole application.