particle system now works as a cascade of nodes

This commit is contained in:
nek0 2016-12-23 14:18:39 +01:00
parent 95c008cc4e
commit 388c141e23
7 changed files with 173 additions and 104 deletions

View file

@ -59,7 +59,9 @@ library
, gegl , gegl
, babl , babl
, monad-loops , monad-loops
, containers
, clock , clock
, glib
-- , sdl2-image -- , sdl2-image
executable example00 executable example00
@ -79,22 +81,22 @@ executable example00
else else
buildable: False buildable: False
executable example01 -- executable example01
hs-source-dirs: examples -- hs-source-dirs: examples
main-is: example01.hs -- main-is: example01.hs
ghc-options: -threaded -Wall -- ghc-options: -threaded -Wall
default-language: Haskell2010 -- default-language: Haskell2010
default-extensions: OverloadedStrings -- default-extensions: OverloadedStrings
if flag(examples) -- if flag(examples)
build-depends: base -- build-depends: base
, affection -- , affection
, sdl2 -- , sdl2
, gegl -- , gegl
, babl -- , babl
, containers -- , containers
, mtl -- , mtl
else -- else
buildable: False -- buildable: False
executable example02 executable example02
hs-source-dirs: examples hs-source-dirs: examples

View file

@ -48,13 +48,17 @@ load _ = do
buffer@(G.GeglBuffer b) <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< buffer@(G.GeglBuffer b) <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<
B.babl_format (B.PixelFormat B.RGBA B.CFfloat) B.babl_format (B.PixelFormat B.RGBA B.CFfloat)
bufPtr <- new b bufPtr <- new b
sink <- G.gegl_node_new_child root $ G.Operation "gegl:buffer-sink" sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer"
[ G.Property "buffer" $ G.PropertyPointer $ castPtr bufPtr [ G.Property "buffer" $ G.PropertyBuffer buffer
] ]
traceM "buffer-sink" traceM "buffer-sink"
nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" [] nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" []
traceM "nop" traceM "nop"
G.gegl_node_link_many [checkerboard, over, sink] crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"
[ G.Property "width" $ G.PropertyDouble 800
, G.Property "height" $ G.PropertyDouble 600
]
G.gegl_node_link_many [checkerboard, over, crop, sink]
G.gegl_node_connect_to nop "output" over "aux" G.gegl_node_connect_to nop "output" over "aux"
traceM "connections made" traceM "connections made"
myMap <- return $ M.fromList myMap <- return $ M.fromList
@ -63,6 +67,7 @@ load _ = do
, ("background" , checkerboard) , ("background" , checkerboard)
, ("sink" , sink) , ("sink" , sink)
, ("nop" , nop) , ("nop" , nop)
, ("crop" , crop)
] ]
traceM "loading complete" traceM "loading complete"
return $ UserData return $ UserData
@ -92,6 +97,7 @@ draw = do
(G.GeglRectangle (x - 10) (y - 10) 20 20) (G.GeglRectangle (x - 10) (y - 10) 20 20)
foreground foreground
) coordinates ) coordinates
liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
update :: Double -> AffectionState (AffectionData UserData) IO () update :: Double -> AffectionState (AffectionData UserData) IO ()
update sec = do update sec = do

View file

@ -29,7 +29,6 @@ main = do
data UserData = UserData data UserData = UserData
{ nodeGraph :: M.Map String G.GeglNode { nodeGraph :: M.Map String G.GeglNode
, foreground :: G.GeglBuffer , foreground :: G.GeglBuffer
, coordinates :: Maybe (Int, Int)
, partsys :: ParticleSystem , partsys :: ParticleSystem
} }
@ -45,37 +44,47 @@ load _ = do
traceM "checkerboard" traceM "checkerboard"
over <- G.gegl_node_new_child root G.defaultOverOperation over <- G.gegl_node_new_child root G.defaultOverOperation
traceM "over" traceM "over"
buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< buffer@(G.GeglBuffer b) <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<
B.babl_format (B.PixelFormat B.RGBA B.CFfloat) B.babl_format (B.PixelFormat B.RGBA B.CFfloat)
bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer"
[ G.Property "buffer" $ G.PropertyBuffer buffer [G.Property "buffer" $ G.PropertyBuffer buffer
] ]
traceM "buffer-source" traceM "buffer-sink"
G.gegl_node_link checkerboard over nop <- G.gegl_node_new_child root $ G.Operation "nop" []
G.gegl_node_connect_to bufsrc "output" over "aux" traceM "nop"
crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"
[ G.Property "width" $ G.PropertyDouble 800
, G.Property "height" $ G.PropertyDouble 600
]
traceM "crop"
G.gegl_node_link_many [checkerboard, over, crop, sink]
G.gegl_node_connect_to nop "output" over "aux"
traceM "connections made" traceM "connections made"
myMap <- return $ M.fromList myMap <- return $ M.fromList
[ ("root" , root) [ ("root" , root)
, ("over" , over) , ("over" , over)
, ("background" , checkerboard) , ("background" , checkerboard)
, ("foreground" , bufsrc) , ("sink" , sink)
, ("nop" , nop)
, ("crop" , crop)
] ]
traceM "loading complete" traceM "loading complete"
return $ UserData return $ UserData
{ nodeGraph = myMap { nodeGraph = myMap
, foreground = buffer , foreground = buffer
, coordinates = Nothing , partsys = ParticleSystem [] nop buffer
, partsys = ParticleSystem [] over buffer
} }
drawInit :: Affection UserData () drawInit :: Affection UserData ()
drawInit = do drawInit = return ()
UserData{..} <- getAffection -- UserData{..} <- getAffection
present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True -- 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"
UserData{..} <- getAffection
liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
-- ad <- get -- ad <- get
-- ud <- getAffection -- ud <- getAffection
-- drawParticles partDraw $ particles ud -- drawParticles partDraw $ particles ud
@ -109,17 +118,30 @@ update sec = do
vx <- liftIO $ randomRIO (-20, 20) vx <- liftIO $ randomRIO (-20, 20)
vy <- liftIO $ randomRIO (-20, 20) vy <- liftIO $ randomRIO (-20, 20)
life <- liftIO $ randomRIO (1, 5) life <- liftIO $ randomRIO (1, 5)
tempRoot <- liftIO $ G.gegl_node_new
tempOver <- liftIO $ G.gegl_node_new_child tempRoot
G.defaultOverOperation
tempNop <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation
"gegl:nop" []
liftIO $ G.gegl_node_connect_to tempNop "output" tempOver "aux"
-- traceM $ "position is: " ++ show x ++ " " ++ show y -- traceM $ "position is: " ++ show x ++ " " ++ show y
-- traceM $ "velocity is: " ++ show vx ++ " " ++ show vy -- traceM $ "velocity is: " ++ show vx ++ " " ++ show vy
putAffection $ ud putAffection $ ud
{ coordinates = Just (fromIntegral x, fromIntegral y) { partsys = (partsys ud)
, partsys = (partsys ud)
{ psParts = (Particle { psParts = (Particle
{ particleLife = life { particleLife = life
, particlePosition = (fromIntegral x, fromIntegral y) , particlePosition = (fromIntegral x, fromIntegral y)
, particleRotation = Rad 0 , particleRotation = Rad 0
, particleVelocity = (vx, vy) , particleVelocity = (vx, vy)
, particlePitchRate = Rad 0 , particlePitchRate = Rad 0
, particleRootNode = tempRoot
, particleNodeGraph = M.fromList
[ ("root", tempRoot)
, ("over", tempOver)
, ("nop" , tempNop)
]
, particleStackCont = tempOver
, particleDrawFlange = tempNop
}) : (psParts $ partsys ud) }) : (psParts $ partsys ud)
} }
} }
@ -144,7 +166,6 @@ partUpd :: Double -> Particle -> Particle
partUpd sec p@Particle{..} = partUpd sec p@Particle{..} =
p p
{ particlePosition = (newX, newY) { particlePosition = (newX, newY)
, particleLife = particleLife - sec
} }
where where
newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
@ -153,9 +174,9 @@ partUpd sec p@Particle{..} =
partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData () partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData ()
partDraw buf node Particle{..} = do partDraw buf node Particle{..} = do
ud <- getAffection ud <- getAffection
drawRect drawRect'
buf particleDrawFlange
node
(G.RGBA 1 0 0 0.5) (G.RGBA 1 0 0 0.5)
(Line 5) (Fill)
(G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20) (G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
buf

View file

@ -83,11 +83,11 @@ withAffection AffectionConfig{..} = do
mapM_ (invalidateDrawRequest pixels stride cpp) $ drawStack ad mapM_ (invalidateDrawRequest pixels stride cpp) $ drawStack ad
put $ ad put $ ad
{ drawStack = [] } { drawStack = [] }
-- execute user defined draw loop
drawLoop
-- execute user defined update loop -- execute user defined update loop
updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
(fromIntegral 10 ^ 9) (fromIntegral 10 ^ 9)
-- execute user defined draw loop
drawLoop
-- handle all new draw requests -- handle all new draw requests
ad2 <- get ad2 <- get
clear <- catMaybes <$> mapM (handleDrawRequest pixels stride cpp) (drawStack ad2) clear <- catMaybes <$> mapM (handleDrawRequest pixels stride cpp) (drawStack ad2)

View file

@ -2,8 +2,9 @@
-- | Module for drawing primitives -- | Module for drawing primitives
module Affection.Draw module Affection.Draw
( drawRect (
, drawRect' -- drawRect
drawRect'
-- , clear -- , clear
, handleDrawRequest , handleDrawRequest
, invalidateDrawRequest , invalidateDrawRequest
@ -13,12 +14,14 @@ module Affection.Draw
import Affection.Types import Affection.Types
import Foreign.Ptr (Ptr, plusPtr, nullPtr) import Foreign
import Foreign.C.Types import Foreign.C.Types
import Control.Monad.State (get, put) import Control.Monad.State (get, put)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import System.Glib.GObject
import qualified SDL import qualified SDL
import qualified BABL as B import qualified BABL as B
@ -28,43 +31,43 @@ import qualified GEGL as G
import Debug.Trace 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
-> G.GeglNode -- ^ Target node -- -> G.GeglNode -- ^ Target node
-> G.Color -- ^ Color to draw in -- -> G.Color -- ^ Color to draw in
-> DrawType -- ^ Draw type -- -> DrawType -- ^ Draw type
-> GeglRectangle -- ^ Dimensions of Rectangle -- -> GeglRectangle -- ^ Dimensions of Rectangle
-> Affection us () -- -> Affection us ()
drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do -- drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do
liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $ -- liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $
(\(x, y) -> -- (\(x, y) ->
let col = unsafeColorize color -- let col = unsafeColorize color
in -- in
G.Pixel x y col -- G.Pixel x y col
) -- )
ad@AffectionData{..} <- get -- ad@AffectionData{..} <- get
put $ ad -- put $ ad
{ drawStack = (DrawRequest rect buf False) : drawStack -- { drawStack = (DrawRequest rect buf False) : drawStack
} -- }
drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do -- drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do
liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $ -- liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $
(\(x, y) -> -- (\(x, y) ->
let col = unsafeColorize color -- let col = unsafeColorize color
in if not ((x >= rectangleX + size && x < rectangleX + rectangleWidth - size) && -- in if not ((x >= rectangleX + size && x < rectangleX + rectangleWidth - size) &&
(y >= rectangleY + size && y < rectangleY + rectangleHeight - size)) -- (y >= rectangleY + size && y < rectangleY + rectangleHeight - size))
then -- then
G.Pixel x y col -- G.Pixel x y col
else -- else
G.Pixel x y $ unsafeColorize $ G.RGBA 0 0 0 0 -- G.Pixel x y $ unsafeColorize $ G.RGBA 0 0 0 0
) -- )
ad@AffectionData{..} <- get -- ad@AffectionData{..} <- get
put $ ad -- put $ ad
{ drawStack = (DrawRequest rect buf False) : drawStack -- { drawStack = (DrawRequest rect buf False) : drawStack
} -- }
-- 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)
drawRect' drawRect'
:: G.GeglNode -- ^ Target Node :: G.GeglNode -- ^ Target Node
@ -75,7 +78,8 @@ drawRect'
-> Affection us () -> Affection us ()
drawRect' node color Fill rect@GeglRectangle{..} buf = do drawRect' node color Fill rect@GeglRectangle{..} buf = do
ad <- get ad <- get
opNode <- liftIO $ G.gegl_node_new_child node $ G.Operation "gegl:rectangle" tempRoot <- liftIO $ G.gegl_node_new
opNode <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation "gegl:rectangle"
[ G.Property "x" $ G.PropertyDouble $ fromIntegral rectangleX [ G.Property "x" $ G.PropertyDouble $ fromIntegral rectangleX
, G.Property "y" $ G.PropertyDouble $ fromIntegral rectangleY , G.Property "y" $ G.PropertyDouble $ fromIntegral rectangleY
, G.Property "width" $ G.PropertyDouble $ fromIntegral rectangleWidth , G.Property "width" $ G.PropertyDouble $ fromIntegral rectangleWidth
@ -85,7 +89,7 @@ drawRect' node color Fill rect@GeglRectangle{..} buf = do
diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input" diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
unless diw $ error "Affection.Draw.drawRect': connect failed" unless diw $ error "Affection.Draw.drawRect': connect failed"
put $ ad put $ ad
{ drawStack = (DrawRequest rect buf False) : drawStack ad { drawStack = (DrawRequest rect buf (Kill tempRoot)) : drawStack ad
} }
-- -- | force a blit of a specified area. Do not use often as it slows down the program -- -- | force a blit of a specified area. Do not use often as it slows down the program
@ -135,11 +139,11 @@ handleDrawRequest pixels stride cpp dr@DrawRequest{..} = do
G.GeglAbyssNone G.GeglAbyssNone
liftIO $ SDL.unlockSurface surf liftIO $ SDL.unlockSurface surf
-- liftIO $ SDL.updateWindowSurface $ drawWindow ad -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
if requestPersist case requestPersist of
then Yes ->
return Nothing return Nothing
else Kill _ ->
return $ Just dr return $ Just dr
-- | clear a previously drawn area -- | clear a previously drawn area
invalidateDrawRequest invalidateDrawRequest
@ -151,7 +155,7 @@ invalidateDrawRequest
-> Affection us () -> Affection us ()
invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
ad <- get ad <- get
let !surf = drawSurface ad let surf = drawSurface ad
liftIO $ clearArea requestBuffer requestArea liftIO $ clearArea requestBuffer requestArea
liftIO $ SDL.lockSurface surf liftIO $ SDL.lockSurface surf
liftIO $ G.gegl_buffer_get liftIO $ G.gegl_buffer_get
@ -164,6 +168,8 @@ invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
stride stride
G.GeglAbyssNone G.GeglAbyssNone
liftIO $ SDL.unlockSurface surf liftIO $ SDL.unlockSurface surf
let Kill victim = requestPersist
liftIO $ G.gegl_node_drop victim
-- liftIO $ SDL.updateWindowSurface $ drawWindow ad -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
-- | compute color for a single pixel -- | compute color for a single pixel

View file

@ -9,7 +9,9 @@ module Affection.Particle
import Affection.Types import Affection.Types
import Data.Maybe (catMaybes) import Control.Monad
import Data.Maybe
import qualified GEGL as G import qualified GEGL as G
@ -22,13 +24,28 @@ updateParticle
-- This Function should take the elapsed time -- This Function should take the elapsed time
-- in seconds and the initial particle as arguments. -- in seconds and the initial particle as arguments.
-> Particle -- ^ 'Particle' to be processed -> Particle -- ^ 'Particle' to be processed
-> Maybe Particle -- ^ resulting 'Particle' -> IO (Maybe Particle) -- ^ resulting 'Particle'
updateParticle time funct p@Particle{..} = updateParticle time funct pa =
if particleLife - time < 0 if particleLife pa - time < 0
then then do
Nothing G.gegl_node_drop $ particleRootNode pa
return $ Nothing
else else
Just $ funct time $ p { particleLife = particleLife - time } return $ Just $ funct time $ pa { particleLife = particleLife pa - time }
-- updateParticle time funct acc@[p] pa =
-- if particleLife pa - time < 0
-- then do
-- G.gegl_node_drop $ particleRootNode pa
-- return $ Nothing : acc
-- else
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc
-- updateParticle time funct acc@(p:ps) pa =
-- if particleLife pa - time < 0
-- then do
-- G.gegl_node_drop $ particleRootNode pa
-- return $ Nothing : acc
-- else
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc
drawParticles drawParticles
:: (Particle -> Affection us ()) :: (Particle -> Affection us ())
@ -43,7 +60,10 @@ updateParticleSystem
-> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ()) -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
-> Affection us ParticleSystem -> Affection us ParticleSystem
updateParticleSystem sys sec upd draw = do updateParticleSystem sys sec upd draw = do
let x = catMaybes $ map (updateParticle sec upd) (psParts sys) -- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
-- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys)
x <- liftIO $ catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode sys]
mapM_ (draw (psBuffer sys) (psNode sys)) x mapM_ (draw (psBuffer sys) (psNode sys)) x
return $ sys return $ sys
{ psParts = x } { psParts = x }

View file

@ -13,6 +13,7 @@ module Affection.Types
, RGBA(..) , RGBA(..)
, DrawType(..) , DrawType(..)
, DrawRequest(..) , DrawRequest(..)
, RequestPersist(..)
, Angle(..) , Angle(..)
, ConvertAngle(..) , ConvertAngle(..)
-- | Particle system -- | Particle system
@ -30,6 +31,7 @@ module Affection.Types
import qualified SDL.Init as SDL import qualified SDL.Init as SDL
import qualified SDL.Video as SDL import qualified SDL.Video as SDL
import qualified Data.Text as T import qualified Data.Text as T
import Data.Map
import qualified GEGL as G import qualified GEGL as G
import qualified BABL as B import qualified BABL as B
@ -81,9 +83,13 @@ data AffectionData us = AffectionData
data DrawRequest = DrawRequest data DrawRequest = DrawRequest
{ requestArea :: G.GeglRectangle -- ^ The area to update { requestArea :: G.GeglRectangle -- ^ The area to update
, requestBuffer :: G.GeglBuffer -- ^ Buffer to draw , requestBuffer :: G.GeglBuffer -- ^ Buffer to draw
, requestPersist :: Bool -- ^ Shall the drawRequest persist , requestPersist :: RequestPersist -- ^ Shall the drawRequest persist
} }
data RequestPersist
= Yes
| Kill G.GeglNode
-- | A type for storing 'DrawRequest' results to be executed frequently. TODO -- | A type for storing 'DrawRequest' results to be executed frequently. TODO
data DrawAsset = DrawAsset data DrawAsset = DrawAsset
@ -159,17 +165,25 @@ instance Eq Angle where
-- | A single particle -- | A single particle
data Particle = Particle data Particle = Particle
{ particleLife :: Double { particleLife :: Double
-- ^ Time to live in seconds -- ^ Time to live in seconds
, particlePosition :: (Double, Double) , particlePosition :: (Double, Double)
-- ^ Position of particle on canvas -- ^ Position of particle on canvas
, particleRotation :: Angle , particleRotation :: Angle
-- ^ Particle rotation -- ^ Particle rotation
, particleVelocity :: (Int, Int) , particleVelocity :: (Int, Int)
-- ^ particle velocity as vector of pixels per second -- ^ particle velocity as vector of pixels per second
, particlePitchRate :: Angle , particlePitchRate :: Angle
-- ^ Rotational velocity of particle in angle per second -- ^ Rotational velocity of particle in angle per second
} deriving (Show, Eq) , particleRootNode :: G.GeglNode
-- ^ Root 'G.GeglNode' of 'Particle'
, particleNodeGraph :: Map String G.GeglNode
-- ^ Node Graph of 'G.GeglNodes' per particle
, particleStackCont :: G.GeglNode
-- ^ 'G.GeglNode' to connect other 'Particle's to
, particleDrawFlange :: G.GeglNode
-- ^ 'G.GeglNode' to connect draw actions to
}
data ParticleSystem = ParticleSystem data ParticleSystem = ParticleSystem
{ psParts :: [Particle] { psParts :: [Particle]