squeezing even more perfomrance out of it

This commit is contained in:
nek0 2016-12-11 17:38:03 +01:00
parent 5a0b78827c
commit 2b1e6c62f1
5 changed files with 113 additions and 40 deletions

View file

@ -125,15 +125,15 @@ draw = do
format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8)
SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
let (w, h) = (fromIntegral rw, fromIntegral rh)
liftIO $ drawRect foreground (G.RGB 1 0 0) (Line 2) (G.GeglRectangle 10 10 500 500)
liftIO $ G.gegl_node_blit
(nodeGraph M.! "over" :: G.GeglNode)
1
(G.GeglRectangle 0 0 w h)
format
pixels
(fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
[G.GeglBlitDefault]
drawRect foreground (nodeGraph M.! "over") (G.RGB 1 0 0) (Line 2) (G.GeglRectangle 10 10 500 500)
-- liftIO $ G.gegl_node_blit
-- (nodeGraph M.! "over" :: G.GeglNode)
-- 1
-- (G.GeglRectangle 0 0 w h)
-- format
-- pixels
-- (fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
-- [G.GeglBlitDefault]
liftIO $ SDL.unlockSurface drawSurface
liftIO $ SDL.updateWindowSurface drawWindow

View file

@ -59,7 +59,7 @@ load surface = do
[ G.Property "buffer" $ G.PropertyBuffer buffer
]
traceM "buffer-source"
G.gegl_node_link_many [checkerboard, over]
G.gegl_node_link checkerboard over
G.gegl_node_connect_to bufsrc "output" over "aux"
traceM "connections made"
myMap <- return $ M.fromList
@ -82,29 +82,34 @@ draw = do
traceM "drawing"
AffectionData{..} <- get
let UserData{..} = userState
liftIO $ SDL.lockSurface drawSurface
pixels <- liftIO $ SDL.surfacePixels drawSurface
-- liftIO $ SDL.lockSurface drawSurface
-- pixels <- liftIO $ SDL.surfacePixels drawSurface
let SDL.Surface rawSurfacePtr _ = drawSurface
rawSurface <- liftIO $ peek rawSurfacePtr
pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface
format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8)
SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
let (w, h) = (fromIntegral rw, fromIntegral rh)
maybe (return ()) (\(x, y) -> do
liftIO $ drawRect foreground (G.RGB 1 0 0) (Line 2) (G.GeglRectangle (x - 10) (y - 10) 20 20)
liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
maybe (return ()) (\(x, y) ->
drawRect
foreground
(nodeGraph M.! "over")
(G.RGB 1 0 0)
(Line 2)
(G.GeglRectangle (x - 10) (y - 10) 20 20)
) coordinates
-- liftIO $ G.gegl_node_process $ nodeGraph M.! "display"
liftIO $ G.gegl_node_blit
(nodeGraph M.! "over" :: G.GeglNode)
1
(G.GeglRectangle 0 0 w h)
format
pixels
(fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
[G.GeglBlitDefault]
liftIO $ SDL.unlockSurface drawSurface
liftIO $ SDL.updateWindowSurface drawWindow
liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
-- liftIO $ G.gegl_node_blit
-- (nodeGraph M.! "over" :: G.GeglNode)
-- 1
-- (G.GeglRectangle 0 0 w h)
-- format
-- pixels
-- (fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
-- [G.GeglBlitDefault]
-- liftIO $ SDL.unlockSurface drawSurface
-- liftIO $ SDL.updateWindowSurface drawWindow
update :: Double -> AffectionState (AffectionData UserData) IO ()
update sec = do

View file

@ -23,9 +23,14 @@ import Control.Monad.Loops
import Control.Monad.State
import Control.Concurrent.MVar
import Foreign.C.Types (CInt(..))
import Foreign.Storable (peek)
import Affection.Types as A
import Affection.Draw as A
import qualified BABL as B
-- | Main function which bootstraps everything else.
withAffection
:: AffectionConfig us -- ^ Configuration of the Game and its engine.
@ -40,15 +45,24 @@ withAffection AffectionConfig{..} = do
execTime <- newMVar =<< getTime Monotonic
window <- SDL.createWindow windowTitle windowConfig
oldSurf@(SDL.Surface ptr _) <- SDL.getWindowSurface window
surface <- (\x -> return $ SDL.Surface x Nothing) =<<
Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0
rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0
let surface = (flip SDL.Surface Nothing) rawSurfacePtr
bablFormat = B.PixelFormat B.RGBA B.CFu8
pixels <- SDL.surfacePixels surface
format <- B.babl_format bablFormat
SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions surface
pixelFormat <- peek . Raw.surfaceFormat =<< peek rawSurfacePtr
let (w, h) = (fromIntegral rw, fromIntegral rh)
stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w
cpp = B.babl_components_per_pixel bablFormat
initContainer <- return . (\x -> AffectionData
{ quitEvent = False
, userState = x
, drawWindow = window
, drawSurface = surface
, drawStack = []
}) =<< loadState surface
(_, nState) <- runStateT ( A.runState $
(_, nState) <- runStateT ( A.runState $ do
whileM_ (do
current <- get
return $ not $ A.quitEvent current
@ -57,6 +71,10 @@ withAffection AffectionConfig{..} = do
now <- liftIO $ getTime Monotonic
lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime
drawLoop
ad <- get
mapM_ (handleDrawRequest pixels format stride cpp) $ drawStack ad
put $ ad
{ drawStack = [] }
liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing
updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
(fromIntegral 10 ^ 9)

View file

@ -4,13 +4,20 @@
module Affection.Draw
( drawRect
-- , clear
, handleDrawRequest
, present
, clearArea
) where
import Affection.Types (DrawType(..), Affection, GeglRectangle(..), liftIO)
import Affection.Types
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.C.Types
import Control.Monad.State (get, put)
import qualified SDL
import qualified BABL as B
import qualified GEGL as G
@ -18,22 +25,61 @@ import qualified GEGL as G
-- | Draw a rectangle on target buffer
drawRect
:: G.GeglBuffer -- ^ Target buffer
-> G.GeglNode -- ^ Target node
-> G.Color -- ^ Color to draw in
-> DrawType -- ^ Draw type
-> GeglRectangle -- ^ Dimensions of Rectangle
-> IO ()
drawRect buf color (Fill) rect@G.GeglRectangle{..} =
G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $
-> Affection us ()
drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do
liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $
(\(x, y) ->
let col = unsafeColorize color
in
G.Pixel x y col
)
drawRect buf color (Line size) rect@G.GeglRectangle{..} = do
drawRect buf color Fill (G.GeglRectangle rectangleX rectangleY rectangleWidth size)
drawRect buf color Fill (G.GeglRectangle rectangleX rectangleY size rectangleHeight)
drawRect buf color Fill (G.GeglRectangle (rectangleX + rectangleWidth - size) rectangleY size rectangleHeight)
drawRect buf color Fill (G.GeglRectangle rectangleX (rectangleY + rectangleHeight - size) rectangleWidth size)
ad@AffectionData{..} <- get
put $ ad
{ drawStack = (DrawRequest node rect) : drawStack
}
drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do
drawRect buf node color Fill (G.GeglRectangle rectangleX rectangleY rectangleWidth size)
drawRect buf node color Fill (G.GeglRectangle rectangleX rectangleY size rectangleHeight)
drawRect buf node color Fill (G.GeglRectangle (rectangleX + rectangleWidth - size) rectangleY size rectangleHeight)
drawRect buf node color Fill (G.GeglRectangle rectangleX (rectangleY + rectangleHeight - size) rectangleWidth size)
-- | force a blit of a specified area
present
:: G.GeglNode -- ^ Node to blit
-> G.GeglRectangle -- ^ Area to blit
-> Affection us ()
present node rect = do
ad@AffectionData{..} <- get
put $ ad
{ drawStack = (DrawRequest node rect) : drawStack
}
-- | function for handling 'DrawRequest's and updating the output
handleDrawRequest
:: Ptr a -- ^ Pixel buffer to blit to
-> B.BablFormatPtr -- ^ format to blit in
-> Int -- ^ Stride
-> Int -- ^ Components per Pixel
-> DrawRequest -- ^ 'DrawRequest' to handle
-> Affection us ()
handleDrawRequest pixels format stride cpp DrawRequest{..} = do
ad <- get
liftIO $ SDL.lockSurface $ drawSurface ad
liftIO $ G.gegl_node_blit
requestNode
1
requestArea
format
(pixels `plusPtr`
(rectangleX requestArea * cpp + rectangleY requestArea * stride))
stride
[G.GeglBlitDefault]
liftIO $ SDL.unlockSurface $ drawSurface ad
liftIO $ SDL.updateWindowSurface $ drawWindow ad
-- | compute color for a single pixel
colorize

View file

@ -12,6 +12,7 @@ module Affection.Types
-- , Loop(..)
, RGBA(..)
, DrawType(..)
, DrawRequest(..)
, SDL.WindowConfig(..)
, SDL.defaultWindow
-- | Convenience exports
@ -57,11 +58,14 @@ data AffectionData us = AffectionData
, userState :: us -- ^ State data provided by user
, drawWindow :: SDL.Window -- ^ SDL window
, drawSurface :: SDL.Surface -- ^ SDL surface
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequests's to be processed
}
-- -- | Data and surfaces for drawing.
-- data AffectionDraw dd = AffectionDraw
-- }
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
data DrawRequest = DrawRequest
{ requestNode :: G.GeglNode -- ^ The 'G.GeglNode' to blit
, requestArea :: G.GeglRectangle -- ^ The area to update
}
-- | Components to initialize in SDL.
data InitComponents