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