affection/src/Affection/Types.hs

237 lines
8.1 KiB
Haskell
Raw Normal View History

{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
2016-03-25 15:58:46 +00:00
module Affection.Types
2017-10-03 10:47:18 +00:00
-- ( 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
2016-03-25 15:58:46 +00:00
import qualified SDL.Init as SDL
import qualified SDL.Video as SDL
2017-02-17 16:15:06 +00:00
import qualified SDL.Event as SDL
import qualified Data.Text as T
2017-03-21 11:04:56 +00:00
import Data.Map.Strict as M
2016-12-21 03:28:57 +00:00
2017-10-03 10:47:18 +00:00
-- 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
2017-11-27 22:30:11 +00:00
import Control.Concurrent.STM as STM
2017-07-29 00:51:18 +00:00
import System.Clock (TimeSpec)
-- import Control.Monad.Reader
-- import Control.Concurrent.MVar
import Foreign.Ptr (Ptr)
2017-11-27 22:30:11 +00:00
import Affection.MessageBus.Message
-- | Configuration for the aplication. needed at startup.
2017-12-10 15:10:09 +00:00
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
2017-03-23 03:31:10 +00:00
, canvasSize :: Maybe (Int, Int)
-- ^ size of the texture canvas
2017-07-29 19:45:40 +00:00
, initScreenMode :: SDL.WindowMode
-- ^ Window mode to start in
2017-12-10 15:10:09 +00:00
, preLoop :: Affection us ()
-- ^ Actions to be performed, before loop starts
2017-12-10 15:10:09 +00:00
, eventLoop :: SDL.EventPayload -> Affection us ()
-- ^ Main update function. Takes fractions of a second as input.
2017-12-10 15:10:09 +00:00
, updateLoop :: Double -> Affection us ()
-- ^ Main update function. Takes fractions of a second as input.
2017-12-10 15:10:09 +00:00
, drawLoop :: Affection us ()
2016-11-04 15:06:16 +00:00
-- ^ Function for updating graphics.
2017-03-23 03:34:04 +00:00
, loadState :: IO us
2016-11-04 15:06:16 +00:00
-- ^ Provide your own load function to create this data.
, cleanUp :: us -> IO ()
-- ^ Provide your own finisher function to clean your data.
}
2016-12-21 03:28:57 +00:00
-- | Components to initialize in SDL.
data InitComponents
= All
| Only [SDL.InitFlag]
-- | Main type for defining the look, feel and action of the whole application.
2017-11-27 22:30:11 +00:00
data AffectionData us msg = 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
2017-09-09 14:47:24 +00:00
, glContext :: SDL.GLContext -- ^ OpenGL rendering context
2017-02-23 21:54:26 +00:00
, windowRenderer :: SDL.Renderer -- ^ Internal renderer of window
2017-03-22 15:59:24 +00:00
, drawTexture :: SDL.Texture -- ^ SDL Texture to draw to
2017-10-03 10:47:18 +00:00
-- , drawFormat :: B.BablFormatPtr -- ^ Target format
2017-07-29 19:45:40 +00:00
, screenMode :: SDL.WindowMode -- ^ current screen mode
2017-10-03 10:47:18 +00:00
-- , drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed
2017-02-24 16:11:52 +00:00
, drawDimensions :: (Int, Int) -- ^ Dimensions of target surface
, drawStride :: Int -- ^ Stride of target buffer
, drawCPP :: Int -- ^ Number of components per pixel
2016-12-25 07:14:51 +00:00
, elapsedTime :: Double -- ^ Elapsed time in seconds
, deltaTime :: Double -- ^ Elapsed time in seconds since last tick
2017-07-29 00:47:26 +00:00
, sysTime :: TimeSpec -- ^ System time (NOT the time on the clock)
2017-07-29 00:40:41 +00:00
, pausedTime :: Bool -- ^ Should the update loop be executed?
2017-12-10 15:10:09 +00:00
-- , messageChannel :: Channel msg -- ^ The main broadcast channel to duplicate all others from
}
2017-10-03 10:47:18 +00:00
-- -- | 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
2016-11-02 00:14:53 +00:00
-- type AffectionStateInner us m a = StateT (AffectionData us) m a
2017-12-10 15:10:09 +00:00
type AffectionStateInner us a = StateT us a
-- | Affection's state monad
2017-12-10 15:10:09 +00:00
newtype AffectionState us a = AffectionState
{ runState :: AffectionStateInner us a }
2016-11-02 00:14:53 +00:00
deriving (Functor, Applicative, Monad, MonadIO, MonadState us)
2017-12-10 15:10:09 +00:00
instance MP.MonadParallel m => MP.MonadParallel (AffectionState us)
2017-12-10 15:10:09 +00:00
type Affection us a = AffectionState (AffectionData us) IO a
2016-12-08 17:22:29 +00:00
-- -- | 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
2017-02-17 16:15:06 +00:00
-- | Fill the specified area completely with color
= Fill
-- | only draw the outline of the area
| Line
2016-12-08 17:22:29 +00:00
{ 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
2016-12-20 10:29:03 +00:00
2017-10-03 10:47:18 +00:00
-- -- | 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
-- }
2017-11-27 22:30:11 +00:00
newtype (Message msg) => Channel msg = Channel (TChan msg)