diff --git a/src/Affection.hs b/src/Affection.hs index 00a2837..7210c40 100644 --- a/src/Affection.hs +++ b/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 diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index 7ac003d..1bb4d24 100644 --- a/src/Affection/Types.hs +++ b/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