diff --git a/affection.cabal b/affection.cabal --- a/affection.cabal +++ b/affection.cabal @@ -6,7 +6,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.0.3 +version: 0.0.0.4 synopsis: A simple Game Engine using SDL description: This package contains Affection, a simple game engine written in Haskell using SDL and GEGL. @@ -57,7 +57,6 @@ build-depends: base >=4.9 && <4.10 , sdl2 , text - , linear , mtl , gegl , babl diff --git a/src/Affection.hs b/src/Affection.hs --- a/src/Affection.hs +++ b/src/Affection.hs @@ -40,19 +40,36 @@ :: 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 @@ { quitEvent = False , userState = x , drawWindow = window - , windowSurface = oldSurf + , windowRenderer = renderer , drawSurface = surface , drawFormat = format , drawPixels = pixels @@ -76,8 +93,6 @@ }) <$> 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 @@ 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 @@ -- 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) @@ -131,6 +149,7 @@ let surface = (flip SDL.Surface Nothing) rawSurfacePtr return (oldSurf, surface) +-- Prehandle SDL events in case any window events occur preHandleEvents :: [SDL.Event] -> Affection us [SDL.Event] preHandleEvents evs = mapM handle evs @@ -139,27 +158,9 @@ case SDL.eventPayload e of SDL.WindowMovedEvent _ -> do liftIO $ traceIO "I was moved" - putNewSurface return e _ -> return e - putNewSurface = do - ad <- get - (oldSurf, surface) <- liftIO $ getSurfaces $ drawWindow ad - pixels <- SDL.surfacePixels $ surface - SDL.V2 (CInt rw) (CInt rh) <- liftIO $ SDL.surfaceDimensions surface - let (SDL.Surface ptr _) = surface - rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0 - pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek rawSurfacePtr - let (w, h) = (fromIntegral rw, fromIntegral rh) - stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w - put ad - { windowSurface = oldSurf - , drawSurface = surface - , drawPixels = pixels - , drawDimensions = (w, h) - , drawStride = stride - } -- | Return the userstate to the user getAffection :: Affection us us diff --git a/src/Affection/Particle.hs b/src/Affection/Particle.hs --- a/src/Affection/Particle.hs +++ b/src/Affection/Particle.hs @@ -117,21 +117,25 @@ -> Affection us ParticleSystem updateParticleSystem sys sec upd draw = do x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts sys) + -- liftIO $ traceIO $ show $ length x -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys) - when (not $ null x) $ do - -- liftIO $ G.gegl_node_link_many $ map particleStackCont (partStorList $ partSysParts sys) - -- liftIO $ traceIO "linking last node to output" - liftIO $ G.gegl_node_link (particleStackCont $ head x) (partSysNode sys) - mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x - return $ sys - { partSysParts = (partSysParts sys) - { partStorList = x - , partStorLatest = - if null x - then Nothing - else partStorLatest (partSysParts sys) - } - } + if (not $ null x) + then do + -- liftIO $ G.gegl_node_link_many $ map particleStackCont (partStorList $ partSysParts sys) + -- liftIO $ traceIO "linking last node to output" + liftIO $ G.gegl_node_link (particleStackCont $ head x) (partSysNode sys) + mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x + return $ sys + { partSysParts = (partSysParts sys) + { partStorList = x + , partStorLatest = + if null x + then Nothing + else partStorLatest (partSysParts sys) + } + } + else + return sys -- | Function for inserting a new 'Particle' into its 'PartileSystem' insertParticle diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -77,7 +77,7 @@ { 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