fixed memory leak by using renderer

This commit is contained in:
nek0 2017-02-23 22:54:26 +01:00
parent 379a571147
commit 31d48f021a
2 changed files with 33 additions and 22 deletions

View File

@ -40,19 +40,36 @@ withAffection
:: AffectionConfig us -- ^ Configuration of the Game and its engine.
-> IO ()
withAffection AffectionConfig{..} = do
-- intialiaze SDL
case initComponents of
All ->
SDL.initializeAll
Only is ->
SDL.initialize is
G.gegl_init
-- give SDL render quality
SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
-- just checking…
do
renderQuality <- SDL.get SDL.HintRenderScaleQuality
when (renderQuality /= SDL.ScaleLinear) $
putStrLn "Warning: Linear texture filtering not enabled!"
-- get current time
execTime <- newIORef =<< getTime Monotonic
-- construct window
window <- SDL.createWindow windowTitle windowConfig
-- let surface = (flip SDL.Surface Nothing) rawSurfacePtr
(oldSurf, surface) <- getSurfaces window
SDL.showWindow window
-- create renderer
renderer <- SDL.createRenderer
window
(-1)
SDL.defaultRenderer
-- make draw surface
surface <- SDL.createRGBSurface
(SDL.windowInitialSize windowConfig)
SDL.ABGR8888
let (SDL.Surface ptr _) = surface
rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0
pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek rawSurfacePtr
pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
SDL.V2 (CInt rw) (CInt rh) <- liftIO $ SDL.surfaceDimensions surface
let (w, h) = (fromIntegral rw, fromIntegral rh)
stride = (fromIntegral $ Raw.pixelFormatBytesPerPixel pixelFormat) * w
@ -64,7 +81,7 @@ withAffection AffectionConfig{..} = do
{ quitEvent = False
, userState = x
, drawWindow = window
, windowSurface = oldSurf
, windowRenderer = renderer
, drawSurface = surface
, drawFormat = format
, drawPixels = pixels
@ -76,8 +93,6 @@ withAffection AffectionConfig{..} = do
}) <$> loadState surface
(_, nState) <- runStateT ( A.runState $ do
preLoop
pad <- get
liftIO $ SDL.surfaceBlit (drawSurface pad) Nothing (windowSurface pad) Nothing
whileM_ (do
current <- get
return $ not $ A.quitEvent current
@ -90,6 +105,8 @@ withAffection AffectionConfig{..} = do
ad <- get
-- clean draw requests from last run
mapM_ (invalidateDrawRequest (drawPixels ad) (drawStride ad) (drawCPP ad)) (drawStack ad)
-- clean the renderer form last time
SDL.clear renderer
-- compute dt and update elapsedTime
let dt = (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9)
put $ ad
@ -109,19 +126,20 @@ withAffection AffectionConfig{..} = do
-- save all draw requests to clear in next run
put $ ad2
{ drawStack = clear }
-- blit surface and update window
liftIO $ SDL.surfaceBlit
(drawSurface ad2)
Nothing
(windowSurface ad2)
Nothing
liftIO $ SDL.updateWindowSurface $ drawWindow ad2
-- get texture from surface
texture <- SDL.createTextureFromSurface (windowRenderer ad2) (drawSurface ad2)
-- actual drawing
SDL.copy (windowRenderer ad2) texture Nothing Nothing
SDL.present (windowRenderer ad2)
-- clean the texture
SDL.destroyTexture texture
-- save new time
liftIO $ writeIORef execTime $ now
)
) initContainer
G.gegl_exit
cleanUp $ userState nState
SDL.destroyWindow window
SDL.quit
getSurfaces :: SDL.Window -> IO (SDL.Surface, SDL.Surface)
@ -140,16 +158,9 @@ preHandleEvents evs =
case SDL.eventPayload e of
SDL.WindowMovedEvent _ -> do
liftIO $ traceIO "I was moved"
putNewSurface
return e
_ ->
return e
putNewSurface = do
ad <- get
(oldSurf, _) <- liftIO $ getSurfaces $ drawWindow ad
put ad
{ windowSurface = oldSurf
}
-- | Return the userstate to the user
getAffection :: Affection us us

View File

@ -77,7 +77,7 @@ data AffectionData us = AffectionData
{ quitEvent :: Bool -- ^ Loop breaker.
, userState :: us -- ^ State data provided by user
, drawWindow :: SDL.Window -- ^ SDL window
, windowSurface :: SDL.Surface -- ^ Internal surface of window
, windowRenderer :: SDL.Renderer -- ^ Internal renderer of window
, drawSurface :: SDL.Surface -- ^ SDL surface
, drawFormat :: B.BablFormatPtr -- ^ Target format
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed