95 lines
2.8 KiB
Haskell
95 lines
2.8 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
module Affection
|
|
( withAffection
|
|
-- , withWindow
|
|
-- , withDefaultWindow
|
|
, delaySec
|
|
, get
|
|
, put
|
|
, module A
|
|
) where
|
|
|
|
import qualified SDL
|
|
import qualified SDL.Internal.Numbered as SDL (toNumber)
|
|
import qualified SDL.Raw as Raw
|
|
import qualified GEGL as G
|
|
|
|
import qualified Data.Text as T
|
|
import Data.Maybe
|
|
|
|
import System.Clock
|
|
|
|
import Control.Monad.Loops
|
|
import Control.Monad.State
|
|
import Control.Concurrent.MVar
|
|
|
|
import Affection.Types as A
|
|
import Affection.Draw as A
|
|
|
|
-- | Main function which bootstraps everything else.
|
|
withAffection
|
|
:: AffectionConfig us -- ^ Configuration of the Game and its engine.
|
|
-> IO ()
|
|
withAffection AffectionConfig{..} = do
|
|
case initComponents of
|
|
All ->
|
|
SDL.initializeAll
|
|
Only is ->
|
|
SDL.initialize is
|
|
G.gegl_init
|
|
execTime <- newMVar =<< getTime Monotonic
|
|
window <- SDL.createWindow windowTitle windowConfig
|
|
oldSurf@(SDL.Surface ptr _) <- SDL.getWindowSurface window
|
|
surface <- (\x -> return $ SDL.Surface x Nothing) =<<
|
|
Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0
|
|
initContainer <- return . (\x -> AffectionData
|
|
{ quitEvent = False
|
|
, userState = x
|
|
, drawWindow = window
|
|
, drawSurface = surface
|
|
}) =<< loadState surface
|
|
(_, nState) <- runStateT ( A.runState $
|
|
whileM_ (do
|
|
current <- get
|
|
return $ not $ A.quitEvent current
|
|
)
|
|
(do
|
|
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
|
|
return ()
|
|
)
|
|
) 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
|
|
|
|
-- | block a thread for a specified amount of time
|
|
delaySec
|
|
:: Int -- ^ Number of seconds
|
|
-> IO ()
|
|
delaySec dur = SDL.delay (fromIntegral $ dur * 1000)
|