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

  -- * GL_NV_viewport_array
  , glDepthRangeArrayfvNV
  , glDepthRangeIndexedfNV
  , glDisableiNV
  , glEnableiNV
  , glGetFloati_vNV
  , glIsEnablediNV
  , glScissorArrayvNV
  , glScissorIndexedNV
  , glScissorIndexedvNV
  , glViewportArrayvNV
  , glViewportIndexedfNV
  , glViewportIndexedfvNV
  , pattern GL_DEPTH_RANGE
  , pattern GL_MAX_VIEWPORTS_NV
  , pattern GL_SCISSOR_BOX
  , pattern GL_SCISSOR_TEST
  , pattern GL_VIEWPORT
  , pattern GL_VIEWPORT_BOUNDS_RANGE_NV
  , pattern GL_VIEWPORT_INDEX_PROVOKING_VERTEX_NV
  , pattern GL_VIEWPORT_SUBPIXEL_BITS_NV
) 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 GL_NV_viewport_array extension is available.

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

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


glDepthRangeArrayfvNV :: MonadIO m => GLuint -> GLsizei -> Ptr GLfloat -> m ()
glDepthRangeArrayfvNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> Ptr GLfloat -> m ()
glDepthRangeArrayfvNV = 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 ())
glDepthRangeArrayfvNVFunPtr

glDepthRangeArrayfvNVFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glDepthRangeArrayfvNVFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glDepthRangeArrayfvNVFunPtr = 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
"glDepthRangeArrayfvNV")

{-# NOINLINE glDepthRangeArrayfvNVFunPtr #-}

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


glDepthRangeIndexedfNV :: MonadIO m => GLuint -> GLfloat -> GLfloat -> m ()
glDepthRangeIndexedfNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLfloat -> GLfloat -> m ()
glDepthRangeIndexedfNV = 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 ())
glDepthRangeIndexedfNVFunPtr

glDepthRangeIndexedfNVFunPtr :: FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
glDepthRangeIndexedfNVFunPtr :: FunPtr (GLuint -> GLfloat -> GLfloat -> IO ())
glDepthRangeIndexedfNVFunPtr = 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
"glDepthRangeIndexedfNV")

{-# NOINLINE glDepthRangeIndexedfNVFunPtr #-}

-- | Usage: @'glDisableiNV' target index@
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glDisablei'.


glDisableiNV :: MonadIO m => GLenum -> GLuint -> m ()
glDisableiNV :: forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glDisableiNV = FunPtr (GLuint -> GLuint -> IO ()) -> GLuint -> GLuint -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLuint -> IO ()) -> GLuint -> GLuint -> m ()
ffienumuintIOV FunPtr (GLuint -> GLuint -> IO ())
glDisableiNVFunPtr

glDisableiNVFunPtr :: FunPtr (GLenum -> GLuint -> IO ())
glDisableiNVFunPtr :: FunPtr (GLuint -> GLuint -> IO ())
glDisableiNVFunPtr = IO (FunPtr (GLuint -> GLuint -> IO ()))
-> FunPtr (GLuint -> GLuint -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLuint -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glDisableiNV")

{-# NOINLINE glDisableiNVFunPtr #-}

-- | Usage: @'glEnableiNV' target index@
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glEnablei'.


glEnableiNV :: MonadIO m => GLenum -> GLuint -> m ()
glEnableiNV :: forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glEnableiNV = FunPtr (GLuint -> GLuint -> IO ()) -> GLuint -> GLuint -> m ()
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLuint -> IO ()) -> GLuint -> GLuint -> m ()
ffienumuintIOV FunPtr (GLuint -> GLuint -> IO ())
glEnableiNVFunPtr

glEnableiNVFunPtr :: FunPtr (GLenum -> GLuint -> IO ())
glEnableiNVFunPtr :: FunPtr (GLuint -> GLuint -> IO ())
glEnableiNVFunPtr = IO (FunPtr (GLuint -> GLuint -> IO ()))
-> FunPtr (GLuint -> GLuint -> IO ())
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLuint -> IO ()))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glEnableiNV")

{-# NOINLINE glEnableiNVFunPtr #-}

-- | Usage: @'glGetFloati_vNV' 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_vNV :: MonadIO m => GLenum -> GLuint -> Ptr GLfloat -> m ()
glGetFloati_vNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLfloat -> m ()
glGetFloati_vNV = 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_vNVFunPtr

glGetFloati_vNVFunPtr :: FunPtr (GLenum -> GLuint -> Ptr GLfloat -> IO ())
glGetFloati_vNVFunPtr :: FunPtr (GLuint -> GLuint -> Ptr GLfloat -> IO ())
glGetFloati_vNVFunPtr = 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_vNV")

{-# NOINLINE glGetFloati_vNVFunPtr #-}

-- | Usage: @'glIsEnablediNV' target index@
--
-- This command is an alias for 'Graphics.GL.Internal.Shared.glIsEnabledi'.


glIsEnablediNV :: MonadIO m => GLenum -> GLuint -> m GLboolean
glIsEnablediNV :: forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m GLboolean
glIsEnablediNV = FunPtr (GLuint -> GLuint -> IO GLboolean)
-> GLuint -> GLuint -> m GLboolean
forall (m :: * -> *).
MonadIO m =>
FunPtr (GLuint -> GLuint -> IO GLboolean)
-> GLuint -> GLuint -> m GLboolean
ffienumuintIOboolean FunPtr (GLuint -> GLuint -> IO GLboolean)
glIsEnablediNVFunPtr

glIsEnablediNVFunPtr :: FunPtr (GLenum -> GLuint -> IO GLboolean)
glIsEnablediNVFunPtr :: FunPtr (GLuint -> GLuint -> IO GLboolean)
glIsEnablediNVFunPtr = IO (FunPtr (GLuint -> GLuint -> IO GLboolean))
-> FunPtr (GLuint -> GLuint -> IO GLboolean)
forall a. IO a -> a
unsafePerformIO (String -> IO (FunPtr (GLuint -> GLuint -> IO GLboolean))
forall a. String -> IO (FunPtr a)
getProcAddress String
"glIsEnablediNV")

{-# NOINLINE glIsEnablediNVFunPtr #-}

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


glScissorArrayvNV :: MonadIO m => GLuint -> GLsizei -> Ptr GLint -> m ()
glScissorArrayvNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> Ptr GLsizei -> m ()
glScissorArrayvNV = 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 ())
glScissorArrayvNVFunPtr

glScissorArrayvNVFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLint -> IO ())
glScissorArrayvNVFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLsizei -> IO ())
glScissorArrayvNVFunPtr = 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
"glScissorArrayvNV")

{-# NOINLINE glScissorArrayvNVFunPtr #-}

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


glScissorIndexedNV :: MonadIO m => GLuint -> GLint -> GLint -> GLsizei -> GLsizei -> m ()
glScissorIndexedNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> m ()
glScissorIndexedNV = 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 ())
glScissorIndexedNVFunPtr

glScissorIndexedNVFunPtr :: FunPtr (GLuint -> GLint -> GLint -> GLsizei -> GLsizei -> IO ())
glScissorIndexedNVFunPtr :: FunPtr
  (GLuint -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> IO ())
glScissorIndexedNVFunPtr = 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
"glScissorIndexedNV")

{-# NOINLINE glScissorIndexedNVFunPtr #-}

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


glScissorIndexedvNV :: MonadIO m => GLuint -> Ptr GLint -> m ()
glScissorIndexedvNV :: forall (m :: * -> *). MonadIO m => GLuint -> Ptr GLsizei -> m ()
glScissorIndexedvNV = 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 ())
glScissorIndexedvNVFunPtr

glScissorIndexedvNVFunPtr :: FunPtr (GLuint -> Ptr GLint -> IO ())
glScissorIndexedvNVFunPtr :: FunPtr (GLuint -> Ptr GLsizei -> IO ())
glScissorIndexedvNVFunPtr = 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
"glScissorIndexedvNV")

{-# NOINLINE glScissorIndexedvNVFunPtr #-}

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


glViewportArrayvNV :: MonadIO m => GLuint -> GLsizei -> Ptr GLfloat -> m ()
glViewportArrayvNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLsizei -> Ptr GLfloat -> m ()
glViewportArrayvNV = 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 ())
glViewportArrayvNVFunPtr

glViewportArrayvNVFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glViewportArrayvNVFunPtr :: FunPtr (GLuint -> GLsizei -> Ptr GLfloat -> IO ())
glViewportArrayvNVFunPtr = 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
"glViewportArrayvNV")

{-# NOINLINE glViewportArrayvNVFunPtr #-}

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


glViewportIndexedfNV :: MonadIO m => GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
glViewportIndexedfNV :: forall (m :: * -> *).
MonadIO m =>
GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
glViewportIndexedfNV = 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 ())
glViewportIndexedfNVFunPtr

glViewportIndexedfNVFunPtr :: FunPtr (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
glViewportIndexedfNVFunPtr :: FunPtr
  (GLuint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())
glViewportIndexedfNVFunPtr = 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
"glViewportIndexedfNV")

{-# NOINLINE glViewportIndexedfNVFunPtr #-}

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


glViewportIndexedfvNV :: MonadIO m => GLuint -> Ptr GLfloat -> m ()
glViewportIndexedfvNV :: forall (m :: * -> *). MonadIO m => GLuint -> Ptr GLfloat -> m ()
glViewportIndexedfvNV = 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 ())
glViewportIndexedfvNVFunPtr

glViewportIndexedfvNVFunPtr :: FunPtr (GLuint -> Ptr GLfloat -> IO ())
glViewportIndexedfvNVFunPtr :: FunPtr (GLuint -> Ptr GLfloat -> IO ())
glViewportIndexedfvNVFunPtr = 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
"glViewportIndexedfvNV")

{-# NOINLINE glViewportIndexedfvNVFunPtr #-}

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

pattern $mGL_MAX_VIEWPORTS_NV :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_MAX_VIEWPORTS_NV :: forall a. (Eq a, Num a) => a
GL_MAX_VIEWPORTS_NV = 0x825B

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

pattern $mGL_VIEWPORT_BOUNDS_RANGE_NV :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_VIEWPORT_BOUNDS_RANGE_NV :: forall a. (Eq a, Num a) => a
GL_VIEWPORT_BOUNDS_RANGE_NV = 0x825D

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

pattern $mGL_VIEWPORT_INDEX_PROVOKING_VERTEX_NV :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_VIEWPORT_INDEX_PROVOKING_VERTEX_NV :: forall a. (Eq a, Num a) => a
GL_VIEWPORT_INDEX_PROVOKING_VERTEX_NV = 0x825F

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

pattern $mGL_VIEWPORT_SUBPIXEL_BITS_NV :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bGL_VIEWPORT_SUBPIXEL_BITS_NV :: forall a. (Eq a, Num a) => a
GL_VIEWPORT_SUBPIXEL_BITS_NV = 0x825C