{-# OPTIONS_HADDOCK hide #-}

-- | Rendering options
module Graphics.Gloss.Internals.Rendering.State
        ( State (..)
        , initState
        , Texture (..))
where
import Graphics.Gloss.Internals.Data.Picture
import Foreign.ForeignPtr
import System.Mem.StableName
import Data.Word
import Data.IORef
import qualified Graphics.Rendering.OpenGL.GL   as GL


-- | Abstract Gloss render state which holds references to textures
--   loaded into the GPU context.
data State
        = State
        { -- | Whether to use color
          State -> Bool
stateColor            :: !Bool

        -- | Whether to force wireframe mode only
        , State -> Bool
stateWireframe        :: !Bool

        -- | Whether to use alpha blending
        , State -> Bool
stateBlendAlpha       :: !Bool

        -- | Whether to use line smoothing
        , State -> Bool
stateLineSmooth       :: !Bool
        
        -- | Cache of Textures that we've sent to OpenGL.
        , State -> IORef [Texture]
stateTextures         :: !(IORef [Texture])
        }
        

-- | A texture that we've sent to OpenGL.
data Texture
        = Texture
        { -- | Stable name derived from the `BitmapData` that the user gives us.
          Texture -> StableName BitmapData
texName       :: StableName BitmapData

        -- | Width of the image, in pixels.
        , Texture -> Int
texWidth      :: Int

        -- | Height of the image, in pixels.
        , Texture -> Int
texHeight     :: Int

        -- | Pointer to the Raw texture data.
        , Texture -> ForeignPtr Word8
texData       :: ForeignPtr Word8
        
        -- | The OpenGL texture object.
        , Texture -> TextureObject
texObject     :: GL.TextureObject

        -- | Whether we want to leave this in OpenGL texture memory between frames.
        , Texture -> Bool
texCacheMe    :: Bool }


-- | A mutable render state holds references to the textures currently loaded
--   into the OpenGL context. To ensure that textures are cached in GPU memory,
--   pass the same `State` each time you call `displayPicture` or `renderPicture`.
initState :: IO State
initState :: IO State
initState
 = do   IORef [Texture]
textures        <- [Texture] -> IO (IORef [Texture])
forall a. a -> IO (IORef a)
newIORef []
        State -> IO State
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return  State
                { stateColor :: Bool
stateColor            = Bool
True
                , stateWireframe :: Bool
stateWireframe        = Bool
False
                , stateBlendAlpha :: Bool
stateBlendAlpha       = Bool
True
                , stateLineSmooth :: Bool
stateLineSmooth       = Bool
False 
                , stateTextures :: IORef [Texture]
stateTextures         = IORef [Texture]
textures }