-- This file was automatically generated.
{-# LANGUAGE CPP, ScopedTypeVariables, PatternSynonyms #-}
module Graphics.GL.Ext.OES.ViewportArray (
  -- * Extension Support
    gl_OES_viewport_array

  -- * GL_OES_viewport_array
  , glDepthRangeArrayfvOES
  , glDepthRangeIndexedfOES
  , glDisableiOES
  , glEnableiOES
  , glGetFloati_vOES
  , glIsEnablediOES
  , glScissorArrayvOES
  , glScissorIndexedOES
  , glScissorIndexedvOES
  , glViewportArrayvOES
  , glViewportIndexedfOES
  , glViewportIndexedfvOES
  , pattern GL_DEPTH_RANGE
  , pattern GL_MAX_VIEWPORTS_OES
  , pattern GL_SCISSOR_BOX
  , pattern GL_SCISSOR_TEST
  , pattern GL_VIEWPORT
  , pattern GL_VIEWPORT_BOUNDS_RANGE_OES
  , pattern GL_VIEWPORT_INDEX_PROVOKING_VERTEX_OES
  , pattern GL_VIEWPORT_SUBPIXEL_BITS_OES
) where

import Control.Monad.IO.Class
import Data.Set
import Foreign.Ptr
import Graphics.GL.Internal.FFI
import Graphics.GL.Internal.Proc
import Graphics.GL.Internal.Shared
import Graphics.GL.Types
import System.IO.Unsafe

-- | Checks that the <https://www.khronos.org/registry/OpenGL/extensions/OES/OES_viewport_array.txt GL_OES_viewport_array> extension is available.

gl_OES_viewport_array :: Bool
gl_OES_viewport_array :: Bool
gl_OES_viewport_array = String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
member String
"GL_OES_viewport_array" Set String
extensions
{-# NOINLINE gl_OES_viewport_array #-}

-- | Usage: @'glDepthRangeArrayfvOES' first count v@


glDepthRangeArrayfvOES :: MonadIO m => GLuint -> GLsizei -> Ptr GLfloat -> m ()
glDepthRangeArrayfvOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> Ptr GLfloat -> m ()
glDepthRangeArrayfvOES = FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
-> GLuint -> GLsizei -> Ptr GLfloat -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
-> GLuint -> GLsizei -> Ptr GLfloat -> m ()
ffiuintsizeiPtrfloatIOV FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glDepthRangeArrayfvOESFunPtr

glDepthRangeArrayfvOESFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glDepthRangeArrayfvOESFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glDepthRangeArrayfvOESFunPtr = IO (FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ()))
-> FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glDepthRangeArrayfvOES")

{-# NOINLINE glDepthRangeArrayfvOESFunPtr #-}

-- | Usage: @'glDepthRangeIndexedfOES' index n f@


glDepthRangeIndexedfOES :: MonadIO m => GLuint -> GLfloat -> GLfloat -> m ()
glDepthRangeIndexedfOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLfloat -> GLfloat -> m ()
glDepthRangeIndexedfOES = FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
-> GLuint -> GLfloat -> GLfloat -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
-> GLuint -> GLfloat -> GLfloat -> m ()
ffiuintfloatfloatIOV FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
glDepthRangeIndexedfOESFunPtr

glDepthRangeIndexedfOESFunPtr :: FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
glDepthRangeIndexedfOESFunPtr :: FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
glDepthRangeIndexedfOESFunPtr = IO (FunPtr (GLuint -> GLfloat -> GLfloat -> IO ()))
-> FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLfloat -> GLfloat -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glDepthRangeIndexedfOES")

{-# NOINLINE glDepthRangeIndexedfOESFunPtr #-}

-- | Usage: @'glGetFloati_vOES' target index data@
--
-- The parameter @target@ is a @TypeEnum@.
--
-- The length of @data@ should be @COMPSIZE(target)@.
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glGetFloati_v'.


glGetFloati_vOES :: MonadIO m => GLenum -> GLuint -> Ptr GLfloat -> m ()
glGetFloati_vOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLfloat -> m ()
glGetFloati_vOES = FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ())
-> GLuint -> GLuint -> Ptr GLfloat -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ())
-> GLuint -> GLuint -> Ptr GLfloat -> m ()
ffienumuintPtrfloatIOV FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ())
glGetFloati_vOESFunPtr

glGetFloati_vOESFunPtr :: FunPtr (GLenum -> GLuint -> Ptr GLfloat -> IO ())
glGetFloati_vOESFunPtr :: FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ())
glGetFloati_vOESFunPtr = IO (FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ()))
-> FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glGetFloati_vOES")

{-# NOINLINE glGetFloati_vOESFunPtr #-}

-- | Usage: @'glScissorArrayvOES' first count v@
--
-- The length of @v@ should be @COMPSIZE(count)@.
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glScissorArrayv'.


glScissorArrayvOES :: MonadIO m => GLuint -> GLsizei -> Ptr GLint -> m ()
glScissorArrayvOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> Ptr GLsizei -> m ()
glScissorArrayvOES = FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ())
-> GLuint -> GLsizei -> Ptr GLsizei -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ())
-> GLuint -> GLsizei -> Ptr GLsizei -> m ()
ffiuintsizeiPtrintIOV FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ())
glScissorArrayvOESFunPtr

glScissorArrayvOESFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLint -> IO ())
glScissorArrayvOESFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ())
glScissorArrayvOESFunPtr = IO (FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ()))
-> FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glScissorArrayvOES")

{-# NOINLINE glScissorArrayvOESFunPtr #-}

-- | Usage: @'glScissorIndexedOES' index left bottom width height@
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glScissorIndexed'.


glScissorIndexedOES :: MonadIO m => GLuint -> GLint -> GLint -> GLsizei -> GLsizei -> m ()
glScissorIndexedOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> m ()
glScissorIndexedOES = FunPtr
  (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ())
-> GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr
  (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ())
-> GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> m ()
ffiuintintintsizeisizeiIOV FunPtr
  (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ())
glScissorIndexedOESFunPtr

glScissorIndexedOESFunPtr :: FunPtr (GLuint -> GLint -> GLint -> GLsizei -> GLsizei -> IO ())
glScissorIndexedOESFunPtr :: FunPtr
  (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ())
glScissorIndexedOESFunPtr = IO
  (FunPtr
     (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ()))
-> FunPtr
     (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ())
forall a. IO a -> a
unsafePerformIO (String
-> IO
     (FunPtr
        (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glScissorIndexedOES")

{-# NOINLINE glScissorIndexedOESFunPtr #-}

-- | Usage: @'glScissorIndexedvOES' index v@
--
-- The length of @v@ should be @4@.
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glScissorIndexedv'.


glScissorIndexedvOES :: MonadIO m => GLuint -> Ptr GLint -> m ()
glScissorIndexedvOES :: forall (m :: * -> *). MonadIO m => GLuint -> Ptr GLsizei -> m ()
glScissorIndexedvOES = FunPtr (GLuint -> Ptr GLsizei -> IO ())
-> GLuint -> Ptr GLsizei -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> Ptr GLsizei -> IO ())
-> GLuint -> Ptr GLsizei -> m ()
ffiuintPtrintIOV FunPtr (GLuint -> Ptr GLsizei -> IO ())
glScissorIndexedvOESFunPtr

glScissorIndexedvOESFunPtr :: FunPtr (GLuint -> Ptr GLint -> IO ())
glScissorIndexedvOESFunPtr :: FunPtr (GLuint -> Ptr GLsizei -> IO ())
glScissorIndexedvOESFunPtr = IO (FunPtr (GLuint -> Ptr GLsizei -> IO ()))
-> FunPtr (GLuint -> Ptr GLsizei -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> Ptr GLsizei -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glScissorIndexedvOES")

{-# NOINLINE glScissorIndexedvOESFunPtr #-}

-- | Usage: @'glViewportArrayvOES' first count v@
--
-- The length of @v@ should be @COMPSIZE(count)@.
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glViewportArrayv'.


glViewportArrayvOES :: MonadIO m => GLuint -> GLsizei -> Ptr GLfloat -> m ()
glViewportArrayvOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> Ptr GLfloat -> m ()
glViewportArrayvOES = FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
-> GLuint -> GLsizei -> Ptr GLfloat -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
-> GLuint -> GLsizei -> Ptr GLfloat -> m ()
ffiuintsizeiPtrfloatIOV FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glViewportArrayvOESFunPtr

glViewportArrayvOESFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glViewportArrayvOESFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glViewportArrayvOESFunPtr = IO (FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ()))
-> FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glViewportArrayvOES")

{-# NOINLINE glViewportArrayvOESFunPtr #-}

-- | Usage: @'glViewportIndexedfOES' index x y w h@
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glViewportIndexedf'.


glViewportIndexedfOES :: MonadIO m => GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
glViewportIndexedfOES :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
glViewportIndexedfOES = FunPtr
  (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
-> GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr
  (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
-> GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
ffiuintfloatfloatfloatfloatIOV FunPtr
  (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
glViewportIndexedfOESFunPtr

glViewportIndexedfOESFunPtr :: FunPtr (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
glViewportIndexedfOESFunPtr :: FunPtr
  (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
glViewportIndexedfOESFunPtr = IO
  (FunPtr
     (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()))
-> FunPtr
     (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
forall a. IO a -> a
unsafePerformIO (String
-> IO
     (FunPtr
        (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glViewportIndexedfOES")

{-# NOINLINE glViewportIndexedfOESFunPtr #-}

-- | Usage: @'glViewportIndexedfvOES' index v@
--
-- The length of @v@ should be @4@.
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glViewportIndexedfv'.


glViewportIndexedfvOES :: MonadIO m => GLuint -> Ptr GLfloat -> m ()
glViewportIndexedfvOES :: forall (m :: * -> *). MonadIO m => GLuint -> Ptr GLfloat -> m ()
glViewportIndexedfvOES = FunPtr (GLuint -> Ptr GLfloat -> IO ())
-> GLuint -> Ptr GLfloat -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> Ptr GLfloat -> IO ())
-> GLuint -> Ptr GLfloat -> m ()
ffiuintPtrfloatIOV FunPtr (GLuint -> Ptr GLfloat -> IO ())
glViewportIndexedfvOESFunPtr

glViewportIndexedfvOESFunPtr :: FunPtr (GLuint -> Ptr GLfloat -> IO ())
glViewportIndexedfvOESFunPtr :: FunPtr (GLuint -> Ptr GLfloat -> IO ())
glViewportIndexedfvOESFunPtr = IO (FunPtr (GLuint -> Ptr GLfloat -> IO ()))
-> FunPtr (GLuint -> Ptr GLfloat -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> Ptr GLfloat -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glViewportIndexedfvOES")

{-# NOINLINE glViewportIndexedfvOESFunPtr #-}

pattern GL_MAX_VIEWPORTS_OES  :: (Eq a, Num a) => a

pattern $mGL_MAX_VIEWPORTS_OES :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_MAX_VIEWPORTS_OES :: forall a. (Eq a, Num a) => a
GL_MAX_VIEWPORTS_OES = 0x825B

pattern GL_VIEWPORT_BOUNDS_RANGE_OES  :: (Eq a, Num a) => a

pattern $mGL_VIEWPORT_BOUNDS_RANGE_OES :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_VIEWPORT_BOUNDS_RANGE_OES :: forall a. (Eq a, Num a) => a
GL_VIEWPORT_BOUNDS_RANGE_OES = 0x825D

pattern GL_VIEWPORT_INDEX_PROVOKING_VERTEX_OES  :: (Eq a, Num a) => a

pattern $mGL_VIEWPORT_INDEX_PROVOKING_VERTEX_OES :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_VIEWPORT_INDEX_PROVOKING_VERTEX_OES :: forall a. (Eq a, Num a) => a
GL_VIEWPORT_INDEX_PROVOKING_VERTEX_OES = 0x825F

pattern GL_VIEWPORT_SUBPIXEL_BITS_OES  :: (Eq a, Num a) => a

pattern $mGL_VIEWPORT_SUBPIXEL_BITS_OES :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_VIEWPORT_SUBPIXEL_BITS_OES :: forall a. (Eq a, Num a) => a
GL_VIEWPORT_SUBPIXEL_BITS_OES = 0x825C