removed old module and added cleanup function

This commit is contained in:
nek0 2016-11-13 13:39:25 +01:00
parent 79cdc4934a
commit 6ed98fae2b
4 changed files with 32 additions and 115 deletions

View File

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

View File

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

View File

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

View File

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