affection/src/Affection/Types.hs

{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Affection.Types
  ( Affection
  , AffectionData(..)
  , AffectionConfig(..)
  , AffectionState(..)
  -- , AffectionDraw(..)
  -- , Draw(..)
  , AffectionStateInner
  -- , AffectionDrawInner(..)
  , InitComponents(..)
  -- , Loop(..)
  -- , RGBA(..)
  , DrawType(..)
  , DrawRequest(..)
  , RequestPersist(..)
  , Angle(..)
  -- , ConvertAngle(..)
    -- | Particle system
  , Particle(..)
  , ParticleSystem(..)
  , ParticleStorage(..)
    -- | Convenience exports
  , liftIO
  , SDL.WindowConfig(..)
  , SDL.defaultWindow
    -- | GEGL reexports
  , G.GeglRectangle(..)
  , G.GeglBuffer(..)
  ) where

import qualified SDL.Init as SDL
import qualified SDL.Video as SDL
import qualified SDL.Event as SDL
import qualified Data.Text as T
import Data.Map.Strict as M

import qualified GEGL as G
import qualified BABL as B

import Control.Monad.IO.Class
import Control.Monad.State
import qualified Control.Monad.Parallel as MP

import System.Clock (TimeSpec)
-- import Control.Monad.Reader

-- import Control.Concurrent.MVar

import Foreign.Ptr (Ptr)

-- | Configuration for the aplication. needed at startup.
data AffectionConfig us = AffectionConfig
  { initComponents :: InitComponents
      -- ^ SDL components to initialize at startup
  , windowTitle    :: T.Text
      -- ^ Window title
  , windowConfig   :: SDL.WindowConfig
      -- ^ Window configuration
  , canvasSize     :: Maybe (Int, Int)
      -- ^ size of the texture canvas
  , preLoop        :: Affection us ()
      -- ^ Actions to be performed, before loop starts
  , eventLoop      :: SDL.EventPayload -> Affection us ()
      -- ^ Main update function. Takes fractions of a second as input.
  , updateLoop     :: Double -> Affection us ()
      -- ^ Main update function. Takes fractions of a second as input.
  , drawLoop       :: Affection us ()
      -- ^ Function for updating graphics.
  , loadState      :: IO us
      -- ^ Provide your own load function to create this data.
  , cleanUp        :: us -> IO ()
      -- ^ 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.
data AffectionData us = AffectionData
  -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
  { quitEvent       :: Bool               -- ^ Loop breaker.
  , userState       :: us                 -- ^ State data provided by user
  , drawWindow      :: SDL.Window         -- ^ SDL window
  , windowRenderer  :: SDL.Renderer       -- ^ Internal renderer of window
  , drawTexture     :: SDL.Texture        -- ^ SDL Texture to draw to
  , drawFormat      :: B.BablFormatPtr    -- ^ Target format
  , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed
  , drawDimensions  :: (Int, Int)         -- ^ Dimensions of target surface
  , drawStride      :: Int                -- ^ Stride of target buffer
  , drawCPP         :: Int                -- ^ Number of components per pixel
  , elapsedTime     :: Double             -- ^ Elapsed time in seconds
  , deltaTime       :: Double             -- ^ Elapsed time in seconds since last tick
  , sysTime         :: TimeSpec           -- ^ System time (NOT the time on the clock)
  , pausedTime      :: Bool               -- ^ Should the update loop be executed?
  }

-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
data DrawRequest = DrawRequest
  { requestArea     :: G.GeglRectangle -- ^ The area to update
  , requestBuffer   :: G.GeglBuffer    -- ^ Buffer to draw
  , requestPersist  :: RequestPersist  -- ^ Shall the drawRequest persist
  }

data RequestPersist
  = Persist
  | Kill (Maybe G.GeglNode)

-- | A type for storing 'DrawRequest' results to be executed frequently. TODO
data DrawAsset = DrawAsset

-- | Inner 'StateT' monad for the update state
-- type AffectionStateInner us m a = StateT (AffectionData us) m a
type AffectionStateInner us m a = StateT us m a

-- | Affection's state monad
newtype AffectionState us m a = AffectionState
  { runState :: AffectionStateInner us m a }
  deriving (Functor, Applicative, Monad, MonadIO, MonadState us)

instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m)

type Affection us a = AffectionState (AffectionData us) IO a

-- -- | Inner 'StateT' monad of Affection
-- type AffectionInner us od a = StateT (AffectionState us od) IO a
-- 
-- -- | Affection state monad
-- newtype Affection us od a = Affection
--   { runAffection :: AffectionInner us od a }
--   deriving (Functor, Applicative, Monad, MonadState (AffectionState us od))
-- 
-- -- | Inner drawing monad of Affection.
-- type AffectionDrawInner ds a = ReaderT (Draw ds) a
-- 
-- -- | Affectiondrawinf reader monad.
-- newtype AffectionDraw ds a = AffectionDraw
--   { runDraw :: (ds -> a) }
--   deriving (Functor, Applicative, Monad, MonadReader ds)
-- 
-- -- | Loop state monad to hold elapsed time per frame
-- newtype Loop f a = Loop
--   { runLoop :: f -> (a, f) }
--   deriving (Functor, Applicative, Monad, MonadState (Loop f))

-- data RGBA = RGBA
--   { r :: Int
--   , g :: Int
--   , b :: Int
--   , a :: Int
--   }

-- | Type for defining the draw type of draw functions
data DrawType
    -- | Fill the specified area completely with color
  = Fill
    -- | only draw the outline of the area
  | Line
    { lineWidth :: Int -- ^ Width of line in pixels
    }

type Angle = Double

-- -- | Type for defining angles
-- data Angle
--   = Rad Double -- ^ Angle in radians
--   | Deg Double -- ^ Angle in degrees
--   deriving (Show)
-- 
-- -- | Typeclass for converting Angles from 'Deg' to 'Rad' and vice versa.
-- class ConvertAngle a where
--   toRad :: a -> a -- Convert to 'Rad'
--   toDeg :: a -> a -- Convert to 'Deg'
-- 
-- instance ConvertAngle Angle where
--   toRad (Deg x) = Rad $ x * pi / 180
--   toRad x = x
-- 
--   toDeg (Rad x) = Deg $ x * 180 / pi
--   toDeg x = x
-- 
-- instance Eq Angle where
--   (==) (Deg x) (Deg y) = x == y
--   (==) (Rad x) (Rad y) = x == y
--   (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry
--   (==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy

-- | A single particle
data Particle = Particle
  { particleTimeToLive :: Double
      -- ^ Time to live in seconds
  , particleCreation   :: Double
      -- ^ Creation time of particle in seconds form program start
  , particlePosition   :: (Double, Double)
      -- ^ Position of particle on canvas
  , particleRotation   :: Angle
      -- ^ Particle rotation
  , particleVelocity   :: (Int, Int)
      -- ^ particle velocity as vector of pixels per second
  , particlePitchRate  :: Angle
      -- ^ Rotational velocity of particle in angle per second
  , 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
  } deriving (Eq)

-- | 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
  }