87 lines
2.6 KiB
Haskell
87 lines
2.6 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
|
|
module Affection.Types
|
|
( Affection
|
|
, AffectionConfig(..)
|
|
, AffectionData(..)
|
|
, AffectionStateInner
|
|
, AffectionState(..)
|
|
, AffectionWindow(..)
|
|
, AffectionContext(..)
|
|
, 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 Control.Monad.Trans.Resource
|
|
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 :: [ AffectionWindow ] -- ^ SDL windows
|
|
, glContext :: [ AffectionContext ] -- ^ OpenGL rendering contexts
|
|
, 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 m = StateT sd m
|
|
|
|
-- | Affection's state monad
|
|
newtype AffectionState sd m a = AffectionState
|
|
{ runState :: AffectionStateInner sd m a }
|
|
deriving (Functor, Applicative, Monad, MonadIO, MonadState sd, MonadResource)
|
|
|
|
instance MP.MonadParallel m => MP.MonadParallel (AffectionState sd m)
|
|
|
|
type Affection a = AffectionState AffectionData ResIO a
|
|
|
|
type Angle = Double
|
|
|
|
data AffectionWindow = AffectionWindow
|
|
{ awWindow :: SDL.Window
|
|
, awReleaseKey :: ReleaseKey
|
|
, awMode :: SDL.WindowMode
|
|
}
|
|
|
|
data AffectionContext = AffectionContext
|
|
{ acContext :: SDL.GLContext
|
|
, acReleaseKey :: ReleaseKey
|
|
}
|