affection/src/Affection/Particle.hs

{-# LANGUAGE RecordWildCards #-}

-- | This module introduces a simple particle system to Affection
module Affection.Particle
  ( updateParticle
  , drawParticles
  , updateParticleSystem
  ) where

import Affection.Types

import Control.Monad

import Data.Maybe

import qualified GEGL as G

import Debug.Trace

-- This function updates particles through a specified function. Particle ageing
-- and death is being handled by 'updateParticles' itself and does not need to
-- bother you.
updateParticle
  :: Double
    -- ^ Elapsed time in seconds
  -> (Double -> Particle -> Affection us Particle) 
    -- ^ Update function for a single 'Particle'
    -- This Function should take the elapsed time
    -- in seconds and the initial particle as arguments.
  -> [Maybe Particle]
  -> Particle
    -- ^ 'Particle' to be processed
  -> Affection us [Maybe Particle]
    -- ^ resulting 'Particle'
updateParticle time funct acc@[] pa =
  if particleLife pa - time < 0
  then do
    liftIO $ G.gegl_node_drop $ particleRootNode pa
    return $ Nothing : acc
  else do
    np <- Just <$> funct time pa { particleLife = particleLife pa - time }
    return $ np : acc
updateParticle time funct acc@[p] pa =
  if particleLife pa - time < 0
  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 { particleLife = particleLife pa - time }
    return $ np : acc
updateParticle time funct acc@(p:ps) pa =
  if particleLife pa - time < 0
  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 { particleLife = particleLife pa - time }
    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
  :: (Particle -> Affection us ())
  -> [Particle]
  -> Affection us ()
drawParticles = mapM_

updateParticleSystem
  :: ParticleSystem
  -> Double
  -> (Double -> Particle -> Affection us Particle)
  -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
  -> Affection us ParticleSystem
updateParticleSystem sys sec upd draw = do
  -- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
  -- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys)
  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) (psNode sys)
  mapM_ (draw (psBuffer sys) (psNode sys)) x
  return $ sys
    { psParts = x }