affection/src/Affection/Types.hs

86 lines
2.7 KiB
Haskell

{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Affection.Types
( Affection
, AffectionConfig(..)
, AffectionData(..)
, AffectionStateInner
, AffectionState(..)
, InitComponents(..)
, Angle
-- | SDL reexports
, SDL.WindowConfig(..)
, SDL.WindowMode(..)
, SDL.EventPayload(..)
, SDL.InitFlag(..)
, SDL.Window
, SDL.GLContext
) 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 Control.Monad.IO.Class
import Control.Monad.State.Strict
import qualified Control.Monad.Parallel as MP
import System.Clock (TimeSpec)
-- | Configuration for the aplication. needed at startup.
data AffectionConfig us = AffectionConfig
{ initComponents :: InitComponents
-- ^ SDL components to initialize at startup
, windowTitle :: T.Text
-- ^ Window title
, windowConfigs ::
[
( Word -- --^ Window identifier
, SDL.WindowConfig -- --^ Window config for given window
, SDL.WindowMode -- -- ^ Window mode to start in
)
]
-- ^ Window configurations
}
-- | 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 = AffectionData
{ drawWindows ::
[
( Word -- --^ Window identifier
, SDL.Window -- --^ Window linked with identifier
, SDL.WindowMode -- -- ^ current screen mode
)
] -- ^ SDL windows
, glContext ::
[
( Word -- --^ Window identifier
, SDL.GLContext -- --^ Associated OpenGL context
)
] -- ^ OpenGL rendering contexts
, screenMode :: SDL.WindowMode -- ^ current screen mode
, 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?
}
-- | Inner 'StateT' monad for the update state
type AffectionStateInner sd a = StateT sd a
-- | Affection's state monad
newtype AffectionState sd m a = AffectionState
{ runState :: AffectionStateInner sd m a }
deriving (Functor, Applicative, Monad, MonadIO, MonadState sd)
instance MP.MonadParallel m => MP.MonadParallel (AffectionState sd m)
type Affection a = AffectionState AffectionData IO a
type Angle = Double