{-# LANGUAGE Arrows                     #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}

{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-unused-foralls #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
module Graphics.GPipe.Internal.GeometryStream where

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

import           Control.Arrow                           (Arrow (arr, first),
                                                          Kleisli (Kleisli),
                                                          returnA)
import           Control.Category                        (Category (..))
import qualified Control.Monad.Trans.Class               as T (lift)
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.Text.Lazy                          (Text)
import           Graphics.GL.Core45
import           Graphics.GPipe.Internal.Compiler        (RenderIOState (rasterizationNameToRenderIO, transformFeedbackToRenderIO))
import           Graphics.GPipe.Internal.Expr            (ExprM,
                                                          GGenerativeGeometry,
                                                          GlobDeclM, S (..),
                                                          SType (..), VBool,
                                                          VFloat, VInt, VWord,
                                                          declareGeometryLayout,
                                                          stypeName,
                                                          tellAssignment',
                                                          tellGlobal,
                                                          tellGlobalLn, tellST,
                                                          tshow, useFInputFromG,
                                                          useGInput)
import           Graphics.GPipe.Internal.FragmentStream  (DepthRange (DepthRange),
                                                          FlatVFloat (..),
                                                          FragmentInput (FragmentFormat),
                                                          FragmentStream (..),
                                                          FragmentStreamData (..),
                                                          NoPerspectiveVFloat (..),
                                                          PolygonMode (..),
                                                          Side (Back, Front),
                                                          VPos,
                                                          ViewPort (ViewPort),
                                                          unFlat, unNPersp)
import           Graphics.GPipe.Internal.PrimitiveArray  (Geometry (..), Lines,
                                                          LinesWithAdjacency,
                                                          Points,
                                                          PrimitiveTopology (..),
                                                          Triangles,
                                                          TrianglesWithAdjacency)
import           Graphics.GPipe.Internal.PrimitiveStream (PointSize,
                                                          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 (..))
import           Prelude                                 hiding (id, length,
                                                          (.))

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

type GeometrizationName = Int

type LayoutName = Text

data GeometryStreamData = GeometryStreamData GeometrizationName LayoutName PrimitiveStreamData

newtype GeometryStream a = GeometryStream [(a, GeometryStreamData)] deriving (b -> GeometryStream a -> GeometryStream a
NonEmpty (GeometryStream a) -> GeometryStream a
GeometryStream a -> GeometryStream a -> GeometryStream a
(GeometryStream a -> GeometryStream a -> GeometryStream a)
-> (NonEmpty (GeometryStream a) -> GeometryStream a)
-> (forall b.
    Integral b =>
    b -> GeometryStream a -> GeometryStream a)
-> Semigroup (GeometryStream a)
forall b. Integral b => b -> GeometryStream a -> GeometryStream a
forall a. NonEmpty (GeometryStream a) -> GeometryStream a
forall a. GeometryStream a -> GeometryStream a -> GeometryStream a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> GeometryStream a -> GeometryStream a
stimes :: b -> GeometryStream a -> GeometryStream a
$cstimes :: forall a b. Integral b => b -> GeometryStream a -> GeometryStream a
sconcat :: NonEmpty (GeometryStream a) -> GeometryStream a
$csconcat :: forall a. NonEmpty (GeometryStream a) -> GeometryStream a
<> :: GeometryStream a -> GeometryStream a -> GeometryStream a
$c<> :: forall a. GeometryStream a -> GeometryStream a -> GeometryStream a
Semigroup, Semigroup (GeometryStream a)
GeometryStream a
Semigroup (GeometryStream a)
-> GeometryStream a
-> (GeometryStream a -> GeometryStream a -> GeometryStream a)
-> ([GeometryStream a] -> GeometryStream a)
-> Monoid (GeometryStream a)
[GeometryStream a] -> GeometryStream a
GeometryStream a -> GeometryStream a -> GeometryStream a
forall a. Semigroup (GeometryStream a)
forall a. GeometryStream a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [GeometryStream a] -> GeometryStream a
forall a. GeometryStream a -> GeometryStream a -> GeometryStream a
mconcat :: [GeometryStream a] -> GeometryStream a
$cmconcat :: forall a. [GeometryStream a] -> GeometryStream a
mappend :: GeometryStream a -> GeometryStream a -> GeometryStream a
$cmappend :: forall a. GeometryStream a -> GeometryStream a -> GeometryStream a
mempty :: GeometryStream a
$cmempty :: forall a. GeometryStream a
$cp1Monoid :: forall a. Semigroup (GeometryStream a)
Monoid)

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

newtype ToGeometry a b = ToGeometry (Kleisli (State (Int, Int)) a b) deriving (ToGeometry a a
ToGeometry b c -> ToGeometry a b -> ToGeometry a c
(forall a. ToGeometry a a)
-> (forall b c a.
    ToGeometry b c -> ToGeometry a b -> ToGeometry a c)
-> Category ToGeometry
forall a. ToGeometry a a
forall b c a. ToGeometry b c -> ToGeometry a b -> ToGeometry 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
. :: ToGeometry b c -> ToGeometry a b -> ToGeometry a c
$c. :: forall b c a. ToGeometry b c -> ToGeometry a b -> ToGeometry a c
id :: ToGeometry a a
$cid :: forall a. ToGeometry a a
Category, Category ToGeometry
Category ToGeometry
-> (forall b c. (b -> c) -> ToGeometry b c)
-> (forall b c d. ToGeometry b c -> ToGeometry (b, d) (c, d))
-> (forall b c d. ToGeometry b c -> ToGeometry (d, b) (d, c))
-> (forall b c b' c'.
    ToGeometry b c -> ToGeometry b' c' -> ToGeometry (b, b') (c, c'))
-> (forall b c c'.
    ToGeometry b c -> ToGeometry b c' -> ToGeometry b (c, c'))
-> Arrow ToGeometry
ToGeometry b c -> ToGeometry (b, d) (c, d)
ToGeometry b c -> ToGeometry (d, b) (d, c)
ToGeometry b c -> ToGeometry b' c' -> ToGeometry (b, b') (c, c')
ToGeometry b c -> ToGeometry b c' -> ToGeometry b (c, c')
(b -> c) -> ToGeometry b c
forall b c. (b -> c) -> ToGeometry b c
forall b c d. ToGeometry b c -> ToGeometry (b, d) (c, d)
forall b c d. ToGeometry b c -> ToGeometry (d, b) (d, c)
forall b c c'.
ToGeometry b c -> ToGeometry b c' -> ToGeometry b (c, c')
forall b c b' c'.
ToGeometry b c -> ToGeometry b' c' -> ToGeometry (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
&&& :: ToGeometry b c -> ToGeometry b c' -> ToGeometry b (c, c')
$c&&& :: forall b c c'.
ToGeometry b c -> ToGeometry b c' -> ToGeometry b (c, c')
*** :: ToGeometry b c -> ToGeometry b' c' -> ToGeometry (b, b') (c, c')
$c*** :: forall b c b' c'.
ToGeometry b c -> ToGeometry b' c' -> ToGeometry (b, b') (c, c')
second :: ToGeometry b c -> ToGeometry (d, b) (d, c)
$csecond :: forall b c d. ToGeometry b c -> ToGeometry (d, b) (d, c)
first :: ToGeometry b c -> ToGeometry (b, d) (c, d)
$cfirst :: forall b c d. ToGeometry b c -> ToGeometry (b, d) (c, d)
arr :: (b -> c) -> ToGeometry b c
$carr :: forall b c. (b -> c) -> ToGeometry b c
$cp1Arrow :: Category ToGeometry
Arrow)

-- TODO Merge PrimitiveTopology and GeometryInput?
class (AnotherVertexInput a, PrimitiveTopology p) => GeometryInput p a where
    toGeometry :: ToGeometry a (Geometry p a)

newtype ToAnotherVertex a b = ToAnotherVertex (Kleisli (State (Int, Int)) (Int, a) b)

instance Category ToAnotherVertex where
    {-# INLINE id #-}
    id :: ToAnotherVertex a a
id = Kleisli (State (Int, Int)) (Int, a) a -> ToAnotherVertex a a
forall a b.
Kleisli (State (Int, Int)) (Int, a) b -> ToAnotherVertex a b
ToAnotherVertex (Kleisli (State (Int, Int)) (Int, a) a -> ToAnotherVertex a a)
-> Kleisli (State (Int, Int)) (Int, a) a -> ToAnotherVertex a a
forall a b. (a -> b) -> a -> b
$ proc ~(Int
i, a
x) -> do
        Kleisli (State (Int, Int)) a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
x
    {-# INLINE (.) #-}
    ToAnotherVertex Kleisli (State (Int, Int)) (Int, b) c
g . :: ToAnotherVertex b c -> ToAnotherVertex a b -> ToAnotherVertex a c
. ToAnotherVertex Kleisli (State (Int, Int)) (Int, a) b
f = Kleisli (State (Int, Int)) (Int, a) c -> ToAnotherVertex a c
forall a b.
Kleisli (State (Int, Int)) (Int, a) b -> ToAnotherVertex a b
ToAnotherVertex (Kleisli (State (Int, Int)) (Int, a) c -> ToAnotherVertex a c)
-> Kleisli (State (Int, Int)) (Int, a) c -> ToAnotherVertex a c
forall a b. (a -> b) -> a -> b
$ proc ~(Int
i, a
x) -> do
        b
y <- Kleisli (State (Int, Int)) (Int, a) b
f -< (Int
i, a
x)
        c
z <- Kleisli (State (Int, Int)) (Int, b) c
g -< (Int
i, b
y)
        Kleisli (State (Int, Int)) c c
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< c
z

instance Arrow ToAnotherVertex where
    {-# INLINE arr #-}
    arr :: (b -> c) -> ToAnotherVertex b c
arr b -> c
f = Kleisli (State (Int, Int)) (Int, b) c -> ToAnotherVertex b c
forall a b.
Kleisli (State (Int, Int)) (Int, a) b -> ToAnotherVertex a b
ToAnotherVertex (((Int, b) -> c) -> Kleisli (State (Int, Int)) (Int, b) c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b -> c
f (b -> c) -> ((Int, b) -> b) -> (Int, b) -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int, b) -> b
forall a b. (a, b) -> b
snd))
    {-# INLINE first #-}
    first :: ToAnotherVertex b c -> ToAnotherVertex (b, d) (c, d)
first (ToAnotherVertex Kleisli (State (Int, Int)) (Int, b) c
f) = Kleisli (State (Int, Int)) (Int, (b, d)) (c, d)
-> ToAnotherVertex (b, d) (c, d)
forall a b.
Kleisli (State (Int, Int)) (Int, a) b -> ToAnotherVertex a b
ToAnotherVertex (Kleisli (State (Int, Int)) (Int, (b, d)) (c, d)
 -> ToAnotherVertex (b, d) (c, d))
-> Kleisli (State (Int, Int)) (Int, (b, d)) (c, d)
-> ToAnotherVertex (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ proc ~(Int
i, (b
x, d
z)) -> do
        c
y <- Kleisli (State (Int, Int)) (Int, b) c
f -< (Int
i, b
x)
        Kleisli (State (Int, Int)) (c, d) (c, d)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (c
y, d
z)

class AnotherVertexInput a where
    toAnotherVertex :: ToAnotherVertex a a

instance AnotherVertexInput a => GeometryInput Points a where
    toGeometry :: ToGeometry a (Geometry Points a)
toGeometry = Kleisli (State (Int, Int)) a (Geometry Points a)
-> ToGeometry a (Geometry Points a)
forall a b. Kleisli (State (Int, Int)) a b -> ToGeometry a b
ToGeometry (Kleisli (State (Int, Int)) a (Geometry Points a)
 -> ToGeometry a (Geometry Points a))
-> Kleisli (State (Int, Int)) a (Geometry Points a)
-> ToGeometry a (Geometry Points a)
forall a b. (a -> b) -> a -> b
$ (a -> StateT (Int, Int) Identity (Geometry Points a))
-> Kleisli (State (Int, Int)) a (Geometry Points a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT (Int, Int) Identity (Geometry Points a))
 -> Kleisli (State (Int, Int)) a (Geometry Points a))
-> (a -> StateT (Int, Int) Identity (Geometry Points a))
-> Kleisli (State (Int, Int)) a (Geometry Points a)
forall a b. (a -> b) -> a -> b
$ \a
x -> do
        let ToAnotherVertex (Kleisli (Int, a) -> State (Int, Int) a
m) = ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex :: ToAnotherVertex a a
        a
x0 <- (Int, a) -> State (Int, Int) a
m (Int
0, a
x)
        Geometry Points a -> StateT (Int, Int) Identity (Geometry Points a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Geometry Points a
 -> StateT (Int, Int) Identity (Geometry Points a))
-> Geometry Points a
-> StateT (Int, Int) Identity (Geometry Points a)
forall a b. (a -> b) -> a -> b
$ a -> Geometry Points a
forall a. a -> Geometry Points a
Point a
x0

instance AnotherVertexInput a => GeometryInput Lines a where
    toGeometry :: ToGeometry a (Geometry Lines a)
toGeometry = Kleisli (State (Int, Int)) a (Geometry Lines a)
-> ToGeometry a (Geometry Lines a)
forall a b. Kleisli (State (Int, Int)) a b -> ToGeometry a b
ToGeometry (Kleisli (State (Int, Int)) a (Geometry Lines a)
 -> ToGeometry a (Geometry Lines a))
-> Kleisli (State (Int, Int)) a (Geometry Lines a)
-> ToGeometry a (Geometry Lines a)
forall a b. (a -> b) -> a -> b
$ (a -> StateT (Int, Int) Identity (Geometry Lines a))
-> Kleisli (State (Int, Int)) a (Geometry Lines a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT (Int, Int) Identity (Geometry Lines a))
 -> Kleisli (State (Int, Int)) a (Geometry Lines a))
-> (a -> StateT (Int, Int) Identity (Geometry Lines a))
-> Kleisli (State (Int, Int)) a (Geometry Lines a)
forall a b. (a -> b) -> a -> b
$ \a
x -> do
        let ToAnotherVertex (Kleisli (Int, a) -> State (Int, Int) a
m) = ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex :: ToAnotherVertex a a
        a
x0 <- (Int, a) -> State (Int, Int) a
m (Int
0, a
x)
        a
x1 <- (Int, a) -> State (Int, Int) a
m (Int
1, a
x)
        Geometry Lines a -> StateT (Int, Int) Identity (Geometry Lines a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Geometry Lines a -> StateT (Int, Int) Identity (Geometry Lines a))
-> Geometry Lines a
-> StateT (Int, Int) Identity (Geometry Lines a)
forall a b. (a -> b) -> a -> b
$ a -> a -> Geometry Lines a
forall a. a -> a -> Geometry Lines a
Line a
x0 a
x1

instance AnotherVertexInput a => GeometryInput LinesWithAdjacency a where
    toGeometry :: ToGeometry a (Geometry LinesWithAdjacency a)
toGeometry = Kleisli (State (Int, Int)) a (Geometry LinesWithAdjacency a)
-> ToGeometry a (Geometry LinesWithAdjacency a)
forall a b. Kleisli (State (Int, Int)) a b -> ToGeometry a b
ToGeometry (Kleisli (State (Int, Int)) a (Geometry LinesWithAdjacency a)
 -> ToGeometry a (Geometry LinesWithAdjacency a))
-> Kleisli (State (Int, Int)) a (Geometry LinesWithAdjacency a)
-> ToGeometry a (Geometry LinesWithAdjacency a)
forall a b. (a -> b) -> a -> b
$ (a -> StateT (Int, Int) Identity (Geometry LinesWithAdjacency a))
-> Kleisli (State (Int, Int)) a (Geometry LinesWithAdjacency a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT (Int, Int) Identity (Geometry LinesWithAdjacency a))
 -> Kleisli (State (Int, Int)) a (Geometry LinesWithAdjacency a))
-> (a
    -> StateT (Int, Int) Identity (Geometry LinesWithAdjacency a))
-> Kleisli (State (Int, Int)) a (Geometry LinesWithAdjacency a)
forall a b. (a -> b) -> a -> b
$ \a
x -> do
        let ToAnotherVertex (Kleisli (Int, a) -> State (Int, Int) a
m) = ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex :: ToAnotherVertex a a
        a
x0 <- (Int, a) -> State (Int, Int) a
m (Int
0, a
x)
        a
x1 <- (Int, a) -> State (Int, Int) a
m (Int
1, a
x)
        a
x2 <- (Int, a) -> State (Int, Int) a
m (Int
2, a
x)
        a
x3 <- (Int, a) -> State (Int, Int) a
m (Int
3, a
x)
        Geometry LinesWithAdjacency a
-> StateT (Int, Int) Identity (Geometry LinesWithAdjacency a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Geometry LinesWithAdjacency a
 -> StateT (Int, Int) Identity (Geometry LinesWithAdjacency a))
-> Geometry LinesWithAdjacency a
-> StateT (Int, Int) Identity (Geometry LinesWithAdjacency a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Geometry LinesWithAdjacency a
forall a. a -> a -> a -> a -> Geometry LinesWithAdjacency a
LineWithAdjacency a
x0 a
x1 a
x2 a
x3

instance AnotherVertexInput a => GeometryInput Triangles a where
    toGeometry :: ToGeometry a (Geometry Triangles a)
toGeometry = Kleisli (State (Int, Int)) a (Geometry Triangles a)
-> ToGeometry a (Geometry Triangles a)
forall a b. Kleisli (State (Int, Int)) a b -> ToGeometry a b
ToGeometry (Kleisli (State (Int, Int)) a (Geometry Triangles a)
 -> ToGeometry a (Geometry Triangles a))
-> Kleisli (State (Int, Int)) a (Geometry Triangles a)
-> ToGeometry a (Geometry Triangles a)
forall a b. (a -> b) -> a -> b
$ (a -> StateT (Int, Int) Identity (Geometry Triangles a))
-> Kleisli (State (Int, Int)) a (Geometry Triangles a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT (Int, Int) Identity (Geometry Triangles a))
 -> Kleisli (State (Int, Int)) a (Geometry Triangles a))
-> (a -> StateT (Int, Int) Identity (Geometry Triangles a))
-> Kleisli (State (Int, Int)) a (Geometry Triangles a)
forall a b. (a -> b) -> a -> b
$ \a
x -> do
        let ToAnotherVertex (Kleisli (Int, a) -> State (Int, Int) a
m) = ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex :: ToAnotherVertex a a
        a
x0 <- (Int, a) -> State (Int, Int) a
m (Int
0, a
x)
        a
x1 <- (Int, a) -> State (Int, Int) a
m (Int
1, a
x)
        a
x2 <- (Int, a) -> State (Int, Int) a
m (Int
2, a
x)
        Geometry Triangles a
-> StateT (Int, Int) Identity (Geometry Triangles a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Geometry Triangles a
 -> StateT (Int, Int) Identity (Geometry Triangles a))
-> Geometry Triangles a
-> StateT (Int, Int) Identity (Geometry Triangles a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Geometry Triangles a
forall a. a -> a -> a -> Geometry Triangles a
Triangle a
x0 a
x1 a
x2

instance AnotherVertexInput a => GeometryInput TrianglesWithAdjacency a where
    toGeometry :: ToGeometry a (Geometry TrianglesWithAdjacency a)
toGeometry = Kleisli (State (Int, Int)) a (Geometry TrianglesWithAdjacency a)
-> ToGeometry a (Geometry TrianglesWithAdjacency a)
forall a b. Kleisli (State (Int, Int)) a b -> ToGeometry a b
ToGeometry (Kleisli (State (Int, Int)) a (Geometry TrianglesWithAdjacency a)
 -> ToGeometry a (Geometry TrianglesWithAdjacency a))
-> Kleisli (State (Int, Int)) a (Geometry TrianglesWithAdjacency a)
-> ToGeometry a (Geometry TrianglesWithAdjacency a)
forall a b. (a -> b) -> a -> b
$ (a
 -> StateT (Int, Int) Identity (Geometry TrianglesWithAdjacency a))
-> Kleisli (State (Int, Int)) a (Geometry TrianglesWithAdjacency a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a
  -> StateT (Int, Int) Identity (Geometry TrianglesWithAdjacency a))
 -> Kleisli
      (State (Int, Int)) a (Geometry TrianglesWithAdjacency a))
-> (a
    -> StateT (Int, Int) Identity (Geometry TrianglesWithAdjacency a))
-> Kleisli (State (Int, Int)) a (Geometry TrianglesWithAdjacency a)
forall a b. (a -> b) -> a -> b
$ \a
x -> do
        let ToAnotherVertex (Kleisli (Int, a) -> State (Int, Int) a
m) = ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex :: ToAnotherVertex a a
        a
x0 <- (Int, a) -> State (Int, Int) a
m (Int
0, a
x)
        a
x1 <- (Int, a) -> State (Int, Int) a
m (Int
1, a
x)
        a
x2 <- (Int, a) -> State (Int, Int) a
m (Int
2, a
x)
        a
x3 <- (Int, a) -> State (Int, Int) a
m (Int
3, a
x)
        a
x4 <- (Int, a) -> State (Int, Int) a
m (Int
4, a
x)
        a
x5 <- (Int, a) -> State (Int, Int) a
m (Int
5, a
x)
        Geometry TrianglesWithAdjacency a
-> StateT (Int, Int) Identity (Geometry TrianglesWithAdjacency a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Geometry TrianglesWithAdjacency a
 -> StateT (Int, Int) Identity (Geometry TrianglesWithAdjacency a))
-> Geometry TrianglesWithAdjacency a
-> StateT (Int, Int) Identity (Geometry TrianglesWithAdjacency a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> a -> a -> Geometry TrianglesWithAdjacency a
forall a.
a -> a -> a -> a -> a -> a -> Geometry TrianglesWithAdjacency a
TriangleWithAdjacency a
x0 a
x1 a
x2 a
x3 a
x4 a
x5

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

-- makeAnotherVertex :: Text -> SType -> ((S c a) -> ExprM Text) -> ToAnotherVertex (S c a) (S c a)
makeAnotherVertex :: Text -> SType -> (b -> ExprM Text) -> (S c a -> b) -> ToAnotherVertex b b
makeAnotherVertex :: Text
-> SType
-> (b -> ExprM Text)
-> (S c a -> b)
-> ToAnotherVertex b b
makeAnotherVertex Text
qual SType
styp b -> ExprM Text
f S c a -> b
f' = Kleisli (State (Int, Int)) (Int, b) b -> ToAnotherVertex b b
forall a b.
Kleisli (State (Int, Int)) (Int, a) b -> ToAnotherVertex a b
ToAnotherVertex (Kleisli (State (Int, Int)) (Int, b) b -> ToAnotherVertex b b)
-> Kleisli (State (Int, Int)) (Int, b) b -> ToAnotherVertex b b
forall a b. (a -> b) -> a -> b
$ ((Int, b) -> StateT (Int, Int) Identity b)
-> Kleisli (State (Int, Int)) (Int, b) b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (((Int, b) -> StateT (Int, Int) Identity b)
 -> Kleisli (State (Int, Int)) (Int, b) b)
-> ((Int, b) -> StateT (Int, Int) Identity b)
-> Kleisli (State (Int, Int)) (Int, b) b
forall a b. (a -> b) -> a -> b
$ \ (Int
i, b
x) -> do
    (Int
j, Int
n) <- StateT (Int, Int) Identity (Int, Int)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let n' :: Int
n' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then Int
n else Int
0 -- reset when index change
    (Int, Int) -> StateT (Int, Int) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
i, Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    b -> StateT (Int, Int) Identity b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> StateT (Int, Int) Identity b)
-> b -> StateT (Int, Int) Identity b
forall a b. (a -> b) -> a -> b
$ S c a -> b
f' (S c a -> b) -> S c a -> b
forall a b. (a -> b) -> a -> b
$ ExprM Text -> S c a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a) -> ExprM Text -> S c a
forall a b. (a -> b) -> a -> b
$ Text -> SType -> Int -> Int -> ExprM Text -> ExprM Text
useGInput Text
qual SType
styp Int
i Int
n' (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ b -> ExprM Text
f b
x

instance AnotherVertexInput () where
    toAnotherVertex :: ToAnotherVertex () ()
toAnotherVertex = (() -> ()) -> ToAnotherVertex () ()
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (() -> () -> ()
forall a b. a -> b -> a
const ())

instance AnotherVertexInput VFloat where
    toAnotherVertex :: ToAnotherVertex VFloat VFloat
toAnotherVertex = Text
-> SType
-> (VFloat -> ExprM Text)
-> (VFloat -> VFloat)
-> ToAnotherVertex VFloat VFloat
forall b c a.
Text
-> SType
-> (b -> ExprM Text)
-> (S c a -> b)
-> ToAnotherVertex b b
makeAnotherVertex Text
"" SType
STypeFloat VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat -> VFloat
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance AnotherVertexInput FlatVFloat where
    toAnotherVertex :: ToAnotherVertex FlatVFloat FlatVFloat
toAnotherVertex = Text
-> SType
-> (FlatVFloat -> ExprM Text)
-> (VFloat -> FlatVFloat)
-> ToAnotherVertex FlatVFloat FlatVFloat
forall b c a.
Text
-> SType
-> (b -> ExprM Text)
-> (S c a -> b)
-> ToAnotherVertex b b
makeAnotherVertex Text
"flat" SType
STypeFloat (VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS (VFloat -> ExprM Text)
-> (FlatVFloat -> VFloat) -> FlatVFloat -> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FlatVFloat -> VFloat
unFlat) VFloat -> FlatVFloat
Flat

instance AnotherVertexInput NoPerspectiveVFloat where
    toAnotherVertex :: ToAnotherVertex NoPerspectiveVFloat NoPerspectiveVFloat
toAnotherVertex = Text
-> SType
-> (NoPerspectiveVFloat -> ExprM Text)
-> (VFloat -> NoPerspectiveVFloat)
-> ToAnotherVertex NoPerspectiveVFloat NoPerspectiveVFloat
forall b c a.
Text
-> SType
-> (b -> ExprM Text)
-> (S c a -> b)
-> ToAnotherVertex b b
makeAnotherVertex Text
"noperspective" SType
STypeFloat (VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS (VFloat -> ExprM Text)
-> (NoPerspectiveVFloat -> VFloat)
-> NoPerspectiveVFloat
-> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NoPerspectiveVFloat -> VFloat
unNPersp) VFloat -> NoPerspectiveVFloat
NoPerspective

instance AnotherVertexInput VInt where
    toAnotherVertex :: ToAnotherVertex VInt VInt
toAnotherVertex = Text
-> SType
-> (VInt -> ExprM Text)
-> (VInt -> VInt)
-> ToAnotherVertex VInt VInt
forall b c a.
Text
-> SType
-> (b -> ExprM Text)
-> (S c a -> b)
-> ToAnotherVertex b b
makeAnotherVertex Text
"flat" SType
STypeInt VInt -> ExprM Text
forall x a. S x a -> ExprM Text
unS VInt -> VInt
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance AnotherVertexInput VWord where
    toAnotherVertex :: ToAnotherVertex VWord VWord
toAnotherVertex = Text
-> SType
-> (VWord -> ExprM Text)
-> (VWord -> VWord)
-> ToAnotherVertex VWord VWord
forall b c a.
Text
-> SType
-> (b -> ExprM Text)
-> (S c a -> b)
-> ToAnotherVertex b b
makeAnotherVertex Text
"flat" SType
STypeUInt VWord -> ExprM Text
forall x a. S x a -> ExprM Text
unS VWord -> VWord
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance AnotherVertexInput VBool where
    toAnotherVertex :: ToAnotherVertex VBool VBool
toAnotherVertex = proc VBool
b -> do
        VInt
i <- ToAnotherVertex VInt VInt
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< VBool -> VInt -> VInt -> VInt
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB VBool
b VInt
1 VInt
0 :: VInt
        ToAnotherVertex VBool VBool
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< VInt
i VInt -> VInt -> VBool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* VInt
1

instance (AnotherVertexInput a) => AnotherVertexInput (V0 a) where
    toAnotherVertex :: ToAnotherVertex (V0 a) (V0 a)
toAnotherVertex = (V0 a -> V0 a) -> ToAnotherVertex (V0 a) (V0 a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (V0 a -> V0 a -> V0 a
forall a b. a -> b -> a
const V0 a
forall a. V0 a
V0)

instance (AnotherVertexInput a) => AnotherVertexInput (V1 a) where
    toAnotherVertex :: ToAnotherVertex (V1 a) (V1 a)
toAnotherVertex = proc ~(V1 a
a) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        ToAnotherVertex (V1 a) (V1 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> V1 a
forall a. a -> V1 a
V1 a
a'

instance (AnotherVertexInput a) => AnotherVertexInput (V2 a) where
    toAnotherVertex :: ToAnotherVertex (V2 a) (V2 a)
toAnotherVertex = proc ~(V2 a
a a
b) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        a
b' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
b
        ToAnotherVertex (V2 a) (V2 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
a' a
b'

instance (AnotherVertexInput a) => AnotherVertexInput (V3 a) where
    toAnotherVertex :: ToAnotherVertex (V3 a) (V3 a)
toAnotherVertex = proc ~(V3 a
a a
b a
c) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        a
b' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
b
        a
c' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
c
        ToAnotherVertex (V3 a) (V3 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
a' a
b' a
c'

instance (AnotherVertexInput a) => AnotherVertexInput (V4 a) where
    toAnotherVertex :: ToAnotherVertex (V4 a) (V4 a)
toAnotherVertex = proc ~(V4 a
a a
b a
c a
d) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        a
b' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
b
        a
c' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
c
        a
d' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
d
        ToAnotherVertex (V4 a) (V4 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a' a
b' a
c' a
d'

instance (AnotherVertexInput a, AnotherVertexInput b) => AnotherVertexInput (a,b) where
    toAnotherVertex :: ToAnotherVertex (a, b) (a, b)
toAnotherVertex = proc ~(a
a,b
b) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        b
b' <- ToAnotherVertex b b
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< b
b
        ToAnotherVertex (a, b) (a, b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b')

instance (AnotherVertexInput a, AnotherVertexInput b, AnotherVertexInput c) => AnotherVertexInput (a,b,c) where
    toAnotherVertex :: ToAnotherVertex (a, b, c) (a, b, c)
toAnotherVertex = proc ~(a
a,b
b,c
c) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        b
b' <- ToAnotherVertex b b
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< b
b
        c
c' <- ToAnotherVertex c c
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< c
c
        ToAnotherVertex (a, b, c) (a, b, c)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c')

instance (AnotherVertexInput a, AnotherVertexInput b, AnotherVertexInput c, AnotherVertexInput d) => AnotherVertexInput (a,b,c,d) where
    toAnotherVertex :: ToAnotherVertex (a, b, c, d) (a, b, c, d)
toAnotherVertex = proc ~(a
a,b
b,c
c,d
d) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        b
b' <- ToAnotherVertex b b
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< b
b
        c
c' <- ToAnotherVertex c c
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< c
c
        d
d' <- ToAnotherVertex d d
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< d
d
        ToAnotherVertex (a, b, c, d) (a, b, c, d)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d')

instance (AnotherVertexInput a, AnotherVertexInput b, AnotherVertexInput c, AnotherVertexInput d, AnotherVertexInput e) => AnotherVertexInput (a,b,c,d,e) where
    toAnotherVertex :: ToAnotherVertex (a, b, c, d, e) (a, b, c, d, e)
toAnotherVertex = proc ~(a
a,b
b,c
c,d
d,e
e) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        b
b' <- ToAnotherVertex b b
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< b
b
        c
c' <- ToAnotherVertex c c
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< c
c
        d
d' <- ToAnotherVertex d d
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< d
d
        e
e' <- ToAnotherVertex e e
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< e
e
        ToAnotherVertex (a, b, c, d, e) (a, b, c, d, e)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d', e
e')

instance (AnotherVertexInput a, AnotherVertexInput b, AnotherVertexInput c, AnotherVertexInput d, AnotherVertexInput e, AnotherVertexInput f) => AnotherVertexInput (a,b,c,d,e,f) where
    toAnotherVertex :: ToAnotherVertex (a, b, c, d, e, f) (a, b, c, d, e, f)
toAnotherVertex = proc ~(a
a,b
b,c
c,d
d,e
e,f
f) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        b
b' <- ToAnotherVertex b b
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< b
b
        c
c' <- ToAnotherVertex c c
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< c
c
        d
d' <- ToAnotherVertex d d
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< d
d
        e
e' <- ToAnotherVertex e e
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< e
e
        f
f' <- ToAnotherVertex f f
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< f
f
        ToAnotherVertex (a, b, c, d, e, f) (a, b, c, d, e, f)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d', e
e', f
f')

instance (AnotherVertexInput a, AnotherVertexInput b, AnotherVertexInput c, AnotherVertexInput d, AnotherVertexInput e, AnotherVertexInput f, AnotherVertexInput g) => AnotherVertexInput (a,b,c,d,e,f,g) where
    toAnotherVertex :: ToAnotherVertex (a, b, c, d, e, f, g) (a, b, c, d, e, f, g)
toAnotherVertex = proc ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        b
b' <- ToAnotherVertex b b
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< b
b
        c
c' <- ToAnotherVertex c c
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< c
c
        d
d' <- ToAnotherVertex d d
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< d
d
        e
e' <- ToAnotherVertex e e
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< e
e
        f
f' <- ToAnotherVertex f f
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< f
f
        g
g' <- ToAnotherVertex g g
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< g
g
        ToAnotherVertex (a, b, c, d, e, f, g) (a, b, c, d, e, f, g)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d', e
e', f
f', g
g')

instance AnotherVertexInput a => AnotherVertexInput (Quaternion a) where
    toAnotherVertex :: ToAnotherVertex (Quaternion a) (Quaternion a)
toAnotherVertex = proc ~(Quaternion a
a V3 a
v) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        V3 a
v' <- ToAnotherVertex (V3 a) (V3 a)
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< V3 a
v
        ToAnotherVertex (Quaternion a) (Quaternion a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> V3 a -> Quaternion a
forall a. a -> V3 a -> Quaternion a
Quaternion a
a' V3 a
v'

instance AnotherVertexInput a => AnotherVertexInput (Plucker a) where
    toAnotherVertex :: ToAnotherVertex (Plucker a) (Plucker a)
toAnotherVertex = proc ~(Plucker a
a a
b a
c a
d a
e a
f) -> do
        a
a' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
a
        a
b' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
b
        a
c' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
c
        a
d' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
d
        a
e' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
e
        a
f' <- ToAnotherVertex a a
forall a. AnotherVertexInput a => ToAnotherVertex a a
toAnotherVertex -< a
f
        ToAnotherVertex (Plucker a) (Plucker a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> a -> a -> a -> a -> Plucker a
forall a. a -> a -> a -> a -> a -> a -> Plucker a
Plucker a
a' a
b' a
c' a
d' a
e' a
f'

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

geometrize :: forall p a s os f. GeometryInput p a => PrimitiveStream p a -> Shader os s (GeometryStream (Geometry p a))
geometrize :: PrimitiveStream p a -> Shader os s (GeometryStream (Geometry p a))
geometrize (PrimitiveStream [(a, (Maybe VFloat, PrimitiveStreamData))]
xs) = ShaderM s (GeometryStream (Geometry p a))
-> Shader os s (GeometryStream (Geometry p a))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (GeometryStream (Geometry p a))
 -> Shader os s (GeometryStream (Geometry p a)))
-> ShaderM s (GeometryStream (Geometry p a))
-> Shader os s (GeometryStream (Geometry p 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 { transformFeedbackToRenderIO :: IntMap Int (s -> GLuint -> IO ())
transformFeedbackToRenderIO = Int
-> (s -> GLuint -> IO ())
-> IntMap Int (s -> GLuint -> IO ())
-> IntMap Int (s -> GLuint -> IO ())
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
insert Int
n s -> GLuint -> IO ()
forall (m :: * -> *) p p. Monad m => p -> p -> m ()
io (RenderIOState s -> IntMap Int (s -> GLuint -> IO ())
forall s. RenderIOState s -> IntMap Int (s -> GLuint -> IO ())
transformFeedbackToRenderIO RenderIOState s
s) } )
        GeometryStream (Geometry p a)
-> ShaderM s (GeometryStream (Geometry p a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Geometry p a, GeometryStreamData)]
-> GeometryStream (Geometry p a)
forall a. [(a, GeometryStreamData)] -> GeometryStream a
GeometryStream ([(Geometry p a, GeometryStreamData)]
 -> GeometryStream (Geometry p a))
-> [(Geometry p a, GeometryStreamData)]
-> GeometryStream (Geometry p a)
forall a b. (a -> b) -> a -> b
$ ((a, (Maybe VFloat, PrimitiveStreamData))
 -> (Geometry p a, GeometryStreamData))
-> [(a, (Maybe VFloat, PrimitiveStreamData))]
-> [(Geometry p a, GeometryStreamData)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
-> (a, (Maybe VFloat, PrimitiveStreamData))
-> (Geometry p a, GeometryStreamData)
f Int
n) [(a, (Maybe VFloat, PrimitiveStreamData))]
xs)
    where
        ToGeometry (Kleisli a -> State (Int, Int) (Geometry p a)
m) = ToGeometry a (Geometry p a)
forall p a. GeometryInput p a => ToGeometry a (Geometry p a)
toGeometry :: ToGeometry a (Geometry p a)
        f :: GeometrizationName -> (a, (Maybe PointSize, PrimitiveStreamData)) -> (Geometry p a, GeometryStreamData)
        f :: Int
-> (a, (Maybe VFloat, PrimitiveStreamData))
-> (Geometry p a, GeometryStreamData)
f Int
n (a
x, (Maybe VFloat
_, PrimitiveStreamData
s)) = (State (Int, Int) (Geometry p a) -> (Int, Int) -> Geometry p a
forall s a. State s a -> s -> a
evalState (a -> State (Int, Int) (Geometry p a)
m a
x) (Int
0, Int
0), Int -> Text -> PrimitiveStreamData -> GeometryStreamData
GeometryStreamData Int
n (p -> Text
forall p. PrimitiveTopology p => p -> Text
toLayoutIn (p
forall a. HasCallStack => a
undefined :: p)) PrimitiveStreamData
s)
        io :: p -> p -> m ()
io p
_ p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

notMeantToBeRead :: Text
notMeantToBeRead :: Text
notMeantToBeRead = Text
"false" -- error "a generative geometry is inherently a write-only value"

generativePoints :: FragmentInput a => GGenerativeGeometry Points a
generativePoints :: GGenerativeGeometry Points a
generativePoints = ExprM Text -> GGenerativeGeometry Points a
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry Points a)
-> ExprM Text -> GGenerativeGeometry Points a
forall a b. (a -> b) -> a -> b
$ Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

generativeLineStrip :: FragmentInput a => GGenerativeGeometry Lines a
generativeLineStrip :: GGenerativeGeometry Lines a
generativeLineStrip = ExprM Text -> GGenerativeGeometry Lines a
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry Lines a)
-> ExprM Text -> GGenerativeGeometry Lines a
forall a b. (a -> b) -> a -> b
$ Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

generativeTriangleStrip :: FragmentInput a => GGenerativeGeometry Triangles a
generativeTriangleStrip :: GGenerativeGeometry Triangles a
generativeTriangleStrip = ExprM Text -> GGenerativeGeometry Triangles a
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry Triangles a)
-> ExprM Text -> GGenerativeGeometry Triangles a
forall a b. (a -> b) -> a -> b
$ Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

emitVertex :: GeometryExplosive a => a -> GGenerativeGeometry p a -> GGenerativeGeometry p a
emitVertex :: a -> GGenerativeGeometry p a -> GGenerativeGeometry p a
emitVertex a
a GGenerativeGeometry p a
g = ExprM Text -> GGenerativeGeometry p a
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry p a)
-> ExprM Text -> GGenerativeGeometry p a
forall a b. (a -> b) -> a -> b
$ do
    Text
g' <- GGenerativeGeometry p a -> ExprM Text
forall x a. S x a -> ExprM Text
unS GGenerativeGeometry p a
g
    a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
a Int
0
    StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO ()
 -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"EmitVertex();\n"
    Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

emitVertexPosition :: GeometryExplosive a => (VPos, a) -> GGenerativeGeometry p (VPos, a) -> GGenerativeGeometry p (VPos, a)
emitVertexPosition :: (VPos, a)
-> GGenerativeGeometry p (VPos, a)
-> GGenerativeGeometry p (VPos, a)
emitVertexPosition (V4 VFloat
x VFloat
y VFloat
z VFloat
w, a
a) GGenerativeGeometry p (VPos, a)
g = ExprM Text -> GGenerativeGeometry p (VPos, a)
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry p (VPos, a))
-> ExprM Text -> GGenerativeGeometry p (VPos, a)
forall a b. (a -> b) -> a -> b
$ do
    Text
g' <- GGenerativeGeometry p (VPos, a) -> ExprM Text
forall x a. S x a -> ExprM Text
unS GGenerativeGeometry p (VPos, a)
g
    Text
x' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
x
    Text
y' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
y
    Text
z' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
z
    Text
w' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
w
    Text -> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
tellAssignment' Text
"gl_Position" (Text -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
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
")"
    a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
a Int
0
    StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO ()
 -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"EmitVertex();\n"
    Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

emitVertexLayer :: GeometryExplosive a => (VInt, a) -> GGenerativeGeometry p (VInt, a) -> GGenerativeGeometry p (VInt, a)
emitVertexLayer :: (VInt, a)
-> GGenerativeGeometry p (VInt, a)
-> GGenerativeGeometry p (VInt, a)
emitVertexLayer (VInt
i, a
a) GGenerativeGeometry p (VInt, a)
g = ExprM Text -> GGenerativeGeometry p (VInt, a)
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry p (VInt, a))
-> ExprM Text -> GGenerativeGeometry p (VInt, a)
forall a b. (a -> b) -> a -> b
$ do
    Text
g' <- GGenerativeGeometry p (VInt, a) -> ExprM Text
forall x a. S x a -> ExprM Text
unS GGenerativeGeometry p (VInt, a)
g
    Text
i' <- VInt -> ExprM Text
forall x a. S x a -> ExprM Text
unS VInt
i
    Text -> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
tellAssignment' Text
"gl_Layer" Text
i'
    StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO ()
 -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"EmitVertex();\n"
    Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

emitVertexPositionAndLayer :: GeometryExplosive a => ((VPos, VInt), a) -> GGenerativeGeometry p ((VPos, VInt), a) -> GGenerativeGeometry p ((VPos, VInt), a)
emitVertexPositionAndLayer :: ((VPos, VInt), a)
-> GGenerativeGeometry p ((VPos, VInt), a)
-> GGenerativeGeometry p ((VPos, VInt), a)
emitVertexPositionAndLayer ((V4 VFloat
x VFloat
y VFloat
z VFloat
w, VInt
i), a
a) GGenerativeGeometry p ((VPos, VInt), a)
g = ExprM Text -> GGenerativeGeometry p ((VPos, VInt), a)
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry p ((VPos, VInt), a))
-> ExprM Text -> GGenerativeGeometry p ((VPos, VInt), a)
forall a b. (a -> b) -> a -> b
$ do
    Text
g' <- GGenerativeGeometry p ((VPos, VInt), a) -> ExprM Text
forall x a. S x a -> ExprM Text
unS GGenerativeGeometry p ((VPos, VInt), a)
g
    Text
x' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
x
    Text
y' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
y
    Text
z' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
z
    Text
w' <- VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS VFloat
w
    Text -> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
tellAssignment' Text
"gl_Position" (Text -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
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
")"
    a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
a Int
0
    Text
i' <- VInt -> ExprM Text
forall x a. S x a -> ExprM Text
unS VInt
i
    Text -> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
tellAssignment' Text
"gl_Layer" Text
i'
    StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO ()
 -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"EmitVertex();\n"
    Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

endPrimitive :: GGenerativeGeometry p a -> GGenerativeGeometry p a
endPrimitive :: GGenerativeGeometry p a -> GGenerativeGeometry p a
endPrimitive GGenerativeGeometry p a
g = ExprM Text -> GGenerativeGeometry p a
forall x a. ExprM Text -> S x a
S (ExprM Text -> GGenerativeGeometry p a)
-> ExprM Text -> GGenerativeGeometry p a
forall a b. (a -> b) -> a -> b
$ do
    Text
g' <- GGenerativeGeometry p a -> ExprM Text
forall x a. S x a -> ExprM Text
unS GGenerativeGeometry p a
g
    StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO ()
 -> SNMapReaderT [Text] (StateT ExprState IO) ())
-> StateT ExprState IO ()
-> SNMapReaderT [Text] (StateT ExprState IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"EndPrimitive();\n"
    Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
notMeantToBeRead

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

class FragmentInput a => GeometryExplosive a where
    exploseGeometry :: a -> Int -> ExprM Int
    declareGeometry :: a -> State Int (GlobDeclM ())
    enumerateVaryings :: a -> State Int [Text]

defaultExploseGeometry :: (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry :: (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry t -> S x a
f t
x Int
n = do
    let name :: Text
name = Text
"vgf" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
    Text
x' <- S x a -> ExprM Text
forall x a. S x a -> ExprM Text
unS (t -> S x a
f t
x)
    Text -> Text -> SNMapReaderT [Text] (StateT ExprState IO) ()
tellAssignment' Text
name Text
x'
    Int -> ExprM Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

defaultDeclareGeometry :: SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry :: SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
t 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    let name :: Text
name = Text
"vgf" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
    GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ do
        Text -> GlobDeclM ()
tellGlobal Text
"out "
        Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
t
        Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

defaultEnumerateVaryings :: a -> State Int [Text]
defaultEnumerateVaryings :: a -> State Int [Text]
defaultEnumerateVaryings 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    [Text] -> State Int [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
"vgf" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n]

instance GeometryExplosive () where
    exploseGeometry :: () -> Int -> ExprM Int
exploseGeometry ()
_ Int
n = Int -> ExprM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
    declareGeometry :: () -> State Int (GlobDeclM ())
declareGeometry ()
_ = GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> GlobDeclM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    enumerateVaryings :: () -> State Int [Text]
enumerateVaryings ()
_ = [Text] -> State Int [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []

instance GeometryExplosive VFloat where
    exploseGeometry :: VFloat -> Int -> ExprM Int
exploseGeometry = (VFloat -> VFloat) -> VFloat -> Int -> ExprM Int
forall t x a. (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry VFloat -> VFloat
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    declareGeometry :: VFloat -> State Int (GlobDeclM ())
declareGeometry = SType -> VFloat -> State Int (GlobDeclM ())
forall a. SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
STypeFloat
    enumerateVaryings :: VFloat -> State Int [Text]
enumerateVaryings = VFloat -> State Int [Text]
forall a. a -> State Int [Text]
defaultEnumerateVaryings

instance GeometryExplosive FlatVFloat where
    exploseGeometry :: FlatVFloat -> Int -> ExprM Int
exploseGeometry = (FlatVFloat -> VFloat) -> FlatVFloat -> Int -> ExprM Int
forall t x a. (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry FlatVFloat -> VFloat
unFlat
    declareGeometry :: FlatVFloat -> State Int (GlobDeclM ())
declareGeometry = SType -> FlatVFloat -> State Int (GlobDeclM ())
forall a. SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
STypeFloat
    enumerateVaryings :: FlatVFloat -> State Int [Text]
enumerateVaryings = FlatVFloat -> State Int [Text]
forall a. a -> State Int [Text]
defaultEnumerateVaryings

instance GeometryExplosive NoPerspectiveVFloat where
    exploseGeometry :: NoPerspectiveVFloat -> Int -> ExprM Int
exploseGeometry = (NoPerspectiveVFloat -> VFloat)
-> NoPerspectiveVFloat -> Int -> ExprM Int
forall t x a. (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry NoPerspectiveVFloat -> VFloat
unNPersp
    declareGeometry :: NoPerspectiveVFloat -> State Int (GlobDeclM ())
declareGeometry = SType -> NoPerspectiveVFloat -> State Int (GlobDeclM ())
forall a. SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
STypeFloat
    enumerateVaryings :: NoPerspectiveVFloat -> State Int [Text]
enumerateVaryings = NoPerspectiveVFloat -> State Int [Text]
forall a. a -> State Int [Text]
defaultEnumerateVaryings

instance GeometryExplosive VInt where
    exploseGeometry :: VInt -> Int -> ExprM Int
exploseGeometry = (VInt -> VInt) -> VInt -> Int -> ExprM Int
forall t x a. (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry VInt -> VInt
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    declareGeometry :: VInt -> State Int (GlobDeclM ())
declareGeometry = SType -> VInt -> State Int (GlobDeclM ())
forall a. SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
STypeInt
    enumerateVaryings :: VInt -> State Int [Text]
enumerateVaryings = VInt -> State Int [Text]
forall a. a -> State Int [Text]
defaultEnumerateVaryings

instance GeometryExplosive VWord where
    exploseGeometry :: VWord -> Int -> ExprM Int
exploseGeometry = (VWord -> VWord) -> VWord -> Int -> ExprM Int
forall t x a. (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry VWord -> VWord
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    declareGeometry :: VWord -> State Int (GlobDeclM ())
declareGeometry = SType -> VWord -> State Int (GlobDeclM ())
forall a. SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
STypeUInt
    enumerateVaryings :: VWord -> State Int [Text]
enumerateVaryings = VWord -> State Int [Text]
forall a. a -> State Int [Text]
defaultEnumerateVaryings

instance GeometryExplosive VBool where
    exploseGeometry :: VBool -> Int -> ExprM Int
exploseGeometry = (VBool -> VBool) -> VBool -> Int -> ExprM Int
forall t x a. (t -> S x a) -> t -> Int -> ExprM Int
defaultExploseGeometry VBool -> VBool
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    declareGeometry :: VBool -> State Int (GlobDeclM ())
declareGeometry = SType -> VBool -> State Int (GlobDeclM ())
forall a. SType -> a -> State Int (GlobDeclM ())
defaultDeclareGeometry SType
STypeBool
    enumerateVaryings :: VBool -> State Int [Text]
enumerateVaryings = VBool -> State Int [Text]
forall a. a -> State Int [Text]
defaultEnumerateVaryings

instance (GeometryExplosive a) => GeometryExplosive (V0 a) where
    exploseGeometry :: V0 a -> Int -> ExprM Int
exploseGeometry V0 a
V0 = Int -> ExprM Int
forall (m :: * -> *) a. Monad m => a -> m a
return
    declareGeometry :: V0 a -> State Int (GlobDeclM ())
declareGeometry V0 a
V0 = GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> GlobDeclM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    enumerateVaryings :: V0 a -> State Int [Text]
enumerateVaryings V0 a
V0 = [Text] -> State Int [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []

instance (GeometryExplosive a) => GeometryExplosive (V1 a) where
    exploseGeometry :: V1 a -> Int -> ExprM Int
exploseGeometry (V1 a
x) Int
n = do
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n
    declareGeometry :: V1 a -> State Int (GlobDeclM ())
declareGeometry ~(V1 a
x) = do
        a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x
    enumerateVaryings :: V1 a -> State Int [Text]
enumerateVaryings ~(V1 a
x) =
        a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x

instance (GeometryExplosive a) => GeometryExplosive (V2 a) where
    exploseGeometry :: V2 a -> Int -> ExprM Int
exploseGeometry (V2 a
x a
y) Int
n = do
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
y
    declareGeometry :: V2 a -> State Int (GlobDeclM ())
declareGeometry ~(V2 a
x a
y) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
y]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: V2 a -> State Int [Text]
enumerateVaryings ~(V2 a
x a
y) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
y]

instance (GeometryExplosive a) => GeometryExplosive (V3 a) where
    exploseGeometry :: V3 a -> Int -> ExprM Int
exploseGeometry (V3 a
x a
y a
z) Int
n = do
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
z
    declareGeometry :: V3 a -> State Int (GlobDeclM ())
declareGeometry ~(V3 a
x a
y a
z) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
y, a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
z]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: V3 a -> State Int [Text]
enumerateVaryings ~(V3 a
x a
y a
z) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
y, a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
z]

instance (GeometryExplosive a) => GeometryExplosive (V4 a) where
    exploseGeometry :: V4 a -> Int -> ExprM Int
exploseGeometry (V4 a
x a
y a
z a
w) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
z ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
w
    declareGeometry :: V4 a -> State Int (GlobDeclM ())
declareGeometry ~(V4 a
x a
y a
z a
w) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
y, a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
z, a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
w]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: V4 a -> State Int [Text]
enumerateVaryings ~(V4 a
x a
y a
z a
w) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
y, a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
z, a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
w]

instance (GeometryExplosive a, GeometryExplosive b) => GeometryExplosive (a,b) where
    exploseGeometry :: (a, b) -> Int -> ExprM Int
exploseGeometry (a
x, b
y) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry b
y
    declareGeometry :: (a, b) -> State Int (GlobDeclM ())
declareGeometry ~(a
x, b
y) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, b -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry b
y]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: (a, b) -> State Int [Text]
enumerateVaryings ~(a
x, b
y) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, b -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings b
y]

instance (GeometryExplosive a, GeometryExplosive b, GeometryExplosive c) => GeometryExplosive (a,b,c) where
    exploseGeometry :: (a, b, c) -> Int -> ExprM Int
exploseGeometry (a
x, b
y, c
z) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry b
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry c
z
    declareGeometry :: (a, b, c) -> State Int (GlobDeclM ())
declareGeometry ~(a
x, b
y, c
z) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, b -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry b
y, c -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry c
z]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: (a, b, c) -> State Int [Text]
enumerateVaryings ~(a
x, b
y, c
z) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, b -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings b
y, c -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings c
z]

instance (GeometryExplosive a, GeometryExplosive b, GeometryExplosive c, GeometryExplosive d) => GeometryExplosive (a,b,c,d) where
    exploseGeometry :: (a, b, c, d) -> Int -> ExprM Int
exploseGeometry (a
x, b
y, c
z, d
w) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry b
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry c
z ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry d
w
    declareGeometry :: (a, b, c, d) -> State Int (GlobDeclM ())
declareGeometry ~(a
x, b
y, c
z, d
w) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, b -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry b
y, c -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry c
z, d -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry d
w]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: (a, b, c, d) -> State Int [Text]
enumerateVaryings ~(a
x, b
y, c
z, d
w) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, b -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings b
y, c -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings c
z, d -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings d
w]

instance (GeometryExplosive a, GeometryExplosive b, GeometryExplosive c, GeometryExplosive d, GeometryExplosive e) => GeometryExplosive (a,b,c,d,e) where
    exploseGeometry :: (a, b, c, d, e) -> Int -> ExprM Int
exploseGeometry (a
x, b
y, c
z, d
w, e
r) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry b
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry c
z ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry d
w ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= e -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry e
r
    declareGeometry :: (a, b, c, d, e) -> State Int (GlobDeclM ())
declareGeometry ~(a
x, b
y, c
z, d
w, e
r) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, b -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry b
y, c -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry c
z, d -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry d
w, e -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry e
r]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: (a, b, c, d, e) -> State Int [Text]
enumerateVaryings ~(a
x, b
y, c
z, d
w, e
r) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, b -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings b
y, c -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings c
z, d -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings d
w, e -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings e
r]

instance (GeometryExplosive a, GeometryExplosive b, GeometryExplosive c, GeometryExplosive d, GeometryExplosive e, GeometryExplosive f) => GeometryExplosive (a,b,c,d,e,f) where
    exploseGeometry :: (a, b, c, d, e, f) -> Int -> ExprM Int
exploseGeometry (a
x, b
y, c
z, d
w, e
r, f
s) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry b
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry c
z ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry d
w ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= e -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry e
r ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry f
s
    declareGeometry :: (a, b, c, d, e, f) -> State Int (GlobDeclM ())
declareGeometry ~(a
x, b
y, c
z, d
w, e
r, f
s) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, b -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry b
y, c -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry c
z, d -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry d
w, e -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry e
r, f -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry f
s]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: (a, b, c, d, e, f) -> State Int [Text]
enumerateVaryings ~(a
x, b
y, c
z, d
w, e
r, f
s) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, b -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings b
y, c -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings c
z, d -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings d
w, e -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings e
r, f -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings f
s]

instance (GeometryExplosive a, GeometryExplosive b, GeometryExplosive c, GeometryExplosive d, GeometryExplosive e, GeometryExplosive f, GeometryExplosive g) => GeometryExplosive (a,b,c,d,e,f,g) where
    exploseGeometry :: (a, b, c, d, e, f, g) -> Int -> ExprM Int
exploseGeometry (a
x, b
y, c
z, d
w, e
r, f
s, g
t) Int
n =
        a -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry a
x Int
n ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry b
y ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry c
z ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry d
w ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= e -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry e
r ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry f
s ExprM Int -> (Int -> ExprM Int) -> ExprM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= g -> Int -> ExprM Int
forall a. GeometryExplosive a => a -> Int -> ExprM Int
exploseGeometry g
t
    declareGeometry :: (a, b, c, d, e, f, g) -> State Int (GlobDeclM ())
declareGeometry ~(a
x, b
y, c
z, d
w, e
r, f
s, g
t) = do
        [GlobDeclM ()]
ws <- [State Int (GlobDeclM ())] -> StateT Int Identity [GlobDeclM ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry a
x, b -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry b
y, c -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry c
z, d -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry d
w, e -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry e
r, f -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry f
s, g -> State Int (GlobDeclM ())
forall a. GeometryExplosive a => a -> State Int (GlobDeclM ())
declareGeometry g
t]
        GlobDeclM () -> State Int (GlobDeclM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobDeclM () -> State Int (GlobDeclM ()))
-> GlobDeclM () -> State Int (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
ws
    enumerateVaryings :: (a, b, c, d, e, f, g) -> State Int [Text]
enumerateVaryings ~(a
x, b
y, c
z, d
w, e
r, f
s, g
t) =
        [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> StateT Int Identity [[Text]] -> State Int [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State Int [Text]] -> StateT Int Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [a -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings a
x, b -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings b
y, c -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings c
z, d -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings d
w, e -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings e
r, f -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings f
s, g -> State Int [Text]
forall a. GeometryExplosive a => a -> State Int [Text]
enumerateVaryings g
t]

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

newtype ToFragmentFromGeometry a b = ToFragmentFromGeometry (Kleisli (State Int) a b) deriving (ToFragmentFromGeometry a a
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry a b -> ToFragmentFromGeometry a c
(forall a. ToFragmentFromGeometry a a)
-> (forall b c a.
    ToFragmentFromGeometry b c
    -> ToFragmentFromGeometry a b -> ToFragmentFromGeometry a c)
-> Category ToFragmentFromGeometry
forall a. ToFragmentFromGeometry a a
forall b c a.
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry a b -> ToFragmentFromGeometry 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
. :: ToFragmentFromGeometry b c
-> ToFragmentFromGeometry a b -> ToFragmentFromGeometry a c
$c. :: forall b c a.
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry a b -> ToFragmentFromGeometry a c
id :: ToFragmentFromGeometry a a
$cid :: forall a. ToFragmentFromGeometry a a
Category, Category ToFragmentFromGeometry
Category ToFragmentFromGeometry
-> (forall b c. (b -> c) -> ToFragmentFromGeometry b c)
-> (forall b c d.
    ToFragmentFromGeometry b c -> ToFragmentFromGeometry (b, d) (c, d))
-> (forall b c d.
    ToFragmentFromGeometry b c -> ToFragmentFromGeometry (d, b) (d, c))
-> (forall b c b' c'.
    ToFragmentFromGeometry b c
    -> ToFragmentFromGeometry b' c'
    -> ToFragmentFromGeometry (b, b') (c, c'))
-> (forall b c c'.
    ToFragmentFromGeometry b c
    -> ToFragmentFromGeometry b c' -> ToFragmentFromGeometry b (c, c'))
-> Arrow ToFragmentFromGeometry
ToFragmentFromGeometry b c -> ToFragmentFromGeometry (b, d) (c, d)
ToFragmentFromGeometry b c -> ToFragmentFromGeometry (d, b) (d, c)
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b' c'
-> ToFragmentFromGeometry (b, b') (c, c')
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b c' -> ToFragmentFromGeometry b (c, c')
(b -> c) -> ToFragmentFromGeometry b c
forall b c. (b -> c) -> ToFragmentFromGeometry b c
forall b c d.
ToFragmentFromGeometry b c -> ToFragmentFromGeometry (b, d) (c, d)
forall b c d.
ToFragmentFromGeometry b c -> ToFragmentFromGeometry (d, b) (d, c)
forall b c c'.
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b c' -> ToFragmentFromGeometry b (c, c')
forall b c b' c'.
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b' c'
-> ToFragmentFromGeometry (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
&&& :: ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b c' -> ToFragmentFromGeometry b (c, c')
$c&&& :: forall b c c'.
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b c' -> ToFragmentFromGeometry b (c, c')
*** :: ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b' c'
-> ToFragmentFromGeometry (b, b') (c, c')
$c*** :: forall b c b' c'.
ToFragmentFromGeometry b c
-> ToFragmentFromGeometry b' c'
-> ToFragmentFromGeometry (b, b') (c, c')
second :: ToFragmentFromGeometry b c -> ToFragmentFromGeometry (d, b) (d, c)
$csecond :: forall b c d.
ToFragmentFromGeometry b c -> ToFragmentFromGeometry (d, b) (d, c)
first :: ToFragmentFromGeometry b c -> ToFragmentFromGeometry (b, d) (c, d)
$cfirst :: forall b c d.
ToFragmentFromGeometry b c -> ToFragmentFromGeometry (b, d) (c, d)
arr :: (b -> c) -> ToFragmentFromGeometry b c
$carr :: forall b c. (b -> c) -> ToFragmentFromGeometry b c
$cp1Arrow :: Category ToFragmentFromGeometry
Arrow)

class FragmentInputFromGeometry p a where
    toFragmentFromGeometry :: ToFragmentFromGeometry (GGenerativeGeometry p (b, a)) (FragmentFormat a)

instance FragmentCreator a => FragmentInputFromGeometry Triangles a where
    toFragmentFromGeometry :: ToFragmentFromGeometry
  (GGenerativeGeometry Triangles (b, a)) (FragmentFormat a)
toFragmentFromGeometry = Kleisli
  (State Int)
  (GGenerativeGeometry Triangles (b, a))
  (FragmentFormat a)
-> ToFragmentFromGeometry
     (GGenerativeGeometry Triangles (b, a)) (FragmentFormat a)
forall a b. Kleisli (State Int) a b -> ToFragmentFromGeometry a b
ToFragmentFromGeometry (Kleisli
   (State Int)
   (GGenerativeGeometry Triangles (b, a))
   (FragmentFormat a)
 -> ToFragmentFromGeometry
      (GGenerativeGeometry Triangles (b, a)) (FragmentFormat a))
-> Kleisli
     (State Int)
     (GGenerativeGeometry Triangles (b, a))
     (FragmentFormat a)
-> ToFragmentFromGeometry
     (GGenerativeGeometry Triangles (b, a)) (FragmentFormat a)
forall a b. (a -> b) -> a -> b
$ (GGenerativeGeometry Triangles (b, a)
 -> StateT Int Identity (FragmentFormat a))
-> Kleisli
     (State Int)
     (GGenerativeGeometry Triangles (b, a))
     (FragmentFormat a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((GGenerativeGeometry Triangles (b, a)
  -> StateT Int Identity (FragmentFormat a))
 -> Kleisli
      (State Int)
      (GGenerativeGeometry Triangles (b, a))
      (FragmentFormat a))
-> (GGenerativeGeometry Triangles (b, a)
    -> StateT Int Identity (FragmentFormat a))
-> Kleisli
     (State Int)
     (GGenerativeGeometry Triangles (b, a))
     (FragmentFormat a)
forall a b. (a -> b) -> a -> b
$ \GGenerativeGeometry Triangles (b, a)
x -> do
        let ToAnotherFragment (Kleisli a -> StateT Int Identity (FragmentFormat a)
m) = ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 :: ToAnotherFragment a (FragmentFormat a)
        a -> StateT Int Identity (FragmentFormat a)
m (State Int a -> Int -> a
forall s a. State s a -> s -> a
evalState (State Int a
forall a. FragmentCreator a => State Int a
createFragment :: State Int a) Int
0)

-- Note: from other constraint, b happens to be VPos or (VPos, VInt).
generateAndRasterize :: forall p b a s os f. (FragmentInputFromGeometry p a, PrimitiveTopology p)
        => (s -> (Side, PolygonMode, ViewPort, DepthRange))
        -> Int
        -> GeometryStream (GGenerativeGeometry p (b, a))
        -> Shader os s (FragmentStream (FragmentFormat a))
generateAndRasterize :: (s -> (Side, PolygonMode, ViewPort, DepthRange))
-> Int
-> GeometryStream (GGenerativeGeometry p (b, a))
-> Shader os s (FragmentStream (FragmentFormat a))
generateAndRasterize s -> (Side, PolygonMode, ViewPort, DepthRange)
sf Int
maxVertices (GeometryStream [(GGenerativeGeometry p (b, a), GeometryStreamData)]
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
$ ((GGenerativeGeometry p (b, a), GeometryStreamData)
 -> (FragmentFormat a, FragmentStreamData))
-> [(GGenerativeGeometry p (b, a), GeometryStreamData)]
-> [(FragmentFormat a, FragmentStreamData)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
-> (GGenerativeGeometry p (b, a), GeometryStreamData)
-> (FragmentFormat a, FragmentStreamData)
f Int
n) [(GGenerativeGeometry p (b, a), GeometryStreamData)]
xs)
    where
        ToFragmentFromGeometry (Kleisli GGenerativeGeometry p (b, a) -> State Int (FragmentFormat a)
m) = ToFragmentFromGeometry
  (GGenerativeGeometry p (b, a)) (FragmentFormat a)
forall p a b.
FragmentInputFromGeometry p a =>
ToFragmentFromGeometry
  (GGenerativeGeometry p (b, a)) (FragmentFormat a)
toFragmentFromGeometry :: ToFragmentFromGeometry (GGenerativeGeometry p (b, a)) (FragmentFormat a)
        f :: Int -> (GGenerativeGeometry p (b, a), GeometryStreamData) -> (FragmentFormat a, FragmentStreamData)
        f :: Int
-> (GGenerativeGeometry p (b, a), GeometryStreamData)
-> (FragmentFormat a, FragmentStreamData)
f Int
n (GGenerativeGeometry p (b, a)
x, GeometryStreamData Int
name Text
layout PrimitiveStreamData
psd) = (State Int (FragmentFormat a) -> Int -> FragmentFormat a
forall s a. State s a -> s -> a
evalState (GGenerativeGeometry p (b, a) -> State Int (FragmentFormat a)
m GGenerativeGeometry p (b, a)
x) Int
0, Int
-> Bool
-> SNMapReaderT [Text] (StateT ExprState IO) ()
-> PrimitiveStreamData
-> FBool
-> FragmentStreamData
FragmentStreamData Int
n Bool
True (Text
-> GGenerativeGeometry p (b, a)
-> SNMapReaderT [Text] (StateT ExprState IO) ()
makePrims Text
layout GGenerativeGeometry p (b, a)
x) PrimitiveStreamData
psd FBool
forall b. Boolean b => b
true)

        makePrims :: Text
-> GGenerativeGeometry p (b, a)
-> SNMapReaderT [Text] (StateT ExprState IO) ()
makePrims Text
a GGenerativeGeometry p (b, a)
x = do
            Text -> Text -> Int -> SNMapReaderT [Text] (StateT ExprState IO) ()
declareGeometryLayout Text
a (p -> Text
forall p. PrimitiveTopology p => p -> Text
toLayoutOut (p
forall a. HasCallStack => a
undefined :: p)) Int
maxVertices
            Text
x' <- GGenerativeGeometry p (b, a) -> ExprM Text
forall x a. S x a -> ExprM Text
unS GGenerativeGeometry p (b, a)
x
            () -> SNMapReaderT [Text] (StateT ExprState IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        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 = GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
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
>> GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glCullFace GLuint
forall a. (Eq a, Num a) => a
GL_BACK -- Back is culled when front is rasterized
        setGlCullFace Side
Back  = GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
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
>> GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glCullFace GLuint
forall a. (Eq a, Num a) => a
GL_FRONT
        setGlCullFace Side
_     = GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_CULL_FACE

        setGlPolygonMode :: PolygonMode -> m ()
setGlPolygonMode PolygonMode
PolygonFill      = GLuint -> GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glPolygonMode GLuint
forall a. (Eq a, Num a) => a
GL_FRONT_AND_BACK GLuint
forall a. (Eq a, Num a) => a
GL_FILL
        setGlPolygonMode PolygonMode
PolygonPoint     = do
            GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEnable GLuint
forall a. (Eq a, Num a) => a
GL_PROGRAM_POINT_SIZE
            GLuint -> GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glPolygonMode GLuint
forall a. (Eq a, Num a) => a
GL_FRONT_AND_BACK GLuint
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)
            GLuint -> GLuint -> m ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glPolygonMode GLuint
forall a. (Eq a, Num a) => a
GL_FRONT_AND_BACK GLuint
forall a. (Eq a, Num a) => a
GL_LINE

        setGLPointSize :: IO ()
setGLPointSize = GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDisable GLuint
forall a. (Eq a, Num a) => a
GL_PROGRAM_POINT_SIZE

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

newtype ToAnotherFragment a b = ToAnotherFragment (Kleisli (State Int) a b) deriving (ToAnotherFragment a a
ToAnotherFragment b c
-> ToAnotherFragment a b -> ToAnotherFragment a c
(forall a. ToAnotherFragment a a)
-> (forall b c a.
    ToAnotherFragment b c
    -> ToAnotherFragment a b -> ToAnotherFragment a c)
-> Category ToAnotherFragment
forall a. ToAnotherFragment a a
forall b c a.
ToAnotherFragment b c
-> ToAnotherFragment a b -> ToAnotherFragment 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
. :: ToAnotherFragment b c
-> ToAnotherFragment a b -> ToAnotherFragment a c
$c. :: forall b c a.
ToAnotherFragment b c
-> ToAnotherFragment a b -> ToAnotherFragment a c
id :: ToAnotherFragment a a
$cid :: forall a. ToAnotherFragment a a
Category, Category ToAnotherFragment
Category ToAnotherFragment
-> (forall b c. (b -> c) -> ToAnotherFragment b c)
-> (forall b c d.
    ToAnotherFragment b c -> ToAnotherFragment (b, d) (c, d))
-> (forall b c d.
    ToAnotherFragment b c -> ToAnotherFragment (d, b) (d, c))
-> (forall b c b' c'.
    ToAnotherFragment b c
    -> ToAnotherFragment b' c' -> ToAnotherFragment (b, b') (c, c'))
-> (forall b c c'.
    ToAnotherFragment b c
    -> ToAnotherFragment b c' -> ToAnotherFragment b (c, c'))
-> Arrow ToAnotherFragment
ToAnotherFragment b c -> ToAnotherFragment (b, d) (c, d)
ToAnotherFragment b c -> ToAnotherFragment (d, b) (d, c)
ToAnotherFragment b c
-> ToAnotherFragment b' c' -> ToAnotherFragment (b, b') (c, c')
ToAnotherFragment b c
-> ToAnotherFragment b c' -> ToAnotherFragment b (c, c')
(b -> c) -> ToAnotherFragment b c
forall b c. (b -> c) -> ToAnotherFragment b c
forall b c d.
ToAnotherFragment b c -> ToAnotherFragment (b, d) (c, d)
forall b c d.
ToAnotherFragment b c -> ToAnotherFragment (d, b) (d, c)
forall b c c'.
ToAnotherFragment b c
-> ToAnotherFragment b c' -> ToAnotherFragment b (c, c')
forall b c b' c'.
ToAnotherFragment b c
-> ToAnotherFragment b' c' -> ToAnotherFragment (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
&&& :: ToAnotherFragment b c
-> ToAnotherFragment b c' -> ToAnotherFragment b (c, c')
$c&&& :: forall b c c'.
ToAnotherFragment b c
-> ToAnotherFragment b c' -> ToAnotherFragment b (c, c')
*** :: ToAnotherFragment b c
-> ToAnotherFragment b' c' -> ToAnotherFragment (b, b') (c, c')
$c*** :: forall b c b' c'.
ToAnotherFragment b c
-> ToAnotherFragment b' c' -> ToAnotherFragment (b, b') (c, c')
second :: ToAnotherFragment b c -> ToAnotherFragment (d, b) (d, c)
$csecond :: forall b c d.
ToAnotherFragment b c -> ToAnotherFragment (d, b) (d, c)
first :: ToAnotherFragment b c -> ToAnotherFragment (b, d) (c, d)
$cfirst :: forall b c d.
ToAnotherFragment b c -> ToAnotherFragment (b, d) (c, d)
arr :: (b -> c) -> ToAnotherFragment b c
$carr :: forall b c. (b -> c) -> ToAnotherFragment b c
$cp1Arrow :: Category ToAnotherFragment
Arrow)

class FragmentInput a => AnotherFragmentInput a where
    toFragment2 :: ToAnotherFragment a (FragmentFormat a)

makeAnotherFragment :: Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment :: Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment Text
qual SType
styp a -> ExprM Text
f = Kleisli (State Int) a (S c a1) -> ToAnotherFragment a (S c a1)
forall a b. Kleisli (State Int) a b -> ToAnotherFragment a b
ToAnotherFragment (Kleisli (State Int) a (S c a1) -> ToAnotherFragment a (S c a1))
-> Kleisli (State Int) a (S c a1) -> ToAnotherFragment 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
n Int -> 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 -> SType -> Int -> ExprM Text -> ExprM Text
useFInputFromG Text
qual 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

instance AnotherFragmentInput () where
    toFragment2 :: ToAnotherFragment () (FragmentFormat ())
toFragment2 = (() -> ()) -> ToAnotherFragment () ()
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (() -> () -> ()
forall a b. a -> b -> a
const ())

instance AnotherFragmentInput VFloat where
    toFragment2 :: ToAnotherFragment VFloat (FragmentFormat VFloat)
toFragment2 = Text
-> SType
-> (VFloat -> ExprM Text)
-> ToAnotherFragment VFloat (S F Float)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment Text
"" SType
STypeFloat VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS

instance AnotherFragmentInput FlatVFloat where
    toFragment2 :: ToAnotherFragment FlatVFloat (FragmentFormat FlatVFloat)
toFragment2 = Text
-> SType
-> (FlatVFloat -> ExprM Text)
-> ToAnotherFragment FlatVFloat (S F Float)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment Text
"flat" SType
STypeFloat (VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS (VFloat -> ExprM Text)
-> (FlatVFloat -> VFloat) -> FlatVFloat -> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FlatVFloat -> VFloat
unFlat)

instance AnotherFragmentInput NoPerspectiveVFloat where
    toFragment2 :: ToAnotherFragment
  NoPerspectiveVFloat (FragmentFormat NoPerspectiveVFloat)
toFragment2 = Text
-> SType
-> (NoPerspectiveVFloat -> ExprM Text)
-> ToAnotherFragment NoPerspectiveVFloat (S F Float)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment Text
"noperspective" SType
STypeFloat (VFloat -> ExprM Text
forall x a. S x a -> ExprM Text
unS (VFloat -> ExprM Text)
-> (NoPerspectiveVFloat -> VFloat)
-> NoPerspectiveVFloat
-> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NoPerspectiveVFloat -> VFloat
unNPersp)

instance AnotherFragmentInput VInt where
    toFragment2 :: ToAnotherFragment VInt (FragmentFormat VInt)
toFragment2 = Text
-> SType
-> (VInt -> ExprM Text)
-> ToAnotherFragment VInt (S F Int)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment Text
"flat" SType
STypeInt VInt -> ExprM Text
forall x a. S x a -> ExprM Text
unS

instance AnotherFragmentInput VWord where
    toFragment2 :: ToAnotherFragment VWord (FragmentFormat VWord)
toFragment2 = Text
-> SType
-> (VWord -> ExprM Text)
-> ToAnotherFragment VWord (S F Word)
forall a c a1.
Text -> SType -> (a -> ExprM Text) -> ToAnotherFragment a (S c a1)
makeAnotherFragment Text
"flat" SType
STypeUInt VWord -> ExprM Text
forall x a. S x a -> ExprM Text
unS

instance AnotherFragmentInput VBool where
    toFragment2 :: ToAnotherFragment VBool (FragmentFormat VBool)
toFragment2 = proc VBool
b -> do
        S F Int
i <- ToAnotherFragment VInt (S F Int)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< VBool -> VInt -> VInt -> VInt
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB VBool
b VInt
1 VInt
0 :: VInt
        ToAnotherFragment 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 (AnotherFragmentInput a) => AnotherFragmentInput (V0 a) where
    toFragment2 :: ToAnotherFragment (V0 a) (FragmentFormat (V0 a))
toFragment2 = (V0 a -> V0 (FragmentFormat a))
-> ToAnotherFragment (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 (AnotherFragmentInput a) => AnotherFragmentInput (V1 a) where
    toFragment2 :: ToAnotherFragment (V1 a) (FragmentFormat (V1 a))
toFragment2 = proc ~(V1 a
a) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        ToAnotherFragment (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 (AnotherFragmentInput a) => AnotherFragmentInput (V2 a) where
    toFragment2 :: ToAnotherFragment (V2 a) (FragmentFormat (V2 a))
toFragment2 = proc ~(V2 a
a a
b) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat a
b' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
b
        ToAnotherFragment (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 (AnotherFragmentInput a) => AnotherFragmentInput (V3 a) where
    toFragment2 :: ToAnotherFragment (V3 a) (FragmentFormat (V3 a))
toFragment2 = proc ~(V3 a
a a
b a
c) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat a
b' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
b
        FragmentFormat a
c' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
c
        ToAnotherFragment (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 (AnotherFragmentInput a) => AnotherFragmentInput (V4 a) where
    toFragment2 :: ToAnotherFragment (V4 a) (FragmentFormat (V4 a))
toFragment2 = proc ~(V4 a
a a
b a
c a
d) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat a
b' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
b
        FragmentFormat a
c' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
c
        FragmentFormat a
d' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
d
        ToAnotherFragment (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 (AnotherFragmentInput a, AnotherFragmentInput b) => AnotherFragmentInput (a,b) where
    toFragment2 :: ToAnotherFragment (a, b) (FragmentFormat (a, b))
toFragment2 = proc ~(a
a,b
b) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat b
b' <- ToAnotherFragment b (FragmentFormat b)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< b
b
        ToAnotherFragment
  (FragmentFormat a, FragmentFormat b) (FragmentFormat (a, b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FragmentFormat a
a', FragmentFormat b
b')

instance (AnotherFragmentInput a, AnotherFragmentInput b, AnotherFragmentInput c) => AnotherFragmentInput (a,b,c) where
    toFragment2 :: ToAnotherFragment (a, b, c) (FragmentFormat (a, b, c))
toFragment2 = proc ~(a
a,b
b,c
c) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat b
b' <- ToAnotherFragment b (FragmentFormat b)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< b
b
        FragmentFormat c
c' <- ToAnotherFragment c (FragmentFormat c)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< c
c
        ToAnotherFragment
  (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 (AnotherFragmentInput a, AnotherFragmentInput b, AnotherFragmentInput c, AnotherFragmentInput d) => AnotherFragmentInput (a,b,c,d) where
    toFragment2 :: ToAnotherFragment (a, b, c, d) (FragmentFormat (a, b, c, d))
toFragment2 = proc ~(a
a,b
b,c
c,d
d) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat b
b' <- ToAnotherFragment b (FragmentFormat b)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< b
b
        FragmentFormat c
c' <- ToAnotherFragment c (FragmentFormat c)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< c
c
        FragmentFormat d
d' <- ToAnotherFragment d (FragmentFormat d)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< d
d
        ToAnotherFragment
  (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 (AnotherFragmentInput a, AnotherFragmentInput b, AnotherFragmentInput c, AnotherFragmentInput d, AnotherFragmentInput e) => AnotherFragmentInput (a,b,c,d,e) where
    toFragment2 :: ToAnotherFragment (a, b, c, d, e) (FragmentFormat (a, b, c, d, e))
toFragment2 = proc ~(a
a,b
b,c
c,d
d,e
e) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat b
b' <- ToAnotherFragment b (FragmentFormat b)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< b
b
        FragmentFormat c
c' <- ToAnotherFragment c (FragmentFormat c)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< c
c
        FragmentFormat d
d' <- ToAnotherFragment d (FragmentFormat d)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< d
d
        FragmentFormat e
e' <- ToAnotherFragment e (FragmentFormat e)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< e
e
        ToAnotherFragment
  (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 (AnotherFragmentInput a, AnotherFragmentInput b, AnotherFragmentInput c, AnotherFragmentInput d, AnotherFragmentInput e, AnotherFragmentInput f) => AnotherFragmentInput (a,b,c,d,e,f) where
    toFragment2 :: ToAnotherFragment
  (a, b, c, d, e, f) (FragmentFormat (a, b, c, d, e, f))
toFragment2 = proc ~(a
a,b
b,c
c,d
d,e
e,f
f) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat b
b' <- ToAnotherFragment b (FragmentFormat b)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< b
b
        FragmentFormat c
c' <- ToAnotherFragment c (FragmentFormat c)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< c
c
        FragmentFormat d
d' <- ToAnotherFragment d (FragmentFormat d)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< d
d
        FragmentFormat e
e' <- ToAnotherFragment e (FragmentFormat e)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< e
e
        FragmentFormat f
f' <- ToAnotherFragment f (FragmentFormat f)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< f
f
        ToAnotherFragment
  (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 (AnotherFragmentInput a, AnotherFragmentInput b, AnotherFragmentInput c, AnotherFragmentInput d, AnotherFragmentInput e, AnotherFragmentInput f, AnotherFragmentInput g) => AnotherFragmentInput (a,b,c,d,e,f,g) where
    toFragment2 :: ToAnotherFragment
  (a, b, c, d, e, f, g) (FragmentFormat (a, b, c, d, e, f, g))
toFragment2 = proc ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat b
b' <- ToAnotherFragment b (FragmentFormat b)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< b
b
        FragmentFormat c
c' <- ToAnotherFragment c (FragmentFormat c)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< c
c
        FragmentFormat d
d' <- ToAnotherFragment d (FragmentFormat d)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< d
d
        FragmentFormat e
e' <- ToAnotherFragment e (FragmentFormat e)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< e
e
        FragmentFormat f
f' <- ToAnotherFragment f (FragmentFormat f)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< f
f
        FragmentFormat g
g' <- ToAnotherFragment g (FragmentFormat g)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< g
g
        ToAnotherFragment
  (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 AnotherFragmentInput a => AnotherFragmentInput (Quaternion a) where
    toFragment2 :: ToAnotherFragment (Quaternion a) (FragmentFormat (Quaternion a))
toFragment2 = proc ~(Quaternion a
a V3 a
v) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        V3 (FragmentFormat a)
v' <- ToAnotherFragment (V3 a) (V3 (FragmentFormat a))
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< V3 a
v
        ToAnotherFragment
  (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 (AnotherFragmentInput (f a), AnotherFragmentInput a, FragmentFormat (f a) ~ f (FragmentFormat a)) => AnotherFragmentInput (Point f a) where
    toFragment2 :: ToAnotherFragment (Point f a) (FragmentFormat (Point f a))
toFragment2 = proc ~(P f a
a) -> do
        f (FragmentFormat a)
a' <- ToAnotherFragment (f a) (f (FragmentFormat a))
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< f a
a
        ToAnotherFragment
  (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 AnotherFragmentInput a => AnotherFragmentInput (Plucker a) where
    toFragment2 :: ToAnotherFragment (Plucker a) (FragmentFormat (Plucker a))
toFragment2 = proc ~(Plucker a
a a
b a
c a
d a
e a
f) -> do
        FragmentFormat a
a' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
a
        FragmentFormat a
b' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
b
        FragmentFormat a
c' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
c
        FragmentFormat a
d' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
d
        FragmentFormat a
e' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
e
        FragmentFormat a
f' <- ToAnotherFragment a (FragmentFormat a)
forall a.
AnotherFragmentInput a =>
ToAnotherFragment a (FragmentFormat a)
toFragment2 -< a
f
        ToAnotherFragment
  (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'

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

class AnotherFragmentInput a => FragmentCreator a where
    createFragment :: State Int a

instance FragmentCreator () where
    createFragment :: StateT Int Identity ()
createFragment = () -> StateT Int Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance FragmentCreator VFloat where
    createFragment :: State Int VFloat
createFragment = 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        VFloat -> State Int VFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (VFloat -> State Int VFloat) -> VFloat -> State Int VFloat
forall a b. (a -> b) -> a -> b
$ ExprM Text -> VFloat
forall x a. ExprM Text -> S x a
S (Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n)

instance FragmentCreator FlatVFloat where
    createFragment :: State Int FlatVFloat
createFragment = 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        FlatVFloat -> State Int FlatVFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (FlatVFloat -> State Int FlatVFloat)
-> FlatVFloat -> State Int FlatVFloat
forall a b. (a -> b) -> a -> b
$ VFloat -> FlatVFloat
Flat (VFloat -> FlatVFloat) -> VFloat -> FlatVFloat
forall a b. (a -> b) -> a -> b
$ ExprM Text -> VFloat
forall x a. ExprM Text -> S x a
S (Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n)

instance FragmentCreator NoPerspectiveVFloat where
    createFragment :: State Int NoPerspectiveVFloat
createFragment = 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        NoPerspectiveVFloat -> State Int NoPerspectiveVFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (NoPerspectiveVFloat -> State Int NoPerspectiveVFloat)
-> NoPerspectiveVFloat -> State Int NoPerspectiveVFloat
forall a b. (a -> b) -> a -> b
$ VFloat -> NoPerspectiveVFloat
NoPerspective (VFloat -> NoPerspectiveVFloat) -> VFloat -> NoPerspectiveVFloat
forall a b. (a -> b) -> a -> b
$ ExprM Text -> VFloat
forall x a. ExprM Text -> S x a
S (Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n)

instance FragmentCreator VInt where
    createFragment :: State Int VInt
createFragment = 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        VInt -> State Int VInt
forall (m :: * -> *) a. Monad m => a -> m a
return (VInt -> State Int VInt) -> VInt -> State Int VInt
forall a b. (a -> b) -> a -> b
$ ExprM Text -> VInt
forall x a. ExprM Text -> S x a
S (Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n)

instance FragmentCreator VWord where
    createFragment :: State Int VWord
createFragment = 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        VWord -> State Int VWord
forall (m :: * -> *) a. Monad m => a -> m a
return (VWord -> State Int VWord) -> VWord -> State Int VWord
forall a b. (a -> b) -> a -> b
$ ExprM Text -> VWord
forall x a. ExprM Text -> S x a
S (Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n)

instance FragmentCreator VBool where
    createFragment :: State Int VBool
createFragment = 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        VBool -> State Int VBool
forall (m :: * -> *) a. Monad m => a -> m a
return (VBool -> State Int VBool) -> VBool -> State Int VBool
forall a b. (a -> b) -> a -> b
$ ExprM Text -> VBool
forall x a. ExprM Text -> S x a
S (Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n)

instance (FragmentCreator a) => FragmentCreator (V0 a) where
    createFragment :: State Int (V0 a)
createFragment = V0 a -> State Int (V0 a)
forall (m :: * -> *) a. Monad m => a -> m a
return V0 a
forall a. V0 a
V0

instance (FragmentCreator a) => FragmentCreator (V1 a) where
    createFragment :: State Int (V1 a)
createFragment = a -> V1 a
forall a. a -> V1 a
V1
        (a -> V1 a) -> StateT Int Identity a -> State Int (V1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a) => FragmentCreator (V2 a) where
    createFragment :: State Int (V2 a)
createFragment = a -> a -> V2 a
forall a. a -> a -> V2 a
V2
        (a -> a -> V2 a)
-> StateT Int Identity a -> StateT Int Identity (a -> V2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> V2 a)
-> StateT Int Identity a -> State Int (V2 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a) => FragmentCreator (V3 a) where
    createFragment :: State Int (V3 a)
createFragment = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3
        (a -> a -> a -> V3 a)
-> StateT Int Identity a -> StateT Int Identity (a -> a -> V3 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> V3 a)
-> StateT Int Identity a -> StateT Int Identity (a -> V3 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> V3 a)
-> StateT Int Identity a -> State Int (V3 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a) => FragmentCreator (V4 a) where
    createFragment :: State Int (V4 a)
createFragment = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4
        (a -> a -> a -> a -> V4 a)
-> StateT Int Identity a
-> StateT Int Identity (a -> a -> a -> V4 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> a -> V4 a)
-> StateT Int Identity a -> StateT Int Identity (a -> a -> V4 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> V4 a)
-> StateT Int Identity a -> StateT Int Identity (a -> V4 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> V4 a)
-> StateT Int Identity a -> State Int (V4 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a, FragmentCreator b) => FragmentCreator (a,b) where
    createFragment :: State Int (a, b)
createFragment = (,)
        (a -> b -> (a, b))
-> StateT Int Identity a -> StateT Int Identity (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (b -> (a, b))
-> StateT Int Identity b -> State Int (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity b
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a, FragmentCreator b, FragmentCreator c) => FragmentCreator (a,b,c) where
    createFragment :: State Int (a, b, c)
createFragment = (,,)
        (a -> b -> c -> (a, b, c))
-> StateT Int Identity a
-> StateT Int Identity (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (b -> c -> (a, b, c))
-> StateT Int Identity b -> StateT Int Identity (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity b
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (c -> (a, b, c))
-> StateT Int Identity c -> State Int (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity c
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a, FragmentCreator b, FragmentCreator c, FragmentCreator d) => FragmentCreator (a,b,c,d) where
    createFragment :: State Int (a, b, c, d)
createFragment = (,,,)
        (a -> b -> c -> d -> (a, b, c, d))
-> StateT Int Identity a
-> StateT Int Identity (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (b -> c -> d -> (a, b, c, d))
-> StateT Int Identity b
-> StateT Int Identity (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity b
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (c -> d -> (a, b, c, d))
-> StateT Int Identity c -> StateT Int Identity (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity c
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (d -> (a, b, c, d))
-> StateT Int Identity d -> State Int (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity d
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a, FragmentCreator b, FragmentCreator c, FragmentCreator d, FragmentCreator e) => FragmentCreator (a,b,c,d,e) where
    createFragment :: State Int (a, b, c, d, e)
createFragment = (,,,,)
        (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> StateT Int Identity a
-> StateT Int Identity (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (b -> c -> d -> e -> (a, b, c, d, e))
-> StateT Int Identity b
-> StateT Int Identity (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity b
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (c -> d -> e -> (a, b, c, d, e))
-> StateT Int Identity c
-> StateT Int Identity (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity c
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (d -> e -> (a, b, c, d, e))
-> StateT Int Identity d
-> StateT Int Identity (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity d
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (e -> (a, b, c, d, e))
-> StateT Int Identity e -> State Int (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity e
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a, FragmentCreator b, FragmentCreator c, FragmentCreator d, FragmentCreator e, FragmentCreator f) => FragmentCreator (a,b,c,d,e,f) where
    createFragment :: State Int (a, b, c, d, e, f)
createFragment = (,,,,,)
        (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> StateT Int Identity a
-> StateT
     Int Identity (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> StateT Int Identity b
-> StateT Int Identity (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity b
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (c -> d -> e -> f -> (a, b, c, d, e, f))
-> StateT Int Identity c
-> StateT Int Identity (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity c
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (d -> e -> f -> (a, b, c, d, e, f))
-> StateT Int Identity d
-> StateT Int Identity (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity d
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (e -> f -> (a, b, c, d, e, f))
-> StateT Int Identity e
-> StateT Int Identity (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity e
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (f -> (a, b, c, d, e, f))
-> StateT Int Identity f -> State Int (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity f
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator a, FragmentCreator b, FragmentCreator c, FragmentCreator d, FragmentCreator e, FragmentCreator f, FragmentCreator g) => FragmentCreator (a,b,c,d,e,f,g) where
    createFragment :: State Int (a, b, c, d, e, f, g)
createFragment = (,,,,,,)
        (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT Int Identity a
-> StateT
     Int Identity (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT
  Int Identity (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT Int Identity b
-> StateT
     Int Identity (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity b
forall a. FragmentCreator a => State Int a
createFragment
        StateT
  Int Identity (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT Int Identity c
-> StateT Int Identity (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity c
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT Int Identity d
-> StateT Int Identity (e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity d
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT Int Identity e
-> StateT Int Identity (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity e
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (f -> g -> (a, b, c, d, e, f, g))
-> StateT Int Identity f
-> StateT Int Identity (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity f
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (g -> (a, b, c, d, e, f, g))
-> StateT Int Identity g -> State Int (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity g
forall a. FragmentCreator a => State Int a
createFragment

instance FragmentCreator a => FragmentCreator (Quaternion a) where
    createFragment :: State Int (Quaternion a)
createFragment = a -> V3 a -> Quaternion a
forall a. a -> V3 a -> Quaternion a
Quaternion
        (a -> V3 a -> Quaternion a)
-> StateT Int Identity a
-> StateT Int Identity (V3 a -> Quaternion a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (V3 a -> Quaternion a)
-> StateT Int Identity (V3 a) -> State Int (Quaternion a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity (V3 a)
forall a. FragmentCreator a => State Int a
createFragment

instance (FragmentCreator (f a), FragmentCreator a, FragmentFormat (f a) ~ f (FragmentFormat a)) => FragmentCreator (Point f a) where
    createFragment :: State Int (Point f a)
createFragment = f a -> Point f a
forall (f :: * -> *) a. f a -> Point f a
P
        (f a -> Point f a)
-> StateT Int Identity (f a) -> State Int (Point f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity (f a)
forall a. FragmentCreator a => State Int a
createFragment

instance FragmentCreator a => FragmentCreator (Plucker a) where
    createFragment :: State Int (Plucker a)
createFragment = a -> a -> a -> a -> a -> a -> Plucker a
forall a. a -> a -> a -> a -> a -> a -> Plucker a
Plucker
        (a -> a -> a -> a -> a -> a -> Plucker a)
-> StateT Int Identity a
-> StateT Int Identity (a -> a -> a -> a -> a -> Plucker a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> a -> a -> a -> Plucker a)
-> StateT Int Identity a
-> StateT Int Identity (a -> a -> a -> a -> Plucker a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> a -> a -> Plucker a)
-> StateT Int Identity a
-> StateT Int Identity (a -> a -> a -> Plucker a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> a -> Plucker a)
-> StateT Int Identity a
-> StateT Int Identity (a -> a -> Plucker a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> a -> Plucker a)
-> StateT Int Identity a -> StateT Int Identity (a -> Plucker a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment
        StateT Int Identity (a -> Plucker a)
-> StateT Int Identity a -> State Int (Plucker a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Int Identity a
forall a. FragmentCreator a => State Int a
createFragment