--------------------------------------------------------------------------------
-- |
-- 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
/= :: FeedbackToken -> FeedbackToken -> Bool
$c/= :: FeedbackToken -> FeedbackToken -> Bool
== :: FeedbackToken -> FeedbackToken -> Bool
$c== :: 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
min :: FeedbackToken -> FeedbackToken -> FeedbackToken
$cmin :: FeedbackToken -> FeedbackToken -> FeedbackToken
max :: FeedbackToken -> FeedbackToken -> FeedbackToken
$cmax :: FeedbackToken -> FeedbackToken -> FeedbackToken
>= :: FeedbackToken -> FeedbackToken -> Bool
$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
compare :: FeedbackToken -> FeedbackToken -> Ordering
$ccompare :: FeedbackToken -> FeedbackToken -> Ordering
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
showList :: [FeedbackToken] -> ShowS
$cshowList :: [FeedbackToken] -> ShowS
show :: FeedbackToken -> String
$cshow :: FeedbackToken -> String
showsPrec :: Int -> FeedbackToken -> ShowS
$cshowsPrec :: Int -> 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
/= :: VertexInfo -> VertexInfo -> Bool
$c/= :: VertexInfo -> VertexInfo -> Bool
== :: VertexInfo -> VertexInfo -> Bool
$c== :: 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
min :: VertexInfo -> VertexInfo -> VertexInfo
$cmin :: VertexInfo -> VertexInfo -> VertexInfo
max :: VertexInfo -> VertexInfo -> VertexInfo
$cmax :: VertexInfo -> VertexInfo -> VertexInfo
>= :: VertexInfo -> VertexInfo -> Bool
$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
compare :: VertexInfo -> VertexInfo -> Ordering
$ccompare :: VertexInfo -> VertexInfo -> Ordering
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
showList :: [VertexInfo] -> ShowS
$cshowList :: [VertexInfo] -> ShowS
show :: VertexInfo -> String
$cshow :: VertexInfo -> String
showsPrec :: Int -> VertexInfo -> ShowS
$cshowsPrec :: Int -> 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
/= :: FeedbackType -> FeedbackType -> Bool
$c/= :: FeedbackType -> FeedbackType -> Bool
== :: FeedbackType -> FeedbackType -> Bool
$c== :: 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
min :: FeedbackType -> FeedbackType -> FeedbackType
$cmin :: FeedbackType -> FeedbackType -> FeedbackType
max :: FeedbackType -> FeedbackType -> FeedbackType
$cmax :: FeedbackType -> FeedbackType -> FeedbackType
>= :: FeedbackType -> FeedbackType -> Bool
$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
compare :: FeedbackType -> FeedbackType -> Ordering
$ccompare :: FeedbackType -> FeedbackType -> Ordering
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
showList :: [FeedbackType] -> ShowS
$cshowList :: [FeedbackType] -> ShowS
show :: FeedbackType -> String
$cshow :: FeedbackType -> String
showsPrec :: Int -> FeedbackType -> ShowS
$cshowsPrec :: Int -> 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
      (a
value, GLint
numValues) <- RenderMode -> IO a -> IO (a, GLint)
forall a. RenderMode -> IO a -> IO (a, GLint)
withRenderMode RenderMode
Feedback IO a
action
      Maybe [FeedbackToken]
tokens <- GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])
parseFeedbackBuffer GLint
numValues Ptr GLfloat
buf FeedbackType
feedbackType
      (a, Maybe [FeedbackToken]) -> IO (a, Maybe [FeedbackToken])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
value, Maybe [FeedbackToken]
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe [FeedbackToken]
forall a. Maybe a
Nothing
   | Bool
otherwise     = do
      Bool
rgba <- GettableStateVar Bool -> GettableStateVar Bool
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get GettableStateVar Bool
rgbaMode
      let end :: Ptr b
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 :: Parser VertexInfo
infoParser = FeedbackType -> Parser ColorInfo -> Parser VertexInfo
calcInfoParser FeedbackType
feedbackType (Bool -> Parser ColorInfo
calcColorParser Bool
rgba)
          loop :: [FeedbackToken] -> IOState GLfloat [FeedbackToken]
loop [FeedbackToken]
tokens = do
             Ptr GLfloat
ptr <- IOState GLfloat (Ptr GLfloat)
forall s. IOState s (Ptr s)
getIOState
             if Ptr GLfloat
ptr Ptr GLfloat -> Ptr GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GLfloat
forall {b}. Ptr b
end
                then [FeedbackToken] -> IOState GLfloat [FeedbackToken]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FeedbackToken] -> [FeedbackToken]
forall a. [a] -> [a]
reverse [FeedbackToken]
tokens)
                else do FeedbackToken
token <- Parser VertexInfo -> Parser FeedbackToken
tokenParser Parser VertexInfo
infoParser
                        [FeedbackToken] -> IOState GLfloat [FeedbackToken]
loop (FeedbackToken
token FeedbackToken -> [FeedbackToken] -> [FeedbackToken]
forall a. a -> [a] -> [a]
: [FeedbackToken]
tokens)
      ([FeedbackToken] -> Maybe [FeedbackToken])
-> IO [FeedbackToken] -> IO (Maybe [FeedbackToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FeedbackToken] -> Maybe [FeedbackToken]
forall a. a -> Maybe a
Just (IO [FeedbackToken] -> IO (Maybe [FeedbackToken]))
-> IO [FeedbackToken] -> IO (Maybe [FeedbackToken])
forall a b. (a -> b) -> a -> b
$ IOState GLfloat [FeedbackToken]
-> Ptr GLfloat -> IO [FeedbackToken]
forall s a. IOState s a -> Ptr s -> IO a
evalIOState ([FeedbackToken] -> IOState GLfloat [FeedbackToken]
loop []) Ptr GLfloat
buf

type Parser a = IOState GLfloat a

tokenParser :: Parser VertexInfo -> Parser FeedbackToken
tokenParser :: Parser VertexInfo -> Parser FeedbackToken
tokenParser Parser VertexInfo
infoParser = do
   GLenum
tag <- Parser GLenum
parseGLenum
   case GLenum -> FeedbackTag
unmarshalFeedbackTag GLenum
tag of
      FeedbackTag
PointTag -> (VertexInfo -> FeedbackToken)
-> Parser VertexInfo -> Parser FeedbackToken
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 GLint
n <- Parser GLint
parseGLint; ([VertexInfo] -> FeedbackToken)
-> IOState GLfloat [VertexInfo] -> Parser FeedbackToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VertexInfo] -> FeedbackToken
PolygonToken (GLint -> Parser VertexInfo -> IOState GLfloat [VertexInfo]
forall a b c. Integral a => a -> IOState b c -> IOState b [c]
nTimes GLint
n Parser VertexInfo
infoParser)
      FeedbackTag
BitmapTag -> (VertexInfo -> FeedbackToken)
-> Parser VertexInfo -> Parser FeedbackToken
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLfloat -> GLenum
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLfloat -> GLint
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
/= :: PassThroughValue -> PassThroughValue -> Bool
$c/= :: PassThroughValue -> PassThroughValue -> Bool
== :: PassThroughValue -> PassThroughValue -> Bool
$c== :: 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
min :: PassThroughValue -> PassThroughValue -> PassThroughValue
$cmin :: PassThroughValue -> PassThroughValue -> PassThroughValue
max :: PassThroughValue -> PassThroughValue -> PassThroughValue
$cmax :: PassThroughValue -> PassThroughValue -> PassThroughValue
>= :: PassThroughValue -> PassThroughValue -> Bool
$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
compare :: PassThroughValue -> PassThroughValue -> Ordering
$ccompare :: PassThroughValue -> PassThroughValue -> Ordering
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
showList :: [PassThroughValue] -> ShowS
$cshowList :: [PassThroughValue] -> ShowS
show :: PassThroughValue -> String
$cshow :: PassThroughValue -> String
showsPrec :: Int -> PassThroughValue -> ShowS
$cshowsPrec :: Int -> PassThroughValue -> ShowS
Show )

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