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

    module Graphics.Rendering.OpenGL.GL.Feedback (
       FeedbackToken(..), VertexInfo(..), ColorInfo, FeedbackType(..),
       getFeedbackTokens, PassThroughValue(..), passThrough
    ) where

    import Control.Monad
    import Data.StateVar
    import Foreign.Marshal.Array
    import Foreign.Ptr
    import Foreign.Storable
    import Graphics.Rendering.OpenGL.GL.IOState
    import Graphics.Rendering.OpenGL.GL.RenderMode
    import Graphics.Rendering.OpenGL.GL.Tensor
    import Graphics.Rendering.OpenGL.GL.VertexSpec
    import Graphics.GL

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

    data FeedbackToken =
         PointToken VertexInfo
       | LineToken VertexInfo VertexInfo
       | LineResetToken VertexInfo VertexInfo
       | PolygonToken [VertexInfo]
       | BitmapToken VertexInfo
       | DrawPixelToken VertexInfo
       | CopyPixelToken VertexInfo
       | PassThroughToken PassThroughValue
       deriving ( FeedbackToken -> FeedbackToken -> Bool
    (FeedbackToken -> FeedbackToken -> Bool)
    -> (FeedbackToken -> FeedbackToken -> Bool) -> Eq FeedbackToken
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FeedbackToken -> FeedbackToken -> Bool
    == :: FeedbackToken -> FeedbackToken -> Bool
    $c/= :: FeedbackToken -> FeedbackToken -> Bool
    /= :: FeedbackToken -> FeedbackToken -> Bool
    Eq, Eq FeedbackToken
    Eq FeedbackToken =>
    (FeedbackToken -> FeedbackToken -> Ordering)
    -> (FeedbackToken -> FeedbackToken -> Bool)
    -> (FeedbackToken -> FeedbackToken -> Bool)
    -> (FeedbackToken -> FeedbackToken -> Bool)
    -> (FeedbackToken -> FeedbackToken -> Bool)
    -> (FeedbackToken -> FeedbackToken -> FeedbackToken)
    -> (FeedbackToken -> FeedbackToken -> FeedbackToken)
    -> Ord FeedbackToken
    FeedbackToken -> FeedbackToken -> Bool
    FeedbackToken -> FeedbackToken -> Ordering
    FeedbackToken -> FeedbackToken -> FeedbackToken
    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 :: FeedbackToken -> FeedbackToken -> Ordering
    compare :: FeedbackToken -> FeedbackToken -> Ordering
    $c< :: FeedbackToken -> FeedbackToken -> Bool
    < :: FeedbackToken -> FeedbackToken -> Bool
    $c<= :: FeedbackToken -> FeedbackToken -> Bool
    <= :: FeedbackToken -> FeedbackToken -> Bool
    $c> :: FeedbackToken -> FeedbackToken -> Bool
    > :: FeedbackToken -> FeedbackToken -> Bool
    $c>= :: FeedbackToken -> FeedbackToken -> Bool
    >= :: FeedbackToken -> FeedbackToken -> Bool
    $cmax :: FeedbackToken -> FeedbackToken -> FeedbackToken
    max :: FeedbackToken -> FeedbackToken -> FeedbackToken
    $cmin :: FeedbackToken -> FeedbackToken -> FeedbackToken
    min :: FeedbackToken -> FeedbackToken -> FeedbackToken
    Ord, Int -> FeedbackToken -> ShowS
    [FeedbackToken] -> ShowS
    FeedbackToken -> String
    (Int -> FeedbackToken -> ShowS)
    -> (FeedbackToken -> String)
    -> ([FeedbackToken] -> ShowS)
    -> Show FeedbackToken
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FeedbackToken -> ShowS
    showsPrec :: Int -> FeedbackToken -> ShowS
    $cshow :: FeedbackToken -> String
    show :: FeedbackToken -> String
    $cshowList :: [FeedbackToken] -> ShowS
    showList :: [FeedbackToken] -> ShowS
    Show )

    data VertexInfo =
         Vertex2D             (Vertex2 GLfloat)
       | Vertex3D             (Vertex3 GLfloat)
       | Vertex3DColor        (Vertex3 GLfloat) ColorInfo
       | Vertex3DColorTexture (Vertex3 GLfloat) ColorInfo (TexCoord4 GLfloat)
       | Vertex4DColorTexture (Vertex4 GLfloat) ColorInfo (TexCoord4 GLfloat)
       deriving ( VertexInfo -> VertexInfo -> Bool
    (VertexInfo -> VertexInfo -> Bool)
    -> (VertexInfo -> VertexInfo -> Bool) -> Eq VertexInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: VertexInfo -> VertexInfo -> Bool
    == :: VertexInfo -> VertexInfo -> Bool
    $c/= :: VertexInfo -> VertexInfo -> Bool
    /= :: VertexInfo -> VertexInfo -> Bool
    Eq, Eq VertexInfo
    Eq VertexInfo =>
    (VertexInfo -> VertexInfo -> Ordering)
    -> (VertexInfo -> VertexInfo -> Bool)
    -> (VertexInfo -> VertexInfo -> Bool)
    -> (VertexInfo -> VertexInfo -> Bool)
    -> (VertexInfo -> VertexInfo -> Bool)
    -> (VertexInfo -> VertexInfo -> VertexInfo)
    -> (VertexInfo -> VertexInfo -> VertexInfo)
    -> Ord VertexInfo
    VertexInfo -> VertexInfo -> Bool
    VertexInfo -> VertexInfo -> Ordering
    VertexInfo -> VertexInfo -> VertexInfo
    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 :: VertexInfo -> VertexInfo -> Ordering
    compare :: VertexInfo -> VertexInfo -> Ordering
    $c< :: VertexInfo -> VertexInfo -> Bool
    < :: VertexInfo -> VertexInfo -> Bool
    $c<= :: VertexInfo -> VertexInfo -> Bool
    <= :: VertexInfo -> VertexInfo -> Bool
    $c> :: VertexInfo -> VertexInfo -> Bool
    > :: VertexInfo -> VertexInfo -> Bool
    $c>= :: VertexInfo -> VertexInfo -> Bool
    >= :: VertexInfo -> VertexInfo -> Bool
    $cmax :: VertexInfo -> VertexInfo -> VertexInfo
    max :: VertexInfo -> VertexInfo -> VertexInfo
    $cmin :: VertexInfo -> VertexInfo -> VertexInfo
    min :: VertexInfo -> VertexInfo -> VertexInfo
    Ord, Int -> VertexInfo -> ShowS
    [VertexInfo] -> ShowS
    VertexInfo -> String
    (Int -> VertexInfo -> ShowS)
    -> (VertexInfo -> String)
    -> ([VertexInfo] -> ShowS)
    -> Show VertexInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> VertexInfo -> ShowS
    showsPrec :: Int -> VertexInfo -> ShowS
    $cshow :: VertexInfo -> String
    show :: VertexInfo -> String
    $cshowList :: [VertexInfo] -> ShowS
    showList :: [VertexInfo] -> ShowS
    Show )

    type ColorInfo = Either (Index1 GLint) (Color4 GLfloat)

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

    data FeedbackTag =
         PointTag
       | LineTag
       | LineResetTag
       | PolygonTag
       | BitmapTag
       | DrawPixelTag
       | CopyPixelTag
       | PassThroughTag

    unmarshalFeedbackTag :: GLenum -> FeedbackTag
    unmarshalFeedbackTag :: GLenum -> FeedbackTag
    unmarshalFeedbackTag GLenum
    x
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_POINT_TOKEN = FeedbackTag
    PointTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_LINE_TOKEN = FeedbackTag
    LineTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_LINE_RESET_TOKEN = FeedbackTag
    LineResetTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_POLYGON_TOKEN = FeedbackTag
    PolygonTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_BITMAP_TOKEN = FeedbackTag
    BitmapTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_DRAW_PIXEL_TOKEN = FeedbackTag
    DrawPixelTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_COPY_PIXEL_TOKEN = FeedbackTag
    CopyPixelTag
       | GLenum
    x GLenum -> GLenum -> Bool
    forall a. Eq a => a -> a -> Bool
    == GLenum
    GL_PASS_THROUGH_TOKEN = FeedbackTag
    PassThroughTag
       | Bool
    otherwise = String -> FeedbackTag
    forall a. HasCallStack => String -> a
    error (String
    "unmarshalFeedbackTag: illegal value " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ GLenum -> String
    forall a. Show a => a -> String
    show GLenum
    x)

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

    data FeedbackType =
         TwoD
       | ThreeD
       | ThreeDColor
       | ThreeDColorTexture
       | FourDColorTexture
       deriving ( FeedbackType -> FeedbackType -> Bool
    (FeedbackType -> FeedbackType -> Bool)
    -> (FeedbackType -> FeedbackType -> Bool) -> Eq FeedbackType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FeedbackType -> FeedbackType -> Bool
    == :: FeedbackType -> FeedbackType -> Bool
    $c/= :: FeedbackType -> FeedbackType -> Bool
    /= :: FeedbackType -> FeedbackType -> Bool
    Eq, Eq FeedbackType
    Eq FeedbackType =>
    (FeedbackType -> FeedbackType -> Ordering)
    -> (FeedbackType -> FeedbackType -> Bool)
    -> (FeedbackType -> FeedbackType -> Bool)
    -> (FeedbackType -> FeedbackType -> Bool)
    -> (FeedbackType -> FeedbackType -> Bool)
    -> (FeedbackType -> FeedbackType -> FeedbackType)
    -> (FeedbackType -> FeedbackType -> FeedbackType)
    -> Ord FeedbackType
    FeedbackType -> FeedbackType -> Bool
    FeedbackType -> FeedbackType -> Ordering
    FeedbackType -> FeedbackType -> FeedbackType
    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 :: FeedbackType -> FeedbackType -> Ordering
    compare :: FeedbackType -> FeedbackType -> Ordering
    $c< :: FeedbackType -> FeedbackType -> Bool
    < :: FeedbackType -> FeedbackType -> Bool
    $c<= :: FeedbackType -> FeedbackType -> Bool
    <= :: FeedbackType -> FeedbackType -> Bool
    $c> :: FeedbackType -> FeedbackType -> Bool
    > :: FeedbackType -> FeedbackType -> Bool
    $c>= :: FeedbackType -> FeedbackType -> Bool
    >= :: FeedbackType -> FeedbackType -> Bool
    $cmax :: FeedbackType -> FeedbackType -> FeedbackType
    max :: FeedbackType -> FeedbackType -> FeedbackType
    $cmin :: FeedbackType -> FeedbackType -> FeedbackType
    min :: FeedbackType -> FeedbackType -> FeedbackType
    Ord, Int -> FeedbackType -> ShowS
    [FeedbackType] -> ShowS
    FeedbackType -> String
    (Int -> FeedbackType -> ShowS)
    -> (FeedbackType -> String)
    -> ([FeedbackType] -> ShowS)
    -> Show FeedbackType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FeedbackType -> ShowS
    showsPrec :: Int -> FeedbackType -> ShowS
    $cshow :: FeedbackType -> String
    show :: FeedbackType -> String
    $cshowList :: [FeedbackType] -> ShowS
    showList :: [FeedbackType] -> ShowS
    Show )

    marshalFeedbackType :: FeedbackType -> GLenum
    marshalFeedbackType :: FeedbackType -> GLenum
    marshalFeedbackType FeedbackType
    x = case FeedbackType
    x of
       FeedbackType
    TwoD -> GLenum
    GL_2D
       FeedbackType
    ThreeD -> GLenum
    GL_3D
       FeedbackType
    ThreeDColor -> GLenum
    GL_3D_COLOR
       FeedbackType
    ThreeDColorTexture -> GLenum
    GL_3D_COLOR_TEXTURE
       FeedbackType
    FourDColorTexture -> GLenum
    GL_4D_COLOR_TEXTURE

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

    getFeedbackTokens ::
       GLsizei -> FeedbackType -> IO a -> IO (a, Maybe [FeedbackToken])
    getFeedbackTokens :: forall a.
    GLint -> FeedbackType -> IO a -> IO (a, Maybe [FeedbackToken])
    getFeedbackTokens GLint
    bufSize FeedbackType
    feedbackType IO a
    action =
       Int
    -> (Ptr GLfloat -> IO (a, Maybe [FeedbackToken]))
    -> IO (a, Maybe [FeedbackToken])
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray (GLint -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLint
    bufSize) ((Ptr GLfloat -> IO (a, Maybe [FeedbackToken]))
     -> IO (a, Maybe [FeedbackToken]))
    -> (Ptr GLfloat -> IO (a, Maybe [FeedbackToken]))
    -> IO (a, Maybe [FeedbackToken])
    forall a b. (a -> b) -> a -> b
    $ \Ptr GLfloat
    buf -> do
          GLint -> GLenum -> Ptr GLfloat -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    GLint -> GLenum -> Ptr GLfloat -> m ()
    glFeedbackBuffer GLint
    bufSize (FeedbackType -> GLenum
    marshalFeedbackType FeedbackType
    feedbackType) Ptr GLfloat
    buf
          (value, numValues) <- RenderMode -> IO a -> IO (a, GLint)
    forall a. RenderMode -> IO a -> IO (a, GLint)
    withRenderMode RenderMode
    Feedback IO a
    action
          tokens <- parseFeedbackBuffer numValues buf feedbackType
          return (value, tokens)

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

    parseFeedbackBuffer ::
       GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])
    parseFeedbackBuffer :: GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])
    parseFeedbackBuffer GLint
    numValues Ptr GLfloat
    buf FeedbackType
    feedbackType
       | GLint
    numValues GLint -> GLint -> Bool
    forall a. Ord a => a -> a -> Bool
    < GLint
    0 = Maybe [FeedbackToken] -> IO (Maybe [FeedbackToken])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [FeedbackToken]
    forall a. Maybe a
    Nothing
       | Bool
    otherwise     = do
          rgba <- GettableStateVar Bool -> GettableStateVar Bool
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
    get GettableStateVar Bool
    rgbaMode
          let end = Ptr GLfloat
    buf Ptr GLfloat -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr`
                      (GLfloat -> Int
    forall a. Storable a => a -> Int
    sizeOf (GLfloat
    forall a. HasCallStack => a
    undefined :: GLfloat) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * GLint -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLint
    numValues)
              infoParser = FeedbackType -> Parser ColorInfo -> Parser VertexInfo
    calcInfoParser FeedbackType
    feedbackType (Bool -> Parser ColorInfo
    calcColorParser Bool
    rgba)
              loop [FeedbackToken]
    tokens = do
                 ptr <- IOState GLfloat (Ptr GLfloat)
    forall s. IOState s (Ptr s)
    getIOState
                 if ptr == end
                    then return (reverse tokens)
                    else do token <- tokenParser infoParser
                            loop (token : tokens)
          fmap Just $ evalIOState (loop []) buf

    type Parser a = IOState GLfloat a

    tokenParser :: Parser VertexInfo -> Parser FeedbackToken
    tokenParser :: Parser VertexInfo -> Parser FeedbackToken
    tokenParser Parser VertexInfo
    infoParser = do
       tag <- Parser GLenum
    parseGLenum
       case unmarshalFeedbackTag tag of
          FeedbackTag
    PointTag -> (VertexInfo -> FeedbackToken)
    -> Parser VertexInfo -> Parser FeedbackToken
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap VertexInfo -> FeedbackToken
    PointToken Parser VertexInfo
    infoParser
          FeedbackTag
    LineTag -> (VertexInfo -> VertexInfo -> FeedbackToken)
    -> Parser VertexInfo -> Parser VertexInfo -> Parser FeedbackToken
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 VertexInfo -> VertexInfo -> FeedbackToken
    LineToken Parser VertexInfo
    infoParser Parser VertexInfo
    infoParser
          FeedbackTag
    LineResetTag -> (VertexInfo -> VertexInfo -> FeedbackToken)
    -> Parser VertexInfo -> Parser VertexInfo -> Parser FeedbackToken
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 VertexInfo -> VertexInfo -> FeedbackToken
    LineResetToken Parser VertexInfo
    infoParser Parser VertexInfo
    infoParser
          FeedbackTag
    PolygonTag -> do n <- Parser GLint
    parseGLint; fmap PolygonToken (nTimes n infoParser)
          FeedbackTag
    BitmapTag -> (VertexInfo -> FeedbackToken)
    -> Parser VertexInfo -> Parser FeedbackToken
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap VertexInfo -> FeedbackToken
    BitmapToken Parser VertexInfo
    infoParser
          FeedbackTag
    DrawPixelTag -> (VertexInfo -> FeedbackToken)
    -> Parser VertexInfo -> Parser FeedbackToken
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap VertexInfo -> FeedbackToken
    DrawPixelToken Parser VertexInfo
    infoParser
          FeedbackTag
    CopyPixelTag -> (VertexInfo -> FeedbackToken)
    -> Parser VertexInfo -> Parser FeedbackToken
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap VertexInfo -> FeedbackToken
    CopyPixelToken Parser VertexInfo
    infoParser
          FeedbackTag
    PassThroughTag -> (PassThroughValue -> FeedbackToken)
    -> IOState GLfloat PassThroughValue -> Parser FeedbackToken
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PassThroughValue -> FeedbackToken
    PassThroughToken IOState GLfloat PassThroughValue
    parsePassThroughValue

    calcInfoParser :: FeedbackType -> Parser ColorInfo -> Parser VertexInfo
    calcInfoParser :: FeedbackType -> Parser ColorInfo -> Parser VertexInfo
    calcInfoParser FeedbackType
    feedbackType Parser ColorInfo
    colorParser = case FeedbackType
    feedbackType of
       FeedbackType
    TwoD ->
          (Vertex2 GLfloat -> VertexInfo)
    -> IOState GLfloat (Vertex2 GLfloat) -> Parser VertexInfo
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Vertex2 GLfloat -> VertexInfo
    Vertex2D IOState GLfloat (Vertex2 GLfloat)
    parseVertex2
       FeedbackType
    ThreeD ->
          (Vertex3 GLfloat -> VertexInfo)
    -> IOState GLfloat (Vertex3 GLfloat) -> Parser VertexInfo
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Vertex3 GLfloat -> VertexInfo
    Vertex3D IOState GLfloat (Vertex3 GLfloat)
    parseVertex3
       FeedbackType
    ThreeDColor ->
          (Vertex3 GLfloat -> ColorInfo -> VertexInfo)
    -> IOState GLfloat (Vertex3 GLfloat)
    -> Parser ColorInfo
    -> Parser VertexInfo
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Vertex3 GLfloat -> ColorInfo -> VertexInfo
    Vertex3DColor IOState GLfloat (Vertex3 GLfloat)
    parseVertex3 Parser ColorInfo
    colorParser
       FeedbackType
    ThreeDColorTexture ->
          (Vertex3 GLfloat -> ColorInfo -> TexCoord4 GLfloat -> VertexInfo)
    -> IOState GLfloat (Vertex3 GLfloat)
    -> Parser ColorInfo
    -> IOState GLfloat (TexCoord4 GLfloat)
    -> Parser VertexInfo
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 Vertex3 GLfloat -> ColorInfo -> TexCoord4 GLfloat -> VertexInfo
    Vertex3DColorTexture IOState GLfloat (Vertex3 GLfloat)
    parseVertex3 Parser ColorInfo
    colorParser IOState GLfloat (TexCoord4 GLfloat)
    parseTexCoord4
       FeedbackType
    FourDColorTexture ->
          (Vertex4 GLfloat -> ColorInfo -> TexCoord4 GLfloat -> VertexInfo)
    -> IOState GLfloat (Vertex4 GLfloat)
    -> Parser ColorInfo
    -> IOState GLfloat (TexCoord4 GLfloat)
    -> Parser VertexInfo
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 Vertex4 GLfloat -> ColorInfo -> TexCoord4 GLfloat -> VertexInfo
    Vertex4DColorTexture IOState GLfloat (Vertex4 GLfloat)
    parseVertex4 Parser ColorInfo
    colorParser IOState GLfloat (TexCoord4 GLfloat)
    parseTexCoord4

    parseVertex2 :: Parser (Vertex2 GLfloat)
    parseVertex2 :: IOState GLfloat (Vertex2 GLfloat)
    parseVertex2 = (GLfloat -> GLfloat -> Vertex2 GLfloat)
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat (Vertex2 GLfloat)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 GLfloat -> GLfloat -> Vertex2 GLfloat
    forall a. a -> a -> Vertex2 a
    Vertex2 IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat

    parseVertex3 :: Parser (Vertex3 GLfloat)
    parseVertex3 :: IOState GLfloat (Vertex3 GLfloat)
    parseVertex3 = (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat)
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat (Vertex3 GLfloat)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
    forall a. a -> a -> a -> Vertex3 a
    Vertex3 IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat

    parseVertex4 :: Parser (Vertex4 GLfloat)
    parseVertex4 :: IOState GLfloat (Vertex4 GLfloat)
    parseVertex4 =
       (GLfloat -> GLfloat -> GLfloat -> GLfloat -> Vertex4 GLfloat)
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat (Vertex4 GLfloat)
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> Vertex4 GLfloat
    forall a. a -> a -> a -> a -> Vertex4 a
    Vertex4 IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat

    calcColorParser :: Bool -> Parser ColorInfo
    calcColorParser :: Bool -> Parser ColorInfo
    calcColorParser Bool
    False = (Index1 GLint -> ColorInfo)
    -> IOState GLfloat (Index1 GLint) -> Parser ColorInfo
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Index1 GLint -> ColorInfo
    forall a b. a -> Either a b
    Left IOState GLfloat (Index1 GLint)
    parseIndex1
    calcColorParser Bool
    True  = (Color4 GLfloat -> ColorInfo)
    -> IOState GLfloat (Color4 GLfloat) -> Parser ColorInfo
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Color4 GLfloat -> ColorInfo
    forall a b. b -> Either a b
    Right IOState GLfloat (Color4 GLfloat)
    parseColor4

    parseIndex1 :: Parser (Index1 GLint)
    parseIndex1 :: IOState GLfloat (Index1 GLint)
    parseIndex1 = (GLint -> Index1 GLint)
    -> Parser GLint -> IOState GLfloat (Index1 GLint)
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GLint -> Index1 GLint
    forall a. a -> Index1 a
    Index1 Parser GLint
    parseGLint

    parseColor4 :: Parser (Color4 GLfloat)
    parseColor4 :: IOState GLfloat (Color4 GLfloat)
    parseColor4 = (GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat)
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat (Color4 GLfloat)
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
    forall a. a -> a -> a -> a -> Color4 a
    Color4 IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat

    parseTexCoord4 :: Parser (TexCoord4 GLfloat)
    parseTexCoord4 :: IOState GLfloat (TexCoord4 GLfloat)
    parseTexCoord4 =
       (GLfloat -> GLfloat -> GLfloat -> GLfloat -> TexCoord4 GLfloat)
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat GLfloat
    -> IOState GLfloat (TexCoord4 GLfloat)
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> TexCoord4 GLfloat
    forall a. a -> a -> a -> a -> TexCoord4 a
    TexCoord4 IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat IOState GLfloat GLfloat
    parseGLfloat

    parsePassThroughValue :: Parser PassThroughValue
    parsePassThroughValue :: IOState GLfloat PassThroughValue
    parsePassThroughValue = (GLfloat -> PassThroughValue)
    -> IOState GLfloat GLfloat -> IOState GLfloat PassThroughValue
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GLfloat -> PassThroughValue
    PassThroughValue IOState GLfloat GLfloat
    parseGLfloat

    parseGLenum :: Parser GLenum
    parseGLenum :: Parser GLenum
    parseGLenum = (GLfloat -> GLenum) -> IOState GLfloat GLfloat -> Parser GLenum
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GLfloat -> GLenum
    forall b. Integral b => GLfloat -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round IOState GLfloat GLfloat
    parseGLfloat

    parseGLint :: Parser GLint
    parseGLint :: Parser GLint
    parseGLint = (GLfloat -> GLint) -> IOState GLfloat GLfloat -> Parser GLint
    forall a b. (a -> b) -> IOState GLfloat a -> IOState GLfloat b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GLfloat -> GLint
    forall b. Integral b => GLfloat -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round IOState GLfloat GLfloat
    parseGLfloat

    parseGLfloat :: Parser GLfloat
    parseGLfloat :: IOState GLfloat GLfloat
    parseGLfloat = IOState GLfloat GLfloat
    forall a. Storable a => IOState a a
    peekIOState

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

    newtype PassThroughValue = PassThroughValue GLfloat
       deriving ( PassThroughValue -> PassThroughValue -> Bool
    (PassThroughValue -> PassThroughValue -> Bool)
    -> (PassThroughValue -> PassThroughValue -> Bool)
    -> Eq PassThroughValue
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PassThroughValue -> PassThroughValue -> Bool
    == :: PassThroughValue -> PassThroughValue -> Bool
    $c/= :: PassThroughValue -> PassThroughValue -> Bool
    /= :: PassThroughValue -> PassThroughValue -> Bool
    Eq, Eq PassThroughValue
    Eq PassThroughValue =>
    (PassThroughValue -> PassThroughValue -> Ordering)
    -> (PassThroughValue -> PassThroughValue -> Bool)
    -> (PassThroughValue -> PassThroughValue -> Bool)
    -> (PassThroughValue -> PassThroughValue -> Bool)
    -> (PassThroughValue -> PassThroughValue -> Bool)
    -> (PassThroughValue -> PassThroughValue -> PassThroughValue)
    -> (PassThroughValue -> PassThroughValue -> PassThroughValue)
    -> Ord PassThroughValue
    PassThroughValue -> PassThroughValue -> Bool
    PassThroughValue -> PassThroughValue -> Ordering
    PassThroughValue -> PassThroughValue -> PassThroughValue
    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 :: PassThroughValue -> PassThroughValue -> Ordering
    compare :: PassThroughValue -> PassThroughValue -> Ordering
    $c< :: PassThroughValue -> PassThroughValue -> Bool
    < :: PassThroughValue -> PassThroughValue -> Bool
    $c<= :: PassThroughValue -> PassThroughValue -> Bool
    <= :: PassThroughValue -> PassThroughValue -> Bool
    $c> :: PassThroughValue -> PassThroughValue -> Bool
    > :: PassThroughValue -> PassThroughValue -> Bool
    $c>= :: PassThroughValue -> PassThroughValue -> Bool
    >= :: PassThroughValue -> PassThroughValue -> Bool
    $cmax :: PassThroughValue -> PassThroughValue -> PassThroughValue
    max :: PassThroughValue -> PassThroughValue -> PassThroughValue
    $cmin :: PassThroughValue -> PassThroughValue -> PassThroughValue
    min :: PassThroughValue -> PassThroughValue -> PassThroughValue
    Ord, Int -> PassThroughValue -> ShowS
    [PassThroughValue] -> ShowS
    PassThroughValue -> String
    (Int -> PassThroughValue -> ShowS)
    -> (PassThroughValue -> String)
    -> ([PassThroughValue] -> ShowS)
    -> Show PassThroughValue
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PassThroughValue -> ShowS
    showsPrec :: Int -> PassThroughValue -> ShowS
    $cshow :: PassThroughValue -> String
    show :: PassThroughValue -> String
    $cshowList :: [PassThroughValue] -> ShowS
    showList :: [PassThroughValue] -> ShowS
    Show )

    passThrough :: PassThroughValue -> IO ()
    passThrough :: PassThroughValue -> IO ()
    passThrough (PassThroughValue GLfloat
    ptv) = GLfloat -> IO ()
    forall (m :: * -> *). MonadIO m => GLfloat -> m ()
    glPassThrough GLfloat
    ptv