now works and cleans and everything \o/

This commit is contained in:
nek0 2016-12-11 20:24:16 +01:00
parent fd7f2ff8ba
commit cb158f1b2b
4 changed files with 70 additions and 19 deletions

View file

@ -19,6 +19,7 @@ main = do
{ initComponents = All { initComponents = All
, windowTitle = "Affection: example00" , windowTitle = "Affection: example00"
, windowConfig = SDL.defaultWindow , windowConfig = SDL.defaultWindow
, preLoop = drawInit
, drawLoop = draw , drawLoop = draw
, updateLoop = update , updateLoop = update
, loadState = load , loadState = load
@ -77,6 +78,12 @@ load surface = do
, coordinates = Nothing , coordinates = Nothing
} }
drawInit :: Affection UserData ()
drawInit = do
AffectionData{..} <- get
let UserData{..} = userState
present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True
draw :: Affection UserData () draw :: Affection UserData ()
draw = do draw = do
traceM "drawing" traceM "drawing"
@ -95,8 +102,8 @@ draw = do
drawRect drawRect
foreground foreground
(nodeGraph M.! "over") (nodeGraph M.! "over")
(G.RGB 1 0 0) (G.RGBA 1 0 0 0.5)
(Line 2) (Line 7)
(G.GeglRectangle (x - 10) (y - 10) 20 20) (G.GeglRectangle (x - 10) (y - 10) 20 20)
) coordinates ) coordinates
-- liftIO $ G.gegl_node_process $ nodeGraph M.! "display" -- liftIO $ G.gegl_node_process $ nodeGraph M.! "display"
@ -114,7 +121,6 @@ draw = do
update :: Double -> AffectionState (AffectionData UserData) IO () update :: Double -> AffectionState (AffectionData UserData) IO ()
update sec = do update sec = do
traceM "updating" traceM "updating"
-- liftIO $ delaySec 5
ad@AffectionData{..} <- get ad@AffectionData{..} <- get
let ud@UserData{..} = userState let ud@UserData{..} = userState
traceM $ (show $ 1 / sec) ++ " FPS" traceM $ (show $ 1 / sec) ++ " FPS"

View file

@ -63,6 +63,7 @@ withAffection AffectionConfig{..} = do
, drawStack = [] , drawStack = []
}) =<< loadState surface }) =<< loadState surface
(_, nState) <- runStateT ( A.runState $ do (_, nState) <- runStateT ( A.runState $ do
preLoop
whileM_ (do whileM_ (do
current <- get current <- get
return $ not $ A.quitEvent current return $ not $ A.quitEvent current
@ -70,11 +71,15 @@ withAffection AffectionConfig{..} = do
(do (do
now <- liftIO $ getTime Monotonic now <- liftIO $ getTime Monotonic
lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime
drawLoop
ad <- get ad <- get
mapM_ (handleDrawRequest pixels format stride cpp) $ drawStack ad mapM_ (invalidateDrawRequest pixels format stride cpp) $ drawStack ad
put $ ad put $ ad
{ drawStack = [] } { drawStack = [] }
drawLoop
ad <- get
clear <- return . catMaybes =<< mapM (handleDrawRequest pixels format stride cpp) (drawStack ad)
put $ ad
{ drawStack = clear }
liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing
updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
(fromIntegral 10 ^ 9) (fromIntegral 10 ^ 9)

View file

@ -5,6 +5,7 @@ module Affection.Draw
( drawRect ( drawRect
-- , clear -- , clear
, handleDrawRequest , handleDrawRequest
, invalidateDrawRequest
, present , present
, clearArea , clearArea
) where ) where
@ -15,6 +16,7 @@ import Foreign.Ptr (Ptr, plusPtr)
import Foreign.C.Types import Foreign.C.Types
import Control.Monad.State (get, put) import Control.Monad.State (get, put)
import Control.Monad (when)
import qualified SDL import qualified SDL
@ -22,6 +24,8 @@ import qualified BABL as B
import qualified GEGL as G import qualified GEGL as G
import Debug.Trace
-- | Draw a rectangle on target buffer -- | Draw a rectangle on target buffer
drawRect drawRect
:: G.GeglBuffer -- ^ Target buffer :: G.GeglBuffer -- ^ Target buffer
@ -39,27 +43,29 @@ drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do
) )
ad@AffectionData{..} <- get ad@AffectionData{..} <- get
put $ ad put $ ad
{ drawStack = (DrawRequest node rect) : drawStack { drawStack = (DrawRequest node rect buf False) : drawStack
} }
drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do 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 rectangleWidth size)
drawRect buf node color Fill (G.GeglRectangle rectangleX rectangleY size rectangleHeight) 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 + rectangleWidth - size) rectangleY size rectangleHeight)
drawRect buf node color Fill (G.GeglRectangle rectangleX (rectangleY + rectangleHeight - size) rectangleWidth size) drawRect buf node color Fill (G.GeglRectangle rectangleX (rectangleY + rectangleHeight - size) rectangleWidth size)
ad@AffectionData{..} <- get -- ad@AffectionData{..} <- get
put $ ad -- put $ ad
{ drawStack = (DrawRequest node rect) : drawStack -- { drawStack = (DrawRequest node rect) : drawStack
} -- }
-- | force a blit of a specified area -- | force a blit of a specified area
present present
:: G.GeglNode -- ^ Node to blit :: G.GeglNode -- ^ Node to blit
-> G.GeglBuffer -- ^ BUffer to draw
-> G.GeglRectangle -- ^ Area to blit -> G.GeglRectangle -- ^ Area to blit
-> Bool -- ^ Shall the drawing be cleared in the next run?
-> Affection us () -> Affection us ()
present node rect = do present node buf rect pers = do
ad@AffectionData{..} <- get ad@AffectionData{..} <- get
put $ ad put $ ad
{ drawStack = (DrawRequest node rect) : drawStack { drawStack = (DrawRequest node rect buf pers) : drawStack
} }
-- | function for handling 'DrawRequest's and updating the output -- | function for handling 'DrawRequest's and updating the output
@ -69,8 +75,8 @@ handleDrawRequest
-> Int -- ^ Stride -> Int -- ^ Stride
-> Int -- ^ Components per Pixel -> Int -- ^ Components per Pixel
-> DrawRequest -- ^ 'DrawRequest' to handle -> DrawRequest -- ^ 'DrawRequest' to handle
-> Affection us () -> Affection us (Maybe DrawRequest)
handleDrawRequest pixels format stride cpp DrawRequest{..} = do handleDrawRequest pixels format stride cpp dr@DrawRequest{..} = do
ad <- get ad <- get
liftIO $ SDL.lockSurface $ drawSurface ad liftIO $ SDL.lockSurface $ drawSurface ad
liftIO $ G.gegl_node_blit liftIO $ G.gegl_node_blit
@ -84,6 +90,35 @@ handleDrawRequest pixels format stride cpp DrawRequest{..} = do
[G.GeglBlitDefault] [G.GeglBlitDefault]
liftIO $ SDL.unlockSurface $ drawSurface ad liftIO $ SDL.unlockSurface $ drawSurface ad
liftIO $ SDL.updateWindowSurface $ drawWindow ad liftIO $ SDL.updateWindowSurface $ drawWindow ad
if requestPersist
then
return Nothing
else
return $ Just dr
-- | clear a previously drawn area
invalidateDrawRequest
:: Ptr a -- ^ Pixel buffer to blit to
-> B.BablFormatPtr -- ^ format to blit in
-> Int -- ^ Stride
-> Int -- ^ Components per Pixel
-> DrawRequest -- ^ Drawrequest to invalidate
-> Affection us ()
invalidateDrawRequest pixels format stride cpp dr@DrawRequest{..} = do
ad <- get
liftIO $ clearArea requestBuffer requestArea
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 -- | compute color for a single pixel
colorize colorize

View file

@ -41,9 +41,11 @@ data AffectionConfig us = AffectionConfig
-- ^ Window title -- ^ Window title
, windowConfig :: SDL.WindowConfig , windowConfig :: SDL.WindowConfig
-- ^ Window configuration -- ^ Window configuration
, drawLoop :: AffectionState (AffectionData us) IO () , preLoop :: Affection us ()
-- ^ Actions to be performed, before loop starts
, drawLoop :: Affection us ()
-- ^ Function for updating graphics. -- ^ Function for updating graphics.
, updateLoop :: Double -> AffectionState (AffectionData us) IO () , updateLoop :: Double -> Affection us ()
-- ^ Main update function. Takes fractions of a second as input. -- ^ Main update function. Takes fractions of a second as input.
, loadState :: SDL.Surface -> IO us , loadState :: SDL.Surface -> IO us
-- ^ Provide your own load function to create this data. -- ^ Provide your own load function to create this data.
@ -58,13 +60,16 @@ data AffectionData us = AffectionData
, userState :: us -- ^ State data provided by user , userState :: us -- ^ State data provided by user
, drawWindow :: SDL.Window -- ^ SDL window , drawWindow :: SDL.Window -- ^ SDL window
, drawSurface :: SDL.Surface -- ^ SDL surface , drawSurface :: SDL.Surface -- ^ SDL surface
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequests's to be processed , drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed
, clearStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be invalidated
} }
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
data DrawRequest = DrawRequest data DrawRequest = DrawRequest
{ requestNode :: G.GeglNode -- ^ The 'G.GeglNode' to blit { requestNode :: G.GeglNode -- ^ The 'G.GeglNode' to blit
, requestArea :: G.GeglRectangle -- ^ The area to update , requestArea :: G.GeglRectangle -- ^ The area to update
, requestBuffer :: G.GeglBuffer -- ^ Buffer to draw
, requestPersist :: Bool -- ^ Shall the drawRequest persist
} }
-- | Components to initialize in SDL. -- | Components to initialize in SDL.