233 lines
8 KiB
Haskell
233 lines
8 KiB
Haskell
{-# 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)
|
|
|
|
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 = 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 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
|
|
-- }
|