{-# OPTIONS_HADDOCK hide #-}

-- | Rendering options
module Brillo.Internals.Rendering.State (
  State (..),
  initState,
  Texture (..),
)
where

import Brillo.Internals.Rendering.Bitmap (BitmapData)
import Data.IORef (IORef, newIORef)
import Data.Word (Word8)
import Foreign.ForeignPtr (ForeignPtr)
import Graphics.Rendering.OpenGL.GL qualified as GL
import System.Mem.StableName (StableName)


{-| Abstract Brillo render state which holds references to textures
  loaded into the GPU context.
-}
data State
  = State
  { State -> Bool
stateColor :: !Bool
  -- ^ Whether to use color
  , State -> Bool
stateWireframe :: !Bool
  -- ^ Whether to force wireframe mode only
  , State -> Bool
stateBlendAlpha :: !Bool
  -- ^ Whether to use alpha blending
  , State -> Bool
stateLineSmooth :: !Bool
  -- ^ Whether to use line smoothing
  , State -> IORef [Texture]
stateTextures :: !(IORef [Texture])
  -- ^ Cache of Textures that we've sent to OpenGL.
  }


-- | A texture that we've sent to OpenGL.
data Texture
  = Texture
  { Texture -> StableName BitmapData
texName :: StableName BitmapData
  -- ^ Stable name derived from the `BitmapData` that the user gives us.
  , Texture -> Int
texWidth :: Int
  -- ^ Width of the image, in pixels.
  , Texture -> Int
texHeight :: Int
  -- ^ Height of the image, in pixels.
  , Texture -> ForeignPtr Word8
texData :: ForeignPtr Word8
  -- ^ Pointer to the Raw texture data.
  , Texture -> TextureObject
texObject :: GL.TextureObject
  -- ^ The OpenGL texture object.
  , Texture -> Bool
texCacheMe :: Bool
  -- ^ Whether we want to leave this in OpenGL texture memory between frames.
  }


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