removed old module and added cleanup function

affection.cabal

@@ -33,7 +33,7 @@ flag examples
 
 library
   exposed-modules:     Affection
-                     , Affection.Render
+                     -- , Affection.Render
                      , Affection.Types
   default-extensions:  OverloadedStrings
 

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

src/Affection/Render.hs

@@ -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

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.