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

View file

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