2016-10-31 22:47:16 +00:00
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
|
2018-09-25 05:02:33 +00:00
|
|
|
module Affection.Types
|
2018-09-25 14:10:36 +00:00
|
|
|
( Affection
|
2018-09-25 05:02:33 +00:00
|
|
|
, AffectionConfig(..)
|
|
|
|
, AffectionData(..)
|
2018-09-25 14:10:36 +00:00
|
|
|
, AffectionStateInner
|
2018-09-25 05:02:33 +00:00
|
|
|
, AffectionState(..)
|
|
|
|
, InitComponents(..)
|
2018-09-25 14:10:36 +00:00
|
|
|
, Angle
|
2018-09-25 05:02:33 +00:00
|
|
|
-- | SDL reexports
|
|
|
|
, SDL.WindowConfig(..)
|
|
|
|
, SDL.WindowMode(..)
|
|
|
|
, SDL.EventPayload(..)
|
2018-09-25 14:10:36 +00:00
|
|
|
, SDL.InitFlag(..)
|
|
|
|
, SDL.Window
|
|
|
|
, SDL.GLContext
|
2018-09-25 05:02:33 +00:00
|
|
|
) where
|
2016-03-25 15:58:46 +00:00
|
|
|
|
2016-10-31 22:47:16 +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
|
2016-10-31 22:47:16 +00:00
|
|
|
import qualified Data.Text as T
|
2016-12-21 03:28:57 +00:00
|
|
|
|
2016-10-31 22:47:16 +00:00
|
|
|
import Control.Monad.IO.Class
|
2018-06-03 00:41:49 +00:00
|
|
|
import Control.Monad.State.Strict
|
2017-03-20 04:24:02 +00:00
|
|
|
import qualified Control.Monad.Parallel as MP
|
2017-07-29 00:51:18 +00:00
|
|
|
|
|
|
|
import System.Clock (TimeSpec)
|
2016-10-31 22:47:16 +00:00
|
|
|
|
|
|
|
-- | 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-13 14:19:53 +00:00
|
|
|
, loadState :: IO us
|
|
|
|
-- ^ Provide your own load function to create this data.
|
2017-12-10 15:10:09 +00:00
|
|
|
, preLoop :: Affection us ()
|
2016-12-11 19:24:16 +00:00
|
|
|
-- ^ Actions to be performed, before loop starts
|
2017-12-13 14:19:53 +00:00
|
|
|
, eventLoop :: [SDL.EventPayload] -> Affection us ()
|
2017-03-16 19:12:41 +00:00
|
|
|
-- ^ Main update function. Takes fractions of a second as input.
|
2017-12-10 15:10:09 +00:00
|
|
|
, updateLoop :: Double -> Affection us ()
|
2017-03-16 19:12:41 +00:00
|
|
|
-- ^ 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.
|
2016-11-13 12:39:25 +00:00
|
|
|
, cleanUp :: us -> IO ()
|
|
|
|
-- ^ Provide your own finisher function to clean your data.
|
2016-10-31 22:47:16 +00:00
|
|
|
}
|
|
|
|
|
2016-12-21 03:28:57 +00:00
|
|
|
-- | Components to initialize in SDL.
|
|
|
|
data InitComponents
|
|
|
|
= All
|
|
|
|
| Only [SDL.InitFlag]
|
|
|
|
|
2016-10-31 22:47:16 +00:00
|
|
|
-- | Main type for defining the look, feel and action of the whole application.
|
2017-12-12 12:12:06 +00:00
|
|
|
data AffectionData us = AffectionData
|
2016-11-04 15:06:16 +00:00
|
|
|
{ quitEvent :: Bool -- ^ Loop breaker.
|
2016-10-31 22:47:16 +00:00
|
|
|
, 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-07-29 19:45:40 +00:00
|
|
|
, screenMode :: SDL.WindowMode -- ^ current screen mode
|
2017-02-24 16:11:52 +00:00
|
|
|
, drawDimensions :: (Int, Int) -- ^ Dimensions of target surface
|
2016-12-25 07:14:51 +00:00
|
|
|
, elapsedTime :: Double -- ^ Elapsed time in seconds
|
2017-06-26 04:57:02 +00:00
|
|
|
, 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?
|
2016-10-31 22:47:16 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
-- | Inner 'StateT' monad for the update state
|
2017-12-10 15:10:09 +00:00
|
|
|
type AffectionStateInner us a = StateT us a
|
2016-10-31 22:47:16 +00:00
|
|
|
|
|
|
|
-- | Affection's state monad
|
2017-12-12 12:12:06 +00:00
|
|
|
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-10-31 22:47:16 +00:00
|
|
|
|
2017-12-12 12:12:06 +00:00
|
|
|
instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m)
|
2017-03-20 04:24:02 +00:00
|
|
|
|
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
|
|
|
|
2017-06-26 04:57:02 +00:00
|
|
|
type Angle = Double
|