678c830e33
This was an issue with the default surface created by sdl, which had the wrong color format. For the future it is advised to use the RGBA CFu8 format from babl, or things may break again.
94 lines
2.7 KiB
Haskell
94 lines
2.7 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
module Affection
|
|
( withAffection
|
|
, withWindow
|
|
, withDefaultWindow
|
|
, delaySec
|
|
, get
|
|
, put
|
|
, module Affection.Render
|
|
, module Types
|
|
) where
|
|
|
|
import qualified SDL
|
|
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.Monad.Reader
|
|
import Control.Concurrent.MVar
|
|
|
|
import Affection.Render
|
|
import Affection.Types as Types
|
|
|
|
-- | Main function which bootstraps everything else.
|
|
withAffection
|
|
:: AffectionConfig us -- ^ Configuration of the Game and its engine.
|
|
-> IO ()
|
|
withAffection conf@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 vect) <- SDL.getWindowSurface window
|
|
surface <- (\x -> return $ SDL.Surface x Nothing) =<< Raw.convertSurfaceFormat ptr Raw.SDL_PIXELFORMAT_ABGR8888 0
|
|
initContainer <- return . (\x -> AffectionData
|
|
{ quitEvent = False
|
|
, userState = x
|
|
, drawWindow = window
|
|
, drawSurface = surface
|
|
}) =<< loadState surface
|
|
(res, 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
|
|
updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
|
|
(fromIntegral 10 ^ 9)
|
|
_ <- liftIO $ swapMVar execTime $ now
|
|
return ()
|
|
)
|
|
) initContainer
|
|
G.gegl_exit
|
|
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)
|