Merge branch 'buffer-get'

This commit is contained in:
nek0 2016-12-26 14:18:02 +01:00
commit 44fdd2e766
10 changed files with 523 additions and 269 deletions

View file

@ -49,7 +49,7 @@ library
, UndecidableInstances , UndecidableInstances
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall -debug
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
build-depends: base >=4.9 && <4.10 build-depends: base >=4.9 && <4.10
, sdl2 , sdl2
@ -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
@ -116,7 +118,7 @@ executable example02
executable example03 executable example03
hs-source-dirs: examples hs-source-dirs: examples
main-is: example03.hs main-is: example03.hs
ghc-options: -threaded -Wall -auto-all -caf-all -rtsopts ghc-options: -threaded -Wall -auto-all -caf-all -rtsopts -debug
default-language: Haskell2010 default-language: Haskell2010
default-extensions: OverloadedStrings default-extensions: OverloadedStrings
if flag(examples) if flag(examples)
@ -130,3 +132,21 @@ executable example03
, random , random
else else
buildable: False buildable: False
-- executable example04
-- hs-source-dirs: examples
-- main-is: example04.hs
-- ghc-options: -threaded -Wall -auto-all -caf-all -rtsopts
-- default-language: Haskell2010
-- default-extensions: OverloadedStrings
-- if flag(examples)
-- build-depends: base
-- , affection
-- , sdl2
-- , gegl
-- , babl
-- , containers
-- , mtl
-- , random
-- else
-- buildable: False

View file

@ -7,6 +7,8 @@ import qualified GEGL as G
import qualified BABL as B import qualified BABL as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Control.Monad (when)
import Foreign.Storable (peek) import Foreign.Storable (peek)
import Foreign.C.Types (CInt(..)) import Foreign.C.Types (CInt(..))
@ -36,7 +38,6 @@ main = do
data UserData = UserData data UserData = UserData
{ nodeGraph :: M.Map String G.GeglNode { nodeGraph :: M.Map String G.GeglNode
, elapsedTime :: Double
} }
load :: SDL.Surface -> IO UserData load :: SDL.Surface -> IO UserData
@ -53,7 +54,7 @@ load _ = do
traceM "over" traceM "over"
text <- G.gegl_node_new_child root $ G.textOperation text <- G.gegl_node_new_child root $ G.textOperation
[ G.Property "string" $ G.PropertyString "Hello world!" [ G.Property "string" $ G.PropertyString "Hello world!"
, G.Property "color" $ G.PropertyColor $ G.RGBA 0 0 1 0.1 , G.Property "color" $ G.PropertyColor $ G.RGBA 0 0 1 0.5
, G.Property "size" $ G.PropertyDouble 40 , G.Property "size" $ G.PropertyDouble 40
] ]
traceM "text" traceM "text"
@ -69,7 +70,6 @@ load _ = do
traceM "loading complete" traceM "loading complete"
return $ UserData return $ UserData
{ nodeGraph = myMap { nodeGraph = myMap
, elapsedTime = 0
} }
draw :: Affection UserData () draw :: Affection UserData ()
@ -99,18 +99,10 @@ draw = do
update :: Double -> Affection UserData () update :: Double -> Affection UserData ()
update sec = do update sec = do
traceM "updating" traceM "updating"
-- liftIO $ delaySec 5 ad <- get
ad@AffectionData{..} <- get ud@UserData{..} <- getAffection
let ud@UserData{..} = userState traceM $ (show $ 1 / sec) ++ " FPS"
traceM $ show elapsedTime when (elapsedTime ad > 5) $
if elapsedTime < 5
then
put $ ad
{ userState = ud
{ elapsedTime = elapsedTime + sec
}
}
else
put $ ad put $ ad
{ quitEvent = True { quitEvent = True
} }

View file

@ -7,6 +7,8 @@ import qualified GEGL as G
import qualified BABL as B import qualified BABL as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Control.Monad (when)
import Foreign.Storable (peek) import Foreign.Storable (peek)
import Foreign.C.Types import Foreign.C.Types
@ -37,7 +39,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
, elapsedTime :: Double
} }
load :: SDL.Surface -> IO UserData load :: SDL.Surface -> IO UserData
@ -54,111 +55,48 @@ load _ = do
traceM "over" traceM "over"
buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< buffer <- 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-source"
G.gegl_node_link checkerboard over nop <- G.gegl_node_new_child root $ G.Operation "gegl: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
]
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)
] ]
let roi = G.GeglRectangle 0 0 20 20 let roi = G.GeglRectangle 0 0 20 20
-- G.iterateOver
-- buffer
-- roi
-- (B.PixelFormat B.RGBA B.CFfloat)
-- G.GeglAccessReadWrite
-- G.GeglAbyssNone
-- (\(G.Pixel px py pc) ->
-- let dsqr = (((10 - px) ^ 2) + ((10 - py) ^ 2))
-- (G.CVfloat (CFloat pr), G.CVfloat (CFloat pg), G.CVfloat (CFloat pb), G.CVfloat (CFloat pa)) = pc
-- dist = (sqrt (fromIntegral dsqr :: Float))
-- in if dsqr < 100
-- then
-- if dist < fromIntegral 9
-- then
-- G.Pixel px py
-- ( G.CVfloat $ CFloat 0
-- , G.CVfloat $ CFloat 0
-- , G.CVfloat $ CFloat 0
-- , G.CVfloat $ CFloat $ if pa < 1 then 1 else pa
-- )
-- else
-- let alpha = fromIntegral 10 - dist
-- dst_a = pa
-- a = alpha + dst_a * (1 - alpha)
-- a_term = dst_a * (1 - alpha)
-- red = 0 * alpha + pr * a_term
-- gre = 0 * alpha + pg * a_term
-- blu = 0 * alpha + pb * a_term
-- in
-- G.Pixel px py
-- ( G.CVfloat $ CFloat $ red / a
-- , G.CVfloat $ CFloat $ gre / a
-- , G.CVfloat $ CFloat $ blu / a
-- , G.CVfloat $ CFloat $ if pa < alpha then alpha else pa
-- )
-- else
-- G.Pixel px py pc
-- )
traceM "loading complete" traceM "loading complete"
return $ UserData return $ UserData
{ nodeGraph = myMap { nodeGraph = myMap
, foreground = buffer , foreground = buffer
, elapsedTime = 0
} }
draw :: Affection UserData () draw :: Affection UserData ()
draw = do draw = do
traceM "drawing" traceM "drawing"
UserData{..} <- getAffection UserData{..} <- getAffection
-- AffectionData{..} <- get drawRect (nodeGraph M.! "nop") (G.RGB 1 0 0) Fill (G.GeglRectangle 10 10 500 500) foreground
-- let UserData{..} = userState liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
-- -- 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)
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
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 -- liftIO $ delaySec 5
ad@AffectionData{..} <- get ad <- get
let ud@UserData{..} = userState ud@UserData{..} <- getAffection
traceM $ (show $ 1 / sec) ++ " FPS" traceM $ (show $ 1 / sec) ++ " FPS"
if elapsedTime < 20 when (elapsedTime ad > 20) $
then do
fg <- liftIO $ G.gegl_buffer_get_extent foreground
_ <- liftIO $ G.gegl_buffer_set_extent foreground $ fg
{ G.rectangleX = G.rectangleX fg + 1
, G.rectangleY = G.rectangleY fg + 1
}
put $ ad
{ userState = ud
{ elapsedTime = elapsedTime + sec
}
}
else
put $ ad put $ ad
{ quitEvent = True { quitEvent = True
} }

View file

@ -3,10 +3,13 @@
import Affection import Affection
import qualified SDL import qualified SDL
import qualified GEGL as G import qualified GEGL as G
import qualified GEGL.FFI.Buffer as G
import qualified BABL as B import qualified BABL as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Foreign.C.Types import Foreign.C.Types
import Foreign.Marshal.Utils (new)
import Foreign.Ptr (castPtr)
import Debug.Trace import Debug.Trace
@ -16,7 +19,7 @@ main = do
{ initComponents = All { initComponents = All
, windowTitle = "Affection: example00" , windowTitle = "Affection: example00"
, windowConfig = SDL.defaultWindow , windowConfig = SDL.defaultWindow
, preLoop = drawInit , preLoop = return ()
, drawLoop = draw , drawLoop = draw
, updateLoop = update , updateLoop = update
, loadState = load , loadState = load
@ -42,20 +45,29 @@ 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 bufPtr <- new b
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 "gegl: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
]
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
@ -64,10 +76,10 @@ load _ = do
, coordinates = Nothing , coordinates = Nothing
} }
drawInit :: Affection UserData () -- drawInit :: Affection UserData ()
drawInit = do -- drawInit = do
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
@ -79,12 +91,13 @@ draw = do
liftIO $ clearArea foreground (GeglRectangle 0 0 w h) liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
maybe (return ()) (\(x, y) -> maybe (return ()) (\(x, y) ->
drawRect drawRect
foreground (nodeGraph M.! "nop")
(nodeGraph M.! "over")
(G.RGBA 1 0 0 0.5) (G.RGBA 1 0 0 0.5)
(Line 7) (Fill)
(G.GeglRectangle (x - 10) (y - 10) 20 20) (G.GeglRectangle (x - 10) (y - 10) 20 20)
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

@ -4,8 +4,11 @@ import Affection
import qualified SDL import qualified SDL
import qualified GEGL as G import qualified GEGL as G
import qualified BABL as B import qualified BABL as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Control.Monad (when)
import Foreign.C.Types import Foreign.C.Types
import System.Random (randomRIO) import System.Random (randomRIO)
@ -29,7 +32,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 +47,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 "gegl: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 (ParticleStorage Nothing []) nop buffer
, partsys = ParticleSystem [] over buffer
} }
drawInit :: Affection UserData () drawInit :: Affection UserData ()
drawInit = do drawInit = do
UserData{..} <- getAffection UserData{..} <- getAffection
present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True present (GeglRectangle 0 0 800 600) foreground 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,20 +121,47 @@ 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)
r <- liftIO $ randomRIO (0,1)
g <- liftIO $ randomRIO (0,1)
b <- liftIO $ randomRIO (0,1)
tempRoot <- liftIO $ G.gegl_node_new
tempOver <- liftIO $ G.gegl_node_new_child tempRoot
G.defaultOverOperation
tempRect <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation
"gegl:rectangle"
[ G.Property "x" $ G.PropertyDouble $ fromIntegral x - 10
, G.Property "y" $ G.PropertyDouble $ fromIntegral y - 10
, G.Property "width" $ G.PropertyDouble 20
, G.Property "height" $ G.PropertyDouble 20
, G.Property "color" $ G.PropertyColor $ (G.RGBA r g b 0.5)
]
liftIO $ G.gegl_node_connect_to tempRect "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 ips <- insertParticle (partsys ud) $
{ coordinates = Just (fromIntegral x, fromIntegral y) Particle
, partsys = (partsys ud) { particleTimeToLive = life
{ psParts = (Particle , particleCreation = elapsedTime ad
{ 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
}) : (psParts $ partsys ud) , particleRootNode = tempRoot
, particleNodeGraph = M.fromList
[ ("root", tempRoot)
, ("over", tempOver)
, ("rect", tempRect)
]
, particleStackCont = tempOver
, particleDrawFlange = tempOver
} }
putAffection $ ud
{ partsys = ips
} }
-- when (not $ null $ psParts $ partsys ud) $
-- liftIO $ G.gegl_node_link
-- tempOver
-- (particleStackCont $ head $ psParts $ partsys ud)
else else
return () return ()
SDL.WindowClosedEvent _ -> do SDL.WindowClosedEvent _ -> do
@ -140,22 +179,28 @@ update sec = do
clean :: UserData -> IO () clean :: UserData -> IO ()
clean _ = return () clean _ = return ()
partUpd :: Double -> Particle -> Particle partUpd :: Double -> Particle -> Affection UserData Particle
partUpd sec p@Particle{..} = partUpd sec p@Particle{..} = do
p let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
{ particlePosition = (newX, newY)
, particleLife = particleLife - sec
}
where
newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity)
liftIO $ G.gegl_node_set (particleNodeGraph M.! "rect") $ G.Operation "gegl:rectangle"
[ G.Property "x" $ G.PropertyDouble $ newX - 10
, G.Property "y" $ G.PropertyDouble $ newY - 10
]
return p
{ particlePosition = (newX, newY)
}
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 present
drawRect (G.GeglRectangle (floor $ fst particlePosition - 10) (floor $ snd particlePosition - 10) 20 20)
buf buf
node False
(G.RGBA 1 0 0 0.5) -- ud <- getAffection
(Line 5) -- drawRect'
(G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20) -- particleDrawFlange
-- (G.RGBA 1 0 0 0.5)
-- (Fill)
-- (G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
-- buf

120
examples/example04.hs Normal file
View file

@ -0,0 +1,120 @@
{-# LANGUAGE RecordWildCards #-}
import Affection
import qualified SDL
import qualified GEGL as G
import qualified BABL as B
import qualified BABL.FFI.Format as B
import qualified Data.Map.Strict as M
import Foreign.C.Types
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.Marshal.Utils (new)
import System.Random (randomRIO)
import Control.Monad (unless)
import Debug.Trace
main :: IO ()
main = do
conf <- return $ AffectionConfig
{ initComponents = All
, windowTitle = "Affection: example00"
, windowConfig = SDL.defaultWindow
, preLoop = return ()
, drawLoop = draw
, updateLoop = update
, loadState = load
, cleanUp = clean
}
withAffection conf
data UserData = UserData
{ nodeGraph :: M.Map String G.GeglNode
, coordinates :: Maybe (Int, Int)
}
load :: SDL.Surface -> IO UserData
load surface = do
traceM "loading"
root <- G.gegl_node_new
traceM "new root node"
checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation
[ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1
, G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1
]
traceM "checkerboard"
over <- G.gegl_node_new_child root G.defaultOverOperation
traceM "over"
nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" []
traceM "nop"
crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"
[ G.Property "x" $ G.PropertyDouble 0
, G.Property "y" $ G.PropertyDouble 0
, G.Property "width" $ G.PropertyDouble 800
, G.Property "height" $ G.PropertyDouble 600
]
traceM "crop"
format <- B.babl_format $ B.PixelFormat B.RGBA B.CFu8
pixels <- liftIO $ new =<< SDL.surfacePixels surface
sink <- G.gegl_node_new_child root $ G.Operation "gegl:buffer-sink"
[ G.Property "buffer" $ G.PropertyPointer $ castPtr $ pixels
, G.Property "format" $ G.PropertyPointer $ nullPtr
]
traceM "sink"
G.gegl_node_link_many [checkerboard, over, crop, sink]
diw <- G.gegl_node_connect_to nop "output" over "aux"
unless diw (error "connect failed")
traceM "connections made"
myMap <- return $ M.fromList
[ ("root" , root)
, ("over" , over)
, ("background" , checkerboard)
, ("nop" , nop)
, ("crop" , crop)
, ("sink" , sink)
]
traceM "loading complete"
return $ UserData
{ nodeGraph = myMap
, coordinates = Nothing
}
update :: Double -> AffectionState (AffectionData UserData) IO ()
update sec = do
traceM "updating"
ad <- get
ud <- getAffection
traceM $ (show $ 1 / sec) ++ " FPS"
ev <- liftIO $ SDL.pollEvents
mapM_ (\e ->
case SDL.eventPayload e of
SDL.MouseButtonEvent dat -> do
let (SDL.P (SDL.V2 x y)) = SDL.mouseButtonEventPos dat
drawRect
(nodeGraph ud M.! "nop")
(G.RGBA 1 0 0 0.5)
Fill
(G.GeglRectangle (fromIntegral x - 10) (fromIntegral y - 10) 20 20)
traceM $ "drewn a rectangle at " ++ show x ++ " " ++ show y
SDL.WindowClosedEvent _ -> do
traceM "seeya!"
put $ ad
{ quitEvent = True
}
_ ->
return ()
) ev
draw :: Affection UserData ()
draw = do
ad <- get
ud <- getAffection
liftIO $ SDL.lockSurface $ drawSurface ad
liftIO $ G.gegl_node_process (nodeGraph ud M.! "sink")
liftIO $ SDL.unlockSurface $ drawSurface ad
clean :: UserData -> IO ()
clean _ = return ()

View file

@ -63,7 +63,9 @@ withAffection AffectionConfig{..} = do
, userState = x , userState = x
, drawWindow = window , drawWindow = window
, drawSurface = surface , drawSurface = surface
, drawFormat = format
, drawStack = [] , drawStack = []
, elapsedTime = 0
}) <$> loadState surface }) <$> loadState surface
(_, nState) <- runStateT ( A.runState $ do (_, nState) <- runStateT ( A.runState $ do
preLoop preLoop
@ -79,17 +81,20 @@ withAffection AffectionConfig{..} = do
-- get state -- get state
ad <- get ad <- get
-- clean draw requests from last run -- clean draw requests from last run
mapM_ (invalidateDrawRequest pixels format stride cpp) $ drawStack ad mapM_ (invalidateDrawRequest pixels stride cpp) $ drawStack ad
-- compute dt and update elapsedTime
let dt = (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9)
put $ ad put $ ad
{ drawStack = [] } { drawStack = []
, elapsedTime = elapsedTime ad + dt
}
-- execute user defined update loop
updateLoop dt
-- execute user defined draw loop -- execute user defined draw loop
drawLoop drawLoop
-- execute user defined update loop
updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
(fromIntegral 10 ^ 9)
-- handle all new draw requests -- handle all new draw requests
ad2 <- get ad2 <- get
clear <- catMaybes <$> mapM (handleDrawRequest pixels format stride cpp) (drawStack ad2) clear <- catMaybes <$> mapM (handleDrawRequest pixels stride cpp) (drawStack ad2)
-- save all draw requests to clear in next run -- save all draw requests to clear in next run
put $ ad2 put $ ad2
{ drawStack = clear } { drawStack = clear }

View file

@ -12,11 +12,13 @@ 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) import Control.Monad (when, unless)
import System.Glib.GObject
import qualified SDL import qualified SDL
@ -26,123 +28,99 @@ import qualified GEGL as G
import Debug.Trace import Debug.Trace
-- | Draw a rectangle on target buffer
drawRect drawRect
:: 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 -> G.GeglRectangle -- ^ Dimensions of Rectangle
-> G.GeglBuffer -- ^ Final Buffer
-> Affection us () -> Affection us ()
drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do drawRect node color Fill rect@GeglRectangle{..} buf = do
liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $ ad <- get
(\(x, y) -> tempRoot <- liftIO $ G.gegl_node_new
let col = unsafeColorize color opNode <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation "gegl:rectangle"
in [ G.Property "x" $ G.PropertyDouble $ fromIntegral rectangleX
G.Pixel x y col , G.Property "y" $ G.PropertyDouble $ fromIntegral rectangleY
) , G.Property "width" $ G.PropertyDouble $ fromIntegral rectangleWidth
ad@AffectionData{..} <- get , G.Property "height" $ G.PropertyDouble $ fromIntegral rectangleHeight
, G.Property "color" $ G.PropertyColor color
]
diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
unless diw $ error "Affection.Draw.drawRect': connect failed"
put $ ad put $ ad
{ drawStack = (DrawRequest node rect buf False) : drawStack { drawStack = (DrawRequest rect buf (Kill (Just tempRoot))) : drawStack ad
} }
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 $
(\(x, y) ->
let col = unsafeColorize color
in if not ((x >= rectangleX + size && x < rectangleX + rectangleWidth - size) &&
(y >= rectangleY + size && y < rectangleY + rectangleHeight - size))
then
G.Pixel x y col
else
G.Pixel x y $ unsafeColorize $ G.RGBA 0 0 0 0
)
ad@AffectionData{..} <- get
put $ ad
{ drawStack = (DrawRequest node rect buf False) : drawStack
}
-- 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. Do not use often as it slows down the program -- | Force update of a specific region on screen
present present
:: G.GeglNode -- ^ Node to blit :: G.GeglRectangle -- ^ Area to be updated
-> G.GeglBuffer -- ^ BUffer to draw -> G.GeglBuffer -- ^ Target buffer
-> G.GeglRectangle -- ^ Area to blit -> Bool -- ^ Shall the 'DrawRequest' persist?
-> Bool -- ^ Shall the drawing be cleared in the next run?
-> Affection us () -> Affection us ()
present node buf rect pers = do present rect buf kill = do
ad <- get ad <- get
put $ ad let k = if not kill then Kill Nothing else Yes
{ drawStack = (DrawRequest node rect buf pers) : drawStack ad put ad
{ drawStack = (DrawRequest rect buf k) : drawStack ad
} }
ad <- get
format <- liftIO $ B.babl_format $ B.PixelFormat B.RGBA B.CFu8
liftIO $ SDL.lockSurface $ drawSurface ad
liftIO $ G.gegl_node_blit
node
1
rect
format
nullPtr
0
[G.GeglBlitDefault]
liftIO $ SDL.unlockSurface $ drawSurface ad
liftIO $ SDL.updateWindowSurface $ drawWindow ad
-- | function for handling 'DrawRequest's and updating the output -- | function for handling 'DrawRequest's and updating the output
handleDrawRequest handleDrawRequest
:: Ptr a -- ^ Pixel buffer to blit to :: Ptr a -- ^ Pixel buffer to blit to
-> B.BablFormatPtr -- ^ format to blit in -- -> B.BablFormatPtr -- ^ format to blit in
-> Int -- ^ Stride -> Int -- ^ Stride
-> Int -- ^ Components per Pixel -> Int -- ^ Components per Pixel
-> DrawRequest -- ^ 'DrawRequest' to handle -> DrawRequest -- ^ 'DrawRequest' to handle
-> Affection us (Maybe DrawRequest) -> Affection us (Maybe DrawRequest)
handleDrawRequest pixels format stride cpp dr@DrawRequest{..} = do handleDrawRequest pixels stride cpp dr@DrawRequest{..} = do
ad <- get ad <- get
let surf = drawSurface ad let surf = drawSurface ad
liftIO $ SDL.lockSurface surf liftIO $ SDL.lockSurface surf
liftIO $ G.gegl_node_blit liftIO $ G.gegl_buffer_get
requestNode requestBuffer
(Just requestArea)
1 1
requestArea (Just $ drawFormat ad)
format
(pixels `plusPtr` (pixels `plusPtr`
(rectangleX requestArea * cpp + rectangleY requestArea * stride)) (rectangleX requestArea * cpp + rectangleY requestArea * stride))
stride stride
[G.GeglBlitDefault] 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
:: Ptr a -- ^ Pixel buffer to blit to :: Ptr a -- ^ Pixel buffer to blit to
-> B.BablFormatPtr -- ^ format to blit in -- -> B.BablFormatPtr -- ^ format to blit in
-> Int -- ^ Stride -> Int -- ^ Stride
-> Int -- ^ Components per Pixel -> Int -- ^ Components per Pixel
-> DrawRequest -- ^ Drawrequest to invalidate -> DrawRequest -- ^ Drawrequest to invalidate
-> Affection us () -> Affection us ()
invalidateDrawRequest pixels format 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_node_blit liftIO $ G.gegl_buffer_get
requestNode requestBuffer
(Just requestArea)
1 1
requestArea (Just $ drawFormat ad)
format
(pixels `plusPtr` (pixels `plusPtr`
(rectangleX requestArea * cpp + rectangleY requestArea * stride)) (rectangleX requestArea * cpp + rectangleY requestArea * stride))
stride stride
[G.GeglBlitDefault] G.GeglAbyssNone
liftIO $ SDL.unlockSurface surf liftIO $ SDL.unlockSurface surf
case requestPersist of
Kill (Just victim) ->
liftIO $ G.gegl_node_drop victim
_ ->
return ()
-- liftIO $ SDL.updateWindowSurface $ drawWindow ad -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
-- | compute color for a single pixel -- | compute color for a single pixel
@ -190,12 +168,6 @@ unsafeColorize col =
, G.CVdouble $ CDouble $ a , G.CVdouble $ CDouble $ a
) )
-- -- | Clear all data from a buffer
-- clear
-- :: G.GeglBuffer -- ^ Target buffer
-- -> IO ()
-- clear buf = clearArea buf =<< G.gegl_rectangle_infinite_plane
-- | Clear a specified area of a buffer from all data -- | Clear a specified area of a buffer from all data
clearArea clearArea
:: G.GeglBuffer -- ^ Target buffer :: G.GeglBuffer -- ^ Target buffer

View file

@ -5,30 +5,103 @@ module Affection.Particle
( updateParticle ( updateParticle
, drawParticles , drawParticles
, updateParticleSystem , updateParticleSystem
, insertParticle
) where ) where
import Affection.Types import Affection.Types
import Data.Maybe (catMaybes) import Control.Monad
import Control.Monad.State (get)
import Data.Maybe
import qualified GEGL as G import qualified GEGL as G
import Debug.Trace
-- This function updates particles through a specified function. Particle ageing -- This function updates particles through a specified function. Particle ageing
-- and death is being handled by 'updateParticles' itself and does not need to -- and death is being handled by 'updateParticles' itself and does not need to
-- bother you. -- bother you.
updateParticle updateParticle
:: Double -- ^ Elapsed time in seconds :: Double
-> (Double -> Particle -> Particle) -- ^ Update function for a single 'Particle' -- ^ Elapsed time in seconds
-> (Double -> Particle -> Affection us Particle)
-- ^ Update function for a single 'Particle'
-- 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 -- -> [Maybe Particle]
-> Maybe Particle -- ^ resulting 'Particle' -> Particle
updateParticle time funct p@Particle{..} = -- ^ 'Particle' to be processed
if particleLife - time < 0 -- -> Affection us [Maybe Particle]
then -> Affection us (Maybe Particle)
Nothing -- ^ resulting 'Particle'
else updateParticle time funct pa = do
Just $ funct time $ p { particleLife = particleLife - time } now <- elapsedTime <$> get
if particleCreation pa + particleTimeToLive pa < now
then do
mproducer <- liftIO $ G.gegl_node_get_producer
(particleStackCont pa)
"input"
case mproducer of
Just (producer, padname) -> do
consumers <- liftIO $ G.gegl_node_get_consumers
(particleStackCont pa)
"output"
liftIO $ mapM_ (\(node, inpad)-> G.gegl_node_connect_to
producer
padname
node
inpad
) consumers
Nothing -> return ()
liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing
else do
np <- Just <$> funct time pa
return $ np
-- updateParticle time funct acc@[p] pa = do
-- now <- elapsedTime <$> get
-- if particleCreation pa + particleTimeToLive pa > now
-- then do
-- liftIO $ G.gegl_node_drop $ particleRootNode pa
-- return $ Nothing : acc
-- else do
-- when (not $ isNothing p) $ do
-- -- liftIO $ traceIO "linking second node in list"
-- liftIO $ G.gegl_node_link
-- (particleStackCont pa)
-- (particleStackCont $ fromJust p)
-- np <- Just <$> funct time pa
-- return $ np : acc
-- updateParticle time funct acc@(p:ps) pa = do
-- now <- elapsedTime <$> get
-- if particleCreation pa + particleTimeToLive pa > now
-- then do
-- liftIO $ G.gegl_node_drop $ particleRootNode pa
-- return $ Nothing : acc
-- else do
-- when (isNothing p) $ do
-- let mnl = nextLiving ps
-- maybe
-- (return ())
-- (\nl -> do
-- -- liftIO $ traceIO "linking nth node on list"
-- liftIO $ G.gegl_node_link (particleStackCont pa) (particleStackCont nl))
-- mnl
-- np <- Just <$> funct time pa
-- return $ np : acc
-- | Get the next living particle from a list
nextLiving
:: [Maybe Particle]
-> Maybe Particle
nextLiving [] = Nothing
nextLiving acc = case catMaybes acc of
[] -> Nothing
ps -> Just $ head $ ps
-- if isNothing p
-- then nextLiving ps
-- else p
drawParticles drawParticles
:: (Particle -> Affection us ()) :: (Particle -> Affection us ())
@ -39,11 +112,57 @@ drawParticles = mapM_
updateParticleSystem updateParticleSystem
:: ParticleSystem :: ParticleSystem
-> Double -> Double
-> (Double -> Particle -> Particle) -> (Double -> Particle -> Affection us Particle)
-> (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) x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts sys)
mapM_ (draw (psBuffer sys) (psNode sys)) x -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys)
when (not $ null x) $ do
-- liftIO $ traceIO "linking last node to output"
liftIO $ G.gegl_node_link (particleStackCont $ last x) (partSysNode sys)
mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x
return $ sys return $ sys
{ psParts = x } { partSysParts = (partSysParts sys)
{ partStorList = x
, partStorLatest =
if null x
then Nothing
else partStorLatest (partSysParts sys)
}
}
-- | Function for inserting a new 'Particle' into its 'PartileSystem'
insertParticle
:: ParticleSystem -- ^ 'ParticleSystem' to insert into
-> Particle -- ^ 'Particle' to insert
-> Affection us ParticleSystem -- ^ resulting new 'ParticleSystem'
insertParticle ps p = do
now <- elapsedTime <$> get
let newList = chronoInsert now (partStorList $ partSysParts ps) p
when (not $ isNothing $ partStorLatest $ partSysParts ps) $
liftIO $ G.gegl_node_link
(particleStackCont p)
(particleStackCont $ fromJust $ partStorLatest $ partSysParts ps)
return $ ps
{ partSysParts = (partSysParts ps)
{ partStorLatest = Just p
, partStorList = newList
}
}
-- | Insert a 'Particle' into its chronologically ordered list
chronoInsert
:: Double -- ^ Time in seconds from beginning of program execution
-> [Particle] -- ^ List to insert to
-> Particle -- ^ 'Particle' to insert
-> [Particle] -- ^ Resulting list
chronoInsert now [] np = [np]
chronoInsert now [p] np =
if now + particleTimeToLive p < particleCreation np
then p : [np]
else np : [p]
chronoInsert now l@(p:ps) np =
if now + particleTimeToLive p < particleCreation np
then p : chronoInsert now ps np
else np : l

View file

@ -13,11 +13,13 @@ module Affection.Types
, RGBA(..) , RGBA(..)
, DrawType(..) , DrawType(..)
, DrawRequest(..) , DrawRequest(..)
, RequestPersist(..)
, Angle(..) , Angle(..)
, ConvertAngle(..) , ConvertAngle(..)
-- | Particle system -- | Particle system
, Particle(..) , Particle(..)
, ParticleSystem(..) , ParticleSystem(..)
, ParticleStorage(..)
-- | Convenience exports -- | Convenience exports
, liftIO , liftIO
, SDL.WindowConfig(..) , SDL.WindowConfig(..)
@ -30,7 +32,10 @@ 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 Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.State import Control.Monad.State
@ -58,6 +63,11 @@ data AffectionConfig us = AffectionConfig
-- ^ Provide your own finisher function to clean your data. -- ^ Provide your own finisher function to clean your data.
} }
-- | Components to initialize in SDL.
data InitComponents
= All
| Only [SDL.InitFlag]
-- | Main type for defining the look, feel and action of the whole application. -- | Main type for defining the look, feel and action of the whole application.
data AffectionData us = AffectionData data AffectionData us = AffectionData
-- { affectionConfig :: AffectionConfig us -- ^ Application configuration. -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
@ -65,22 +75,25 @@ 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
, drawFormat :: B.BablFormatPtr -- ^ Target format
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed , drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed
, clearStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be invalidated , clearStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be invalidated
, elapsedTime :: Double -- ^ Elapsed time in seconds
} }
-- | 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 { 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
} }
-- | Components to initialize in SDL. data RequestPersist
data InitComponents = Yes
= All | Kill (Maybe G.GeglNode)
| Only [SDL.InitFlag]
-- | A type for storing 'DrawRequest' results to be executed frequently. TODO
data DrawAsset = DrawAsset
-- | Inner 'StateT' monad for the update state -- | Inner 'StateT' monad for the update state
-- type AffectionStateInner us m a = StateT (AffectionData us) m a -- type AffectionStateInner us m a = StateT (AffectionData us) m a
@ -154,8 +167,10 @@ instance Eq Angle where
-- | A single particle -- | A single particle
data Particle = Particle data Particle = Particle
{ particleLife :: Double { particleTimeToLive :: Double
-- ^ Time to live in seconds -- ^ Time to live in seconds
, particleCreation :: Double
-- ^ Creation time of particle in seconds form program start
, particlePosition :: (Double, Double) , particlePosition :: (Double, Double)
-- ^ Position of particle on canvas -- ^ Position of particle on canvas
, particleRotation :: Angle , particleRotation :: Angle
@ -164,10 +179,25 @@ data Particle = Particle
-- ^ 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'
data ParticleSystem = ParticleSystem , particleNodeGraph :: Map String G.GeglNode
{ psParts :: [Particle] -- ^ Node Graph of 'G.GeglNodes' per particle
, psNode :: G.GeglNode , particleStackCont :: G.GeglNode
, psBuffer :: G.GeglBuffer -- ^ 'G.GeglNode' to connect other 'Particle's to
, particleDrawFlange :: G.GeglNode
-- ^ 'G.GeglNode' to connect draw actions to
}
-- | The particle system
data ParticleSystem = ParticleSystem
{ partSysParts :: ParticleStorage
, partSysNode :: G.GeglNode
, partSysBuffer :: G.GeglBuffer
}
-- | The particle storage datatype
data ParticleStorage = ParticleStorage
{ partStorLatest :: Maybe Particle -- ^ The particle stored last
, partStorList :: [Particle] -- ^ List of particles in ascending order of remaining lifetime
} }