diff --git a/affection.cabal b/affection.cabal index 8b3959c..3d9bf49 100644 --- a/affection.cabal +++ b/affection.cabal @@ -69,6 +69,7 @@ library , containers , clock , glib + , bytestring -- , sdl2-image executable example00 diff --git a/src/Affection.hs b/src/Affection.hs index dc82f06..165ac2d 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -73,6 +73,12 @@ withAffection AffectionConfig{..} = do window (-1) SDL.defaultRenderer + -- make draw texture + texture <- SDL.createTexture + renderer + SDL.ABGR8888 + SDL.TextureAccessStreaming + (SDL.windowInitialSize windowConfig) -- make draw surface surface <- SDL.createRGBSurface (SDL.windowInitialSize windowConfig) @@ -91,7 +97,8 @@ withAffection AffectionConfig{..} = do , userState = x , drawWindow = window , windowRenderer = renderer - , drawSurface = surface + -- , drawSurface = surface + , drawTexture = texture , drawFormat = format , drawPixels = pixels , drawDimensions = (w, h) @@ -140,12 +147,12 @@ withAffection AffectionConfig{..} = do put $ ad2 { drawStack = clear } -- get texture from surface - texture <- SDL.createTextureFromSurface (windowRenderer ad2) (drawSurface ad2) + -- 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 + -- SDL.destroyTexture texture -- save new time liftIO $ writeIORef execTime now ) diff --git a/src/Affection/Draw.hs b/src/Affection/Draw.hs index 20620b6..9a1ac08 100644 --- a/src/Affection/Draw.hs +++ b/src/Affection/Draw.hs @@ -14,9 +14,11 @@ module Affection.Draw import Affection.Types import Data.Maybe (maybe) +import Data.ByteString (ByteString) import Foreign import Foreign.C.Types +import Foreign.Marshal.Alloc (malloc, free) import Control.Monad.State (get, put) import Control.Monad (when, unless) @@ -93,6 +95,49 @@ putToSurface pixels realRect stride cpp DrawRequest{..} = do G.GeglAbyssNone liftIO $ SDL.unlockSurface $ drawSurface ad +putToTexture + :: G.GeglRectangle + -> Int + -> Int + -> DrawRequest + -> Affection us () +putToTexture realRect stride cpp DrawRequest{..} = do + ad <- get + destRect <- return $ + SDL.Rectangle + (SDL.P $ SDL.V2 + (CInt $ fromIntegral $ rectangleX realRect) + (CInt $ fromIntegral $ rectangleY realRect) + ) + (SDL.V2 + (CInt $ fromIntegral $ rectangleWidth realRect) + (CInt $ fromIntegral $ rectangleHeight realRect) + ) + (destPtr, destStride) <- SDL.lockTexture + (drawTexture ad) + (Just destRect) + -- destPtr <- liftIO $ malloc :: (Ptr ByteString) + liftIO $ G.gegl_buffer_get + requestBuffer + (Just realRect) + 1 + (Just $ drawFormat ad) + destPtr + stride + G.GeglAbyssNone + -- pixelData <- liftIO $ peekArray + -- (rectangleWidth realRect * rectangleHeight realRect) + -- destPtr + -- SDL.updateTexture + -- (drawTexture ad) + -- (Just $ SDL.Rectangle + -- (SDL.P $ SDL.V2 (rectangleX realRect) (rectangleY realRect)) + -- (SDL.V2 (rectangleWidth realRect) (rectangleHeight realRect)) + -- ) + -- pixelData + -- (CInt $ fromIntegral stride) + SDL.unlockTexture $ drawTexture ad + -- | function for handling 'DrawRequest's and updating the output handleDrawRequest :: Ptr a -- ^ Pixel buffer to blit to @@ -108,7 +153,8 @@ handleDrawRequest pixels stride cpp dr@DrawRequest{..} = do requestArea (uncurry (G.GeglRectangle 0 0) (drawDimensions ad)) maybe (return()) (\realRect -> - putToSurface pixels realRect stride cpp dr + -- putToSurface pixels realRect stride cpp dr + putToTexture realRect stride cpp dr ) mrealRect case requestPersist of Persist -> @@ -131,7 +177,8 @@ invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do (uncurry (G.GeglRectangle 0 0) (drawDimensions ad)) maybe (return()) (\realRect -> do liftIO $ clearArea requestBuffer realRect - putToSurface pixels realRect stride cpp dr + -- putToSurface pixels realRect stride cpp dr + putToTexture realRect stride cpp dr ) mrealRect case requestPersist of Kill (Just victim) -> diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index d659cb4..018c64e 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -82,6 +82,7 @@ data AffectionData us = AffectionData , drawWindow :: SDL.Window -- ^ SDL window , windowRenderer :: SDL.Renderer -- ^ Internal renderer of window , drawSurface :: SDL.Surface -- ^ SDL surface + , drawTexture :: SDL.Texture -- ^ SDL Texture to draw to , drawFormat :: B.BablFormatPtr -- ^ Target format , drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed , drawPixels :: Ptr () -- ^ Destination Pixel buffer