fixed memory leak by using renderer

src/Affection.hs

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

src/Affection/Types.hs

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