{-# LANGUAGE Arrows                     #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# OPTIONS_GHC -Wno-unused-foralls #-}
module Graphics.GPipe.Internal.FragmentStream where

#if __GLASGOW_HASKELL__ < 804
import           Data.Semigroup                          (Semigroup (..))
#endif

import           Control.Arrow                           (Arrow (arr, first),
                                                          Kleisli (Kleisli),
                                                          returnA)
import           Control.Category                        (Category)
import           Control.Monad.Trans.State.Lazy          (State, evalState, get,
                                                          put)
import           Data.Boolean                            (Boolean (true, (&&*)),
                                                          EqB ((==*)),
                                                          IfB (ifB))
import           Data.IntMap.Polymorphic.Lazy            (insert)
import           Data.Maybe                              (isJust)
import           Data.Text.Lazy                          (Text)
import           Graphics.GL.Core45
import           Graphics.GPipe.Internal.Compiler        (RenderIOState (rasterizationNameToRenderIO))
import           Graphics.GPipe.Internal.Expr
import           Graphics.GPipe.Internal.PrimitiveStream (PrimitiveStream (..),
                                                          PrimitiveStreamData)
import           Graphics.GPipe.Internal.Shader          (Shader (..),
                                                          getNewName,
                                                          modifyRenderIO)
import           Linear.Affine                           (Point (..))
import           Linear.Plucker                          (Plucker (..))
import           Linear.Quaternion                       (Quaternion (..))
import           Linear.V0                               (V0 (..))
import           Linear.V1                               (V1 (..))
import           Linear.V2                               (V2 (..))
import           Linear.V3                               (V3 (..))
import           Linear.V4                               (V4 (..))

type VPos = V4 VFloat

type ExprPos = ExprM ()
type RasterizationName = Int
data FragmentStreamData = FragmentStreamData RasterizationName Bool ExprPos PrimitiveStreamData FBool

-- | A @'FragmentStream' a @ is a stream of fragments of type @a@. You may append 'FragmentStream's using the 'Monoid' instance, and you
--   can operate a stream's values using the 'Functor' instance (this will result in a shader running on the GPU).
newtype FragmentStream a = FragmentStream [(a, FragmentStreamData)] deriving (b -> FragmentStream a -> FragmentStream a
NonEmpty (FragmentStream a) -> FragmentStream a
FragmentStream a -> FragmentStream a -> FragmentStream a
(FragmentStream a -> FragmentStream a -> FragmentStream a)
-> (NonEmpty (FragmentStream a) -> FragmentStream a)
-> (forall b.
    Integral b =>
    b -> FragmentStream a -> FragmentStream a)
-> Semigroup (FragmentStream a)
forall b. Integral b => b -> FragmentStream a -> FragmentStream a
forall a. NonEmpty (FragmentStream a) -> FragmentStream a
forall a. FragmentStream a -> FragmentStream a -> FragmentStream a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> FragmentStream a -> FragmentStream a
stimes :: b -> FragmentStream a -> FragmentStream a
$cstimes :: forall a b. Integral b => b -> FragmentStream a -> FragmentStream a
sconcat :: NonEmpty (FragmentStream a) -> FragmentStream a
$csconcat :: forall a. NonEmpty (FragmentStream a) -> FragmentStream a
<> :: FragmentStream a -> FragmentStream a -> FragmentStream a
$c<> :: forall a. FragmentStream a -> FragmentStream a -> FragmentStream a
Semigroup, Semigroup (FragmentStream a)
FragmentStream a
Semigroup (FragmentStream a)
-> FragmentStream a
-> (FragmentStream a -> FragmentStream a -> FragmentStream a)
-> ([FragmentStream a] -> FragmentStream a)
-> Monoid (FragmentStream a)
[FragmentStream a] -> FragmentStream a
FragmentStream a -> FragmentStream a -> FragmentStream a
forall a. Semigroup (FragmentStream a)
forall a. FragmentStream a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [FragmentStream a] -> FragmentStream a
forall a. FragmentStream a -> FragmentStream a -> FragmentStream a
mconcat :: [FragmentStream a] -> FragmentStream a
$cmconcat :: forall a. [FragmentStream a] -> FragmentStream a
mappend :: FragmentStream a -> FragmentStream a -> FragmentStream a
$cmappend :: forall a. FragmentStream a -> FragmentStream a -> FragmentStream a
mempty :: FragmentStream a
$cmempty :: forall a. FragmentStream a
$cp1Monoid :: forall a. Semigroup (FragmentStream a)
Monoid)

instance Functor FragmentStream where
        fmap :: (a -> b) -> FragmentStream a -> FragmentStream b
fmap a -> b
f (FragmentStream [(a, FragmentStreamData)]
xs) = [(b, FragmentStreamData)] -> FragmentStream b
forall a. [(a, FragmentStreamData)] -> FragmentStream a
FragmentStream ([(b, FragmentStreamData)] -> FragmentStream b)
-> [(b, FragmentStreamData)] -> FragmentStream b
forall a b. (a -> b) -> a -> b
$ ((a, FragmentStreamData) -> (b, FragmentStreamData))
-> [(a, FragmentStreamData)] -> [(b, FragmentStreamData)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (a, FragmentStreamData) -> (b, FragmentStreamData)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f) [(a, FragmentStreamData)]
xs

-- | The arrow type for 'toFragment'.
newtype ToFragment a b = ToFragment (Kleisli (State Int) a b) deriving (ToFragment a a
ToFragment b c -> ToFragment a b -> ToFragment a c
(forall a. ToFragment a a)
-> (forall b c a.
    ToFragment b c -> ToFragment a b -> ToFragment a c)
-> Category ToFragment
forall a. ToFragment a a
forall b c a. ToFragment b c -> ToFragment a b -> ToFragment a c
forall k (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
    cat b c -> cat a b -> cat a c)
-> Category cat
. :: ToFragment b c -> ToFragment a b -> ToFragment a c
$c. :: forall b c a. ToFragment b c -> ToFragment a b -> ToFragment a c
id :: ToFragment a a
$cid :: forall a. ToFragment a a
Category, Category ToFragment
Category ToFragment
-> (forall b c. (b -> c) -> ToFragment b c)
-> (forall b c d. ToFragment b c -> ToFragment (b, d) (c, d))
-> (forall b c d. ToFragment b c -> ToFragment (d, b) (d, c))
-> (forall b c b' c'.
    ToFragment b c -> ToFragment b' c' -> ToFragment (b, b') (c, c'))
-> (forall b c c'.
    ToFragment b c -> ToFragment b c' -> ToFragment b (c, c'))
-> Arrow ToFragment
ToFragment b c -> ToFragment (b, d) (c, d)
ToFragment b c -> ToFragment (d, b) (d, c)
ToFragment b c -> ToFragment b' c' -> ToFragment (b, b') (c, c')
ToFragment b c -> ToFragment b c' -> ToFragment b (c, c')
(b -> c) -> ToFragment b c
forall b c. (b -> c) -> ToFragment b c
forall b c d. ToFragment b c -> ToFragment (b, d) (c, d)
forall b c d. ToFragment b c -> ToFragment (d, b) (d, c)
forall b c c'.
ToFragment b c -> ToFragment b c' -> ToFragment b (c, c')
forall b c b' c'.
ToFragment b c -> ToFragment b' c' -> ToFragment (b, b') (c, c')
forall (a :: * -> * -> *).
Category a
-> (forall b c. (b -> c) -> a b c)
-> (forall b c d. a b c -> a (b, d) (c, d))
-> (forall b c d. a b c -> a (d, b) (d, c))
-> (forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c'))
-> (forall b c c'. a b c -> a b c' -> a b (c, c'))
-> Arrow a
&&& :: ToFragment b c -> ToFragment b c' -> ToFragment b (c, c')
$c&&& :: forall b c c'.
ToFragment b c -> ToFragment b c' -> ToFragment b (c, c')
*** :: ToFragment b c -> ToFragment b' c' -> ToFragment (b, b') (c, c')
$c*** :: forall b c b' c'.
ToFragment b c -> ToFragment b' c' -> ToFragment (b, b') (c, c')
second :: ToFragment b c -> ToFragment (d, b) (d, c)
$csecond :: forall b c d. ToFragment b c -> ToFragment (d, b) (d, c)
first :: ToFragment b c -> ToFragment (b, d) (c, d)
$cfirst :: forall b c d. ToFragment b c -> ToFragment (b, d) (c, d)
arr :: (b -> c) -> ToFragment b c
$carr :: forall b c. (b -> c) -> ToFragment b c
$cp1Arrow :: Category ToFragment
Arrow)

-- | This class constraints which vertex types can be turned into fragment values, and what type those values have.
class FragmentInput a where
    -- | The type the vertex value will be turned into once it becomes a fragment value.
    type FragmentFormat a
    -- | An arrow action that turns a value from it's vertex representation to it's fragment representation. Use 'toFragment' from
    --   the GPipe provided instances to operate in this arrow. Also note that this arrow needs to be able to return a value
    --   lazily, so ensure you use
    --
    --  @proc ~pattern -> do ...@.
    toFragment :: ToFragment a (FragmentFormat a)

-- | Rasterize a stream of primitives into fragments, using a 'Side',
--   'PolygonMode', 'Viewport' and 'DepthRange' from the shader environment.
--   Primitives will be transformed from canonical view space, i.e.
--   [(-1,-1,-1),(1,1,1)], to the 2D space defined by the 'ViewPort' parameter
--   and the depth range defined by the 'DepthRange' parameter. 'PolygonMode'
--   controls whether to fill in the primitives or whether to show a wireframe
--   or points only.
rasterize:: forall p a s os f. FragmentInput a
          => (s -> (Side, PolygonMode, ViewPort, DepthRange))
          -> PrimitiveStream p (VPos, a)
          -> Shader os s (FragmentStream (FragmentFormat a))
rasterize :: (s -> (Side, PolygonMode, ViewPort, DepthRange))
-> PrimitiveStream p (VPos, a)
-> Shader os s (FragmentStream (FragmentFormat a))
rasterize s -> (Side, PolygonMode, ViewPort, DepthRange)
sf (PrimitiveStream [((VPos, a), (Maybe PointSize, PrimitiveStreamData))]
xs) = ShaderM s (FragmentStream (FragmentFormat a))
-> Shader os s (FragmentStream (FragmentFormat a))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (FragmentStream (FragmentFormat a))
 -> Shader os s (FragmentStream (FragmentFormat a)))
-> ShaderM s (FragmentStream (FragmentFormat a))
-> Shader os s (FragmentStream (FragmentFormat a))
forall a b. (a -> b) -> a -> b
$ do
        Int
n <- ShaderM s Int
forall s. ShaderM s Int
getNewName
        (RenderIOState s -> RenderIOState s) -> ShaderM s ()
forall s. (RenderIOState s -> RenderIOState s) -> ShaderM s ()
modifyRenderIO (\RenderIOState s
s -> RenderIOState s
s { rasterizationNameToRenderIO :: IntMap Int (s -> IO ())
rasterizationNameToRenderIO = Int
-> (s -> IO ())
-> IntMap Int (s -> IO ())
-> IntMap Int (s -> IO ())
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
insert Int
n s -> IO ()
io (RenderIOState s -> IntMap Int (s -> IO ())
forall s. RenderIOState s -> IntMap Int (s -> IO ())
rasterizationNameToRenderIO RenderIOState s
s) } )
        FragmentStream (FragmentFormat a)
-> ShaderM s (FragmentStream (FragmentFormat a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FragmentFormat a, FragmentStreamData)]
-> FragmentStream (FragmentFormat a)
forall a. [(a, FragmentStreamData)] -> FragmentStream a
FragmentStream ([(FragmentFormat a, FragmentStreamData)]
 -> FragmentStream (FragmentFormat a))
-> [(FragmentFormat a, FragmentStreamData)]
-> FragmentStream (FragmentFormat a)
forall a b. (a -> b) -> a -> b
$ (((VPos, a), (Maybe PointSize, PrimitiveStreamData))
 -> (FragmentFormat a, FragmentStreamData))
-> [((VPos, a), (Maybe PointSize, PrimitiveStreamData))]
-> [(FragmentFormat a, FragmentStreamData)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
-> ((VPos, a), (Maybe PointSize, PrimitiveStreamData))
-> (FragmentFormat a, FragmentStreamData)
f Int
n) [((VPos, a), (Maybe PointSize, PrimitiveStreamData))]
xs)
    where
        ToFragment (Kleisli a -> State Int (FragmentFormat a)
m) = ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment :: ToFragment a (FragmentFormat a)
        f :: Int
-> ((VPos, a), (Maybe PointSize, PrimitiveStreamData))
-> (FragmentFormat a, FragmentStreamData)
f Int
n ((VPos
p, a
x),(Maybe PointSize
ps, PrimitiveStreamData
s)) = (State Int (FragmentFormat a) -> Int -> FragmentFormat a
forall s a. State s a -> s -> a
evalState (a -> State Int (FragmentFormat a)
m a
x) Int
0, Int
-> Bool
-> ExprPos
-> PrimitiveStreamData
-> FBool
-> FragmentStreamData
FragmentStreamData Int
n Bool
False (VPos -> ExprPos
forall x a. V4 (S x a) -> ExprPos
makePos VPos
p ExprPos -> ExprPos -> ExprPos
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe PointSize -> ExprPos
forall x a. Maybe (S x a) -> ExprPos
makePointSize Maybe PointSize
ps) PrimitiveStreamData
s FBool
forall b. Boolean b => b
true)
        makePos :: V4 (S x a) -> ExprPos
makePos (V4 (S ExprM Text
x) (S ExprM Text
y) (S ExprM Text
z) (S ExprM Text
w)) = do
                                       Text
x' <- ExprM Text
x
                                       Text
y' <- ExprM Text
y
                                       Text
z' <- ExprM Text
z
                                       Text
w' <- ExprM Text
w
                                       Text -> Text -> ExprPos
tellAssignment' Text
"gl_Position" (Text -> ExprPos) -> Text -> ExprPos
forall a b. (a -> b) -> a -> b
$ Text
"vec4("Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
x'Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
","Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
y'Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
","Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
z'Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
","Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
w'Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
")"
        makePointSize :: Maybe (S x a) -> ExprPos
makePointSize Maybe (S x a)
Nothing       = () -> ExprPos
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        makePointSize (Just (S ExprM Text
ps)) = ExprM Text
ps ExprM Text -> (Text -> ExprPos) -> ExprPos
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> ExprPos
tellAssignment' Text
"gl_PointSize"
        io :: s -> IO ()
io s
s =
            let (Side
side, PolygonMode
polygonMode, ViewPort (V2 Int
x Int
y) (V2 Int
w Int
h), DepthRange Float
dmin Float
dmax) = s -> (Side, PolygonMode, ViewPort, DepthRange)
sf s
s
            in  if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                    then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"ViewPort, negative size"
                    else do Side -> IO ()
forall (m :: * -> *). MonadIO m => Side -> m ()
setGlCullFace Side
side
                            PolygonMode -> IO ()
forall (m :: * -> *). MonadIO m => PolygonMode -> m ()
setGlPolygonMode PolygonMode
polygonMode
                            GLint -> GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
glScissor (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
                            GLint -> GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
glViewport (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
                            GLdouble -> GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLdouble -> GLdouble -> m ()
glDepthRange (Float -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dmin) (Float -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dmax)
                            IO ()
setGLPointSize

        setGlCullFace :: Side -> m ()
setGlCullFace Side
Front = GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnable GLenum
forall a. (Eq a, Num a) => a
GL_CULL_FACE m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCullFace GLenum
forall a. (Eq a, Num a) => a
GL_BACK -- Back is culled when front is rasterized
        setGlCullFace Side
Back  = GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnable GLenum
forall a. (Eq a, Num a) => a
GL_CULL_FACE m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCullFace GLenum
forall a. (Eq a, Num a) => a
GL_FRONT
        setGlCullFace Side
_     = GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glDisable GLenum
forall a. (Eq a, Num a) => a
GL_CULL_FACE

        setGlPolygonMode :: PolygonMode -> m ()
setGlPolygonMode PolygonMode
PolygonFill      = GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glPolygonMode GLenum
forall a. (Eq a, Num a) => a
GL_FRONT_AND_BACK GLenum
forall a. (Eq a, Num a) => a
GL_FILL
        setGlPolygonMode PolygonMode
PolygonPoint     = do
            GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnable GLenum
forall a. (Eq a, Num a) => a
GL_PROGRAM_POINT_SIZE
            GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glPolygonMode GLenum
forall a. (Eq a, Num a) => a
GL_FRONT_AND_BACK GLenum
forall a. (Eq a, Num a) => a
GL_POINT
        setGlPolygonMode (PolygonLine Float
lw) = do
            Float -> m ()
forall (m :: * -> *). MonadIO m => Float -> m ()
glLineWidth (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
lw)
            GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glPolygonMode GLenum
forall a. (Eq a, Num a) => a
GL_FRONT_AND_BACK GLenum
forall a. (Eq a, Num a) => a
GL_LINE

        setGLPointSize :: IO ()
setGLPointSize = if (((VPos, a), (Maybe PointSize, PrimitiveStreamData)) -> Bool)
-> [((VPos, a), (Maybe PointSize, PrimitiveStreamData))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe PointSize -> Bool
forall a. Maybe a -> Bool
isJust(Maybe PointSize -> Bool)
-> (((VPos, a), (Maybe PointSize, PrimitiveStreamData))
    -> Maybe PointSize)
-> ((VPos, a), (Maybe PointSize, PrimitiveStreamData))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PointSize, PrimitiveStreamData) -> Maybe PointSize
forall a b. (a, b) -> a
fst((Maybe PointSize, PrimitiveStreamData) -> Maybe PointSize)
-> (((VPos, a), (Maybe PointSize, PrimitiveStreamData))
    -> (Maybe PointSize, PrimitiveStreamData))
-> ((VPos, a), (Maybe PointSize, PrimitiveStreamData))
-> Maybe PointSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((VPos, a), (Maybe PointSize, PrimitiveStreamData))
-> (Maybe PointSize, PrimitiveStreamData)
forall a b. (a, b) -> b
snd) [((VPos, a), (Maybe PointSize, PrimitiveStreamData))]
xs then GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnable GLenum
forall a. (Eq a, Num a) => a
GL_PROGRAM_POINT_SIZE else GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glDisable GLenum
forall a. (Eq a, Num a) => a
GL_PROGRAM_POINT_SIZE

-- | Defines which side to rasterize. Non triangle primitives only has a front side.
data Side = Front | Back | FrontAndBack
-- | Defines whether to fill the polygon or to show points or wireframes.
data PolygonMode = PolygonFill | PolygonLine Float | PolygonPoint
-- | The viewport in pixel coordinates (where (0,0) is the lower left corner) in to which the canonical view volume [(-1,-1,-1),(1,1,1)] is transformed and clipped/scissored.
data ViewPort = ViewPort { ViewPort -> V2 Int
viewPortLowerLeft :: V2 Int, ViewPort -> V2 Int
viewPortSize :: V2 Int }
-- | The fragment depth range to map the canonical view volume's z-coordinate to. Depth values are clamped to [0,1], so @DepthRange 0 1@ gives maximum depth resolution.
data DepthRange = DepthRange { DepthRange -> Float
minDepth :: Float, DepthRange -> Float
maxDepth :: Float }

-- | Filter out fragments from the stream where the predicate in the first argument evaluates to 'true', and discard all other fragments.
filterFragments :: (a -> FBool) -> FragmentStream a -> FragmentStream a
filterFragments :: (a -> FBool) -> FragmentStream a -> FragmentStream a
filterFragments a -> FBool
f (FragmentStream [(a, FragmentStreamData)]
xs) = [(a, FragmentStreamData)] -> FragmentStream a
forall a. [(a, FragmentStreamData)] -> FragmentStream a
FragmentStream ([(a, FragmentStreamData)] -> FragmentStream a)
-> [(a, FragmentStreamData)] -> FragmentStream a
forall a b. (a -> b) -> a -> b
$ ((a, FragmentStreamData) -> (a, FragmentStreamData))
-> [(a, FragmentStreamData)] -> [(a, FragmentStreamData)]
forall a b. (a -> b) -> [a] -> [b]
map (a, FragmentStreamData) -> (a, FragmentStreamData)
g [(a, FragmentStreamData)]
xs
    where g :: (a, FragmentStreamData) -> (a, FragmentStreamData)
g (a
a,FragmentStreamData Int
x1 Bool
x2 ExprPos
x3 PrimitiveStreamData
x4 FBool
x5) = (a
a,Int
-> Bool
-> ExprPos
-> PrimitiveStreamData
-> FBool
-> FragmentStreamData
FragmentStreamData Int
x1 Bool
x2 ExprPos
x3 PrimitiveStreamData
x4 (FBool
x5 FBool -> FBool -> FBool
forall b. Boolean b => b -> b -> b
&&* a -> FBool
f a
a))

data RasterizedInfo = RasterizedInfo {
        RasterizedInfo -> V4 FFloat
rasterizedFragCoord   :: V4 FFloat,
        RasterizedInfo -> FBool
rasterizedFrontFacing :: FBool,
        RasterizedInfo -> V2 FFloat
rasterizedPointCoord  :: V2 FFloat
    }

-- | Like 'fmap', but where various auto generated information from the rasterization is provided for each vertex.
withRasterizedInfo :: (a -> RasterizedInfo -> b) -> FragmentStream a -> FragmentStream b
withRasterizedInfo :: (a -> RasterizedInfo -> b) -> FragmentStream a -> FragmentStream b
withRasterizedInfo a -> RasterizedInfo -> b
f = (a -> b) -> FragmentStream a -> FragmentStream b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> a -> RasterizedInfo -> b
f a
a (V4 FFloat -> FBool -> V2 FFloat -> RasterizedInfo
RasterizedInfo (Text -> V4 FFloat
forall c a. Text -> V4 (S c a)
vec4S' Text
"gl_FragCoord") (Text -> FBool
forall c a. Text -> S c a
scalarS' Text
"gl_FrontFacing") (Text -> V2 FFloat
forall c a. Text -> V2 (S c a)
vec2S' Text
"gl_PointCoord")))

-- | A float value that is not interpolated (like integers), and all fragments will instead get the value of the primitive's last vertex
newtype FlatVFloat = Flat VFloat
-- | A float value that doesn't get divided by the interpolated position's w-component during interpolation.
newtype NoPerspectiveVFloat = NoPerspective VFloat

makeFragment :: Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment :: Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment Text
qual SType
styp a -> ExprM Text
f = Kleisli (State Int) a (S c a1) -> ToFragment a (S c a1)
forall a b. Kleisli (State Int) a b -> ToFragment a b
ToFragment (Kleisli (State Int) a (S c a1) -> ToFragment a (S c a1))
-> Kleisli (State Int) a (S c a1) -> ToFragment a (S c a1)
forall a b. (a -> b) -> a -> b
$ (a -> StateT Int Identity (S c a1))
-> Kleisli (State Int) a (S c a1)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT Int Identity (S c a1))
 -> Kleisli (State Int) a (S c a1))
-> (a -> StateT Int Identity (S c a1))
-> Kleisli (State Int) a (S c a1)
forall a b. (a -> b) -> a -> b
$ \ a
x -> do Int
n <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
                                                            Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                                                            S c a1 -> StateT Int Identity (S c a1)
forall (m :: * -> *) a. Monad m => a -> m a
return (S c a1 -> StateT Int Identity (S c a1))
-> S c a1 -> StateT Int Identity (S c a1)
forall a b. (a -> b) -> a -> b
$ ExprM Text -> S c a1
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a1) -> ExprM Text -> S c a1
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SType -> Int -> ExprM Text -> ExprM Text
useFInput Text
qual Text
"vf" SType
styp Int
n (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ a -> ExprM Text
f a
x
unFlat :: FlatVFloat -> VFloat
unFlat :: FlatVFloat -> PointSize
unFlat (Flat PointSize
s) = PointSize
s
unNPersp :: NoPerspectiveVFloat -> VFloat
unNPersp :: NoPerspectiveVFloat -> PointSize
unNPersp (NoPerspective PointSize
s) = PointSize
s

instance FragmentInput () where
    type FragmentFormat () = ()
    toFragment :: ToFragment () (FragmentFormat ())
toFragment = (() -> ()) -> ToFragment () ()
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (() -> () -> ()
forall a b. a -> b -> a
const ())

instance FragmentInput VFloat where
        type FragmentFormat VFloat = FFloat
        toFragment :: ToFragment PointSize (FragmentFormat PointSize)
toFragment = Text
-> SType
-> (PointSize -> ExprM Text)
-> ToFragment PointSize FFloat
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment Text
"" SType
STypeFloat PointSize -> ExprM Text
forall x a. S x a -> ExprM Text
unS

instance FragmentInput FlatVFloat where
        type FragmentFormat FlatVFloat = FFloat
        toFragment :: ToFragment FlatVFloat (FragmentFormat FlatVFloat)
toFragment = Text
-> SType
-> (FlatVFloat -> ExprM Text)
-> ToFragment FlatVFloat FFloat
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment Text
"flat" SType
STypeFloat (PointSize -> ExprM Text
forall x a. S x a -> ExprM Text
unS (PointSize -> ExprM Text)
-> (FlatVFloat -> PointSize) -> FlatVFloat -> ExprM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatVFloat -> PointSize
unFlat)

instance FragmentInput NoPerspectiveVFloat where
        type FragmentFormat NoPerspectiveVFloat = FFloat
        toFragment :: ToFragment NoPerspectiveVFloat (FragmentFormat NoPerspectiveVFloat)
toFragment = Text
-> SType
-> (NoPerspectiveVFloat -> ExprM Text)
-> ToFragment NoPerspectiveVFloat FFloat
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment Text
"noperspective" SType
STypeFloat (PointSize -> ExprM Text
forall x a. S x a -> ExprM Text
unS (PointSize -> ExprM Text)
-> (NoPerspectiveVFloat -> PointSize)
-> NoPerspectiveVFloat
-> ExprM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoPerspectiveVFloat -> PointSize
unNPersp)

instance FragmentInput VInt where
        type FragmentFormat VInt = FInt
        toFragment :: ToFragment VInt (FragmentFormat VInt)
toFragment = Text -> SType -> (VInt -> ExprM Text) -> ToFragment VInt (S F Int)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment Text
"flat" SType
STypeInt VInt -> ExprM Text
forall x a. S x a -> ExprM Text
unS

instance FragmentInput VWord where
        type FragmentFormat VWord = FWord
        toFragment :: ToFragment VWord (FragmentFormat VWord)
toFragment = Text
-> SType -> (VWord -> ExprM Text) -> ToFragment VWord (S F Word)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToFragment a (S c a1)
makeFragment Text
"flat" SType
STypeUInt VWord -> ExprM Text
forall x a. S x a -> ExprM Text
unS

instance FragmentInput VBool where
        type FragmentFormat VBool = FBool
        toFragment :: ToFragment VBool (FragmentFormat VBool)
toFragment = proc VBool
b -> do S F Int
i <- ToFragment VInt (S F Int)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< VBool -> VInt -> VInt -> VInt
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB VBool
b VInt
1 VInt
0 :: VInt
                                  ToFragment FBool (FragmentFormat VBool)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< S F Int
i S F Int -> S F Int -> FBool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* S F Int
1

instance (FragmentInput a) => FragmentInput (V0 a) where
    type FragmentFormat (V0 a) = V0 (FragmentFormat a)
    toFragment :: ToFragment (V0 a) (FragmentFormat (V0 a))
toFragment = (V0 a -> V0 (FragmentFormat a))
-> ToFragment (V0 a) (V0 (FragmentFormat a))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (V0 (FragmentFormat a) -> V0 a -> V0 (FragmentFormat a)
forall a b. a -> b -> a
const V0 (FragmentFormat a)
forall a. V0 a
V0)

instance (FragmentInput a) => FragmentInput (V1 a) where
    type FragmentFormat (V1 a) = V1 (FragmentFormat a)
    toFragment :: ToFragment (V1 a) (FragmentFormat (V1 a))
toFragment = proc ~(V1 a
a) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                    ToFragment (V1 (FragmentFormat a)) (FragmentFormat (V1 a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FragmentFormat a -> V1 (FragmentFormat a)
forall a. a -> V1 a
V1 FragmentFormat a
a'

instance (FragmentInput a) => FragmentInput (V2 a) where
    type FragmentFormat (V2 a) = V2 (FragmentFormat a)
    toFragment :: ToFragment (V2 a) (FragmentFormat (V2 a))
toFragment = proc ~(V2 a
a a
b) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                      FragmentFormat a
b' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
b
                                      ToFragment (V2 (FragmentFormat a)) (FragmentFormat (V2 a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FragmentFormat a -> FragmentFormat a -> V2 (FragmentFormat a)
forall a. a -> a -> V2 a
V2 FragmentFormat a
a' FragmentFormat a
b'

instance (FragmentInput a) => FragmentInput (V3 a) where
    type FragmentFormat (V3 a) = V3 (FragmentFormat a)
    toFragment :: ToFragment (V3 a) (FragmentFormat (V3 a))
toFragment = proc ~(V3 a
a a
b a
c) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                        FragmentFormat a
b' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
b
                                        FragmentFormat a
c' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
c
                                        ToFragment (V3 (FragmentFormat a)) (FragmentFormat (V3 a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FragmentFormat a
-> FragmentFormat a -> FragmentFormat a -> V3 (FragmentFormat a)
forall a. a -> a -> a -> V3 a
V3 FragmentFormat a
a' FragmentFormat a
b' FragmentFormat a
c'

instance (FragmentInput a) => FragmentInput (V4 a) where
    type FragmentFormat (V4 a) = V4 (FragmentFormat a)
    toFragment :: ToFragment (V4 a) (FragmentFormat (V4 a))
toFragment = proc ~(V4 a
a a
b a
c a
d) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                          FragmentFormat a
b' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
b
                                          FragmentFormat a
c' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
c
                                          FragmentFormat a
d' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
d
                                          ToFragment (V4 (FragmentFormat a)) (FragmentFormat (V4 a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FragmentFormat a
-> FragmentFormat a
-> FragmentFormat a
-> FragmentFormat a
-> V4 (FragmentFormat a)
forall a. a -> a -> a -> a -> V4 a
V4 FragmentFormat a
a' FragmentFormat a
b' FragmentFormat a
c' FragmentFormat a
d'

instance (FragmentInput a, FragmentInput b) => FragmentInput (a,b) where
    type FragmentFormat (a,b) = (FragmentFormat a, FragmentFormat b)
    toFragment :: ToFragment (a, b) (FragmentFormat (a, b))
toFragment = proc ~(a
a,b
b) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                   FragmentFormat b
b' <- ToFragment b (FragmentFormat b)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< b
b
                                   ToFragment
  (FragmentFormat a, FragmentFormat b) (FragmentFormat (a, b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b')

instance (FragmentInput a, FragmentInput b, FragmentInput c) => FragmentInput (a,b,c) where
    type FragmentFormat (a,b,c) = (FragmentFormat a, FragmentFormat b, FragmentFormat c)
    toFragment :: ToFragment (a, b, c) (FragmentFormat (a, b, c))
toFragment = proc ~(a
a,b
b,c
c) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                     FragmentFormat b
b' <- ToFragment b (FragmentFormat b)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< b
b
                                     FragmentFormat c
c' <- ToFragment c (FragmentFormat c)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< c
c
                                     ToFragment
  (FragmentFormat a, FragmentFormat b, FragmentFormat c)
  (FragmentFormat (a, b, c))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b', FragmentFormat c
c')

instance (FragmentInput a, FragmentInput b, FragmentInput c, FragmentInput d) => FragmentInput (a,b,c,d) where
    type FragmentFormat (a,b,c,d) = (FragmentFormat a, FragmentFormat b, FragmentFormat c, FragmentFormat d)
    toFragment :: ToFragment (a, b, c, d) (FragmentFormat (a, b, c, d))
toFragment = proc ~(a
a,b
b,c
c,d
d) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                       FragmentFormat b
b' <- ToFragment b (FragmentFormat b)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< b
b
                                       FragmentFormat c
c' <- ToFragment c (FragmentFormat c)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< c
c
                                       FragmentFormat d
d' <- ToFragment d (FragmentFormat d)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< d
d
                                       ToFragment
  (FragmentFormat a, FragmentFormat b, FragmentFormat c,
   FragmentFormat d)
  (FragmentFormat (a, b, c, d))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b', FragmentFormat c
c', FragmentFormat d
d')

instance (FragmentInput a, FragmentInput b, FragmentInput c, FragmentInput d, FragmentInput e) => FragmentInput (a,b,c,d,e) where
    type FragmentFormat (a,b,c,d,e) = (FragmentFormat a, FragmentFormat b, FragmentFormat c, FragmentFormat d, FragmentFormat e)
    toFragment :: ToFragment (a, b, c, d, e) (FragmentFormat (a, b, c, d, e))
toFragment = proc ~(a
a,b
b,c
c,d
d,e
e) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                         FragmentFormat b
b' <- ToFragment b (FragmentFormat b)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< b
b
                                         FragmentFormat c
c' <- ToFragment c (FragmentFormat c)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< c
c
                                         FragmentFormat d
d' <- ToFragment d (FragmentFormat d)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< d
d
                                         FragmentFormat e
e' <- ToFragment e (FragmentFormat e)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< e
e
                                         ToFragment
  (FragmentFormat a, FragmentFormat b, FragmentFormat c,
   FragmentFormat d, FragmentFormat e)
  (FragmentFormat (a, b, c, d, e))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b', FragmentFormat c
c', FragmentFormat d
d', FragmentFormat e
e')

instance (FragmentInput a, FragmentInput b, FragmentInput c, FragmentInput d, FragmentInput e, FragmentInput f) => FragmentInput (a,b,c,d,e,f) where
    type FragmentFormat (a,b,c,d,e,f) = (FragmentFormat a, FragmentFormat b, FragmentFormat c, FragmentFormat d, FragmentFormat e, FragmentFormat f)
    toFragment :: ToFragment (a, b, c, d, e, f) (FragmentFormat (a, b, c, d, e, f))
toFragment = proc ~(a
a,b
b,c
c,d
d,e
e,f
f) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                           FragmentFormat b
b' <- ToFragment b (FragmentFormat b)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< b
b
                                           FragmentFormat c
c' <- ToFragment c (FragmentFormat c)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< c
c
                                           FragmentFormat d
d' <- ToFragment d (FragmentFormat d)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< d
d
                                           FragmentFormat e
e' <- ToFragment e (FragmentFormat e)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< e
e
                                           FragmentFormat f
f' <- ToFragment f (FragmentFormat f)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< f
f
                                           ToFragment
  (FragmentFormat a, FragmentFormat b, FragmentFormat c,
   FragmentFormat d, FragmentFormat e, FragmentFormat f)
  (FragmentFormat (a, b, c, d, e, f))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b', FragmentFormat c
c', FragmentFormat d
d', FragmentFormat e
e', FragmentFormat f
f')

instance (FragmentInput a, FragmentInput b, FragmentInput c, FragmentInput d, FragmentInput e, FragmentInput f, FragmentInput g) => FragmentInput (a,b,c,d,e,f,g) where
    type FragmentFormat (a,b,c,d,e,f,g) = (FragmentFormat a, FragmentFormat b, FragmentFormat c, FragmentFormat d, FragmentFormat e, FragmentFormat f, FragmentFormat g)
    toFragment :: ToFragment
  (a, b, c, d, e, f, g) (FragmentFormat (a, b, c, d, e, f, g))
toFragment = proc ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) -> do FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                                             FragmentFormat b
b' <- ToFragment b (FragmentFormat b)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< b
b
                                             FragmentFormat c
c' <- ToFragment c (FragmentFormat c)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< c
c
                                             FragmentFormat d
d' <- ToFragment d (FragmentFormat d)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< d
d
                                             FragmentFormat e
e' <- ToFragment e (FragmentFormat e)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< e
e
                                             FragmentFormat f
f' <- ToFragment f (FragmentFormat f)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< f
f
                                             FragmentFormat g
g' <- ToFragment g (FragmentFormat g)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< g
g
                                             ToFragment
  (FragmentFormat a, FragmentFormat b, FragmentFormat c,
   FragmentFormat d, FragmentFormat e, FragmentFormat f,
   FragmentFormat g)
  (FragmentFormat (a, b, c, d, e, f, g))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b', FragmentFormat c
c', FragmentFormat d
d', FragmentFormat e
e', FragmentFormat f
f', FragmentFormat g
g')

instance FragmentInput a => FragmentInput (Quaternion a) where
    type FragmentFormat (Quaternion a) = Quaternion (FragmentFormat a)
    toFragment :: ToFragment (Quaternion a) (FragmentFormat (Quaternion a))
toFragment = proc ~(Quaternion a
a V3 a
v) -> do
                FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                V3 (FragmentFormat a)
v' <- ToFragment (V3 a) (V3 (FragmentFormat a))
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< V3 a
v
                ToFragment
  (Quaternion (FragmentFormat a)) (FragmentFormat (Quaternion a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FragmentFormat a
-> V3 (FragmentFormat a) -> Quaternion (FragmentFormat a)
forall a. a -> V3 a -> Quaternion a
Quaternion FragmentFormat a
a' V3 (FragmentFormat a)
v'

instance (FragmentInput (f a), FragmentInput a, FragmentFormat (f a) ~ f (FragmentFormat a)) => FragmentInput (Point f a) where
    type FragmentFormat (Point f a) = Point f (FragmentFormat a)
    toFragment :: ToFragment (Point f a) (FragmentFormat (Point f a))
toFragment = proc ~(P f a
a) -> do
                f (FragmentFormat a)
a' <- ToFragment (f a) (f (FragmentFormat a))
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< f a
a
                ToFragment
  (Point f (FragmentFormat a)) (FragmentFormat (Point f a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< f (FragmentFormat a) -> Point f (FragmentFormat a)
forall (f :: * -> *) a. f a -> Point f a
P f (FragmentFormat a)
a'

instance FragmentInput a => FragmentInput (Plucker a) where
    type FragmentFormat (Plucker a) = Plucker (FragmentFormat a)
    toFragment :: ToFragment (Plucker a) (FragmentFormat (Plucker a))
toFragment = proc ~(Plucker a
a a
b a
c a
d a
e a
f) -> do
                FragmentFormat a
a' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
a
                FragmentFormat a
b' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
b
                FragmentFormat a
c' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
c
                FragmentFormat a
d' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
d
                FragmentFormat a
e' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
e
                FragmentFormat a
f' <- ToFragment a (FragmentFormat a)
forall a. FragmentInput a => ToFragment a (FragmentFormat a)
toFragment -< a
f
                ToFragment
  (Plucker (FragmentFormat a)) (FragmentFormat (Plucker a))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FragmentFormat a
-> FragmentFormat a
-> FragmentFormat a
-> FragmentFormat a
-> FragmentFormat a
-> FragmentFormat a
-> Plucker (FragmentFormat a)
forall a. a -> a -> a -> a -> a -> a -> Plucker a
Plucker FragmentFormat a
a' FragmentFormat a
b' FragmentFormat a
c' FragmentFormat a
d' FragmentFormat a
e' FragmentFormat a
f'