    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Polygons
    -- Copyright   :  (c) Sven Panne 2002-2006
    -- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
    --
    -- Maintainer  :  sven.panne@aedion.de
    -- 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 ( liftM2 )
    import Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrArray, withForeignPtr )
    import Foreign.Marshal.Array ( allocaArray, withArray, peekArray, pokeArray )
    import Foreign.Ptr ( Ptr )
    import Graphics.Rendering.OpenGL.GL.Capability (
       EnableCap(CapPolygonSmooth,CapCullFace,CapPolygonStipple,
                 CapPolygonOffsetPoint,CapPolygonOffsetLine,CapPolygonOffsetFill),
       makeCapability, makeStateVarMaybe )
    import Graphics.Rendering.OpenGL.GL.BasicTypes (
       GLenum, GLubyte, GLfloat, Capability )
    import Graphics.Rendering.OpenGL.GL.Face ( marshalFace, unmarshalFace )
    import Graphics.Rendering.OpenGL.GL.Colors ( Face(..) )
    import Graphics.Rendering.OpenGL.GL.PixelRectangles (
       PixelStoreDirection(..), rowLength, skipRows, skipPixels )
    import Graphics.Rendering.OpenGL.GL.PolygonMode (
       PolygonMode(..), marshalPolygonMode, unmarshalPolygonMode )
    import Graphics.Rendering.OpenGL.GL.QueryUtils (
       GetPName(GetCullFaceMode,GetPolygonMode,GetPolygonOffsetFactor,
                GetPolygonOffsetUnits),
       getInteger2, getEnum1, getFloat1 )
    import Graphics.Rendering.OpenGL.GL.SavingState (
       ClientAttributeGroup(PixelStoreAttributes), preservingClientAttrib )
    import Graphics.Rendering.OpenGL.GL.StateVar (
       HasSetter(($=)), StateVar, makeStateVar )

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

    polygonSmooth :: StateVar Capability
    polygonSmooth = makeCapability CapPolygonSmooth

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

    cullFace :: StateVar (Maybe Face)
    cullFace = makeStateVarMaybe (return CapCullFace)
                                 (getEnum1 unmarshalFace GetCullFaceMode)
                                 (glCullFace . marshalFace)

    foreign import CALLCONV unsafe "glCullFace" glCullFace :: GLenum -> IO ()

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

    numPolygonStippleBytes :: Int
    numPolygonStippleBytes = 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 act =
          allocaArray numPolygonStippleBytes $ \p -> do
             act p
             components <- peekArray numPolygonStippleBytes p
             newPolygonStipple components

       withPolygonStipple s act = do
          components <- getPolygonStippleComponents s
          withArray components act

       newPolygonStipple components =
          withNewPolygonStipple $
             flip pokeArray (take numPolygonStippleBytes components)

       getPolygonStippleComponents s =
          withPolygonStipple s $ peekArray numPolygonStippleBytes

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

    data GLpolygonstipple = GLpolygonstipple (ForeignPtr GLubyte)
       deriving ( Eq, Ord, Show )

    instance PolygonStipple GLpolygonstipple where
       withNewPolygonStipple f = do
          fp <- mallocForeignPtrArray numPolygonStippleBytes
          withForeignPtr fp f
          return $ GLpolygonstipple fp

       withPolygonStipple (GLpolygonstipple fp) = withForeignPtr fp

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

    polygonStipple :: PolygonStipple s => StateVar (Maybe s)
    polygonStipple =
       makeStateVarMaybe (return CapPolygonStipple)
          (withoutGaps Pack $ withNewPolygonStipple glGetPolygonStipple)
          (\s -> withoutGaps Unpack $ withPolygonStipple s 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 direction action =
       preservingClientAttrib [ PixelStoreAttributes ] $ do
          rowLength  direction $= 0
          skipRows   direction $= 0
          skipPixels direction $= 0
          action

    foreign import CALLCONV unsafe "glGetPolygonStipple" glGetPolygonStipple ::
       Ptr GLubyte -> IO ()

    foreign import CALLCONV unsafe "glPolygonStipple" glPolygonStipple ::
       Ptr GLubyte -> IO ()

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

    polygonMode :: StateVar (PolygonMode, PolygonMode)
    polygonMode = makeStateVar getPolygonMode setPolygonMode

    getPolygonMode :: IO (PolygonMode, PolygonMode)
    getPolygonMode = getInteger2 (\front back -> (un front, un back)) GetPolygonMode
       where un = unmarshalPolygonMode . fromIntegral

    setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()
    setPolygonMode (front, back) = do
       glPolygonMode (marshalFace Front) (marshalPolygonMode front)
       glPolygonMode (marshalFace Back ) (marshalPolygonMode back )

    foreign import CALLCONV unsafe "glPolygonMode" glPolygonMode ::
       GLenum -> GLenum -> IO ()

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

    polygonOffset :: StateVar (GLfloat, GLfloat)
    polygonOffset =
       makeStateVar (liftM2 (,) (getFloat1 id GetPolygonOffsetFactor)
                                (getFloat1 id GetPolygonOffsetUnits))
                    (uncurry glPolygonOffset)

    foreign import CALLCONV unsafe "glPolygonOffset" glPolygonOffset ::
       GLfloat -> GLfloat -> IO ()

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

    polygonOffsetPoint :: StateVar Capability
    polygonOffsetPoint = makeCapability CapPolygonOffsetPoint

    polygonOffsetLine :: StateVar Capability
    polygonOffsetLine = makeCapability CapPolygonOffsetLine

    polygonOffsetFill :: StateVar Capability
    polygonOffsetFill = makeCapability CapPolygonOffsetFill