diff --git a/examples/example01.hs b/examples/example01.hs index 5ec6295..084a844 100644 --- a/examples/example01.hs +++ b/examples/example01.hs @@ -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 diff --git a/examples/example02.hs b/examples/example02.hs index f32721c..7d22021 100644 --- a/examples/example02.hs +++ b/examples/example02.hs @@ -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 diff --git a/src/Affection.hs b/src/Affection.hs index addd755..d08e4d9 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -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) diff --git a/src/Affection/Draw.hs b/src/Affection/Draw.hs index b1d5091..6be8e4a 100644 --- a/src/Affection/Draw.hs +++ b/src/Affection/Draw.hs @@ -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 diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index a710371..b58f75c 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -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