{-# 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 Control.Concurrent.STM as STM import System.Clock (TimeSpec) -- import Control.Monad.Reader -- import Control.Concurrent.MVar import Foreign.Ptr (Ptr) import Affection.MessageBus.Message -- | 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 , initScreenMode :: SDL.WindowMode -- ^ Window mode to start in , 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 msg = AffectionData -- { affectionConfig :: AffectionConfig us -- ^ Application configuration. { quitEvent :: Bool -- ^ Loop breaker. , userState :: us -- ^ State data provided by user , drawWindow :: SDL.Window -- ^ SDL window , glContext :: SDL.GLContext -- ^ OpenGL rendering context , windowRenderer :: SDL.Renderer -- ^ Internal renderer of window , drawTexture :: SDL.Texture -- ^ SDL Texture to draw to -- , drawFormat :: B.BablFormatPtr -- ^ Target format , screenMode :: SDL.WindowMode -- ^ current screen mode -- , 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? -- , messageChannel :: Channel msg -- ^ The main broadcast channel to duplicate all others from } -- -- | 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 a = StateT us a -- | Affection's state monad newtype AffectionState us a = AffectionState { runState :: AffectionStateInner us a } deriving (Functor, Applicative, Monad, MonadIO, MonadState us) instance MP.MonadParallel m => MP.MonadParallel (AffectionState us) 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 -- } newtype (Message msg) => Channel msg = Channel (TChan msg)