pituicat/src/Affection/Types.hs

174 lines
5.4 KiB
Haskell
Raw Normal View History

{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
2016-03-25 15:58:46 +00:00
module Affection.Types
2016-12-08 17:22:29 +00:00
( Affection
, AffectionData(..)
, AffectionConfig(..)
2016-11-02 00:14:53 +00:00
, AffectionState(..)
-- , AffectionDraw(..)
-- , Draw(..)
, AffectionStateInner
-- , AffectionDrawInner(..)
, InitComponents(..)
-- , Loop(..)
, RGBA(..)
2016-12-08 17:22:29 +00:00
, DrawType(..)
, DrawRequest(..)
2016-12-20 10:29:03 +00:00
, Angle(..)
, ConvertAngle(..)
-- | Particle system
, Particle(..)
, ParticleSystem(..)
-- | Convenience exports
, liftIO
, SDL.WindowConfig(..)
, SDL.defaultWindow
2016-12-08 17:22:29 +00:00
-- | GEGL reexports
, G.GeglRectangle(..)
, G.GeglBuffer(..)
2016-03-25 15:58:46 +00:00
) where
import qualified SDL.Init as SDL
import qualified SDL.Video as SDL
import qualified Data.Text as T
2016-12-08 17:22:29 +00:00
import qualified GEGL as G
import Control.Monad.IO.Class
import Control.Monad.State
-- import Control.Monad.Reader
-- import Control.Concurrent.MVar
-- | Configuration for the aplication. needed at startup.
data AffectionConfig us = AffectionConfig
2016-11-04 15:06:16 +00:00
{ initComponents :: InitComponents
-- ^ SDL components to initialize at startup
, windowTitle :: T.Text
-- ^ Window title
, windowConfig :: SDL.WindowConfig
-- ^ Window configuration
, preLoop :: Affection us ()
-- ^ Actions to be performed, before loop starts
, drawLoop :: Affection us ()
2016-11-04 15:06:16 +00:00
-- ^ Function for updating graphics.
, updateLoop :: Double -> Affection us ()
2016-11-04 15:06:16 +00:00
-- ^ Main update function. Takes fractions of a second as input.
, loadState :: SDL.Surface -> IO us
-- ^ Provide your own load function to create this data.
, cleanUp :: us -> IO ()
-- ^ Provide your own finisher function to clean your data.
}
-- | Main type for defining the look, feel and action of the whole application.
data AffectionData us = AffectionData
2016-11-04 15:06:16 +00:00
-- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
{ quitEvent :: Bool -- ^ Loop breaker.
, userState :: us -- ^ State data provided by user
, drawWindow :: SDL.Window -- ^ SDL window
, drawSurface :: SDL.Surface -- ^ SDL surface
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed
, clearStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be invalidated
}
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
data DrawRequest = DrawRequest
{ requestNode :: G.GeglNode -- ^ The 'G.GeglNode' to blit
, requestArea :: G.GeglRectangle -- ^ The area to update
, requestBuffer :: G.GeglBuffer -- ^ Buffer to draw
, requestPersist :: Bool -- ^ Shall the drawRequest persist
}
-- | Components to initialize in SDL.
data InitComponents
= All
| Only [SDL.InitFlag]
-- | Inner 'StateT' monad for the update state
2016-11-02 00:14:53 +00:00
-- 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 }
2016-11-02 00:14:53 +00:00
deriving (Functor, Applicative, Monad, MonadIO, MonadState us)
2016-12-08 17:22:29 +00:00
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
}
2016-12-08 17:22:29 +00:00
-- | Type for defining the draw type of draw functions
data DrawType
= Fill -- ^ Fill the specified area completely with color
| Line -- ^ only draw the outline of the area
{ lineWidth :: Int -- ^ Width of line in pixels
}
2016-12-20 10:29:03 +00:00
-- | 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
2016-12-20 10:29:03 +00:00
{ particleLife :: Double
-- ^ Time to live in seconds
, 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
} deriving (Show, Eq)
data ParticleSystem = ParticleSystem
{ psParts :: [Particle]
, psNode :: G.GeglNode
, psBuffer :: G.GeglBuffer
}