{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}

{-# OPTIONS_GHC -Wno-unused-foralls #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
module Graphics.GPipe.Internal.FrameBuffer where

import           Control.Monad                           (void, when)
import           Control.Monad.IO.Class                  (MonadIO (liftIO))
import           Control.Monad.Trans.Class               (MonadTrans (lift))
import           Control.Monad.Trans.Except              (ExceptT, throwE)
import           Control.Monad.Trans.State.Lazy          (StateT (..), get, put)
import qualified Control.Monad.Trans.State.Strict        as StrictState
import           Control.Monad.Trans.Writer.Lazy         (Writer, execWriter,
                                                          tell)
import           Data.IORef                              (mkWeakIORef, newIORef,
                                                          readIORef)
import qualified Data.IntMap.Polymorphic                 as IMap
import           Data.Text.Lazy                          (Text)
import qualified Data.Text.Lazy                          as LT
import qualified Data.Text.Lazy.IO                       as LT
import           Foreign.Marshal.Alloc                   (alloca)
import           Foreign.Marshal.Array                   (withArray)
import           Foreign.Marshal.Utils                   (fromBool, with)
import           Foreign.Ptr                             (nullPtr)
import           Foreign.Storable                        (peek)
import           Graphics.GL.Core45
import           Graphics.GL.Types                       (GLenum, GLuint)
import           Graphics.GPipe.Internal.Compiler        (Drawcall (Drawcall),
                                                          getFboError)
import           Graphics.GPipe.Internal.Context         (FBOKey,
                                                          FBOKeys (FBOKeys),
                                                          Render (Render),
                                                          RenderState (perWindowRenderState),
                                                          Window (getWinName),
                                                          asSync, getFBO,
                                                          getLastRenderWin,
                                                          setFBO)
import           Graphics.GPipe.Internal.Expr            (ExprM,
                                                          ExprResult (ExprResult),
                                                          F, FFloat, GlobDeclM,
                                                          S (..), discard,
                                                          runExprM,
                                                          tellAssignment',
                                                          tellGlobal,
                                                          tellGlobalLn, tshow)
import           Graphics.GPipe.Internal.Format          (ColorRenderable (clearColor),
                                                          ColorSampleable (Color, ColorElement, fromColor, typeStr),
                                                          ContextColorFormat,
                                                          DepthRenderable,
                                                          DepthStencil, Format,
                                                          StencilRenderable)
import           Graphics.GPipe.Internal.FragmentStream  (FragmentStream (..),
                                                          FragmentStreamData (..))
import           Graphics.GPipe.Internal.IDs             (WinId)
import           Graphics.GPipe.Internal.PrimitiveStream (PrimitiveStreamData (PrimitiveStreamData))
import           Graphics.GPipe.Internal.Shader          (Shader (..), ShaderM,
                                                          tellDrawcall)
import           Graphics.GPipe.Internal.Texture         (ComparisonFunction,
                                                          Image, getGlCompFunc,
                                                          getImageBinding,
                                                          getImageFBOKey,
                                                          imageEquals)
import           Language.GLSL.Optimizer                (optimizeShader)
import           Linear.V4                               (V4 (..))
import qualified System.Environment                      as Env

-- | A monad in which individual color images can be drawn.
newtype DrawColors os s a = DrawColors (StateT Int (Writer [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]) a) deriving (a -> DrawColors os s b -> DrawColors os s a
(a -> b) -> DrawColors os s a -> DrawColors os s b
(forall a b. (a -> b) -> DrawColors os s a -> DrawColors os s b)
-> (forall a b. a -> DrawColors os s b -> DrawColors os s a)
-> Functor (DrawColors os s)
forall a b. a -> DrawColors os s b -> DrawColors os s a
forall a b. (a -> b) -> DrawColors os s a -> DrawColors os s b
forall os s a b. a -> DrawColors os s b -> DrawColors os s a
forall os s a b. (a -> b) -> DrawColors os s a -> DrawColors os s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DrawColors os s b -> DrawColors os s a
$c<$ :: forall os s a b. a -> DrawColors os s b -> DrawColors os s a
fmap :: (a -> b) -> DrawColors os s a -> DrawColors os s b
$cfmap :: forall os s a b. (a -> b) -> DrawColors os s a -> DrawColors os s b
Functor, Functor (DrawColors os s)
a -> DrawColors os s a
Functor (DrawColors os s)
-> (forall a. a -> DrawColors os s a)
-> (forall a b.
    DrawColors os s (a -> b) -> DrawColors os s a -> DrawColors os s b)
-> (forall a b c.
    (a -> b -> c)
    -> DrawColors os s a -> DrawColors os s b -> DrawColors os s c)
-> (forall a b.
    DrawColors os s a -> DrawColors os s b -> DrawColors os s b)
-> (forall a b.
    DrawColors os s a -> DrawColors os s b -> DrawColors os s a)
-> Applicative (DrawColors os s)
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
DrawColors os s a -> DrawColors os s b -> DrawColors os s a
DrawColors os s (a -> b) -> DrawColors os s a -> DrawColors os s b
(a -> b -> c)
-> DrawColors os s a -> DrawColors os s b -> DrawColors os s c
forall a. a -> DrawColors os s a
forall os s. Functor (DrawColors os s)
forall a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s a
forall a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
forall a b.
DrawColors os s (a -> b) -> DrawColors os s a -> DrawColors os s b
forall os s a. a -> DrawColors os s a
forall a b c.
(a -> b -> c)
-> DrawColors os s a -> DrawColors os s b -> DrawColors os s c
forall os s a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s a
forall os s a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
forall os s a b.
DrawColors os s (a -> b) -> DrawColors os s a -> DrawColors os s b
forall os s a b c.
(a -> b -> c)
-> DrawColors os s a -> DrawColors os s b -> DrawColors os s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: DrawColors os s a -> DrawColors os s b -> DrawColors os s a
$c<* :: forall os s a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s a
*> :: DrawColors os s a -> DrawColors os s b -> DrawColors os s b
$c*> :: forall os s a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
liftA2 :: (a -> b -> c)
-> DrawColors os s a -> DrawColors os s b -> DrawColors os s c
$cliftA2 :: forall os s a b c.
(a -> b -> c)
-> DrawColors os s a -> DrawColors os s b -> DrawColors os s c
<*> :: DrawColors os s (a -> b) -> DrawColors os s a -> DrawColors os s b
$c<*> :: forall os s a b.
DrawColors os s (a -> b) -> DrawColors os s a -> DrawColors os s b
pure :: a -> DrawColors os s a
$cpure :: forall os s a. a -> DrawColors os s a
$cp1Applicative :: forall os s. Functor (DrawColors os s)
Applicative, Applicative (DrawColors os s)
a -> DrawColors os s a
Applicative (DrawColors os s)
-> (forall a b.
    DrawColors os s a -> (a -> DrawColors os s b) -> DrawColors os s b)
-> (forall a b.
    DrawColors os s a -> DrawColors os s b -> DrawColors os s b)
-> (forall a. a -> DrawColors os s a)
-> Monad (DrawColors os s)
DrawColors os s a -> (a -> DrawColors os s b) -> DrawColors os s b
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
forall a. a -> DrawColors os s a
forall os s. Applicative (DrawColors os s)
forall a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
forall a b.
DrawColors os s a -> (a -> DrawColors os s b) -> DrawColors os s b
forall os s a. a -> DrawColors os s a
forall os s a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
forall os s a b.
DrawColors os s a -> (a -> DrawColors os s b) -> DrawColors os s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> DrawColors os s a
$creturn :: forall os s a. a -> DrawColors os s a
>> :: DrawColors os s a -> DrawColors os s b -> DrawColors os s b
$c>> :: forall os s a b.
DrawColors os s a -> DrawColors os s b -> DrawColors os s b
>>= :: DrawColors os s a -> (a -> DrawColors os s b) -> DrawColors os s b
$c>>= :: forall os s a b.
DrawColors os s a -> (a -> DrawColors os s b) -> DrawColors os s b
$cp1Monad :: forall os s. Applicative (DrawColors os s)
Monad)

runDrawColors :: DrawColors os s a -> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
runDrawColors :: DrawColors os s a
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
runDrawColors (DrawColors StateT
  Int
  (Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
  a
m) = ((ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
 -> (Int,
     Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))
 -> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ())))
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
-> [(Int,
     Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))]
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
-> (Int,
    Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall (m :: * -> *) (m :: * -> *) (m :: * -> *) (m :: * -> *)
       (m :: * -> *) a a p a a a a b b b b.
(Monad m, Monad m, Monad m, Monad m, Monad m) =>
(m a, m a, p -> (m [a], m a, m a))
-> (a, a -> (m b, m b, p -> (m a, m b, m b)))
-> (m b, m b, p -> (m [a], m b, m b))
sf (() -> ExprM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), () -> GlobDeclM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), (IO [FBOKey], IO (), IO ()) -> s -> (IO [FBOKey], IO (), IO ())
forall a b. a -> b -> a
const ([FBOKey] -> IO [FBOKey]
forall (m :: * -> *) a. Monad m => a -> m a
return [], () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) ([(Int,
   Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))]
 -> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ())))
-> [(Int,
     Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))]
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall a b. (a -> b) -> a -> b
$ [Int]
-> [Int
    -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
-> [(Int,
     Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
 -> [(Int,
      Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))])
-> [Int
    -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
-> [(Int,
     Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))]
forall a b. (a -> b) -> a -> b
$ Writer
  [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
  (a, Int)
-> [Int
    -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
forall w a. Writer w a -> w
execWriter (StateT
  Int
  (Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
  a
-> Int
-> Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
     (a, Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT
  Int
  (Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
  a
m Int
0)
    where
        sf :: (m a, m a, p -> (m [a], m a, m a))
-> (a, a -> (m b, m b, p -> (m a, m b, m b)))
-> (m b, m b, p -> (m [a], m b, m b))
sf (m a
ms, m a
mg, p -> (m [a], m a, m a)
mio) (a
n, a -> (m b, m b, p -> (m a, m b, m b))
f) = let (m b
sh, m b
g, p -> (m a, m b, m b)
io) = a -> (m b, m b, p -> (m a, m b, m b))
f a
n in (m a
ms m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
sh, m a
mg m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
g, (p -> (m [a], m a, m a))
-> (p -> (m a, m b, m b)) -> p -> (m [a], m b, m b)
forall (m :: * -> *) (m :: * -> *) (m :: * -> *) p a a a b b.
(Monad m, Monad m, Monad m) =>
(p -> (m [a], m a, m a))
-> (p -> (m a, m b, m b)) -> p -> (m [a], m b, m b)
sf' p -> (m [a], m a, m a)
mio p -> (m a, m b, m b)
io)
        sf' :: (p -> (m [a], m a, m a))
-> (p -> (m a, m b, m b)) -> p -> (m [a], m b, m b)
sf' p -> (m [a], m a, m a)
mio p -> (m a, m b, m b)
io p
s =
            let (m [a]
a, m a
b, m a
c) = p -> (m [a], m a, m a)
mio p
s
                (m a
x, m b
y, m b
z) = p -> (m a, m b, m b)
io p
s
            in  ( do
                    [a]
ns <- m [a]
a
                    a
n <- m a
x
                    [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a]
ns [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
n]
                , m a
b m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
y
                , m a
c m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
z
                )

-- | Draw color values into a color renderable texture image.
drawColor :: forall c s os. ColorRenderable c => (s -> (Image (Format c), ColorMask c, UseBlending)) -> FragColor c -> DrawColors os s ()
drawColor :: (s -> (Image (Format c), ColorMask c, UseBlending))
-> FragColor c -> DrawColors os s ()
drawColor s -> (Image (Format c), ColorMask c, UseBlending)
sf FragColor c
c = StateT
  Int
  (Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
  ()
-> DrawColors os s ()
forall os s a.
StateT
  Int
  (Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
  a
-> DrawColors os s a
DrawColors (StateT
   Int
   (Writer
      [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
   ()
 -> DrawColors os s ())
-> StateT
     Int
     (Writer
        [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
     ()
-> DrawColors os s ()
forall a b. (a -> b) -> a -> b
$ do
    Int
n <- StateT
  Int
  (Writer
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
  Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Int
-> StateT
     Int
     (Writer
        [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
     ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
 -> StateT
      Int
      (Writer
         [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
      ())
-> Int
-> StateT
     Int
     (Writer
        [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
     ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    WriterT
  [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
  Identity
  ()
-> StateT
     Int
     (Writer
        [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
   [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
   Identity
   ()
 -> StateT
      Int
      (Writer
         [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
      ())
-> WriterT
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
     Identity
     ()
-> StateT
     Int
     (Writer
        [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))])
     ()
forall a b. (a -> b) -> a -> b
$
        [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
-> WriterT
     [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]
     Identity
     ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell
            [ \Int
ix -> (ExprM (), GlobDeclM ())
-> (s -> (IO FBOKey, IO (), IO ()))
-> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))
forall t t1 t2. (t, t1) -> t2 -> (t, t1, t2)
make3 (c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
forall c.
ColorSampleable c =>
c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor c
cf Int
ix FragColor c
c) ((s -> (IO FBOKey, IO (), IO ()))
 -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ())))
-> (s -> (IO FBOKey, IO (), IO ()))
-> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))
forall a b. (a -> b) -> a -> b
$ \s
s ->
                let (Image (Format c)
i, ColorMask c
mask, UseBlending
o) = s -> (Image (Format c), ColorMask c, UseBlending)
sf s
s
                    n' :: GLuint
n' = Int -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
                    useblend :: IO ()
useblend = if UseBlending
o then GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glEnablei GLuint
forall a. (Eq a, Num a) => a
GL_BLEND GLuint
n' else GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glDisablei GLuint
forall a. (Eq a, Num a) => a
GL_BLEND GLuint
n'
                in  ( Image (Format c) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format c)
i
                    , Image (Format c) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format c)
i (GLuint
forall a. (Eq a, Num a) => a
GL_COLOR_ATTACHMENT0 GLuint -> GLuint -> GLuint
forall a. Num a => a -> a -> a
+ GLuint
n')
                    , do
                        IO ()
useblend
                        c -> GLuint -> ColorMask c -> IO ()
forall f.
ColorSampleable f =>
f -> GLuint -> Color f UseBlending -> IO ()
setGlColorMask c
cf GLuint
n' ColorMask c
mask
                    )
            ]
    where
        cf :: c
cf = c
forall a. HasCallStack => a
undefined :: c

-- | Draw all fragments in a 'FragmentStream' using the provided function that
--   passes each fragment value into a 'DrawColors' monad. The first argument is
--   a function that retrieves a 'Blending' setting from the shader environment,
--   which will be used for all 'drawColor' actions in the 'DrawColors' monad
--   where 'UseBlending' is 'True'. (OpenGL 3.3 unfortunately doesn't support
--   having different blending settings for different color targets.)
--
--   TODO: we're using OpenGL 4.5 now. Is this still true?
draw :: forall a os f s. (s -> Blending)
    -> FragmentStream a
    -> (a -> DrawColors os s ())
    -> Shader os s ()

-- | Like 'draw', but performs a depth test on each fragment first. The
--   'DrawColors' monad is then only run for fragments where the depth test
--   passes.
drawDepth :: forall a os f s d. DepthRenderable d
    => (s -> (Blending, Image (Format d), DepthOption))
    -> FragmentStream (a, FragDepth)
    -> (a -> DrawColors os s ())
    -> Shader os s ()

-- | Like 'draw', but performs a stencil test on each fragment first. The
--   'DrawColors' monad is then only run for fragments where the stencil test
--   passes.
drawStencil :: forall a os f s st. StencilRenderable st
    => (s -> (Blending, Image (Format st), StencilOptions))
    -> FragmentStream a
    -> (a -> DrawColors os s ())
    -> Shader os s ()

-- | Like 'draw', but performs a stencil test and a depth test (in that order)
--   on each fragment first. The 'DrawColors' monad is then only run for
--   fragments where the stencil and depth test passes.
drawDepthStencil :: forall a os f s d st. (DepthRenderable d, StencilRenderable st)
    => (s -> (Blending, Image (Format d), Image (Format st), DepthStencilOption))
    -> FragmentStream (a, FragDepth)
    -> (a -> DrawColors os s ())
    -> Shader os s ()

makeFBOKeys :: IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
makeFBOKeys :: IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
makeFBOKeys IO [FBOKey]
c IO (Maybe FBOKey)
d IO (Maybe FBOKey)
s =
    [FBOKey] -> Maybe FBOKey -> Maybe FBOKey -> FBOKeys
FBOKeys ([FBOKey] -> Maybe FBOKey -> Maybe FBOKey -> FBOKeys)
-> IO [FBOKey] -> IO (Maybe FBOKey -> Maybe FBOKey -> FBOKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FBOKey]
c IO (Maybe FBOKey -> Maybe FBOKey -> FBOKeys)
-> IO (Maybe FBOKey) -> IO (Maybe FBOKey -> FBOKeys)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe FBOKey)
d IO (Maybe FBOKey -> FBOKeys) -> IO (Maybe FBOKey) -> IO FBOKeys
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe FBOKey)
s

draw :: (s -> Blending)
-> FragmentStream a -> (a -> DrawColors os s ()) -> Shader os s ()
draw s -> Blending
sf FragmentStream a
fs a -> DrawColors os s ()
m = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream a
fs ((a
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \a
c -> let (ExprM ()
sh, GlobDeclM ()
g, s -> (IO [FBOKey], IO (), IO ())
ioc) = DrawColors os s ()
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall os s a.
DrawColors os s a
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
runDrawColors (a -> DrawColors os s ()
m a
c) in (ExprM ()
sh, GlobDeclM ()
g, (s -> (IO [FBOKey], IO (), IO ()))
-> s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b a a.
(s -> (IO [FBOKey], b, IO a))
-> s -> (Either a (IO FBOKeys, b), IO ())
f s -> (IO [FBOKey], IO (), IO ())
ioc)
    where
        f :: (s -> (IO [FBOKey], b, IO a))
-> s -> (Either a (IO FBOKeys, b), IO ())
f s -> (IO [FBOKey], b, IO a)
ioc s
s =
            let (IO [FBOKey]
fbokeyio, b
fboio, IO a
io) = s -> (IO [FBOKey], b, IO a)
ioc s
s
                b :: Blending
b = s -> Blending
sf s
s
            in  ( (IO FBOKeys, b) -> Either a (IO FBOKeys, b)
forall a b. b -> Either a b
Right (IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
makeFBOKeys IO [FBOKey]
fbokeyio (Maybe FBOKey -> IO (Maybe FBOKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FBOKey
forall a. Maybe a
Nothing) (Maybe FBOKey -> IO (Maybe FBOKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FBOKey
forall a. Maybe a
Nothing), b
fboio)
                , IO a
io IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blending -> IO ()
setGlBlend Blending
b
                )

drawDepth :: (s -> (Blending, Image (Format d), DepthOption))
-> FragmentStream (a, FragDepth)
-> (a -> DrawColors os s ())
-> Shader os s ()
drawDepth s -> (Blending, Image (Format d), DepthOption)
sf FragmentStream (a, FragDepth)
fs a -> DrawColors os s ()
m = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream (a, FragDepth)
-> ((a, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream (a, FragDepth)
fs (((a, FragDepth)
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> ((a, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \(a
c, FragDepth
d) -> let (ExprM ()
sh, GlobDeclM ()
g, s -> (IO [FBOKey], IO (), IO ())
ioc) = DrawColors os s ()
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall os s a.
DrawColors os s a
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
runDrawColors (a -> DrawColors os s ()
m a
c) in (ExprM ()
sh ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FragDepth -> ExprM ()
setDepth FragDepth
d, GlobDeclM ()
g, (s -> (IO [FBOKey], IO (), IO ()))
-> s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall a a a.
(s -> (IO [FBOKey], IO a, IO a))
-> s -> (Either a (IO FBOKeys, IO ()), IO ())
f s -> (IO [FBOKey], IO (), IO ())
ioc)
    where
        f :: (s -> (IO [FBOKey], IO a, IO a))
-> s -> (Either a (IO FBOKeys, IO ()), IO ())
f s -> (IO [FBOKey], IO a, IO a)
ioc s
s =
            let (IO [FBOKey]
fbokeyio, IO a
fboio, IO a
io) = s -> (IO [FBOKey], IO a, IO a)
ioc s
s
                (Blending
b, Image (Format d)
di, DepthOption
o) = s -> (Blending, Image (Format d), DepthOption)
sf s
s
            in  ( (IO FBOKeys, IO ()) -> Either a (IO FBOKeys, IO ())
forall a b. b -> Either a b
Right
                    ( IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
makeFBOKeys IO [FBOKey]
fbokeyio (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just (FBOKey -> Maybe FBOKey) -> IO FBOKey -> IO (Maybe FBOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image (Format d) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format d)
di) (Maybe FBOKey -> IO (Maybe FBOKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FBOKey
forall a. Maybe a
Nothing)
                    , IO a
fboio IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Image (Format d) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format d)
di GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_ATTACHMENT
                    )
                , IO a
io IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blending -> IO ()
setGlBlend Blending
b IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepthOption -> IO ()
setGlDepthOptions DepthOption
o
                )

drawStencil :: (s -> (Blending, Image (Format st), StencilOptions))
-> FragmentStream a -> (a -> DrawColors os s ()) -> Shader os s ()
drawStencil s -> (Blending, Image (Format st), StencilOptions)
sf FragmentStream a
fs a -> DrawColors os s ()
m = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream a
fs ((a
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \a
c -> let (ExprM ()
sh, GlobDeclM ()
g, s -> (IO [FBOKey], IO (), IO ())
ioc) = DrawColors os s ()
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall os s a.
DrawColors os s a
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
runDrawColors (a -> DrawColors os s ()
m a
c) in (ExprM ()
sh, GlobDeclM ()
g, (s -> (IO [FBOKey], IO (), IO ()))
-> s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall a a a.
(s -> (IO [FBOKey], IO a, IO a))
-> s -> (Either a (IO FBOKeys, IO ()), IO ())
f s -> (IO [FBOKey], IO (), IO ())
ioc)
    where
        f :: (s -> (IO [FBOKey], IO a, IO a))
-> s -> (Either a (IO FBOKeys, IO ()), IO ())
f s -> (IO [FBOKey], IO a, IO a)
ioc s
s =
            let (IO [FBOKey]
fbokeyio, IO a
fboio, IO a
io) = s -> (IO [FBOKey], IO a, IO a)
ioc s
s
                (Blending
b, Image (Format st)
si, StencilOptions
o) = s -> (Blending, Image (Format st), StencilOptions)
sf s
s
            in  ( (IO FBOKeys, IO ()) -> Either a (IO FBOKeys, IO ())
forall a b. b -> Either a b
Right
                    ( IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
makeFBOKeys IO [FBOKey]
fbokeyio (Maybe FBOKey -> IO (Maybe FBOKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FBOKey
forall a. Maybe a
Nothing) (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just (FBOKey -> Maybe FBOKey) -> IO FBOKey -> IO (Maybe FBOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image (Format st) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format st)
si)
                    , IO a
fboio IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Image (Format st) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format st)
si GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_ATTACHMENT
                    )
                , IO a
io IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blending -> IO ()
setGlBlend Blending
b IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StencilOptions -> StencilOp -> StencilOp -> IO ()
setGlStencilOptions StencilOptions
o StencilOp
OpZero StencilOp
OpZero
                )

drawDepthStencil :: (s
 -> (Blending, Image (Format d), Image (Format st),
     DepthStencilOption))
-> FragmentStream (a, FragDepth)
-> (a -> DrawColors os s ())
-> Shader os s ()
drawDepthStencil s
-> (Blending, Image (Format d), Image (Format st),
    DepthStencilOption)
sf FragmentStream (a, FragDepth)
fs a -> DrawColors os s ()
m = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream (a, FragDepth)
-> ((a, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream (a, FragDepth)
fs (((a, FragDepth)
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> ((a, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \(a
c, FragDepth
d) -> let (ExprM ()
sh, GlobDeclM ()
g, s -> (IO [FBOKey], IO (), IO ())
ioc) = DrawColors os s ()
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
forall os s a.
DrawColors os s a
-> (ExprM (), GlobDeclM (), s -> (IO [FBOKey], IO (), IO ()))
runDrawColors (a -> DrawColors os s ()
m a
c) in (ExprM ()
sh ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FragDepth -> ExprM ()
setDepth FragDepth
d, GlobDeclM ()
g, (s -> (IO [FBOKey], IO (), IO ()))
-> s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall a a a.
(s -> (IO [FBOKey], IO a, IO a))
-> s -> (Either a (IO FBOKeys, IO ()), IO ())
f s -> (IO [FBOKey], IO (), IO ())
ioc)
    where
        f :: (s -> (IO [FBOKey], IO a, IO a))
-> s -> (Either a (IO FBOKeys, IO ()), IO ())
f s -> (IO [FBOKey], IO a, IO a)
ioc s
s =
            let (IO [FBOKey]
fbokeyio, IO a
fboio, IO a
io) = s -> (IO [FBOKey], IO a, IO a)
ioc s
s
                (Blending
b, Image (Format d)
di, Image (Format st)
si, DepthStencilOption
o) = s
-> (Blending, Image (Format d), Image (Format st),
    DepthStencilOption)
sf s
s
            in  ( (IO FBOKeys, IO ()) -> Either a (IO FBOKeys, IO ())
forall a b. b -> Either a b
Right
                    ( IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
makeFBOKeys IO [FBOKey]
fbokeyio (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just (FBOKey -> Maybe FBOKey) -> IO FBOKey -> IO (Maybe FBOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image (Format d) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format d)
di) (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just (FBOKey -> Maybe FBOKey) -> IO FBOKey -> IO (Maybe FBOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image (Format st) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format st)
si)
                    , IO a
fboio IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Image (Format d) -> Image (Format st) -> IO ()
forall t t. Image t -> Image t -> IO ()
getCombinedBinding Image (Format d)
di Image (Format st)
si
                    )
                , IO a
io IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blending -> IO ()
setGlBlend Blending
b IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepthStencilOption -> IO ()
setGlDepthStencilOptions DepthStencilOption
o
                )
        getCombinedBinding :: Image t -> Image t -> IO ()
getCombinedBinding Image t
di Image t
si
            | Image t -> Image t -> UseBlending
forall a b. Image a -> Image b -> UseBlending
imageEquals Image t
di Image t
si = Image t -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image t
di GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_STENCIL_ATTACHMENT
            | UseBlending
otherwise = Image t -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image t
di GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_ATTACHMENT IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Image t -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image t
si GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_ATTACHMENT

-- | Draw color values from a 'FragmentStream' into the window.
drawWindowColor :: forall os s c ds. ContextColorFormat c
    => (s -> (Window os c ds, ContextColorOption c))
    -> FragmentStream (FragColor c) -> Shader os s ()

-- | Perform a depth test for each fragment from a 'FragmentStream' in the
--   window. This doesn't draw any color values and only affects the depth
--   buffer.
drawWindowDepth :: forall os s c ds. DepthRenderable ds
    => (s -> (Window os c ds, DepthOption))
    -> FragmentStream FragDepth -> Shader os s ()

-- | Perform a depth test for each fragment from a 'FragmentStream' and write a
--   color value from each fragment that passes the test into the window.
drawWindowColorDepth :: forall os s c ds. (ContextColorFormat c, DepthRenderable ds)
    => (s -> (Window os c ds, ContextColorOption c, DepthOption))
    -> FragmentStream (FragColor c, FragDepth) -> Shader os s ()

-- | Perform a stencil test for each fragment from a 'FragmentStream' in the
--   window. This doesn't draw any color values and only affects the stencil buffer.
drawWindowStencil :: forall os s c ds. StencilRenderable ds
    => (s -> (Window os c ds, StencilOptions))
    -> FragmentStream () -> Shader os s ()

-- | Perform a stencil test for each fragment from a 'FragmentStream' and write
--   a color value from each fragment that passes the test into the window.
drawWindowColorStencil :: forall os s c ds. (ContextColorFormat c, StencilRenderable ds)
    => (s -> (Window os c ds, ContextColorOption c, StencilOptions))
    -> FragmentStream (FragColor c) -> Shader os s ()

-- | Perform a stencil test and depth test (in that order) for each fragment
--   from a 'FragmentStream' in the window. This doesnt draw any color values
--   and only affects the depth and stencil buffer.
drawWindowDepthStencil :: forall os s c ds. (DepthRenderable ds, StencilRenderable ds)
    => (s -> (Window os c ds, DepthStencilOption))
    -> FragmentStream FragDepth -> Shader os s ()

-- | Perform a stencil test and depth test (in that order) for each fragment
--   from a 'FragmentStream' and write a color value from each fragment that
--   passes the tests into the window.
drawWindowColorDepthStencil :: forall os s c ds. (ContextColorFormat c, DepthRenderable ds, StencilRenderable ds)
    => (s -> (Window os c ds, ContextColorOption c, DepthStencilOption))
    -> FragmentStream (FragColor c, FragDepth) -> Shader os s ()

drawWindowColor :: (s -> (Window os c ds, ContextColorOption c))
-> FragmentStream (FragColor c) -> Shader os s ()
drawWindowColor s -> (Window os c ds, ContextColorOption c)
sf FragmentStream (FragColor c)
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream (FragColor c)
-> (FragColor c
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream (FragColor c)
fs ((FragColor c
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (FragColor c
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \FragColor c
a -> (ExprM (), GlobDeclM ())
-> (s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> (ExprM (), GlobDeclM (),
    s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
forall t t1 t2. (t, t1) -> t2 -> (t, t1, t2)
make3 (c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
forall c.
ColorSampleable c =>
c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor c
cf Int
0 FragColor c
a) s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, ContextColorOption c
op) = s -> (Window os c ds, ContextColorOption c)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> ContextColorOption c -> IO ()
forall f. ColorSampleable f => f -> ContextColorOption f -> IO ()
setGlContextColorOptions c
cf ContextColorOption c
op)
        cf :: c
cf = c
forall a. HasCallStack => a
undefined :: c

drawWindowDepth :: (s -> (Window os c ds, DepthOption))
-> FragmentStream FragDepth -> Shader os s ()
drawWindowDepth s -> (Window os c ds, DepthOption)
sf FragmentStream FragDepth
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream FragDepth
-> (FragDepth
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream FragDepth
fs ((FragDepth
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (FragDepth
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \FragDepth
a -> (FragDepth -> ExprM ()
setDepth FragDepth
a, () -> GlobDeclM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io)
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, DepthOption
op) = s -> (Window os c ds, DepthOption)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepthOption -> IO ()
setGlDepthOptions DepthOption
op)

drawWindowColorDepth :: (s -> (Window os c ds, ContextColorOption c, DepthOption))
-> FragmentStream (FragColor c, FragDepth) -> Shader os s ()
drawWindowColorDepth s -> (Window os c ds, ContextColorOption c, DepthOption)
sf FragmentStream (FragColor c, FragDepth)
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream (FragColor c, FragDepth)
-> ((FragColor c, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream (FragColor c, FragDepth)
fs (((FragColor c, FragDepth)
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> ((FragColor c, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \(FragColor c
c, FragDepth
d) -> let (ExprM ()
s, GlobDeclM ()
g) = c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
forall c.
ColorSampleable c =>
c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor c
cf Int
0 FragColor c
c in (ExprM ()
s ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FragDepth -> ExprM ()
setDepth FragDepth
d, GlobDeclM ()
g, s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io)
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, ContextColorOption c
cop, DepthOption
dop) = s -> (Window os c ds, ContextColorOption c, DepthOption)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> ContextColorOption c -> IO ()
forall f. ColorSampleable f => f -> ContextColorOption f -> IO ()
setGlContextColorOptions c
cf ContextColorOption c
cop IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepthOption -> IO ()
setGlDepthOptions DepthOption
dop)
        cf :: c
cf = c
forall a. HasCallStack => a
undefined :: c

drawWindowStencil :: (s -> (Window os c ds, StencilOptions))
-> FragmentStream () -> Shader os s ()
drawWindowStencil s -> (Window os c ds, StencilOptions)
sf FragmentStream ()
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream ()
-> (()
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream ()
fs ((()
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (()
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ (ExprM (), GlobDeclM (),
 s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> ()
-> (ExprM (), GlobDeclM (),
    s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
forall a b. a -> b -> a
const (() -> ExprM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), () -> GlobDeclM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io)
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, StencilOptions
op) = s -> (Window os c ds, StencilOptions)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StencilOptions -> StencilOp -> StencilOp -> IO ()
setGlStencilOptions StencilOptions
op StencilOp
OpZero StencilOp
OpZero)

drawWindowColorStencil :: (s -> (Window os c ds, ContextColorOption c, StencilOptions))
-> FragmentStream (FragColor c) -> Shader os s ()
drawWindowColorStencil s -> (Window os c ds, ContextColorOption c, StencilOptions)
sf FragmentStream (FragColor c)
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream (FragColor c)
-> (FragColor c
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream (FragColor c)
fs ((FragColor c
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (FragColor c
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \FragColor c
a -> (ExprM (), GlobDeclM ())
-> (s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> (ExprM (), GlobDeclM (),
    s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
forall t t1 t2. (t, t1) -> t2 -> (t, t1, t2)
make3 (c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
forall c.
ColorSampleable c =>
c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor c
cf Int
0 FragColor c
a) s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, ContextColorOption c
cop, StencilOptions
dop) = s -> (Window os c ds, ContextColorOption c, StencilOptions)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_TEST IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> ContextColorOption c -> IO ()
forall f. ColorSampleable f => f -> ContextColorOption f -> IO ()
setGlContextColorOptions c
cf ContextColorOption c
cop IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StencilOptions -> StencilOp -> StencilOp -> IO ()
setGlStencilOptions StencilOptions
dop StencilOp
OpZero StencilOp
OpZero)
        cf :: c
cf = c
forall a. HasCallStack => a
undefined :: c

drawWindowDepthStencil :: (s -> (Window os c ds, DepthStencilOption))
-> FragmentStream FragDepth -> Shader os s ()
drawWindowDepthStencil s -> (Window os c ds, DepthStencilOption)
sf FragmentStream FragDepth
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream FragDepth
-> (FragDepth
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream FragDepth
fs ((FragDepth
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> (FragDepth
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \FragDepth
a -> (FragDepth -> ExprM ()
setDepth FragDepth
a, () -> GlobDeclM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io)
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, DepthStencilOption
op) = s -> (Window os c ds, DepthStencilOption)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), DepthStencilOption -> IO ()
setGlDepthStencilOptions DepthStencilOption
op)

drawWindowColorDepthStencil :: (s -> (Window os c ds, ContextColorOption c, DepthStencilOption))
-> FragmentStream (FragColor c, FragDepth) -> Shader os s ()
drawWindowColorDepthStencil s -> (Window os c ds, ContextColorOption c, DepthStencilOption)
sf FragmentStream (FragColor c, FragDepth)
fs = ShaderM s () -> Shader os s ()
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s () -> Shader os s ()) -> ShaderM s () -> Shader os s ()
forall a b. (a -> b) -> a -> b
$ FragmentStream (FragColor c, FragDepth)
-> ((FragColor c, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a s.
FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls FragmentStream (FragColor c, FragDepth)
fs (((FragColor c, FragDepth)
  -> (ExprM (), GlobDeclM (),
      s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
 -> ShaderM s ())
-> ((FragColor c, FragDepth)
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \(FragColor c
c, FragDepth
d) -> let (ExprM ()
s, GlobDeclM ()
g) = c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
forall c.
ColorSampleable c =>
c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor c
cf Int
0 FragColor c
c in (ExprM ()
s ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FragDepth -> ExprM ()
setDepth FragDepth
d, GlobDeclM ()
g, s -> (Either WinId (IO FBOKeys, IO ()), IO ())
forall b. s -> (Either WinId b, IO ())
io)
    where
        io :: s -> (Either WinId b, IO ())
io s
s = let (Window os c ds
w, ContextColorOption c
cop, DepthStencilOption
dop) = s -> (Window os c ds, ContextColorOption c, DepthStencilOption)
sf s
s in (WinId -> Either WinId b
forall a b. a -> Either a b
Left (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w), c -> ContextColorOption c -> IO ()
forall f. ColorSampleable f => f -> ContextColorOption f -> IO ()
setGlContextColorOptions c
cf ContextColorOption c
cop IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepthStencilOption -> IO ()
setGlDepthStencilOptions DepthStencilOption
dop)
        cf :: c
cf = c
forall a. HasCallStack => a
undefined :: c

tellDrawcalls :: FragmentStream a -> (a -> (ExprM (), GlobDeclM (), s -> (Either WinId (IO FBOKeys, IO ()), IO ()))) -> ShaderM s ()
tellDrawcalls :: FragmentStream a
-> (a
    -> (ExprM (), GlobDeclM (),
        s -> (Either WinId (IO FBOKeys, IO ()), IO ())))
-> ShaderM s ()
tellDrawcalls (FragmentStream [(a, FragmentStreamData)]
xs) a
-> (ExprM (), GlobDeclM (),
    s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
f = do
    let g :: (a, FragmentStreamData) -> ShaderM s ()
g (a
x, FragmentStreamData
fd) = IO (Drawcall s) -> ShaderM s ()
forall s. IO (Drawcall s) -> ShaderM s ()
tellDrawcall (IO (Drawcall s) -> ShaderM s ())
-> IO (Drawcall s) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ (ExprM (), GlobDeclM (),
 s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> FragmentStreamData -> IO (Drawcall s)
forall s.
(ExprM (), GlobDeclM (),
 s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> FragmentStreamData -> IO (Drawcall s)
makeDrawcall (a
-> (ExprM (), GlobDeclM (),
    s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
f a
x) FragmentStreamData
fd
    ((a, FragmentStreamData) -> ShaderM s ())
-> [(a, FragmentStreamData)] -> ShaderM s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a, FragmentStreamData) -> ShaderM s ()
g [(a, FragmentStreamData)]
xs

makeDrawcall ::
    (   ExprM (), -- sh - shader
        GlobDeclM (), -- shd - shader declarations
        s -> (Either WinId (IO FBOKeys, IO ()), IO ()) -- wOrIo - where to draw, as a window ID or a FBO (only this second case seems to be used)
    ) ->
    FragmentStreamData ->
    IO (Drawcall s)
makeDrawcall :: (ExprM (), GlobDeclM (),
 s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> FragmentStreamData -> IO (Drawcall s)
makeDrawcall (ExprM ()
sh, GlobDeclM ()
shd, s -> (Either WinId (IO FBOKeys, IO ()), IO ())
wOrIo) (FragmentStreamData Int
rastN UseBlending
False ExprM ()
shaderpos (PrimitiveStreamData Int
primN Int
ubuff) FBool
keep) =
    do
        ExprResult Text
fsource [UniformId]
funis [SamplerId]
fsamps [Int]
_ GlobDeclM ()
prevDecls ExprM ()
prevS <- GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
shd (FBool -> ExprM ()
discard FBool
keep ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExprM ()
sh)
        ExprResult Text
vsource [UniformId]
vunis [SamplerId]
vsamps [Int]
vinps GlobDeclM ()
_ ExprM ()
_ <- GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
prevDecls (ExprM ()
prevS ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExprM ()
shaderpos)
        let prefix :: String
prefix = String
"generated-shaders/shader" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
primN
        String -> String -> Text -> IO ()
dumpGeneratedFile String
prefix String
".frag" Text
fsource
        String -> String -> Text -> IO ()
dumpGeneratedFile String
prefix String
".vert" Text
vsource
        Drawcall s -> IO (Drawcall s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Drawcall s -> IO (Drawcall s)) -> Drawcall s -> IO (Drawcall s)
forall a b. (a -> b) -> a -> b
$ (s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> Maybe (s -> IO (GLuint, GLuint, GLuint, GLuint))
-> Int
-> Maybe Int
-> Text
-> Maybe Text
-> Maybe Text
-> [Int]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> Int
-> Drawcall s
forall s.
(s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> Maybe (s -> IO (GLuint, GLuint, GLuint, GLuint))
-> Int
-> Maybe Int
-> Text
-> Maybe Text
-> Maybe Text
-> [Int]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> Int
-> Drawcall s
Drawcall s -> (Either WinId (IO FBOKeys, IO ()), IO ())
wOrIo Maybe (s -> IO (GLuint, GLuint, GLuint, GLuint))
forall a. Maybe a
Nothing Int
primN (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
rastN) Text
vsource Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fsource) [Int]
vinps [UniformId]
vunis [SamplerId]
vsamps [] [] [UniformId]
funis [SamplerId]
fsamps Int
ubuff
makeDrawcall (ExprM ()
sh, GlobDeclM ()
shd, s -> (Either WinId (IO FBOKeys, IO ()), IO ())
wOrIo) (FragmentStreamData Int
rastN UseBlending
True ExprM ()
shaderpos (PrimitiveStreamData Int
primN Int
ubuff) FBool
keep) =
    do
        ExprResult Text
fsource [UniformId]
funis [SamplerId]
fsamps [Int]
_ GlobDeclM ()
prevDecls ExprM ()
prevS <- GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
shd (FBool -> ExprM ()
discard FBool
keep ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExprM ()
sh)
        ExprResult Text
gsource [UniformId]
gunis [SamplerId]
gsamps [Int]
_ GlobDeclM ()
prevDecls2 ExprM ()
prevS2 <- GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
prevDecls (ExprM ()
prevS ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExprM ()
shaderpos)
        ExprResult Text
vsource [UniformId]
vunis [SamplerId]
vsamps [Int]
vinps GlobDeclM ()
_ ExprM ()
_ <- GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
prevDecls2 ExprM ()
prevS2
        let prefix :: String
prefix = String
"generated-shaders/shader" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
primN
        String -> String -> Text -> IO ()
dumpGeneratedFile String
prefix String
".frag" Text
fsource
        String -> String -> Text -> IO ()
dumpGeneratedFile String
prefix String
".geom" Text
gsource
        String -> String -> Text -> IO ()
dumpGeneratedFile String
prefix String
".vert" Text
vsource
        Drawcall s -> IO (Drawcall s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Drawcall s -> IO (Drawcall s)) -> Drawcall s -> IO (Drawcall s)
forall a b. (a -> b) -> a -> b
$ (s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> Maybe (s -> IO (GLuint, GLuint, GLuint, GLuint))
-> Int
-> Maybe Int
-> Text
-> Maybe Text
-> Maybe Text
-> [Int]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> Int
-> Drawcall s
forall s.
(s -> (Either WinId (IO FBOKeys, IO ()), IO ()))
-> Maybe (s -> IO (GLuint, GLuint, GLuint, GLuint))
-> Int
-> Maybe Int
-> Text
-> Maybe Text
-> Maybe Text
-> [Int]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> [UniformId]
-> [SamplerId]
-> Int
-> Drawcall s
Drawcall s -> (Either WinId (IO FBOKeys, IO ()), IO ())
wOrIo Maybe (s -> IO (GLuint, GLuint, GLuint, GLuint))
forall a. Maybe a
Nothing Int
primN (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
rastN) Text
vsource (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
gsource) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fsource) [Int]
vinps [UniformId]
vunis [SamplerId]
vsamps [UniformId]
gunis [SamplerId]
gsamps [UniformId]
funis [SamplerId]
fsamps Int
ubuff

dumpGeneratedFile :: FilePath -> String -> Text -> IO ()
dumpGeneratedFile :: String -> String -> Text -> IO ()
dumpGeneratedFile String
prefix String
extension Text
text = do
    UseBlending
shouldWrite <- (String
"GPIPE_DEBUG" String -> [String] -> UseBlending
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> UseBlending
`elem`) ([String] -> UseBlending)
-> ([(String, String)] -> [String])
-> [(String, String)]
-> UseBlending
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> UseBlending)
-> IO [(String, String)] -> IO UseBlending
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
Env.getEnvironment
    UseBlending -> IO () -> IO ()
forall (f :: * -> *). Applicative f => UseBlending -> f () -> f ()
when UseBlending
shouldWrite (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> Text -> IO ()
LT.writeFile (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".out" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
extension) Text
text
      String -> Text -> IO ()
LT.writeFile (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".opt" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
extension) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
            case Text -> Either String Text
optimizeShader Text
text of
                Left String
err -> Text
"// " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
LT.pack String
err
                Right Text
ok -> Text
ok

setColor :: forall c. ColorSampleable c => c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor :: c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
setColor c
ct Int
n FragColor c
c =
    let name :: Text
name = Text
"out" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
        typeS :: Text
typeS = c -> Text
forall f. ColorSampleable f => f -> Text
typeStr c
ct
    in  ( do
            [Text]
xs <- (S F (ColorElement c)
 -> SNMapReaderT [Text] (StateT ExprState IO) Text)
-> [S F (ColorElement c)]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM S F (ColorElement c)
-> SNMapReaderT [Text] (StateT ExprState IO) Text
forall x a. S x a -> SNMapReaderT [Text] (StateT ExprState IO) Text
unS (c -> FragColor c -> [S F (ColorElement c)]
forall f x. ColorSampleable f => f -> Color f x -> [x]
fromColor c
ct FragColor c
c :: [S F (ColorElement c)])
            Text -> Text -> ExprM ()
tellAssignment' Text
name (Text
typeS Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
LT.intercalate Text
"," [Text]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
        , do
            Text -> GlobDeclM ()
tellGlobal Text
"layout(location = "
            Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n
            Text -> GlobDeclM ()
tellGlobal Text
") out "
            Text -> GlobDeclM ()
tellGlobal Text
typeS
            Text -> GlobDeclM ()
tellGlobal Text
" "
            Text -> GlobDeclM ()
tellGlobalLn Text
name
        )

setDepth :: FFloat -> ExprM ()
setDepth :: FragDepth -> ExprM ()
setDepth (S SNMapReaderT [Text] (StateT ExprState IO) Text
d) = do
    Text
d' <- SNMapReaderT [Text] (StateT ExprState IO) Text
d
    UseBlending -> ExprM () -> ExprM ()
forall (f :: * -> *). Applicative f => UseBlending -> f () -> f ()
when (Text
d' Text -> Text -> UseBlending
forall a. Eq a => a -> a -> UseBlending
/= Text
"gl_FragDepth") (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> ExprM ()
tellAssignment' Text
"gl_FragDepth" Text
d'

make3 :: (t, t1) -> t2 -> (t, t1, t2)
make3 :: (t, t1) -> t2 -> (t, t1, t2)
make3 (t
a, t1
b) t2
c = (t
a, t1
b, t2
c)

type FragColor c = Color c (S F (ColorElement c))

type FragDepth = FFloat

setGlColorMask :: ColorSampleable f => f -> GLuint -> Color f Bool -> IO ()
setGlColorMask :: f -> GLuint -> Color f UseBlending -> IO ()
setGlColorMask f
c GLuint
i Color f UseBlending
mask = GLuint -> GLboolean -> GLboolean -> GLboolean -> GLboolean -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLboolean -> GLboolean -> GLboolean -> GLboolean -> m ()
glColorMaski GLuint
i GLboolean
x GLboolean
y GLboolean
z GLboolean
w
    where
        [GLboolean
x, GLboolean
y, GLboolean
z, GLboolean
w] = (UseBlending -> GLboolean) -> [UseBlending] -> [GLboolean]
forall a b. (a -> b) -> [a] -> [b]
map UseBlending -> GLboolean
forall a. Num a => UseBlending -> a
fromBool ([UseBlending] -> [GLboolean]) -> [UseBlending] -> [GLboolean]
forall a b. (a -> b) -> a -> b
$ Int -> [UseBlending] -> [UseBlending]
forall a. Int -> [a] -> [a]
take Int
4 ([UseBlending] -> [UseBlending]) -> [UseBlending] -> [UseBlending]
forall a b. (a -> b) -> a -> b
$ f -> Color f UseBlending -> [UseBlending]
forall f x. ColorSampleable f => f -> Color f x -> [x]
fromColor f
c Color f UseBlending
mask [UseBlending] -> [UseBlending] -> [UseBlending]
forall a. [a] -> [a] -> [a]
++ [UseBlending
False, UseBlending
False, UseBlending
False]

setGlContextColorOptions :: ColorSampleable f => f -> ContextColorOption f -> IO ()
setGlContextColorOptions :: f -> ContextColorOption f -> IO ()
setGlContextColorOptions f
c (ContextColorOption Blending
blend ColorMask f
mask) = do
    f -> GLuint -> ColorMask f -> IO ()
forall f.
ColorSampleable f =>
f -> GLuint -> Color f UseBlending -> IO ()
setGlColorMask f
c GLuint
0 ColorMask f
mask
    Blending -> IO ()
setGlBlend Blending
blend
    case Blending
blend of
        Blending
NoBlending -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_BLEND
        LogicOp LogicOp
_  -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_BLEND
        Blending
_          -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_BLEND

setGlBlend :: Blending -> IO ()
setGlBlend :: Blending -> IO ()
setGlBlend Blending
NoBlending = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setGlBlend (BlendRgbAlpha (BlendEquation
e, BlendEquation
ea) (BlendingFactors BlendingFactor
sf BlendingFactor
df, BlendingFactors BlendingFactor
sfa BlendingFactor
dfa) (V4 Float
r Float
g Float
b Float
a)) = do
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBlendEquationSeparate (BlendEquation -> GLuint
getGlBlendEquation BlendEquation
e) (BlendEquation -> GLuint
getGlBlendEquation BlendEquation
ea)
    GLuint -> GLuint -> GLuint -> GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> GLuint -> m ()
glBlendFuncSeparate (BlendingFactor -> GLuint
getGlBlendFunc BlendingFactor
sf) (BlendingFactor -> GLuint
getGlBlendFunc BlendingFactor
df) (BlendingFactor -> GLuint
getGlBlendFunc BlendingFactor
sfa) (BlendingFactor -> GLuint
getGlBlendFunc BlendingFactor
dfa)
    UseBlending -> IO () -> IO ()
forall (f :: * -> *). Applicative f => UseBlending -> f () -> f ()
when (BlendingFactor -> UseBlending
usesConstantColor BlendingFactor
sf UseBlending -> UseBlending -> UseBlending
|| BlendingFactor -> UseBlending
usesConstantColor BlendingFactor
df UseBlending -> UseBlending -> UseBlending
|| BlendingFactor -> UseBlending
usesConstantColor BlendingFactor
sfa UseBlending -> UseBlending -> UseBlending
|| BlendingFactor -> UseBlending
usesConstantColor BlendingFactor
dfa) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Float -> Float -> Float -> Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
Float -> Float -> Float -> Float -> m ()
glBlendColor (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
r) (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
g) (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
b) (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a)
setGlBlend (LogicOp LogicOp
op) = GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_COLOR_LOGIC_OP IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glLogicOp (LogicOp -> GLuint
getGlLogicOp LogicOp
op)

setGlDepthOptions :: DepthOption -> IO ()
setGlDepthOptions :: DepthOption -> IO ()
setGlDepthOptions (DepthOption DepthFunction
df UseBlending
dm) = do
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_TEST
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDepthFunc (DepthFunction -> GLuint
forall a. (Num a, Eq a) => DepthFunction -> a
getGlCompFunc DepthFunction
df)
    GLboolean -> IO ()
forall (m :: * -> *). MonadIO m => GLboolean -> m ()
glDepthMask (GLboolean -> IO ()) -> GLboolean -> IO ()
forall a b. (a -> b) -> a -> b
$ UseBlending -> GLboolean
forall a. Num a => UseBlending -> a
fromBool UseBlending
dm

setGlStencilOptions :: FrontBack StencilOption -> StencilOp -> StencilOp -> IO ()
setGlStencilOptions :: StencilOptions -> StencilOp -> StencilOp -> IO ()
setGlStencilOptions (FrontBack (StencilOption DepthFunction
ft Int
fr StencilOp
ff StencilOp
fp Word
frm Word
fwm) (StencilOption DepthFunction
bt Int
br StencilOp
bf StencilOp
bp Word
brm Word
bwm)) StencilOp
fdf StencilOp
bdf = do
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_TEST
    GLuint -> GLuint -> GLint -> GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLint -> GLuint -> m ()
glStencilFuncSeparate GLuint
forall a. (Eq a, Num a) => a
GL_FRONT (DepthFunction -> GLuint
forall a. (Num a, Eq a) => DepthFunction -> a
getGlCompFunc DepthFunction
ft) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fr) (Word -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
frm)
    GLuint -> GLuint -> GLuint -> GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> GLuint -> m ()
glStencilOpSeparate GLuint
forall a. (Eq a, Num a) => a
GL_FRONT (StencilOp -> GLuint
getGlStencilOp StencilOp
ff) (StencilOp -> GLuint
getGlStencilOp StencilOp
fdf) (StencilOp -> GLuint
getGlStencilOp StencilOp
fp)
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glStencilMaskSeparate GLuint
forall a. (Eq a, Num a) => a
GL_FRONT (Word -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
fwm)
    GLuint -> GLuint -> GLint -> GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLint -> GLuint -> m ()
glStencilFuncSeparate GLuint
forall a. (Eq a, Num a) => a
GL_BACK (DepthFunction -> GLuint
forall a. (Num a, Eq a) => DepthFunction -> a
getGlCompFunc DepthFunction
bt) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
br) (Word -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
brm)
    GLuint -> GLuint -> GLuint -> GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> GLuint -> m ()
glStencilOpSeparate GLuint
forall a. (Eq a, Num a) => a
GL_BACK (StencilOp -> GLuint
getGlStencilOp StencilOp
bf) (StencilOp -> GLuint
getGlStencilOp StencilOp
bdf) (StencilOp -> GLuint
getGlStencilOp StencilOp
bp)
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glStencilMaskSeparate GLuint
forall a. (Eq a, Num a) => a
GL_BACK (Word -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
bwm)

setGlDepthStencilOptions :: DepthStencilOption -> IO ()
setGlDepthStencilOptions :: DepthStencilOption -> IO ()
setGlDepthStencilOptions (DepthStencilOption StencilOptions
sop DepthOption
dop (FrontBack StencilOp
fdf StencilOp
bdf)) = do
    DepthOption -> IO ()
setGlDepthOptions DepthOption
dop
    StencilOptions -> StencilOp -> StencilOp -> IO ()
setGlStencilOptions StencilOptions
sop StencilOp
fdf StencilOp
bdf

data ContextColorOption f = ContextColorOption Blending (ColorMask f)

data DepthOption = DepthOption DepthFunction DepthMask

type StencilOptions = FrontBack StencilOption

data StencilOption = StencilOption
    { StencilOption -> DepthFunction
stencilTest         :: ComparisonFunction
    , StencilOption -> Int
stencilReference    :: Int
    , StencilOption -> StencilOp
opWhenStencilFail   :: StencilOp
    , StencilOption -> StencilOp
opWhenStencilPass   :: StencilOp
    , StencilOption -> Word
stencilReadBitMask  :: Word
    , StencilOption -> Word
stencilWriteBitMask :: Word
    }

data DepthStencilOption = DepthStencilOption
    { DepthStencilOption -> StencilOptions
dsStencilOptions              :: StencilOptions
    , DepthStencilOption -> DepthOption
dsDepthOption                 :: DepthOption
    , DepthStencilOption -> FrontBack StencilOp
opWhenStencilPassButDepthFail :: FrontBack StencilOp
    }

data FrontBack a = FrontBack {FrontBack a -> a
front :: a, FrontBack a -> a
back :: a}

-- | 'True' for each color component that should be written to the target.
type ColorMask f = Color f Bool

-- | 'True' if the depth component should be written to the target.
type DepthMask = Bool

-- | The function used to compare the fragment's depth and the depth buffers depth with. E.g. 'Less' means "where fragment's depth is less than the buffers current depth".
type DepthFunction = ComparisonFunction

-- | Indicates whether this color draw should use the 'Blending' setting given to the draw action. If this is 'False', the fragment's color value will simply replace the
--   target value.
type UseBlending = Bool

-- | Denotes how each fragment's color value should be blended with the target value.
data Blending
    = -- | The fragment's color will simply replace the target value.
        NoBlending
    | -- | The fragment's color will be blended using an equation and a set of factors for the RGB components, and a separate equation and set of factors for the Alpha component (if present), and a 'ConstantColor' that may be referenced from the 'BlendingFactors'. The 'ConstantColor' may be 'undefined' if none of the 'BlendingFactors' needs it.
        --   This kind of blending will only be made on colors with a 'Float' representation (e.g. 'RGB8' or 'RGB32F', but not 'RGB8I'), integer colors will simply replace the target value.
        BlendRgbAlpha (BlendEquation, BlendEquation) (BlendingFactors, BlendingFactors) ConstantColor
    | -- | A logical operation that will be done on the bits of the fragment color and the target color. This kind of blending is only done on colors that has a
        --   integral /internal/ representation (e.g. 'RGB8' or 'RGB8I', but not 'RGB32F'; note the difference with @BlendRgbAlpha@ restriction). For targets with an internal floating point representation, the fragment value will simply replace the target value.
        LogicOp LogicOp

type ConstantColor = V4 Float

-- | A set of blending factors used for the source (fragment) and the destination (target).
data BlendingFactors = BlendingFactors {BlendingFactors -> BlendingFactor
blendFactorSrc :: BlendingFactor, BlendingFactors -> BlendingFactor
blendFactorDst :: BlendingFactor}

-- | The equation used to combine the source (fragment) and the destination (target) after they have been multiplied with their respective 'BlendingFactor's.
data BlendEquation
    = FuncAdd
    | FuncSubtract
    | FuncReverseSubtract
    | Min
    | Max

-- | A factor that the source (fragment) or the destination (target) will be multiplied with before combined with the other in the 'BlendEquation'.
data BlendingFactor
    = Zero
    | One
    | SrcColor
    | OneMinusSrcColor
    | DstColor
    | OneMinusDstColor
    | SrcAlpha
    | OneMinusSrcAlpha
    | DstAlpha
    | OneMinusDstAlpha
    | ConstantColor
    | OneMinusConstantColor
    | ConstantAlpha
    | OneMinusConstantAlpha
    | SrcAlphaSaturate

usesConstantColor :: BlendingFactor -> Bool
usesConstantColor :: BlendingFactor -> UseBlending
usesConstantColor BlendingFactor
ConstantColor         = UseBlending
True
usesConstantColor BlendingFactor
OneMinusConstantColor = UseBlending
True
usesConstantColor BlendingFactor
ConstantAlpha         = UseBlending
True
usesConstantColor BlendingFactor
OneMinusConstantAlpha = UseBlending
True
usesConstantColor BlendingFactor
_                     = UseBlending
False

-- | A bitwise logical operation that will be used to combine colors that has an integral internal representation.
data LogicOp
    = Clear
    | And
    | AndReverse
    | Copy
    | AndInverted
    | Noop
    | Xor
    | Or
    | Nor
    | Equiv
    | Invert
    | OrReverse
    | CopyInverted
    | OrInverted
    | Nand
    | Set

-- | Denotes the operation that will be performed on the target's stencil value
data StencilOp
    = OpZero
    | OpKeep
    | OpReplace
    | OpIncr
    | OpIncrWrap
    | OpDecr
    | OpDecrWrap
    | OpInvert

-----------

-- | Fill a color image with a constant color value
clearImageColor :: forall c os. ColorRenderable c => Image (Format c) -> Color c (ColorElement c) -> Render os ()
clearImageColor :: Image (Format c) -> Color c (ColorElement c) -> Render os ()
clearImageColor Image (Format c)
i Color c (ColorElement c)
c = do
    (WinId
cwid, ContextData
cd, IO () -> IO ()
doAsync) <- Render os (WinId, ContextData, IO () -> IO ())
forall os. Render os (WinId, ContextData, IO () -> IO ())
getLastRenderWin
    FBOKey
key <- ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
 -> Render os FBOKey)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) FBOKey
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey)
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO FBOKey
 -> ReaderT RenderEnv (StateT RenderState IO) FBOKey)
-> StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall a b. (a -> b) -> a -> b
$ IO FBOKey -> StateT RenderState IO FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FBOKey -> StateT RenderState IO FBOKey)
-> IO FBOKey -> StateT RenderState IO FBOKey
forall a b. (a -> b) -> a -> b
$ Image (Format c) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format c)
i
    let fbokey :: FBOKeys
fbokey = [FBOKey] -> Maybe FBOKey -> Maybe FBOKey -> FBOKeys
FBOKeys [FBOKey
key] Maybe FBOKey
forall a. Maybe a
Nothing Maybe FBOKey
forall a. Maybe a
Nothing
    Maybe (IORef GLuint)
mfbo <- ExceptT
  String
  (ReaderT RenderEnv (StateT RenderState IO))
  (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT
   String
   (ReaderT RenderEnv (StateT RenderState IO))
   (Maybe (IORef GLuint))
 -> Render os (Maybe (IORef GLuint)))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
 -> ExceptT
      String
      (ReaderT RenderEnv (StateT RenderState IO))
      (Maybe (IORef GLuint)))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO (Maybe (IORef GLuint))
 -> ReaderT
      RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint)))
-> StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (IORef GLuint))
 -> StateT RenderState IO (Maybe (IORef GLuint)))
-> IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ContextData -> FBOKeys -> IO (Maybe (IORef GLuint))
getFBO ContextData
cd FBOKeys
fbokey
    case Maybe (IORef GLuint)
mfbo of
        Just IORef GLuint
fbo -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$ IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            GLuint
fbo' <- IORef GLuint -> IO GLuint
forall a. IORef a -> IO a
readIORef IORef GLuint
fbo
            GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
        Maybe (IORef GLuint)
Nothing -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$ ExceptT
  String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) e.
Monad m =>
ExceptT e m (Maybe e) -> ExceptT e m ()
maybeThrow (ExceptT
   String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$ IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String))
-> IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> IO (Maybe String) -> IO (Maybe String)
forall x. (IO () -> IO ()) -> IO x -> IO x
asSync IO () -> IO ()
doAsync (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
            GLuint
fbo' <- (Ptr GLuint -> IO GLuint) -> IO GLuint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLuint
ptr -> GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glGenFramebuffers GLint
1 Ptr GLuint
ptr IO () -> IO GLuint -> IO GLuint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLuint -> IO GLuint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLuint
ptr)
            IORef GLuint
fbo <- GLuint -> IO (IORef GLuint)
forall a. a -> IO (IORef a)
newIORef GLuint
fbo'
            IO (Weak (IORef GLuint)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (IORef GLuint)) -> IO ())
-> IO (Weak (IORef GLuint)) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef GLuint -> IO () -> IO (Weak (IORef GLuint))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef GLuint
fbo (IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLuint
fbo' ((Ptr GLuint -> IO ()) -> IO ()) -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDeleteFramebuffers GLint
1)
            ContextData -> FBOKeys -> IORef GLuint -> IO ()
setFBO ContextData
cd FBOKeys
fbokey IORef GLuint
fbo
            GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
            GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_FRAMEBUFFER_SRGB
            Image (Format c) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format c)
i GLuint
forall a. (Eq a, Num a) => a
GL_COLOR_ATTACHMENT0
            [GLuint] -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLuint
forall a. (Eq a, Num a) => a
GL_COLOR_ATTACHMENT0] ((Ptr GLuint -> IO ()) -> IO ()) -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDrawBuffers GLint
1
            IO (Maybe String)
forall (m :: * -> *). MonadIO m => m (Maybe String)
getFboError

    ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$ IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
        GLboolean -> GLboolean -> GLboolean -> GLboolean -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLboolean -> GLboolean -> GLboolean -> GLboolean -> m ()
glColorMask GLboolean
forall n. Num n => n
glTrue GLboolean
forall n. Num n => n
glTrue GLboolean
forall n. Num n => n
glTrue GLboolean
forall n. Num n => n
glTrue
        c -> Color c (ColorElement c) -> IO ()
forall c.
ColorRenderable c =>
c -> Color c (ColorElement c) -> IO ()
clearColor (c
forall a. HasCallStack => a
undefined :: c) Color c (ColorElement c)
c
        GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

-- | Fill a depth image with a constant depth value (in the range [0,1])
clearImageDepth :: DepthRenderable d => Image (Format d) -> Float -> Render os ()
clearImageDepth :: Image (Format d) -> Float -> Render os ()
clearImageDepth Image (Format d)
i Float
d = do
    (WinId
cwid, ContextData
cd, IO () -> IO ()
doAsync) <- Render os (WinId, ContextData, IO () -> IO ())
forall os. Render os (WinId, ContextData, IO () -> IO ())
getLastRenderWin
    FBOKey
key <- ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
 -> Render os FBOKey)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) FBOKey
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey)
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO FBOKey
 -> ReaderT RenderEnv (StateT RenderState IO) FBOKey)
-> StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall a b. (a -> b) -> a -> b
$ IO FBOKey -> StateT RenderState IO FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FBOKey -> StateT RenderState IO FBOKey)
-> IO FBOKey -> StateT RenderState IO FBOKey
forall a b. (a -> b) -> a -> b
$ Image (Format d) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format d)
i
    let fbokey :: FBOKeys
fbokey = [FBOKey] -> Maybe FBOKey -> Maybe FBOKey -> FBOKeys
FBOKeys [] (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just FBOKey
key) Maybe FBOKey
forall a. Maybe a
Nothing
    Maybe (IORef GLuint)
mfbo <- ExceptT
  String
  (ReaderT RenderEnv (StateT RenderState IO))
  (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT
   String
   (ReaderT RenderEnv (StateT RenderState IO))
   (Maybe (IORef GLuint))
 -> Render os (Maybe (IORef GLuint)))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
 -> ExceptT
      String
      (ReaderT RenderEnv (StateT RenderState IO))
      (Maybe (IORef GLuint)))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO (Maybe (IORef GLuint))
 -> ReaderT
      RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint)))
-> StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (IORef GLuint))
 -> StateT RenderState IO (Maybe (IORef GLuint)))
-> IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ContextData -> FBOKeys -> IO (Maybe (IORef GLuint))
getFBO ContextData
cd FBOKeys
fbokey
    case Maybe (IORef GLuint)
mfbo of
        Just IORef GLuint
fbo -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
            IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
                IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    GLuint
fbo' <- IORef GLuint -> IO GLuint
forall a. IORef a -> IO a
readIORef IORef GLuint
fbo
                    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
        Maybe (IORef GLuint)
Nothing -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
            ExceptT
  String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) e.
Monad m =>
ExceptT e m (Maybe e) -> ExceptT e m ()
maybeThrow (ExceptT
   String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
                IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String))
-> IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall a b. (a -> b) -> a -> b
$
                    (IO () -> IO ()) -> IO (Maybe String) -> IO (Maybe String)
forall x. (IO () -> IO ()) -> IO x -> IO x
asSync IO () -> IO ()
doAsync (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
                        GLuint
fbo' <- (Ptr GLuint -> IO GLuint) -> IO GLuint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLuint
ptr -> GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glGenFramebuffers GLint
1 Ptr GLuint
ptr IO () -> IO GLuint -> IO GLuint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLuint -> IO GLuint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLuint
ptr)
                        IORef GLuint
fbo <- GLuint -> IO (IORef GLuint)
forall a. a -> IO (IORef a)
newIORef GLuint
fbo'
                        IO (Weak (IORef GLuint)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (IORef GLuint)) -> IO ())
-> IO (Weak (IORef GLuint)) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef GLuint -> IO () -> IO (Weak (IORef GLuint))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef GLuint
fbo (IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLuint
fbo' ((Ptr GLuint -> IO ()) -> IO ()) -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDeleteFramebuffers GLint
1)
                        ContextData -> FBOKeys -> IORef GLuint -> IO ()
setFBO ContextData
cd FBOKeys
fbokey IORef GLuint
fbo
                        GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
                        GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_FRAMEBUFFER_SRGB
                        Image (Format d) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format d)
i GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_ATTACHMENT
                        GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDrawBuffers GLint
0 Ptr GLuint
forall a. Ptr a
nullPtr
                        IO (Maybe String)
forall (m :: * -> *). MonadIO m => m (Maybe String)
getFboError
    ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
        IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
            IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
                GLboolean -> IO ()
forall (m :: * -> *). MonadIO m => GLboolean -> m ()
glDepthMask GLboolean
forall n. Num n => n
glTrue
                Float -> (Ptr Float -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
d) ((Ptr Float -> IO ()) -> IO ()) -> (Ptr Float -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> GLint -> Ptr Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Ptr Float -> m ()
glClearBufferfv GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH GLint
0
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

-- | Fill a depth image with a constant stencil value
clearImageStencil :: StencilRenderable s => Image (Format s) -> Int -> Render os ()
clearImageStencil :: Image (Format s) -> Int -> Render os ()
clearImageStencil Image (Format s)
i Int
s = do
    (WinId
cwid, ContextData
cd, IO () -> IO ()
doAsync) <- Render os (WinId, ContextData, IO () -> IO ())
forall os. Render os (WinId, ContextData, IO () -> IO ())
getLastRenderWin
    FBOKey
key <- ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
 -> Render os FBOKey)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) FBOKey
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey)
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO FBOKey
 -> ReaderT RenderEnv (StateT RenderState IO) FBOKey)
-> StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall a b. (a -> b) -> a -> b
$ IO FBOKey -> StateT RenderState IO FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FBOKey -> StateT RenderState IO FBOKey)
-> IO FBOKey -> StateT RenderState IO FBOKey
forall a b. (a -> b) -> a -> b
$ Image (Format s) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format s)
i
    let fbokey :: FBOKeys
fbokey = [FBOKey] -> Maybe FBOKey -> Maybe FBOKey -> FBOKeys
FBOKeys [] Maybe FBOKey
forall a. Maybe a
Nothing (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just FBOKey
key)
    Maybe (IORef GLuint)
mfbo <- ExceptT
  String
  (ReaderT RenderEnv (StateT RenderState IO))
  (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT
   String
   (ReaderT RenderEnv (StateT RenderState IO))
   (Maybe (IORef GLuint))
 -> Render os (Maybe (IORef GLuint)))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
 -> ExceptT
      String
      (ReaderT RenderEnv (StateT RenderState IO))
      (Maybe (IORef GLuint)))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO (Maybe (IORef GLuint))
 -> ReaderT
      RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint)))
-> StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (IORef GLuint))
 -> StateT RenderState IO (Maybe (IORef GLuint)))
-> IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ContextData -> FBOKeys -> IO (Maybe (IORef GLuint))
getFBO ContextData
cd FBOKeys
fbokey
    case Maybe (IORef GLuint)
mfbo of
        Just IORef GLuint
fbo -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
            IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
                IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    GLuint
fbo' <- IORef GLuint -> IO GLuint
forall a. IORef a -> IO a
readIORef IORef GLuint
fbo
                    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
        Maybe (IORef GLuint)
Nothing -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
            ExceptT
  String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) e.
Monad m =>
ExceptT e m (Maybe e) -> ExceptT e m ()
maybeThrow (ExceptT
   String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
                IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String))
-> IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall a b. (a -> b) -> a -> b
$
                    (IO () -> IO ()) -> IO (Maybe String) -> IO (Maybe String)
forall x. (IO () -> IO ()) -> IO x -> IO x
asSync IO () -> IO ()
doAsync (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
                        GLuint
fbo' <- (Ptr GLuint -> IO GLuint) -> IO GLuint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLuint
ptr -> GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glGenFramebuffers GLint
1 Ptr GLuint
ptr IO () -> IO GLuint -> IO GLuint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLuint -> IO GLuint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLuint
ptr)
                        IORef GLuint
fbo <- GLuint -> IO (IORef GLuint)
forall a. a -> IO (IORef a)
newIORef GLuint
fbo'
                        IO (Weak (IORef GLuint)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (IORef GLuint)) -> IO ())
-> IO (Weak (IORef GLuint)) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef GLuint -> IO () -> IO (Weak (IORef GLuint))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef GLuint
fbo (IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLuint
fbo' ((Ptr GLuint -> IO ()) -> IO ()) -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDeleteFramebuffers GLint
1)
                        ContextData -> FBOKeys -> IORef GLuint -> IO ()
setFBO ContextData
cd FBOKeys
fbokey IORef GLuint
fbo
                        GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
                        GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_FRAMEBUFFER_SRGB
                        Image (Format s) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format s)
i GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL_ATTACHMENT
                        GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDrawBuffers GLint
0 Ptr GLuint
forall a. Ptr a
nullPtr
                        IO (Maybe String)
forall (m :: * -> *). MonadIO m => m (Maybe String)
getFboError
    ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
        IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
            IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glStencilMask GLuint
forall a. Bounded a => a
maxBound
                GLint -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) ((Ptr GLint -> IO ()) -> IO ()) -> (Ptr GLint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> GLint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Ptr GLint -> m ()
glClearBufferiv GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL GLint
0
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

-- | Fill a combined depth stencil image with a constant depth value (in the range [0,1]) and a constant stencil value
clearImageDepthStencil :: Image (Format DepthStencil) -> Float -> Int -> Render os ()
clearImageDepthStencil :: Image (Format DepthStencil) -> Float -> Int -> Render os ()
clearImageDepthStencil Image (Format DepthStencil)
i Float
d Int
s = do
    (WinId
cwid, ContextData
cd, IO () -> IO ()
doAsync) <- Render os (WinId, ContextData, IO () -> IO ())
forall os. Render os (WinId, ContextData, IO () -> IO ())
getLastRenderWin
    FBOKey
key <- ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
 -> Render os FBOKey)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
-> Render os FBOKey
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) FBOKey
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey)
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) FBOKey
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO FBOKey
 -> ReaderT RenderEnv (StateT RenderState IO) FBOKey)
-> StateT RenderState IO FBOKey
-> ReaderT RenderEnv (StateT RenderState IO) FBOKey
forall a b. (a -> b) -> a -> b
$ IO FBOKey -> StateT RenderState IO FBOKey
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FBOKey -> StateT RenderState IO FBOKey)
-> IO FBOKey -> StateT RenderState IO FBOKey
forall a b. (a -> b) -> a -> b
$ Image (Format DepthStencil) -> IO FBOKey
forall t. Image t -> IO FBOKey
getImageFBOKey Image (Format DepthStencil)
i
    let fbokey :: FBOKeys
fbokey = [FBOKey] -> Maybe FBOKey -> Maybe FBOKey -> FBOKeys
FBOKeys [] Maybe FBOKey
forall a. Maybe a
Nothing (FBOKey -> Maybe FBOKey
forall a. a -> Maybe a
Just FBOKey
key)
    Maybe (IORef GLuint)
mfbo <- ExceptT
  String
  (ReaderT RenderEnv (StateT RenderState IO))
  (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT
   String
   (ReaderT RenderEnv (StateT RenderState IO))
   (Maybe (IORef GLuint))
 -> Render os (Maybe (IORef GLuint)))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
-> Render os (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
 -> ExceptT
      String
      (ReaderT RenderEnv (StateT RenderState IO))
      (Maybe (IORef GLuint)))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO (Maybe (IORef GLuint))
 -> ReaderT
      RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint)))
-> StateT RenderState IO (Maybe (IORef GLuint))
-> ReaderT RenderEnv (StateT RenderState IO) (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (IORef GLuint))
 -> StateT RenderState IO (Maybe (IORef GLuint)))
-> IO (Maybe (IORef GLuint))
-> StateT RenderState IO (Maybe (IORef GLuint))
forall a b. (a -> b) -> a -> b
$ ContextData -> FBOKeys -> IO (Maybe (IORef GLuint))
getFBO ContextData
cd FBOKeys
fbokey
    case Maybe (IORef GLuint)
mfbo of
        Just IORef GLuint
fbo -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
            IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
                IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    GLuint
fbo' <- IORef GLuint -> IO GLuint
forall a. IORef a -> IO a
readIORef IORef GLuint
fbo
                    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
        Maybe (IORef GLuint)
Nothing -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
            ExceptT
  String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) e.
Monad m =>
ExceptT e m (Maybe e) -> ExceptT e m ()
maybeThrow (ExceptT
   String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
                IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String))
-> IO (Maybe String)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) (Maybe String)
forall a b. (a -> b) -> a -> b
$
                    (IO () -> IO ()) -> IO (Maybe String) -> IO (Maybe String)
forall x. (IO () -> IO ()) -> IO x -> IO x
asSync IO () -> IO ()
doAsync (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
                        GLuint
fbo' <- (Ptr GLuint -> IO GLuint) -> IO GLuint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLuint
ptr -> GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glGenFramebuffers GLint
1 Ptr GLuint
ptr IO () -> IO GLuint -> IO GLuint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLuint -> IO GLuint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLuint
ptr)
                        IORef GLuint
fbo <- GLuint -> IO (IORef GLuint)
forall a. a -> IO (IORef a)
newIORef GLuint
fbo'
                        IO (Weak (IORef GLuint)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (IORef GLuint)) -> IO ())
-> IO (Weak (IORef GLuint)) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef GLuint -> IO () -> IO (Weak (IORef GLuint))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef GLuint
fbo (IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLuint
fbo' ((Ptr GLuint -> IO ()) -> IO ()) -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDeleteFramebuffers GLint
1)
                        ContextData -> FBOKeys -> IORef GLuint -> IO ()
setFBO ContextData
cd FBOKeys
fbokey IORef GLuint
fbo
                        GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
fbo'
                        GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_FRAMEBUFFER_SRGB
                        Image (Format DepthStencil) -> GLuint -> IO ()
forall t. Image t -> GLuint -> IO ()
getImageBinding Image (Format DepthStencil)
i GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_STENCIL_ATTACHMENT
                        GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDrawBuffers GLint
0 Ptr GLuint
forall a. Ptr a
nullPtr
                        IO (Maybe String)
forall (m :: * -> *). MonadIO m => m (Maybe String)
getFboError
    ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$
        IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$
            IO () -> IO ()
doAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
                GLboolean -> IO ()
forall (m :: * -> *). MonadIO m => GLboolean -> m ()
glDepthMask GLboolean
forall n. Num n => n
glTrue
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glStencilMask GLuint
forall a. Bounded a => a
maxBound
                GLuint -> GLint -> Float -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Float -> GLint -> m ()
glClearBufferfi GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_STENCIL GLint
0 (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
d) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
                GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

inWin :: Window os c ds -> IO () -> Render os ()
inWin :: Window os c ds -> IO () -> Render os ()
inWin Window os c ds
w IO ()
m = ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
 -> Render os ())
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
-> Render os ()
forall a b. (a -> b) -> a -> b
$ do
    RenderState
rs <- ReaderT RenderEnv (StateT RenderState IO) RenderState
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) RenderState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) RenderState
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) RenderState)
-> ReaderT RenderEnv (StateT RenderState IO) RenderState
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) RenderState
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO RenderState
-> ReaderT RenderEnv (StateT RenderState IO) RenderState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT RenderState IO RenderState
forall (m :: * -> *) s. Monad m => StateT s m s
StrictState.get
    case WinId
-> IntMap WinId (WindowState, IO () -> IO ())
-> Maybe (WindowState, IO () -> IO ())
forall k v. Integral k => k -> IntMap k v -> Maybe v
IMap.lookup (Window os c ds -> WinId
forall os c ds. Window os c ds -> WinId
getWinName Window os c ds
w) (RenderState -> IntMap WinId (WindowState, IO () -> IO ())
perWindowRenderState RenderState
rs) of
        Maybe (WindowState, IO () -> IO ())
Nothing           -> () -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Window deleted, do nothing
        Just (WindowState
_, IO () -> IO ()
doAsync) -> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ())
-> IO ()
-> ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
doAsync IO ()
m

-- | Fill the window's back buffer with a constant color value
clearWindowColor :: forall os c ds. ContextColorFormat c => Window os c ds -> Color c Float -> Render os ()
clearWindowColor :: Window os c ds -> Color c Float -> Render os ()
clearWindowColor Window os c ds
w Color c Float
c = Window os c ds -> IO () -> Render os ()
forall os c ds. Window os c ds -> IO () -> Render os ()
inWin Window os c ds
w (IO () -> Render os ()) -> IO () -> Render os ()
forall a b. (a -> b) -> a -> b
$ do
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
    GLboolean -> GLboolean -> GLboolean -> GLboolean -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLboolean -> GLboolean -> GLboolean -> GLboolean -> m ()
glColorMask GLboolean
forall n. Num n => n
glTrue GLboolean
forall n. Num n => n
glTrue GLboolean
forall n. Num n => n
glTrue GLboolean
forall n. Num n => n
glTrue
    [Float] -> (Ptr Float -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (c -> Color c Float -> [Float]
forall f x. ColorSampleable f => f -> Color f x -> [x]
fromColor (c
forall a. HasCallStack => a
undefined :: c) Color c Float
c [Float] -> [Float] -> [Float]
forall a. [a] -> [a] -> [a]
++ Int -> Float -> [Float]
forall a. Int -> a -> [a]
replicate Int
3 Float
0 :: [Float])) ((Ptr Float -> IO ()) -> IO ()) -> (Ptr Float -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> GLint -> Ptr Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Ptr Float -> m ()
glClearBufferfv GLuint
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

-- | Fill the window's back depth buffer with a constant depth value (in the range [0,1])
clearWindowDepth :: DepthRenderable ds => Window os c ds -> Float -> Render os ()
clearWindowDepth :: Window os c ds -> Float -> Render os ()
clearWindowDepth Window os c ds
w Float
d = Window os c ds -> IO () -> Render os ()
forall os c ds. Window os c ds -> IO () -> Render os ()
inWin Window os c ds
w (IO () -> Render os ()) -> IO () -> Render os ()
forall a b. (a -> b) -> a -> b
$ do
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
    GLboolean -> IO ()
forall (m :: * -> *). MonadIO m => GLboolean -> m ()
glDepthMask GLboolean
forall n. Num n => n
glTrue
    Float -> (Ptr Float -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
d) ((Ptr Float -> IO ()) -> IO ()) -> (Ptr Float -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> GLint -> Ptr Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Ptr Float -> m ()
glClearBufferfv GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH GLint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

-- | Fill the window's back stencil buffer with a constant stencil value
clearWindowStencil :: StencilRenderable ds => Window os c ds -> Int -> Render os ()
clearWindowStencil :: Window os c ds -> Int -> Render os ()
clearWindowStencil Window os c ds
w Int
s = Window os c ds -> IO () -> Render os ()
forall os c ds. Window os c ds -> IO () -> Render os ()
inWin Window os c ds
w (IO () -> Render os ()) -> IO () -> Render os ()
forall a b. (a -> b) -> a -> b
$ do
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glStencilMask GLuint
forall a. Bounded a => a
maxBound
    GLint -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) ((Ptr GLint -> IO ()) -> IO ()) -> (Ptr GLint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLuint -> GLint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Ptr GLint -> m ()
glClearBufferiv GLuint
forall a. (Eq a, Num a) => a
GL_STENCIL GLint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

-- | Fill the window's back depth and stencil buffers with a constant depth value (in the range [0,1]) and a constant stencil value
clearWindowDepthStencil :: Window os c DepthStencil -> Float -> Int -> Render os ()
clearWindowDepthStencil :: Window os c DepthStencil -> Float -> Int -> Render os ()
clearWindowDepthStencil Window os c DepthStencil
w Float
d Int
s = Window os c DepthStencil -> IO () -> Render os ()
forall os c ds. Window os c ds -> IO () -> Render os ()
inWin Window os c DepthStencil
w (IO () -> Render os ()) -> IO () -> Render os ()
forall a b. (a -> b) -> a -> b
$ do
    GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindFramebuffer GLuint
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLuint
0
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST
    GLboolean -> IO ()
forall (m :: * -> *). MonadIO m => GLboolean -> m ()
glDepthMask GLboolean
forall n. Num n => n
glTrue
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glStencilMask GLuint
forall a. Bounded a => a
maxBound
    GLuint -> GLint -> Float -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLint -> Float -> GLint -> m ()
glClearBufferfi GLuint
forall a. (Eq a, Num a) => a
GL_DEPTH_STENCIL GLint
0 (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
d) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
    GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_SCISSOR_TEST

maybeThrow :: Monad m => ExceptT e m (Maybe e) -> ExceptT e m ()
maybeThrow :: ExceptT e m (Maybe e) -> ExceptT e m ()
maybeThrow = (ExceptT e m (Maybe e)
-> (Maybe e -> ExceptT e m ()) -> ExceptT e m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> ExceptT e m Any) -> Maybe e -> ExceptT e m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ e -> ExceptT e m Any
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE)

---------------
glTrue :: Num n => n
glTrue :: n
glTrue = UseBlending -> n
forall a. Num a => UseBlending -> a
fromBool UseBlending
True

getGlBlendEquation :: BlendEquation -> GLenum
getGlBlendEquation :: BlendEquation -> GLuint
getGlBlendEquation BlendEquation
FuncAdd             = GLuint
forall a. (Eq a, Num a) => a
GL_FUNC_ADD
getGlBlendEquation BlendEquation
FuncSubtract        = GLuint
forall a. (Eq a, Num a) => a
GL_FUNC_SUBTRACT
getGlBlendEquation BlendEquation
FuncReverseSubtract = GLuint
forall a. (Eq a, Num a) => a
GL_FUNC_REVERSE_SUBTRACT
getGlBlendEquation BlendEquation
Min                 = GLuint
forall a. (Eq a, Num a) => a
GL_MIN
getGlBlendEquation BlendEquation
Max                 = GLuint
forall a. (Eq a, Num a) => a
GL_MAX

getGlBlendFunc :: BlendingFactor -> GLenum
getGlBlendFunc :: BlendingFactor -> GLuint
getGlBlendFunc BlendingFactor
Zero                  = GLuint
forall a. (Eq a, Num a) => a
GL_ZERO
getGlBlendFunc BlendingFactor
One                   = GLuint
forall a. (Eq a, Num a) => a
GL_ONE
getGlBlendFunc BlendingFactor
SrcColor              = GLuint
forall a. (Eq a, Num a) => a
GL_SRC_COLOR
getGlBlendFunc BlendingFactor
OneMinusSrcColor      = GLuint
forall a. (Eq a, Num a) => a
GL_ONE_MINUS_SRC_COLOR
getGlBlendFunc BlendingFactor
DstColor              = GLuint
forall a. (Eq a, Num a) => a
GL_DST_COLOR
getGlBlendFunc BlendingFactor
OneMinusDstColor      = GLuint
forall a. (Eq a, Num a) => a
GL_ONE_MINUS_DST_COLOR
getGlBlendFunc BlendingFactor
SrcAlpha              = GLuint
forall a. (Eq a, Num a) => a
GL_SRC_ALPHA
getGlBlendFunc BlendingFactor
OneMinusSrcAlpha      = GLuint
forall a. (Eq a, Num a) => a
GL_ONE_MINUS_SRC_ALPHA
getGlBlendFunc BlendingFactor
DstAlpha              = GLuint
forall a. (Eq a, Num a) => a
GL_DST_ALPHA
getGlBlendFunc BlendingFactor
OneMinusDstAlpha      = GLuint
forall a. (Eq a, Num a) => a
GL_ONE_MINUS_DST_ALPHA
getGlBlendFunc BlendingFactor
ConstantColor         = GLuint
forall a. (Eq a, Num a) => a
GL_CONSTANT_COLOR
getGlBlendFunc BlendingFactor
OneMinusConstantColor = GLuint
forall a. (Eq a, Num a) => a
GL_ONE_MINUS_CONSTANT_COLOR
getGlBlendFunc BlendingFactor
ConstantAlpha         = GLuint
forall a. (Eq a, Num a) => a
GL_CONSTANT_ALPHA
getGlBlendFunc BlendingFactor
OneMinusConstantAlpha = GLuint
forall a. (Eq a, Num a) => a
GL_ONE_MINUS_CONSTANT_ALPHA
getGlBlendFunc BlendingFactor
SrcAlphaSaturate      = GLuint
forall a. (Eq a, Num a) => a
GL_SRC_ALPHA_SATURATE

getGlLogicOp :: LogicOp -> GLenum
getGlLogicOp :: LogicOp -> GLuint
getGlLogicOp LogicOp
Clear        = GLuint
forall a. (Eq a, Num a) => a
GL_CLEAR
getGlLogicOp LogicOp
And          = GLuint
forall a. (Eq a, Num a) => a
GL_AND
getGlLogicOp LogicOp
AndReverse   = GLuint
forall a. (Eq a, Num a) => a
GL_AND_REVERSE
getGlLogicOp LogicOp
Copy         = GLuint
forall a. (Eq a, Num a) => a
GL_COPY
getGlLogicOp LogicOp
AndInverted  = GLuint
forall a. (Eq a, Num a) => a
GL_AND_INVERTED
getGlLogicOp LogicOp
Noop         = GLuint
forall a. (Eq a, Num a) => a
GL_NOOP
getGlLogicOp LogicOp
Xor          = GLuint
forall a. (Eq a, Num a) => a
GL_XOR
getGlLogicOp LogicOp
Or           = GLuint
forall a. (Eq a, Num a) => a
GL_OR
getGlLogicOp LogicOp
Nor          = GLuint
forall a. (Eq a, Num a) => a
GL_NOR
getGlLogicOp LogicOp
Equiv        = GLuint
forall a. (Eq a, Num a) => a
GL_EQUIV
getGlLogicOp LogicOp
Invert       = GLuint
forall a. (Eq a, Num a) => a
GL_INVERT
getGlLogicOp LogicOp
OrReverse    = GLuint
forall a. (Eq a, Num a) => a
GL_OR_REVERSE
getGlLogicOp LogicOp
CopyInverted = GLuint
forall a. (Eq a, Num a) => a
GL_COPY_INVERTED
getGlLogicOp LogicOp
OrInverted   = GLuint
forall a. (Eq a, Num a) => a
GL_OR_INVERTED
getGlLogicOp LogicOp
Nand         = GLuint
forall a. (Eq a, Num a) => a
GL_NAND
getGlLogicOp LogicOp
Set          = GLuint
forall a. (Eq a, Num a) => a
GL_SET

getGlStencilOp :: StencilOp -> GLenum
getGlStencilOp :: StencilOp -> GLuint
getGlStencilOp StencilOp
OpZero     = GLuint
forall a. (Eq a, Num a) => a
GL_ZERO
getGlStencilOp StencilOp
OpKeep     = GLuint
forall a. (Eq a, Num a) => a
GL_KEEP
getGlStencilOp StencilOp
OpReplace  = GLuint
forall a. (Eq a, Num a) => a
GL_REPLACE
getGlStencilOp StencilOp
OpIncr     = GLuint
forall a. (Eq a, Num a) => a
GL_INCR
getGlStencilOp StencilOp
OpIncrWrap = GLuint
forall a. (Eq a, Num a) => a
GL_INCR_WRAP
getGlStencilOp StencilOp
OpDecr     = GLuint
forall a. (Eq a, Num a) => a
GL_DECR
getGlStencilOp StencilOp
OpDecrWrap = GLuint
forall a. (Eq a, Num a) => a
GL_DECR_WRAP
getGlStencilOp StencilOp
OpInvert   = GLuint
forall a. (Eq a, Num a) => a
GL_INVERT