2016-10-31 22:47:16 +00:00
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
|
2016-03-25 15:58:46 +00:00
|
|
|
module Affection.Types
|
2016-12-08 17:22:29 +00:00
|
|
|
( Affection
|
|
|
|
, AffectionData(..)
|
2016-10-31 22:47:16 +00:00
|
|
|
, AffectionConfig(..)
|
2016-11-02 00:14:53 +00:00
|
|
|
, AffectionState(..)
|
2016-10-31 22:47:16 +00:00
|
|
|
-- , AffectionDraw(..)
|
|
|
|
-- , Draw(..)
|
2016-11-13 12:39:25 +00:00
|
|
|
, AffectionStateInner
|
2016-10-31 22:47:16 +00:00
|
|
|
-- , AffectionDrawInner(..)
|
|
|
|
, InitComponents(..)
|
|
|
|
-- , Loop(..)
|
|
|
|
, RGBA(..)
|
2016-12-08 17:22:29 +00:00
|
|
|
, DrawType(..)
|
2016-12-11 16:38:03 +00:00
|
|
|
, DrawRequest(..)
|
2016-10-31 22:47:16 +00:00
|
|
|
, SDL.WindowConfig(..)
|
|
|
|
, SDL.defaultWindow
|
2016-11-13 12:39:25 +00:00
|
|
|
-- | Convenience exports
|
|
|
|
, liftIO
|
2016-12-08 17:22:29 +00:00
|
|
|
-- | GEGL reexports
|
|
|
|
, G.GeglRectangle(..)
|
|
|
|
, G.GeglBuffer(..)
|
2016-03-25 15:58:46 +00:00
|
|
|
) where
|
|
|
|
|
2016-10-31 22:47:16 +00:00
|
|
|
import qualified SDL.Init as SDL
|
|
|
|
import qualified SDL.Video as SDL
|
|
|
|
import qualified Data.Text as T
|
2016-12-08 17:22:29 +00:00
|
|
|
import qualified GEGL as G
|
2016-10-31 22:47:16 +00:00
|
|
|
|
|
|
|
import Control.Monad.IO.Class
|
|
|
|
import Control.Monad.State
|
2016-11-13 12:39:25 +00:00
|
|
|
-- import Control.Monad.Reader
|
2016-10-31 22:47:16 +00:00
|
|
|
|
2016-11-13 12:39:25 +00:00
|
|
|
-- import Control.Concurrent.MVar
|
2016-10-31 22:47:16 +00:00
|
|
|
|
|
|
|
-- | Configuration for the aplication. needed at startup.
|
|
|
|
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
|
|
|
|
, drawLoop :: AffectionState (AffectionData us) IO ()
|
|
|
|
-- ^ Function for updating graphics.
|
|
|
|
, updateLoop :: Double -> AffectionState (AffectionData us) IO ()
|
|
|
|
-- ^ Main update function. Takes fractions of a second as input.
|
|
|
|
, loadState :: SDL.Surface -> IO us
|
|
|
|
-- ^ Provide your own load function to create this data.
|
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
|
|
|
}
|
|
|
|
|
|
|
|
-- | Main type for defining the look, feel and action of the whole application.
|
|
|
|
data AffectionData us = AffectionData
|
2016-11-04 15:06:16 +00:00
|
|
|
-- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
|
|
|
|
{ quitEvent :: Bool -- ^ Loop breaker.
|
2016-10-31 22:47:16 +00:00
|
|
|
, userState :: us -- ^ State data provided by user
|
|
|
|
, drawWindow :: SDL.Window -- ^ SDL window
|
|
|
|
, drawSurface :: SDL.Surface -- ^ SDL surface
|
2016-12-11 16:38:03 +00:00
|
|
|
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequests's to be processed
|
2016-10-31 22:47:16 +00:00
|
|
|
}
|
|
|
|
|
2016-12-11 16:38:03 +00:00
|
|
|
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
|
|
|
|
data DrawRequest = DrawRequest
|
|
|
|
{ requestNode :: G.GeglNode -- ^ The 'G.GeglNode' to blit
|
|
|
|
, requestArea :: G.GeglRectangle -- ^ The area to update
|
|
|
|
}
|
2016-10-31 22:47:16 +00:00
|
|
|
|
|
|
|
-- | Components to initialize in SDL.
|
|
|
|
data InitComponents
|
|
|
|
= All
|
|
|
|
| Only [SDL.InitFlag]
|
|
|
|
|
|
|
|
-- | 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
|
|
|
|
type AffectionStateInner us m a = StateT us m a
|
2016-10-31 22:47:16 +00:00
|
|
|
|
|
|
|
-- | Affection's state monad
|
|
|
|
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
|
|
|
|
2016-12-08 17:22:29 +00:00
|
|
|
type Affection us a = AffectionState (AffectionData us) IO a
|
|
|
|
|
2016-10-31 22:47:16 +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))
|
|
|
|
|
2016-03-26 08:33:38 +00:00
|
|
|
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
|
|
|
|
= Fill -- ^ Fill the specified area completely with color
|
|
|
|
| Line -- ^ only draw the outline of the area
|
|
|
|
{ lineWidth :: Int -- ^ Width of line in pixels
|
|
|
|
}
|