    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Polygons
    -- Copyright   :  (c) Sven Panne 2002-2019
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- This module corresponds to section 3.5 (Polygons) of the OpenGL 2.1 specs.
    --
    --------------------------------------------------------------------------------

    module Graphics.Rendering.OpenGL.GL.Polygons (
       polygonSmooth, cullFace,
       PolygonStipple(..), GLpolygonstipple, polygonStipple,
       PolygonMode(..), polygonMode, polygonOffset,
       polygonOffsetPoint, polygonOffsetLine, polygonOffsetFill
    ) where

    import Control.Monad
    import Data.StateVar
    import Foreign.ForeignPtr
    import Foreign.Marshal.Array
    import Foreign.Ptr
    import Graphics.Rendering.OpenGL.GL.Capability
    import Graphics.Rendering.OpenGL.GL.Face
    import Graphics.Rendering.OpenGL.GL.PixelRectangles
    import Graphics.Rendering.OpenGL.GL.PolygonMode
    import Graphics.Rendering.OpenGL.GL.QueryUtils
    import Graphics.Rendering.OpenGL.GL.SavingState
    import Graphics.GL

    --------------------------------------------------------------------------------

    polygonSmooth :: StateVar Capability
    polygonSmooth :: StateVar Capability
    polygonSmooth = EnableCap -> StateVar Capability
    makeCapability EnableCap
    CapPolygonSmooth

    --------------------------------------------------------------------------------

    cullFace :: StateVar (Maybe Face)
    cullFace :: StateVar (Maybe Face)
    cullFace = IO EnableCap -> IO Face -> (Face -> IO ()) -> StateVar (Maybe Face)
    forall a.
    IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
    makeStateVarMaybe (EnableCap -> IO EnableCap
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EnableCap
    CapCullFace)
                                 ((GLenum -> Face) -> PName1I -> IO Face
    forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
    forall a. (GLenum -> a) -> PName1I -> IO a
    getEnum1 GLenum -> Face
    unmarshalFace PName1I
    GetCullFaceMode)
                                 (GLenum -> IO ()
    forall (m :: * -> *). MonadIO m => GLenum -> m ()
    glCullFace (GLenum -> IO ()) -> (Face -> GLenum) -> Face -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Face -> GLenum
    marshalFace)

    --------------------------------------------------------------------------------

    numPolygonStippleBytes :: Int
    numPolygonStippleBytes :: Int
    numPolygonStippleBytes = Int
    128   -- 32x32 bits divided into GLubytes

    class PolygonStipple s where
       withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO s
       withPolygonStipple :: s -> (Ptr GLubyte -> IO a) -> IO a
       newPolygonStipple :: [GLubyte] -> IO s
       getPolygonStippleComponents :: s -> IO [GLubyte]

       withNewPolygonStipple Ptr GLubyte -> IO ()
    act =
          Int -> (Ptr GLubyte -> IO s) -> IO s
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray Int
    numPolygonStippleBytes ((Ptr GLubyte -> IO s) -> IO s) -> (Ptr GLubyte -> IO s) -> IO s
    forall a b. (a -> b) -> a -> b
    $ \Ptr GLubyte
    p -> do
             Ptr GLubyte -> IO ()
    act Ptr GLubyte
    p
             components <- Int -> Ptr GLubyte -> IO [GLubyte]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray Int
    numPolygonStippleBytes Ptr GLubyte
    p
             newPolygonStipple components

       withPolygonStipple s
    s Ptr GLubyte -> IO a
    act = do
          components <- s -> IO [GLubyte]
    forall s. PolygonStipple s => s -> IO [GLubyte]
    getPolygonStippleComponents s
    s
          withArray components act

       newPolygonStipple [GLubyte]
    components =
          (Ptr GLubyte -> IO ()) -> IO s
    forall s. PolygonStipple s => (Ptr GLubyte -> IO ()) -> IO s
    withNewPolygonStipple ((Ptr GLubyte -> IO ()) -> IO s) -> (Ptr GLubyte -> IO ()) -> IO s
    forall a b. (a -> b) -> a -> b
    $
             (Ptr GLubyte -> [GLubyte] -> IO ())
    -> [GLubyte] -> Ptr GLubyte -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Ptr GLubyte -> [GLubyte] -> IO ()
    forall a. Storable a => Ptr a -> [a] -> IO ()
    pokeArray (Int -> [GLubyte] -> [GLubyte]
    forall a. Int -> [a] -> [a]
    take Int
    numPolygonStippleBytes [GLubyte]
    components)

       getPolygonStippleComponents s
    s =
          s -> (Ptr GLubyte -> IO [GLubyte]) -> IO [GLubyte]
    forall a. s -> (Ptr GLubyte -> IO a) -> IO a
    forall s a. PolygonStipple s => s -> (Ptr GLubyte -> IO a) -> IO a
    withPolygonStipple s
    s ((Ptr GLubyte -> IO [GLubyte]) -> IO [GLubyte])
    -> (Ptr GLubyte -> IO [GLubyte]) -> IO [GLubyte]
    forall a b. (a -> b) -> a -> b
    $ Int -> Ptr GLubyte -> IO [GLubyte]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray Int
    numPolygonStippleBytes

    --------------------------------------------------------------------------------

    data GLpolygonstipple = GLpolygonstipple (ForeignPtr GLubyte)
       deriving ( GLpolygonstipple -> GLpolygonstipple -> Bool
    (GLpolygonstipple -> GLpolygonstipple -> Bool)
    -> (GLpolygonstipple -> GLpolygonstipple -> Bool)
    -> Eq GLpolygonstipple
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: GLpolygonstipple -> GLpolygonstipple -> Bool
    == :: GLpolygonstipple -> GLpolygonstipple -> Bool
    $c/= :: GLpolygonstipple -> GLpolygonstipple -> Bool
    /= :: GLpolygonstipple -> GLpolygonstipple -> Bool
    Eq, Eq GLpolygonstipple
    Eq GLpolygonstipple =>
    (GLpolygonstipple -> GLpolygonstipple -> Ordering)
    -> (GLpolygonstipple -> GLpolygonstipple -> Bool)
    -> (GLpolygonstipple -> GLpolygonstipple -> Bool)
    -> (GLpolygonstipple -> GLpolygonstipple -> Bool)
    -> (GLpolygonstipple -> GLpolygonstipple -> Bool)
    -> (GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple)
    -> (GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple)
    -> Ord GLpolygonstipple
    GLpolygonstipple -> GLpolygonstipple -> Bool
    GLpolygonstipple -> GLpolygonstipple -> Ordering
    GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: GLpolygonstipple -> GLpolygonstipple -> Ordering
    compare :: GLpolygonstipple -> GLpolygonstipple -> Ordering
    $c< :: GLpolygonstipple -> GLpolygonstipple -> Bool
    < :: GLpolygonstipple -> GLpolygonstipple -> Bool
    $c<= :: GLpolygonstipple -> GLpolygonstipple -> Bool
    <= :: GLpolygonstipple -> GLpolygonstipple -> Bool
    $c> :: GLpolygonstipple -> GLpolygonstipple -> Bool
    > :: GLpolygonstipple -> GLpolygonstipple -> Bool
    $c>= :: GLpolygonstipple -> GLpolygonstipple -> Bool
    >= :: GLpolygonstipple -> GLpolygonstipple -> Bool
    $cmax :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
    max :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
    $cmin :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
    min :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
    Ord, Int -> GLpolygonstipple -> ShowS
    [GLpolygonstipple] -> ShowS
    GLpolygonstipple -> String
    (Int -> GLpolygonstipple -> ShowS)
    -> (GLpolygonstipple -> String)
    -> ([GLpolygonstipple] -> ShowS)
    -> Show GLpolygonstipple
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> GLpolygonstipple -> ShowS
    showsPrec :: Int -> GLpolygonstipple -> ShowS
    $cshow :: GLpolygonstipple -> String
    show :: GLpolygonstipple -> String
    $cshowList :: [GLpolygonstipple] -> ShowS
    showList :: [GLpolygonstipple] -> ShowS
    Show )

    instance PolygonStipple GLpolygonstipple where
       withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO GLpolygonstipple
    withNewPolygonStipple Ptr GLubyte -> IO ()
    f = do
          fp <- Int -> IO (ForeignPtr GLubyte)
    forall a. Storable a => Int -> IO (ForeignPtr a)
    mallocForeignPtrArray Int
    numPolygonStippleBytes
          withForeignPtr fp f
          return $ GLpolygonstipple fp

       withPolygonStipple :: forall a. GLpolygonstipple -> (Ptr GLubyte -> IO a) -> IO a
    withPolygonStipple (GLpolygonstipple ForeignPtr GLubyte
    fp) = ForeignPtr GLubyte -> (Ptr GLubyte -> IO a) -> IO a
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr GLubyte
    fp

    --------------------------------------------------------------------------------

    polygonStipple :: PolygonStipple s => StateVar (Maybe s)
    polygonStipple :: forall s. PolygonStipple s => StateVar (Maybe s)
    polygonStipple =
       IO EnableCap -> IO s -> (s -> IO ()) -> StateVar (Maybe s)
    forall a.
    IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
    makeStateVarMaybe (EnableCap -> IO EnableCap
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EnableCap
    CapPolygonStipple)
          (PixelStoreDirection -> IO s -> IO s
    forall a. PixelStoreDirection -> IO a -> IO a
    withoutGaps PixelStoreDirection
    Pack (IO s -> IO s) -> IO s -> IO s
    forall a b. (a -> b) -> a -> b
    $ (Ptr GLubyte -> IO ()) -> IO s
    forall s. PolygonStipple s => (Ptr GLubyte -> IO ()) -> IO s
    withNewPolygonStipple Ptr GLubyte -> IO ()
    forall (m :: * -> *). MonadIO m => Ptr GLubyte -> m ()
    glGetPolygonStipple)
          (\s
    s -> PixelStoreDirection -> IO () -> IO ()
    forall a. PixelStoreDirection -> IO a -> IO a
    withoutGaps PixelStoreDirection
    Unpack (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ s -> (Ptr GLubyte -> IO ()) -> IO ()
    forall a. s -> (Ptr GLubyte -> IO a) -> IO a
    forall s a. PolygonStipple s => s -> (Ptr GLubyte -> IO a) -> IO a
    withPolygonStipple s
    s Ptr GLubyte -> IO ()
    forall (m :: * -> *). MonadIO m => Ptr GLubyte -> m ()
    glPolygonStipple)

    -- Note: No need to set rowAlignment, our memory allocator always returns a
    -- region which is at least 8-byte aligned (the maximum)
    withoutGaps :: PixelStoreDirection -> IO a -> IO a
    withoutGaps :: forall a. PixelStoreDirection -> IO a -> IO a
    withoutGaps PixelStoreDirection
    direction IO a
    action =
       [ClientAttributeGroup] -> IO a -> IO a
    forall a. [ClientAttributeGroup] -> IO a -> IO a
    preservingClientAttrib [ ClientAttributeGroup
    PixelStoreAttributes ] (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
          PixelStoreDirection -> StateVar GLint
    rowLength  PixelStoreDirection
    direction StateVar GLint -> GLint -> IO ()
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *). MonadIO m => StateVar GLint -> GLint -> m ()
    $= GLint
    0
          PixelStoreDirection -> StateVar GLint
    skipRows   PixelStoreDirection
    direction StateVar GLint -> GLint -> IO ()
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *). MonadIO m => StateVar GLint -> GLint -> m ()
    $= GLint
    0
          PixelStoreDirection -> StateVar GLint
    skipPixels PixelStoreDirection
    direction StateVar GLint -> GLint -> IO ()
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *). MonadIO m => StateVar GLint -> GLint -> m ()
    $= GLint
    0
          IO a
    action

    --------------------------------------------------------------------------------

    polygonMode :: StateVar (PolygonMode, PolygonMode)
    polygonMode :: StateVar (PolygonMode, PolygonMode)
    polygonMode = IO (PolygonMode, PolygonMode)
    -> ((PolygonMode, PolygonMode) -> IO ())
    -> StateVar (PolygonMode, PolygonMode)
    forall a. IO a -> (a -> IO ()) -> StateVar a
    makeStateVar IO (PolygonMode, PolygonMode)
    getPolygonMode (PolygonMode, PolygonMode) -> IO ()
    setPolygonMode

    getPolygonMode :: IO (PolygonMode, PolygonMode)
    getPolygonMode :: IO (PolygonMode, PolygonMode)
    getPolygonMode = (GLint -> GLint -> (PolygonMode, PolygonMode))
    -> PName2I -> IO (PolygonMode, PolygonMode)
    forall p a. GetPName2I p => (GLint -> GLint -> a) -> p -> IO a
    forall a. (GLint -> GLint -> a) -> PName2I -> IO a
    getInteger2 (\GLint
    front GLint
    back -> (GLint -> PolygonMode
    un GLint
    front, GLint -> PolygonMode
    un GLint
    back)) PName2I
    GetPolygonMode
       where un :: GLint -> PolygonMode
    un = GLenum -> PolygonMode
    unmarshalPolygonMode (GLenum -> PolygonMode)
    -> (GLint -> GLenum) -> GLint -> PolygonMode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GLint -> GLenum
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()
    setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()
    setPolygonMode (PolygonMode
    front, PolygonMode
    back)
       -- OpenGL 3 deprecated separate polygon draw modes, so try to avoid them.
       | PolygonMode
    front PolygonMode -> PolygonMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == PolygonMode
    back = Face -> PolygonMode -> IO ()
    forall {m :: * -> *}. MonadIO m => Face -> PolygonMode -> m ()
    setPM Face
    FrontAndBack PolygonMode
    front
       | Bool
    otherwise = do Face -> PolygonMode -> IO ()
    forall {m :: * -> *}. MonadIO m => Face -> PolygonMode -> m ()
    setPM Face
    Front PolygonMode
    front; Face -> PolygonMode -> IO ()
    forall {m :: * -> *}. MonadIO m => Face -> PolygonMode -> m ()
    setPM Face
    Back PolygonMode
    back
       where setPM :: Face -> PolygonMode -> m ()
    setPM Face
    f PolygonMode
    m = GLenum -> GLenum -> m ()
    forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
    glPolygonMode (Face -> GLenum
    marshalFace Face
    f) (PolygonMode -> GLenum
    marshalPolygonMode PolygonMode
    m)

    --------------------------------------------------------------------------------

    polygonOffset :: StateVar (GLfloat, GLfloat)
    polygonOffset :: StateVar (GLfloat, GLfloat)
    polygonOffset =
       IO (GLfloat, GLfloat)
    -> ((GLfloat, GLfloat) -> IO ()) -> StateVar (GLfloat, GLfloat)
    forall a. IO a -> (a -> IO ()) -> StateVar a
    makeStateVar ((GLfloat -> GLfloat -> (GLfloat, GLfloat))
    -> IO GLfloat -> IO GLfloat -> IO (GLfloat, GLfloat)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) ((GLfloat -> GLfloat) -> PName1F -> IO GLfloat
    forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
    forall a. (GLfloat -> a) -> PName1F -> IO a
    getFloat1 GLfloat -> GLfloat
    forall a. a -> a
    id PName1F
    GetPolygonOffsetFactor)
                                ((GLfloat -> GLfloat) -> PName1F -> IO GLfloat
    forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
    forall a. (GLfloat -> a) -> PName1F -> IO a
    getFloat1 GLfloat -> GLfloat
    forall a. a -> a
    id PName1F
    GetPolygonOffsetUnits))
                    ((GLfloat -> GLfloat -> IO ()) -> (GLfloat, GLfloat) -> IO ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry GLfloat -> GLfloat -> IO ()
    forall (m :: * -> *). MonadIO m => GLfloat -> GLfloat -> m ()
    glPolygonOffset)

    --------------------------------------------------------------------------------

    polygonOffsetPoint :: StateVar Capability
    polygonOffsetPoint :: StateVar Capability
    polygonOffsetPoint = EnableCap -> StateVar Capability
    makeCapability EnableCap
    CapPolygonOffsetPoint

    polygonOffsetLine :: StateVar Capability
    polygonOffsetLine :: StateVar Capability
    polygonOffsetLine = EnableCap -> StateVar Capability
    makeCapability EnableCap
    CapPolygonOffsetLine

    polygonOffsetFill :: StateVar Capability
    polygonOffsetFill :: StateVar Capability
    polygonOffsetFill = EnableCap -> StateVar Capability
    makeCapability EnableCap
    CapPolygonOffsetFill