pituicat/src/Affection/Types.hs

{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Affection.Types
  -- ( 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

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 Data.Map.Strict as M

-- 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
import Control.Concurrent.STM as STM

import System.Clock (TimeSpec)
-- import Control.Monad.Reader

-- import Control.Concurrent.MVar

import Foreign.Ptr (Ptr)

import Affection.MessageBus.Message

-- | Configuration for the aplication. needed at startup.
data AffectionConfig us = AffectionConfig
  { initComponents :: InitComponents
      -- ^ SDL components to initialize at startup
  , windowTitle    :: T.Text
      -- ^ Window title
  , windowConfig   :: SDL.WindowConfig
      -- ^ Window configuration
  , canvasSize     :: Maybe (Int, Int)
      -- ^ size of the texture canvas
  , initScreenMode :: SDL.WindowMode
      -- ^ Window mode to start in
  , preLoop        :: Affection us ()
      -- ^ Actions to be performed, before loop starts
  , eventLoop      :: SDL.EventPayload -> Affection us ()
      -- ^ Main update function. Takes fractions of a second as input.
  , updateLoop     :: Double -> Affection us ()
      -- ^ Main update function. Takes fractions of a second as input.
  , drawLoop       :: Affection us ()
      -- ^ Function for updating graphics.
  , loadState      :: IO us
      -- ^ Provide your own load function to create this data.
  , cleanUp        :: us -> IO ()
      -- ^ Provide your own finisher function to clean your data.
  }

-- | 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 us = AffectionData
  -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
  { quitEvent       :: Bool               -- ^ Loop breaker.
  , userState       :: us                 -- ^ State data provided by user
  , drawWindow      :: SDL.Window         -- ^ SDL window
  , glContext       :: SDL.GLContext      -- ^ OpenGL rendering context
  , windowRenderer  :: SDL.Renderer       -- ^ Internal renderer of window
  , drawTexture     :: SDL.Texture        -- ^ SDL Texture to draw to
  -- , drawFormat      :: B.BablFormatPtr    -- ^ Target format
  , screenMode      :: SDL.WindowMode     -- ^ current screen mode
  -- , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed
  , drawDimensions  :: (Int, Int)         -- ^ Dimensions of target surface
  , drawStride      :: Int                -- ^ Stride of target buffer
  , drawCPP         :: Int                -- ^ Number of components per pixel
  , 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?
  -- , messageChannel  :: Channel msg        -- ^ The main broadcast channel to duplicate all others from
  }

-- -- | 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
-- type AffectionStateInner us m a = StateT (AffectionData us) m a
type AffectionStateInner us a = StateT us a

-- | Affection's state monad
newtype AffectionState us m a = AffectionState
  { runState :: AffectionStateInner us m a }
  deriving (Functor, Applicative, Monad, MonadIO, MonadState us)

instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m)

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
--   }

-- | Type for defining the draw type of draw functions
data DrawType
    -- | Fill the specified area completely with color
  = Fill
    -- | only draw the outline of the area
  | Line
    { 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

-- -- | 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
--   }

newtype (Message msg) => Channel msg = Channel (TChan msg)