{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
module Graphics.GPipe.Internal.Expr where
import Control.Applicative (liftA2, liftA3)
import Control.Category (Category (id, (.)))
import Control.Monad (void, when)
import qualified Control.Monad.Trans.Class as T (lift)
import Control.Monad.Trans.Reader (ReaderT (runReaderT), ask)
import Control.Monad.Trans.State.Strict (State, StateT, evalState,
evalStateT, execStateT, get,
modify, modify', put)
import Control.Monad.Trans.Writer.Strict (Writer,
WriterT (runWriterT),
execWriter, execWriterT,
tell)
import Data.Bits (FiniteBits (finiteBitSize))
import Data.Boolean (Boolean (..), BooleanOf,
EqB (..), IfB (..),
OrdB (..), maxB, minB)
import Data.Foldable (Foldable (toList))
import Data.Int (Int16, Int32, Int8)
import qualified Data.IntMap.Polymorphic.Lazy as Map
import Data.Maybe (fromJust, isJust)
import Data.SNMap (SNMapReaderT, memoizeM,
runSNMapReaderT, scopedM)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LTB
import Data.Word (Word16, Word32, Word8)
import Graphics.GPipe.Internal.IDs (SamplerId, UniformId)
import Linear.Affine (distanceA)
import Linear.Conjugate (Conjugate, TrivialConjugate)
import Linear.Matrix ((!*!), (!*), (*!))
import Linear.Metric (Metric (distance, dot, norm, signorm))
import Linear.V0 (V0 (..))
import Linear.V1 (V1 (..))
import Linear.V2 (V2 (..))
import Linear.V3 (V3 (..), cross)
import Linear.V4 (V4 (..))
import Linear.Vector (outer)
import Prelude hiding (id, (.), (<*))
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
LT.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
show
type NextTempVar = Int
type NextGlobal = Int
data SType
= STypeFloat
| STypeInt
| STypeBool
| STypeUInt
| STypeDyn !Text
| STypeMat !Int !Int
| STypeVec !Int
| STypeIVec !Int
| STypeUVec !Int
| STypeGenerativeGeometry
stypeName :: SType -> Text
stypeName :: SType -> Text
stypeName SType
STypeFloat = Text
"float"
stypeName SType
STypeInt = Text
"int"
stypeName SType
STypeBool = Text
"bool"
stypeName SType
STypeUInt = Text
"uint"
stypeName (STypeDyn Text
s) = Text
s
stypeName (STypeMat Int
r Int
c) = Text
"mat" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
r
stypeName (STypeVec Int
n) = Text
"vec" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
stypeName (STypeIVec Int
n) = Text
"ivec" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
stypeName (STypeUVec Int
n) = Text
"uvec" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
stypeName SType
STypeGenerativeGeometry = Text
"bool"
stypeSize :: SType -> Int
stypeSize :: SType -> Int
stypeSize (STypeVec Int
n) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
stypeSize (STypeIVec Int
n) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
stypeSize (STypeUVec Int
n) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
stypeSize SType
_ = Int
4
type ExprM = SNMapReaderT
[Text]
(StateT ExprState IO)
type GlobDeclM = Writer Text
data ExprState = ExprState
ShaderInputs
!NextTempVar
!LTB.Builder
emptyExprState :: ExprState
emptyExprState :: ExprState
emptyExprState = ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
emptyShaderInputs Int
0 Builder
forall a. Monoid a => a
mempty
data ShaderInputs = ShaderInputs
{ ShaderInputs -> IntMap UniformId (GlobDeclM ())
shaderUsedUniformBlocks :: !(Map.IntMap UniformId (GlobDeclM ()))
, ShaderInputs -> IntMap SamplerId (GlobDeclM ())
shaderUsedSamplers :: !(Map.IntMap SamplerId (GlobDeclM ()))
, ShaderInputs -> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput :: !(Map.IntMap Int
( GlobDeclM ()
, ( ExprM ()
, GlobDeclM ()
)
))
, ShaderInputs -> Maybe (GlobDeclM ())
shaderGeometry :: !(Maybe (GlobDeclM ()))
}
emptyShaderInputs :: ShaderInputs
emptyShaderInputs :: ShaderInputs
emptyShaderInputs = IntMap UniformId (GlobDeclM ())
-> IntMap SamplerId (GlobDeclM ())
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> Maybe (GlobDeclM ())
-> ShaderInputs
ShaderInputs IntMap UniformId (GlobDeclM ())
forall k v. IntMap k v
Map.empty IntMap SamplerId (GlobDeclM ())
forall k v. IntMap k v
Map.empty IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall k v. IntMap k v
Map.empty Maybe (GlobDeclM ())
forall a. Maybe a
Nothing
data ExprResult = ExprResult
{ ExprResult -> Text
finalSource :: !Text
, ExprResult -> [UniformId]
unis :: ![UniformId]
, ExprResult -> [SamplerId]
samps :: ![SamplerId]
, ExprResult -> [Int]
inps :: [Int]
, ExprResult -> GlobDeclM ()
prevDecls :: GlobDeclM ()
, ExprResult -> ExprM ()
prevSs :: ExprM ()
}
runExprM
:: GlobDeclM ()
-> ExprM ()
-> IO ExprResult
runExprM :: GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
d ExprM ()
m = do
ExprState ShaderInputs
st Int
_ Builder
body <- StateT ExprState IO () -> ExprState -> IO ExprState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (ExprM () -> StateT ExprState IO ()
forall (m :: * -> *) a b. MonadIO m => SNMapReaderT a m b -> m b
runSNMapReaderT ExprM ()
m) ExprState
emptyExprState
let ([UniformId]
unis, [GlobDeclM ()]
uniDecls) = [(UniformId, GlobDeclM ())] -> ([UniformId], [GlobDeclM ()])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(UniformId, GlobDeclM ())] -> ([UniformId], [GlobDeclM ()]))
-> [(UniformId, GlobDeclM ())] -> ([UniformId], [GlobDeclM ()])
forall a b. (a -> b) -> a -> b
$ IntMap UniformId (GlobDeclM ()) -> [(UniformId, GlobDeclM ())]
forall k v. Integral k => IntMap k v -> [(k, v)]
Map.toAscList (ShaderInputs -> IntMap UniformId (GlobDeclM ())
shaderUsedUniformBlocks ShaderInputs
st)
([SamplerId]
samps, [GlobDeclM ()]
sampDecls) = [(SamplerId, GlobDeclM ())] -> ([SamplerId], [GlobDeclM ()])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(SamplerId, GlobDeclM ())] -> ([SamplerId], [GlobDeclM ()]))
-> [(SamplerId, GlobDeclM ())] -> ([SamplerId], [GlobDeclM ()])
forall a b. (a -> b) -> a -> b
$ IntMap SamplerId (GlobDeclM ()) -> [(SamplerId, GlobDeclM ())]
forall k v. Integral k => IntMap k v -> [(k, v)]
Map.toAscList (ShaderInputs -> IntMap SamplerId (GlobDeclM ())
shaderUsedSamplers ShaderInputs
st)
([Int]
inps, [(GlobDeclM (), (ExprM (), GlobDeclM ()))]
inpDescs) = [(Int, (GlobDeclM (), (ExprM (), GlobDeclM ())))]
-> ([Int], [(GlobDeclM (), (ExprM (), GlobDeclM ()))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, (GlobDeclM (), (ExprM (), GlobDeclM ())))]
-> ([Int], [(GlobDeclM (), (ExprM (), GlobDeclM ()))]))
-> [(Int, (GlobDeclM (), (ExprM (), GlobDeclM ())))]
-> ([Int], [(GlobDeclM (), (ExprM (), GlobDeclM ()))])
forall a b. (a -> b) -> a -> b
$ IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> [(Int, (GlobDeclM (), (ExprM (), GlobDeclM ())))]
forall k v. Integral k => IntMap k v -> [(k, v)]
Map.toAscList (ShaderInputs -> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput ShaderInputs
st)
geoDescs :: Maybe (GlobDeclM ())
geoDescs = ShaderInputs -> Maybe (GlobDeclM ())
shaderGeometry ShaderInputs
st
([GlobDeclM ()]
inpDecls, [(ExprM (), GlobDeclM ())]
prevDesc) = [(GlobDeclM (), (ExprM (), GlobDeclM ()))]
-> ([GlobDeclM ()], [(ExprM (), GlobDeclM ())])
forall a b. [(a, b)] -> ([a], [b])
unzip [(GlobDeclM (), (ExprM (), GlobDeclM ()))]
inpDescs
([ExprM ()] -> ExprM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ -> ExprM ()
prevSs, [GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ -> GlobDeclM ()
prevDecls) = [(ExprM (), GlobDeclM ())] -> ([ExprM ()], [GlobDeclM ()])
forall a b. [(a, b)] -> ([a], [b])
unzip [(ExprM (), GlobDeclM ())]
prevDesc
decls :: GlobDeclM ()
decls = do
GlobDeclM ()
d
Bool -> GlobDeclM () -> GlobDeclM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (GlobDeclM ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (GlobDeclM ())
geoDescs) (Maybe (GlobDeclM ()) -> GlobDeclM ()
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (GlobDeclM ())
geoDescs)
[GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
uniDecls
[GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
sampDecls
[GlobDeclM ()] -> GlobDeclM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GlobDeclM ()]
inpDecls
finalSource :: Text
finalSource = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"#version 450\n"
, GlobDeclM () -> Text
forall w a. Writer w a -> w
execWriter GlobDeclM ()
decls
, Text
"void main() {\n"
, Builder -> Text
LTB.toLazyText Builder
body
, Text
"}\n"
]
ExprResult -> IO ExprResult
forall (m :: * -> *) a. Monad m => a -> m a
return ExprResult :: Text
-> [UniformId]
-> [SamplerId]
-> [Int]
-> GlobDeclM ()
-> ExprM ()
-> ExprResult
ExprResult{[Int]
[SamplerId]
[UniformId]
Text
GlobDeclM ()
ExprM ()
finalSource :: Text
prevDecls :: GlobDeclM ()
prevSs :: ExprM ()
inps :: [Int]
samps :: [SamplerId]
unis :: [UniformId]
prevSs :: ExprM ()
prevDecls :: GlobDeclM ()
inps :: [Int]
samps :: [SamplerId]
unis :: [UniformId]
finalSource :: Text
..}
data ShaderStageInput = ShaderStageInput
{
ShaderStageInput -> GlobDeclM ()
outputDeclarations :: !(GlobDeclM ())
, ShaderStageInput -> ExprM ()
expression :: !(ExprM ())
}
data ShaderStageOutput = ShaderStageOutput
{ ShaderStageOutput -> Text
source :: !Text
, ShaderStageOutput -> [UniformId]
uniforms :: ![UniformId]
, ShaderStageOutput -> [SamplerId]
samplers :: ![SamplerId]
, ShaderStageOutput -> [Int]
inputs :: ![Int]
, ShaderStageOutput -> GlobDeclM ()
previousDeclarations :: !(GlobDeclM ())
, ShaderStageOutput -> ExprM ()
prevExpression :: !(ExprM ())
}
evaluateExpression :: [ExprM ()] -> ExprM () -> GlobDeclM () -> IO ShaderStageOutput
evaluateExpression :: [ExprM ()] -> ExprM () -> GlobDeclM () -> IO ShaderStageOutput
evaluateExpression [ExprM ()]
staticExpressions ExprM ()
expression GlobDeclM ()
requiredOutputDeclarations = do
ExprResult Text
s [UniformId]
u [SamplerId]
ss [Int]
is GlobDeclM ()
pds ExprM ()
pe <- GlobDeclM () -> ExprM () -> IO ExprResult
runExprM GlobDeclM ()
requiredOutputDeclarations ExprM ()
expression
case [ExprM ()]
staticExpressions of
(ExprM ()
se:[ExprM ()]
ses) -> [ExprM ()] -> ExprM () -> GlobDeclM () -> IO ShaderStageOutput
evaluateExpression [ExprM ()]
ses (ExprM ()
pe ExprM () -> ExprM () -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExprM ()
se) GlobDeclM ()
pds
[] -> ShaderStageOutput -> IO ShaderStageOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderStageOutput -> IO ShaderStageOutput)
-> ShaderStageOutput -> IO ShaderStageOutput
forall a b. (a -> b) -> a -> b
$ Text
-> [UniformId]
-> [SamplerId]
-> [Int]
-> GlobDeclM ()
-> ExprM ()
-> ShaderStageOutput
ShaderStageOutput Text
s [UniformId]
u [SamplerId]
ss [Int]
is GlobDeclM ()
pds ExprM ()
pe
newtype S x a = S { S x a -> ExprM Text
unS :: ExprM Text }
scalarS :: SType -> ExprM RValue -> S c a
scalarS :: SType -> ExprM Text -> S c a
scalarS SType
typ = ExprM Text -> S c a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a)
-> (ExprM Text -> ExprM Text) -> ExprM Text -> S c a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ
vec2S :: SType -> ExprM RValue -> V2 (S c a)
vec2S :: SType -> ExprM Text -> V2 (S c a)
vec2S SType
typ ExprM Text
s =
let V4 S c a
x S c a
y S c a
_z S c a
_w = SType -> ExprM Text -> V4 (S c a)
forall c a. SType -> ExprM Text -> V4 (S c a)
vec4S SType
typ ExprM Text
s
in S c a -> S c a -> V2 (S c a)
forall a. a -> a -> V2 a
V2 S c a
x S c a
y
vec3S :: SType -> ExprM RValue -> V3 (S c a)
vec3S :: SType -> ExprM Text -> V3 (S c a)
vec3S SType
typ ExprM Text
s =
let V4 S c a
x S c a
y S c a
z S c a
_w = SType -> ExprM Text -> V4 (S c a)
forall c a. SType -> ExprM Text -> V4 (S c a)
vec4S SType
typ ExprM Text
s
in S c a -> S c a -> S c a -> V3 (S c a)
forall a. a -> a -> a -> V3 a
V3 S c a
x S c a
y S c a
z
vec4S :: SType -> ExprM RValue -> V4 (S c a)
vec4S :: SType -> ExprM Text -> V4 (S c a)
vec4S SType
typ ExprM Text
s =
let m :: ExprM Text
m = SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ ExprM Text
s
f :: Text -> S c a
f Text
p = 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 -> Text) -> ExprM Text -> ExprM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p) ExprM Text
m
in S c a -> S c a -> S c a -> S c a -> V4 (S c a)
forall a. a -> a -> a -> a -> V4 a
V4 (Text -> S c a
f Text
".x") (Text -> S c a
f Text
".y") (Text -> S c a
f Text
".z") (Text -> S c a
f Text
".w")
scalarS' :: RValue -> S c a
scalarS' :: Text -> S c a
scalarS' = ExprM Text -> S c a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a) -> (Text -> ExprM Text) -> Text -> S c a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return
vec2S' :: RValue -> V2 (S c a)
vec2S' :: Text -> V2 (S c a)
vec2S' = S c a -> V2 (S c a)
forall c a. S c a -> V2 (S c a)
vec2S'' (S c a -> V2 (S c a)) -> (Text -> S c a) -> Text -> V2 (S c a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExprM Text -> S c a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a) -> (Text -> ExprM Text) -> Text -> S c a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return
vec3S' :: RValue -> V3 (S c a)
vec3S' :: Text -> V3 (S c a)
vec3S' = S c a -> V3 (S c a)
forall c a. S c a -> V3 (S c a)
vec3S'' (S c a -> V3 (S c a)) -> (Text -> S c a) -> Text -> V3 (S c a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExprM Text -> S c a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a) -> (Text -> ExprM Text) -> Text -> S c a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return
vec4S' :: RValue -> V4 (S c a)
vec4S' :: Text -> V4 (S c a)
vec4S' = S c a -> V4 (S c a)
forall c a. S c a -> V4 (S c a)
vec4S'' (S c a -> V4 (S c a)) -> (Text -> S c a) -> Text -> V4 (S c a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExprM Text -> S c a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c a) -> (Text -> ExprM Text) -> Text -> S c a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return
vec2S'' :: S c a -> V2 (S c a)
vec2S'' :: S c a -> V2 (S c a)
vec2S'' S c a
s =
let V4 S c a
x S c a
y S c a
_z S c a
_w = S c a -> V4 (S c a)
forall c a. S c a -> V4 (S c a)
vec4S'' S c a
s
in S c a -> S c a -> V2 (S c a)
forall a. a -> a -> V2 a
V2 S c a
x S c a
y
vec3S'' :: S c a -> V3 (S c a)
vec3S'' :: S c a -> V3 (S c a)
vec3S'' S c a
s =
let V4 S c a
x S c a
y S c a
z S c a
_w = S c a -> V4 (S c a)
forall c a. S c a -> V4 (S c a)
vec4S'' S c a
s
in S c a -> S c a -> S c a -> V3 (S c a)
forall a. a -> a -> a -> V3 a
V3 S c a
x S c a
y S c a
z
vec4S'' :: S c a -> V4 (S c a)
vec4S'' :: S c a -> V4 (S c a)
vec4S'' S c a
s =
let f :: Int -> S c a
f Int
p = 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 -> Text) -> ExprM Text -> ExprM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
p :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")) (S c a -> ExprM Text
forall x a. S x a -> ExprM Text
unS S c a
s)
in S c a -> S c a -> S c a -> S c a -> V4 (S c a)
forall a. a -> a -> a -> a -> V4 a
V4 (Int -> S c a
f Int
0) (Int -> S c a
f Int
1) (Int -> S c a
f Int
2) (Int -> S c a
f Int
3)
data V
data F
type G = V
newtype GenerativeGeometry p a = GenerativeGeometry a
type VFloat = S V Float
type VInt = S V Int
type VWord = S V Word
type VBool = S V Bool
type GGenerativeGeometry p a = S G (GenerativeGeometry p a)
type FFloat = S F Float
type FInt = S F Int
type FWord = S F Word
type FBool = S F Bool
useVInput :: SType -> Int -> ExprM Text
useVInput :: SType -> Int -> ExprM Text
useVInput SType
stype Int
i = do
ExprState ShaderInputs
s Int
nvar Builder
body <- StateT ExprState IO ExprState
-> SNMapReaderT [Text] (StateT ExprState IO) ExprState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState IO ExprState
forall (m :: * -> *) s. Monad m => StateT s m s
get
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprState -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderUsedInput :: IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput = Int
-> (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
Map.insert Int
i (GlobDeclM ()
gDeclInput, (ExprM (), GlobDeclM ())
forall a. HasCallStack => a
undefined) (IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ())))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput ShaderInputs
s } Int
nvar Builder
body)
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
$ Text
"in" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i
where
gDeclInput :: GlobDeclM ()
gDeclInput = do
Text -> GlobDeclM ()
tellGlobal Text
"in "
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
stype
Text -> GlobDeclM ()
tellGlobal Text
" in"
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
i
useGInput :: Text -> SType -> Int -> Int -> ExprM Text -> ExprM Text
useGInput :: Text -> SType -> Int -> Int -> ExprM Text -> ExprM Text
useGInput Text
qual SType
stype Int
i Int
n ExprM Text
v = do
ExprState ShaderInputs
s Int
nvar Builder
body <- StateT ExprState IO ExprState
-> SNMapReaderT [Text] (StateT ExprState IO) ExprState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState IO ExprState
forall (m :: * -> *) s. Monad m => StateT s m s
get
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprState -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderUsedInput :: IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput = Int
-> (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
Map.insert Int
n (GlobDeclM ()
gDeclIn, (ExprM ()
assignOutput, GlobDeclM ()
gDeclOut)) (IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ())))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput ShaderInputs
s } Int
nvar Builder
body)
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
$ Text
forall p. IsString p => p
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
where
prefix :: p
prefix = p
"vg"
space :: Text
space = if Text -> Bool
LT.null Text
qual then Text
"" else Text
" "
assignOutput :: ExprM ()
assignOutput = do
Text
val <- ExprM Text
v
let name :: Text
name = Text
forall p. IsString p => p
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
Text -> Text -> ExprM ()
tellAssignment' Text
name Text
val
gDeclOut :: GlobDeclM ()
gDeclOut = do
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
qual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"out "
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
stype
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
forall p. IsString p => p
prefix
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n
gDeclIn :: GlobDeclM ()
gDeclIn = do
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
qual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in "
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
stype
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
forall p. IsString p => p
prefix
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
n
Text -> GlobDeclM ()
tellGlobalLn Text
"[]"
useFInputFromG :: Text -> SType -> Int -> ExprM Text -> ExprM Text
useFInputFromG :: Text -> SType -> Int -> ExprM Text -> ExprM Text
useFInputFromG Text
qual SType
stype Int
i ExprM Text
v = do
ExprState ShaderInputs
s Int
nvar Builder
body <- StateT ExprState IO ExprState
-> SNMapReaderT [Text] (StateT ExprState IO) ExprState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState IO ExprState
forall (m :: * -> *) s. Monad m => StateT s m s
get
Int
val :: Int <- String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
LT.unpack (Text -> Int)
-> ExprM Text -> SNMapReaderT [Text] (StateT ExprState IO) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprM Text
v
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprState -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderUsedInput :: IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput = Int
-> (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
Map.insert Int
i (Int -> GlobDeclM ()
gDeclIn Int
val, (() -> ExprM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), Int -> GlobDeclM ()
gDeclOut Int
val)) (IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ())))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput ShaderInputs
s } Int
nvar Builder
body)
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
$ Text
forall p. IsString p => p
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
val
where
prefix :: p
prefix = p
"vgf"
space :: Text
space = if Text -> Bool
LT.null Text
qual then Text
"" else Text
" "
gDecl :: Int -> Text -> GlobDeclM ()
gDecl Int
val Text
s = do
Text -> GlobDeclM ()
tellGlobal Text
s
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
stype
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
forall p. IsString p => p
prefix
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
val
gDeclOut :: Int -> GlobDeclM ()
gDeclOut Int
val = Int -> Text -> GlobDeclM ()
gDecl Int
val (Text
qual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"out ")
gDeclIn :: Int -> GlobDeclM ()
gDeclIn Int
val = Int -> Text -> GlobDeclM ()
gDecl Int
val (Text
qual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in ")
useFInput :: Text -> Text -> SType -> Int -> ExprM Text -> ExprM Text
useFInput :: Text -> Text -> SType -> Int -> ExprM Text -> ExprM Text
useFInput Text
qual Text
prefix SType
stype Int
i ExprM Text
v = do
ExprState ShaderInputs
s Int
nvar Builder
body <- StateT ExprState IO ExprState
-> SNMapReaderT [Text] (StateT ExprState IO) ExprState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState IO ExprState
forall (m :: * -> *) s. Monad m => StateT s m s
get
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprState -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderUsedInput :: IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput = Int
-> (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
Map.insert Int
i (GlobDeclM ()
gDeclIn, (ExprM ()
assignOutput, GlobDeclM ()
gDeclOut)) (IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ())))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
-> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> IntMap Int (GlobDeclM (), (ExprM (), GlobDeclM ()))
shaderUsedInput ShaderInputs
s } Int
nvar Builder
body)
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
$ Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i
where
space :: Text
space = if Text -> Bool
LT.null Text
qual then Text
"" else Text
" "
assignOutput :: ExprM ()
assignOutput = do
Text
val <- ExprM Text
v
let name :: Text
name = Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i
Text -> Text -> ExprM ()
tellAssignment' Text
name Text
val
gDecl :: Text -> GlobDeclM ()
gDecl Text
s = do
Text -> GlobDeclM ()
tellGlobal Text
s
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
stype
Text -> GlobDeclM ()
tellGlobal (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
i
gDeclOut :: GlobDeclM ()
gDeclOut = Text -> GlobDeclM ()
gDecl (Text
qual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"out ")
gDeclIn :: GlobDeclM ()
gDeclIn = Text -> GlobDeclM ()
gDecl (Text
qual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in ")
declareGeometryLayout :: Text -> Text -> Int -> ExprM ()
declareGeometryLayout :: Text -> Text -> Int -> ExprM ()
declareGeometryLayout Text
inputPrimitive Text
outputPrimitive Int
maxVertices =
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ (ExprState -> ExprState) -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((ExprState -> ExprState) -> StateT ExprState IO ())
-> (ExprState -> ExprState) -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ \(ExprState ShaderInputs
s Int
nvar Builder
body) -> ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderGeometry :: Maybe (GlobDeclM ())
shaderGeometry = GlobDeclM () -> Maybe (GlobDeclM ())
forall a. a -> Maybe a
Just GlobDeclM ()
gDeclBlock } Int
nvar Builder
body
where
gDeclBlock :: GlobDeclM ()
gDeclBlock = do
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
"layout(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inputPrimitive Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") in"
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
"layout(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
outputPrimitive Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", max_vertices = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
maxVertices Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") out"
useUniform :: GlobDeclM () -> UniformId -> Int -> ExprM Text
useUniform :: GlobDeclM () -> UniformId -> Int -> ExprM Text
useUniform GlobDeclM ()
decls UniformId
blockI Int
offset = do
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ (ExprState -> ExprState) -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((ExprState -> ExprState) -> StateT ExprState IO ())
-> (ExprState -> ExprState) -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ \(ExprState ShaderInputs
s Int
nvar Builder
body) ->
ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderUsedUniformBlocks :: IntMap UniformId (GlobDeclM ())
shaderUsedUniformBlocks =
UniformId
-> GlobDeclM ()
-> IntMap UniformId (GlobDeclM ())
-> IntMap UniformId (GlobDeclM ())
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
Map.insert UniformId
blockI GlobDeclM ()
gDeclUniformBlock (IntMap UniformId (GlobDeclM ())
-> IntMap UniformId (GlobDeclM ()))
-> IntMap UniformId (GlobDeclM ())
-> IntMap UniformId (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> IntMap UniformId (GlobDeclM ())
shaderUsedUniformBlocks ShaderInputs
s }
Int
nvar
Builder
body
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
$ Text
"u" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UniformId -> Text
forall a. Show a => a -> Text
tshow UniformId
blockI Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"u" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
offset
where
gDeclUniformBlock :: GlobDeclM ()
gDeclUniformBlock = do
let blockStr :: Text
blockStr = UniformId -> Text
forall a. Show a => a -> Text
tshow UniformId
blockI
Text -> GlobDeclM ()
tellGlobal Text
"layout(std140) uniform uBlock"
Text -> GlobDeclM ()
tellGlobal Text
blockStr
Text -> GlobDeclM ()
tellGlobal Text
" {\n"
GlobDeclM ()
decls
Text -> GlobDeclM ()
tellGlobal Text
"} u"
Text -> GlobDeclM ()
tellGlobalLn Text
blockStr
useSampler :: Text -> Text -> SamplerId -> ExprM Text
useSampler :: Text -> Text -> SamplerId -> ExprM Text
useSampler Text
prefix Text
str SamplerId
name = do
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ (ExprState -> ExprState) -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((ExprState -> ExprState) -> StateT ExprState IO ())
-> (ExprState -> ExprState) -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ \(ExprState ShaderInputs
s Int
nvar Builder
body) -> ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s{ shaderUsedSamplers :: IntMap SamplerId (GlobDeclM ())
shaderUsedSamplers = SamplerId
-> GlobDeclM ()
-> IntMap SamplerId (GlobDeclM ())
-> IntMap SamplerId (GlobDeclM ())
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
Map.insert SamplerId
name GlobDeclM ()
gDeclSampler (IntMap SamplerId (GlobDeclM ())
-> IntMap SamplerId (GlobDeclM ()))
-> IntMap SamplerId (GlobDeclM ())
-> IntMap SamplerId (GlobDeclM ())
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> IntMap SamplerId (GlobDeclM ())
shaderUsedSamplers ShaderInputs
s } Int
nvar Builder
body
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
$ Text
"s" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SamplerId -> Text
forall a. Show a => a -> Text
tshow SamplerId
name
where
gDeclSampler :: GlobDeclM ()
gDeclSampler = do
Text -> GlobDeclM ()
tellGlobal Text
"uniform "
Text -> GlobDeclM ()
tellGlobal Text
prefix
Text -> GlobDeclM ()
tellGlobal Text
"sampler"
Text -> GlobDeclM ()
tellGlobal Text
str
Text -> GlobDeclM ()
tellGlobal Text
" s"
Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ SamplerId -> Text
forall a. Show a => a -> Text
tshow SamplerId
name
getNext :: Monad m => StateT ExprState m Int
getNext :: StateT ExprState m Int
getNext = do
ExprState ShaderInputs
s Int
nvar Builder
body <- StateT ExprState m ExprState
forall (m :: * -> *) s. Monad m => StateT s m s
get
ExprState -> StateT ExprState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ExprState -> StateT ExprState m ())
-> ExprState -> StateT ExprState m ()
forall a b. (a -> b) -> a -> b
$ ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s (Int
nvar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Builder
body
Int -> StateT ExprState m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
nvar
type RValue = Text
tellAssignment :: SType -> ExprM RValue -> ExprM Text
tellAssignment :: SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ ExprM Text
m = ([Text] -> Text)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text] -> ExprM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. [a] -> a
head (SNMapReaderT [Text] (StateT ExprState IO) [Text] -> ExprM Text)
-> (SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a.
MonadIO m =>
SNMapReaderT a m a -> SNMapReaderT a m a
memoizeM (SNMapReaderT [Text] (StateT ExprState IO) [Text] -> ExprM Text)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text] -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
val <- ExprM Text
m
Int
var <- StateT ExprState IO Int
-> SNMapReaderT [Text] (StateT ExprState IO) Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState IO Int
forall (m :: * -> *). Monad m => StateT ExprState m Int
getNext
let name :: Text
name = Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
var
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST (Text -> StateT ExprState IO ()) -> Text -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ SType -> Text
stypeName SType
typ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> ExprM ()
tellAssignment' Text
name Text
val
[Text] -> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
name]
tellAssignment' :: Text -> RValue -> ExprM ()
tellAssignment' :: Text -> Text -> ExprM ()
tellAssignment' Text
name Text
string = StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST (Text -> StateT ExprState IO ()) -> Text -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, Text
" = ", Text
string, Text
";\n"]
tellST :: Text -> StateT ExprState IO ()
tellST :: Text -> StateT ExprState IO ()
tellST Text
text = (ExprState -> ExprState) -> StateT ExprState IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((ExprState -> ExprState) -> StateT ExprState IO ())
-> (ExprState -> ExprState) -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ \(ExprState ShaderInputs
s Int
nvar Builder
body) -> ShaderInputs -> Int -> Builder -> ExprState
ExprState ShaderInputs
s Int
nvar (Builder
body Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
LTB.fromLazyText Text
text)
discard :: FBool -> ExprM ()
discard :: FBool -> ExprM ()
discard (S ExprM Text
m) = do
Text
b <- ExprM Text
m
Bool -> ExprM () -> ExprM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"true") (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST (Text -> StateT ExprState IO ()) -> Text -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"if (!(", Text
b, Text
")) discard;\n"]
tellGlobalLn :: Text -> GlobDeclM ()
tellGlobalLn :: Text -> GlobDeclM ()
tellGlobalLn Text
string = Text -> GlobDeclM ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
string Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";\n"
tellGlobal :: Text -> GlobDeclM ()
tellGlobal :: Text -> GlobDeclM ()
tellGlobal = Text -> GlobDeclM ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell
data ShaderBase a x where
ShaderBaseFloat :: S x Float -> ShaderBase (S x Float) x
ShaderBaseInt :: S x Int -> ShaderBase (S x Int) x
ShaderBaseWord :: S x Word -> ShaderBase (S x Word) x
ShaderBaseBool :: S x Bool -> ShaderBase (S x Bool) x
ShaderBaseUnit :: ShaderBase () x
ShaderBaseProd :: ShaderBase a x -> ShaderBase b x -> ShaderBase (a,b) x
ShaderBaseGenerativeGeometry :: S x (GenerativeGeometry p a) -> ShaderBase (S x (GenerativeGeometry p a)) x
shaderbaseDeclare :: ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseAssign :: ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseReturn :: ShaderBase a x -> ReaderT (ExprM [Text]) (State ExprState) (ShaderBase a x)
shaderbaseDeclare :: ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare (ShaderBaseFloat S x Float
_) = S x Float -> ShaderBase (S x Float) x
forall x. S x Float -> ShaderBase (S x Float) x
ShaderBaseFloat (S x Float -> ShaderBase (S x Float) x)
-> WriterT [Text] ExprM (S x Float)
-> WriterT [Text] ExprM (ShaderBase (S x Float) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SType -> WriterT [Text] ExprM (S x Float)
forall x a. SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef SType
STypeFloat
shaderbaseDeclare (ShaderBaseInt S x Int
_) = S x Int -> ShaderBase (S x Int) x
forall x. S x Int -> ShaderBase (S x Int) x
ShaderBaseInt (S x Int -> ShaderBase (S x Int) x)
-> WriterT [Text] ExprM (S x Int)
-> WriterT [Text] ExprM (ShaderBase (S x Int) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SType -> WriterT [Text] ExprM (S x Int)
forall x a. SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef SType
STypeInt
shaderbaseDeclare (ShaderBaseWord S x Word
_) = S x Word -> ShaderBase (S x Word) x
forall x. S x Word -> ShaderBase (S x Word) x
ShaderBaseWord (S x Word -> ShaderBase (S x Word) x)
-> WriterT [Text] ExprM (S x Word)
-> WriterT [Text] ExprM (ShaderBase (S x Word) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SType -> WriterT [Text] ExprM (S x Word)
forall x a. SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef SType
STypeUInt
shaderbaseDeclare (ShaderBaseBool S x Bool
_) = S x Bool -> ShaderBase (S x Bool) x
forall x. S x Bool -> ShaderBase (S x Bool) x
ShaderBaseBool (S x Bool -> ShaderBase (S x Bool) x)
-> WriterT [Text] ExprM (S x Bool)
-> WriterT [Text] ExprM (ShaderBase (S x Bool) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SType -> WriterT [Text] ExprM (S x Bool)
forall x a. SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef SType
STypeBool
shaderbaseDeclare ShaderBase a x
ShaderBaseUnit = ShaderBase () x -> WriterT [Text] ExprM (ShaderBase () x)
forall (m :: * -> *) a. Monad m => a -> m a
return ShaderBase () x
forall x. ShaderBase () x
ShaderBaseUnit
shaderbaseDeclare (ShaderBaseProd ShaderBase a x
a ShaderBase b x
b) = do
ShaderBase a x
a' <- ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
forall a x. ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare ShaderBase a x
a
ShaderBase b x
b' <- ShaderBase b x -> WriterT [Text] ExprM (ShaderBase b x)
forall a x. ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare ShaderBase b x
b
ShaderBase (a, b) x -> WriterT [Text] ExprM (ShaderBase (a, b) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderBase (a, b) x -> WriterT [Text] ExprM (ShaderBase (a, b) x))
-> ShaderBase (a, b) x
-> WriterT [Text] ExprM (ShaderBase (a, b) x)
forall a b. (a -> b) -> a -> b
$ ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd ShaderBase a x
a' ShaderBase b x
b'
shaderbaseDeclare (ShaderBaseGenerativeGeometry S x (GenerativeGeometry p a)
_) = S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x
forall x p a.
S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x
ShaderBaseGenerativeGeometry (S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x)
-> WriterT [Text] ExprM (S x (GenerativeGeometry p a))
-> WriterT
[Text] ExprM (ShaderBase (S x (GenerativeGeometry p a)) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SType -> WriterT [Text] ExprM (S x (GenerativeGeometry p a))
forall x a. SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef SType
STypeGenerativeGeometry
shaderbaseAssign :: ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign (ShaderBaseFloat S x Float
a) = S x Float -> StateT [Text] ExprM ()
forall x a. S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef S x Float
a
shaderbaseAssign (ShaderBaseInt S x Int
a) = S x Int -> StateT [Text] ExprM ()
forall x a. S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef S x Int
a
shaderbaseAssign (ShaderBaseWord S x Word
a) = S x Word -> StateT [Text] ExprM ()
forall x a. S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef S x Word
a
shaderbaseAssign (ShaderBaseBool S x Bool
a) = S x Bool -> StateT [Text] ExprM ()
forall x a. S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef S x Bool
a
shaderbaseAssign ShaderBase a x
ShaderBaseUnit = () -> StateT [Text] ExprM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shaderbaseAssign (ShaderBaseProd ShaderBase a x
a ShaderBase b x
b) = do
ShaderBase a x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign ShaderBase a x
a
ShaderBase b x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign ShaderBase b x
b
shaderbaseAssign (ShaderBaseGenerativeGeometry S x (GenerativeGeometry p a)
a) = S x (GenerativeGeometry p a) -> StateT [Text] ExprM ()
forall x a. S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef S x (GenerativeGeometry p a)
a
shaderbaseReturn :: ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
shaderbaseReturn (ShaderBaseFloat S x Float
_) = S x Float -> ShaderBase (S x Float) x
forall x. S x Float -> ShaderBase (S x Float) x
ShaderBaseFloat (S x Float -> ShaderBase (S x Float) x)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Float)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (S x Float) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Float)
forall x a.
ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
shaderbaseReturnDef
shaderbaseReturn (ShaderBaseInt S x Int
_) = S x Int -> ShaderBase (S x Int) x
forall x. S x Int -> ShaderBase (S x Int) x
ShaderBaseInt (S x Int -> ShaderBase (S x Int) x)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Int)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (S x Int) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Int)
forall x a.
ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
shaderbaseReturnDef
shaderbaseReturn (ShaderBaseWord S x Word
_) = S x Word -> ShaderBase (S x Word) x
forall x. S x Word -> ShaderBase (S x Word) x
ShaderBaseWord (S x Word -> ShaderBase (S x Word) x)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Word)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (S x Word) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Word)
forall x a.
ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
shaderbaseReturnDef
shaderbaseReturn (ShaderBaseBool S x Bool
_) = S x Bool -> ShaderBase (S x Bool) x
forall x. S x Bool -> ShaderBase (S x Bool) x
ShaderBaseBool (S x Bool -> ShaderBase (S x Bool) x)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Bool)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (S x Bool) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x Bool)
forall x a.
ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
shaderbaseReturnDef
shaderbaseReturn ShaderBase a x
ShaderBaseUnit = ShaderBase () x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase () x)
forall (m :: * -> *) a. Monad m => a -> m a
return ShaderBase () x
forall x. ShaderBase () x
ShaderBaseUnit
shaderbaseReturn (ShaderBaseProd ShaderBase a x
a ShaderBase b x
b) = do
ShaderBase a x
a' <- ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
forall a x.
ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
shaderbaseReturn ShaderBase a x
a
ShaderBase b x
b' <- ShaderBase b x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase b x)
forall a x.
ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
shaderbaseReturn ShaderBase b x
b
ShaderBase (a, b) x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (a, b) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderBase (a, b) x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (a, b) x))
-> ShaderBase (a, b) x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (a, b) x)
forall a b. (a -> b) -> a -> b
$ ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd ShaderBase a x
a' ShaderBase b x
b'
shaderbaseReturn (ShaderBaseGenerativeGeometry S x (GenerativeGeometry p a)
_) = S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x
forall x p a.
S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x
ShaderBaseGenerativeGeometry (S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x (GenerativeGeometry p a))
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (S x (GenerativeGeometry p a)) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x (GenerativeGeometry p a))
forall x a.
ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
shaderbaseReturnDef
shaderbaseDeclareDef :: SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef :: SType -> WriterT [Text] ExprM (S x a)
shaderbaseDeclareDef SType
styp = do
Int
var <- SNMapReaderT [Text] (StateT ExprState IO) Int
-> WriterT [Text] ExprM Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (SNMapReaderT [Text] (StateT ExprState IO) Int
-> WriterT [Text] ExprM Int)
-> SNMapReaderT [Text] (StateT ExprState IO) Int
-> WriterT [Text] ExprM Int
forall a b. (a -> b) -> a -> b
$ StateT ExprState IO Int
-> SNMapReaderT [Text] (StateT ExprState IO) Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState IO Int
forall (m :: * -> *). Monad m => StateT ExprState m Int
getNext
let root :: Text
root = Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
var
ExprM () -> WriterT [Text] ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (ExprM () -> WriterT [Text] ExprM ())
-> ExprM () -> WriterT [Text] ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST (Text -> StateT ExprState IO ()) -> Text -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [SType -> Text
stypeName SType
styp, Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
root, Text
";\n"]
[Text] -> WriterT [Text] ExprM ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Text
root]
S x a -> WriterT [Text] ExprM (S x a)
forall (m :: * -> *) a. Monad m => a -> m a
return (S x a -> WriterT [Text] ExprM (S x a))
-> S x a -> WriterT [Text] ExprM (S x a)
forall a b. (a -> b) -> a -> b
$ ExprM Text -> S x a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x a) -> ExprM Text -> S x a
forall a b. (a -> b) -> a -> b
$ Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
root
shaderbaseAssignDef :: S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef :: S x a -> StateT [Text] ExprM ()
shaderbaseAssignDef (S ExprM Text
shaderM) = do
Text
ul <- ExprM Text -> StateT [Text] ExprM Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift ExprM Text
shaderM
[Text]
xs <- StateT [Text] ExprM [Text]
forall (m :: * -> *) s. Monad m => StateT s m s
get
[Text] -> StateT [Text] ExprM ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put ([Text] -> StateT [Text] ExprM ())
-> [Text] -> StateT [Text] ExprM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
xs
ExprM () -> StateT [Text] ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (ExprM () -> StateT [Text] ExprM ())
-> ExprM () -> StateT [Text] ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ExprM ()
tellAssignment' ([Text] -> Text
forall a. [a] -> a
head [Text]
xs) Text
ul
() -> StateT [Text] ExprM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shaderbaseReturnDef :: ReaderT (ExprM [Text]) (State ExprState) (S x a)
shaderbaseReturnDef :: ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
shaderbaseReturnDef = do
Int
i <- StateT ExprState Identity Int
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift StateT ExprState Identity Int
forall (m :: * -> *). Monad m => StateT ExprState m Int
getNext
ExprM Text -> S x a
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x a)
-> (SNMapReaderT [Text] (StateT ExprState IO) [Text] -> ExprM Text)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> S x a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Text] -> Text)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text] -> ExprM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Int -> Text
forall a. [a] -> Int -> a
!!Int
i) (SNMapReaderT [Text] (StateT ExprState IO) [Text] -> S x a)
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(S x a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
class ShaderType a x where
type ShaderBaseType a
toBase :: x -> a -> ShaderBase (ShaderBaseType a) x
fromBase :: x -> ShaderBase (ShaderBaseType a) x -> a
instance ShaderType (S x Float) x where
type ShaderBaseType (S x Float) = (S x Float)
toBase :: x -> S x Float -> ShaderBase (ShaderBaseType (S x Float)) x
toBase x
_ = S x Float -> ShaderBase (ShaderBaseType (S x Float)) x
forall x. S x Float -> ShaderBase (S x Float) x
ShaderBaseFloat
fromBase :: x -> ShaderBase (ShaderBaseType (S x Float)) x -> S x Float
fromBase x
_ (ShaderBaseFloat S x Float
a) = S x Float
a
instance ShaderType (S x Int) x where
type ShaderBaseType (S x Int) = (S x Int)
toBase :: x -> S x Int -> ShaderBase (ShaderBaseType (S x Int)) x
toBase x
_ = S x Int -> ShaderBase (ShaderBaseType (S x Int)) x
forall x. S x Int -> ShaderBase (S x Int) x
ShaderBaseInt
fromBase :: x -> ShaderBase (ShaderBaseType (S x Int)) x -> S x Int
fromBase x
_ (ShaderBaseInt S x Int
a) = S x Int
a
instance ShaderType (S x Word) x where
type ShaderBaseType (S x Word) = (S x Word)
toBase :: x -> S x Word -> ShaderBase (ShaderBaseType (S x Word)) x
toBase x
_ = S x Word -> ShaderBase (ShaderBaseType (S x Word)) x
forall x. S x Word -> ShaderBase (S x Word) x
ShaderBaseWord
fromBase :: x -> ShaderBase (ShaderBaseType (S x Word)) x -> S x Word
fromBase x
_ (ShaderBaseWord S x Word
a) = S x Word
a
instance ShaderType (S x Bool) x where
type ShaderBaseType (S x Bool) = (S x Bool)
toBase :: x -> S x Bool -> ShaderBase (ShaderBaseType (S x Bool)) x
toBase x
_ = S x Bool -> ShaderBase (ShaderBaseType (S x Bool)) x
forall x. S x Bool -> ShaderBase (S x Bool) x
ShaderBaseBool
fromBase :: x -> ShaderBase (ShaderBaseType (S x Bool)) x -> S x Bool
fromBase x
_ (ShaderBaseBool S x Bool
a) = S x Bool
a
instance ShaderType () x where
type ShaderBaseType () = ()
toBase :: x -> () -> ShaderBase (ShaderBaseType ()) x
toBase x
_ ()
_ = ShaderBase (ShaderBaseType ()) x
forall x. ShaderBase () x
ShaderBaseUnit
fromBase :: x -> ShaderBase (ShaderBaseType ()) x -> ()
fromBase x
_ ShaderBase (ShaderBaseType ()) x
ShaderBaseUnit = ()
instance ShaderType (S x (GenerativeGeometry p a)) x where
type ShaderBaseType (S x (GenerativeGeometry p a)) = (S x (GenerativeGeometry p a))
toBase :: x
-> S x (GenerativeGeometry p a)
-> ShaderBase (ShaderBaseType (S x (GenerativeGeometry p a))) x
toBase x
_ = S x (GenerativeGeometry p a)
-> ShaderBase (ShaderBaseType (S x (GenerativeGeometry p a))) x
forall x p a.
S x (GenerativeGeometry p a)
-> ShaderBase (S x (GenerativeGeometry p a)) x
ShaderBaseGenerativeGeometry
fromBase :: x
-> ShaderBase (ShaderBaseType (S x (GenerativeGeometry p a))) x
-> S x (GenerativeGeometry p a)
fromBase x
_ (ShaderBaseGenerativeGeometry S x (GenerativeGeometry p a)
a) = S x (GenerativeGeometry p a)
S x (GenerativeGeometry p a)
a
instance ShaderType a x => ShaderType (V0 a) x where
type ShaderBaseType (V0 a) = ()
toBase :: x -> V0 a -> ShaderBase (ShaderBaseType (V0 a)) x
toBase x
_ V0 a
V0 = ShaderBase (ShaderBaseType (V0 a)) x
forall x. ShaderBase () x
ShaderBaseUnit
fromBase :: x -> ShaderBase (ShaderBaseType (V0 a)) x -> V0 a
fromBase x
_ ShaderBase (ShaderBaseType (V0 a)) x
ShaderBaseUnit = V0 a
forall a. V0 a
V0
instance ShaderType a x => ShaderType (V1 a) x where
type ShaderBaseType (V1 a) = ShaderBaseType a
toBase :: x -> V1 a -> ShaderBase (ShaderBaseType (V1 a)) x
toBase x
x ~(V1 a
a) = x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a
fromBase :: x -> ShaderBase (ShaderBaseType (V1 a)) x -> V1 a
fromBase x
x ShaderBase (ShaderBaseType (V1 a)) x
a = a -> V1 a
forall a. a -> V1 a
V1 (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase (ShaderBaseType a) x
ShaderBase (ShaderBaseType (V1 a)) x
a)
instance ShaderType a x => ShaderType (V2 a) x where
type ShaderBaseType (V2 a) = (ShaderBaseType a, ShaderBaseType a)
toBase :: x -> V2 a -> ShaderBase (ShaderBaseType (V2 a)) x
toBase x
x ~(V2 a
a a
b) = ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a, ShaderBaseType a) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
b)
fromBase :: x -> ShaderBase (ShaderBaseType (V2 a)) x -> V2 a
fromBase x
x (ShaderBaseProd ShaderBase a x
a ShaderBase b x
b) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a) (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType a) x
b)
instance ShaderType a x => ShaderType (V3 a) x where
type ShaderBaseType (V3 a) = (ShaderBaseType a, (ShaderBaseType a, ShaderBaseType a))
toBase :: x -> V3 a -> ShaderBase (ShaderBaseType (V3 a)) x
toBase x
x ~(V3 a
a a
b a
c) = ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a, ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType a, (ShaderBaseType a, ShaderBaseType a)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a, ShaderBaseType a) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
b) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
c))
fromBase :: x -> ShaderBase (ShaderBaseType (V3 a)) x -> V3 a
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b ShaderBase b x
c)) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a) (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
b) (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType a) x
c)
instance ShaderType a x => ShaderType (V4 a) x where
type ShaderBaseType (V4 a) = (ShaderBaseType a, (ShaderBaseType a, (ShaderBaseType a, ShaderBaseType a)))
toBase :: x -> V4 a -> ShaderBase (ShaderBaseType (V4 a)) x
toBase x
x ~(V4 a
a a
b a
c a
d) = ShaderBase (ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType a, (ShaderBaseType a, ShaderBaseType a)) x
-> ShaderBase
(ShaderBaseType a,
(ShaderBaseType a, (ShaderBaseType a, ShaderBaseType a)))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a, ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType a, (ShaderBaseType a, ShaderBaseType a)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
b) (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a, ShaderBaseType a) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
c) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
d)))
fromBase :: x -> ShaderBase (ShaderBaseType (V4 a)) x -> V4 a
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b (ShaderBaseProd ShaderBase a x
c ShaderBase b x
d))) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a) (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
b) (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
c) (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType a) x
d)
instance (ShaderType a x, ShaderType b x) => ShaderType (a,b) x where
type ShaderBaseType (a,b) = (ShaderBaseType a, ShaderBaseType b)
toBase :: x -> (a, b) -> ShaderBase (ShaderBaseType (a, b)) x
toBase x
x ~(a
a,b
b) = ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x
-> ShaderBase (ShaderBaseType a, ShaderBaseType b) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x b
b)
fromBase :: x -> ShaderBase (ShaderBaseType (a, b)) x -> (a, b)
fromBase x
x (ShaderBaseProd ShaderBase a x
a ShaderBase b x
b) = (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a, x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType b) x
b)
instance (ShaderType a x, ShaderType b x, ShaderType c x) => ShaderType (a,b,c) x where
type ShaderBaseType (a,b,c) = (ShaderBaseType a, (ShaderBaseType b, ShaderBaseType c))
toBase :: x -> (a, b, c) -> ShaderBase (ShaderBaseType (a, b, c)) x
toBase x
x ~(a
a,b
b,c
c) = ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b, ShaderBaseType c) x
-> ShaderBase
(ShaderBaseType a, (ShaderBaseType b, ShaderBaseType c)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType b) x
-> ShaderBase (ShaderBaseType c) x
-> ShaderBase (ShaderBaseType b, ShaderBaseType c) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x b
b) (x -> c -> ShaderBase (ShaderBaseType c) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x c
c))
fromBase :: x -> ShaderBase (ShaderBaseType (a, b, c)) x -> (a, b, c)
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b ShaderBase b x
c)) = (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a, x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType b) x
b, x -> ShaderBase (ShaderBaseType c) x -> c
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType c) x
c)
instance (ShaderType a x, ShaderType b x, ShaderType c x, ShaderType d x) => ShaderType (a,b,c,d) x where
type ShaderBaseType (a,b,c,d) = (ShaderBaseType a, (ShaderBaseType b, (ShaderBaseType c, ShaderBaseType d)))
toBase :: x -> (a, b, c, d) -> ShaderBase (ShaderBaseType (a, b, c, d)) x
toBase x
x ~(a
a,b
b,c
c,d
d) = ShaderBase (ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType b, (ShaderBaseType c, ShaderBaseType d)) x
-> ShaderBase
(ShaderBaseType a,
(ShaderBaseType b, (ShaderBaseType c, ShaderBaseType d)))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType b) x
-> ShaderBase (ShaderBaseType c, ShaderBaseType d) x
-> ShaderBase
(ShaderBaseType b, (ShaderBaseType c, ShaderBaseType d)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x b
b) (ShaderBase (ShaderBaseType c) x
-> ShaderBase (ShaderBaseType d) x
-> ShaderBase (ShaderBaseType c, ShaderBaseType d) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> c -> ShaderBase (ShaderBaseType c) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x c
c) (x -> d -> ShaderBase (ShaderBaseType d) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x d
d)))
fromBase :: x -> ShaderBase (ShaderBaseType (a, b, c, d)) x -> (a, b, c, d)
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b (ShaderBaseProd ShaderBase a x
c ShaderBase b x
d))) = (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a, x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType b) x
b, x -> ShaderBase (ShaderBaseType c) x -> c
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType c) x
c, x -> ShaderBase (ShaderBaseType d) x -> d
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType d) x
d)
instance (ShaderType a x, ShaderType b x, ShaderType c x, ShaderType d x, ShaderType e x) => ShaderType (a,b,c,d,e) x where
type ShaderBaseType (a,b,c,d,e) = (ShaderBaseType a, (ShaderBaseType b, (ShaderBaseType c, (ShaderBaseType d, ShaderBaseType e))))
toBase :: x
-> (a, b, c, d, e) -> ShaderBase (ShaderBaseType (a, b, c, d, e)) x
toBase x
x ~(a
a,b
b,c
c,d
d,e
e) = ShaderBase (ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType b,
(ShaderBaseType c, (ShaderBaseType d, ShaderBaseType e)))
x
-> ShaderBase
(ShaderBaseType a,
(ShaderBaseType b,
(ShaderBaseType c, (ShaderBaseType d, ShaderBaseType e))))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType b) x
-> ShaderBase
(ShaderBaseType c, (ShaderBaseType d, ShaderBaseType e)) x
-> ShaderBase
(ShaderBaseType b,
(ShaderBaseType c, (ShaderBaseType d, ShaderBaseType e)))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x b
b) (ShaderBase (ShaderBaseType c) x
-> ShaderBase (ShaderBaseType d, ShaderBaseType e) x
-> ShaderBase
(ShaderBaseType c, (ShaderBaseType d, ShaderBaseType e)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> c -> ShaderBase (ShaderBaseType c) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x c
c) (ShaderBase (ShaderBaseType d) x
-> ShaderBase (ShaderBaseType e) x
-> ShaderBase (ShaderBaseType d, ShaderBaseType e) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> d -> ShaderBase (ShaderBaseType d) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x d
d) (x -> e -> ShaderBase (ShaderBaseType e) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x e
e))))
fromBase :: x
-> ShaderBase (ShaderBaseType (a, b, c, d, e)) x -> (a, b, c, d, e)
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b (ShaderBaseProd ShaderBase a x
c (ShaderBaseProd ShaderBase a x
d ShaderBase b x
e)))) = (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a, x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType b) x
b, x -> ShaderBase (ShaderBaseType c) x -> c
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType c) x
c, x -> ShaderBase (ShaderBaseType d) x -> d
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType d) x
d, x -> ShaderBase (ShaderBaseType e) x -> e
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType e) x
e)
instance (ShaderType a x, ShaderType b x, ShaderType c x, ShaderType d x, ShaderType e x, ShaderType f x) => ShaderType (a,b,c,d,e,f) x where
type ShaderBaseType (a,b,c,d,e,f) = (ShaderBaseType a, (ShaderBaseType b, (ShaderBaseType c, (ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f)))))
toBase :: x
-> (a, b, c, d, e, f)
-> ShaderBase (ShaderBaseType (a, b, c, d, e, f)) x
toBase x
x ~(a
a,b
b,c
c,d
d,e
e,f
f) = ShaderBase (ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType b,
(ShaderBaseType c,
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f))))
x
-> ShaderBase
(ShaderBaseType a,
(ShaderBaseType b,
(ShaderBaseType c,
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f)))))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType b) x
-> ShaderBase
(ShaderBaseType c,
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f)))
x
-> ShaderBase
(ShaderBaseType b,
(ShaderBaseType c,
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f))))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x b
b) (ShaderBase (ShaderBaseType c) x
-> ShaderBase
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f)) x
-> ShaderBase
(ShaderBaseType c,
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f)))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> c -> ShaderBase (ShaderBaseType c) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x c
c) (ShaderBase (ShaderBaseType d) x
-> ShaderBase (ShaderBaseType e, ShaderBaseType f) x
-> ShaderBase
(ShaderBaseType d, (ShaderBaseType e, ShaderBaseType f)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> d -> ShaderBase (ShaderBaseType d) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x d
d) (ShaderBase (ShaderBaseType e) x
-> ShaderBase (ShaderBaseType f) x
-> ShaderBase (ShaderBaseType e, ShaderBaseType f) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> e -> ShaderBase (ShaderBaseType e) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x e
e) (x -> f -> ShaderBase (ShaderBaseType f) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x f
f)))))
fromBase :: x
-> ShaderBase (ShaderBaseType (a, b, c, d, e, f)) x
-> (a, b, c, d, e, f)
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b (ShaderBaseProd ShaderBase a x
c (ShaderBaseProd ShaderBase a x
d (ShaderBaseProd ShaderBase a x
e ShaderBase b x
f))))) = (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a, x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType b) x
b, x -> ShaderBase (ShaderBaseType c) x -> c
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType c) x
c, x -> ShaderBase (ShaderBaseType d) x -> d
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType d) x
d, x -> ShaderBase (ShaderBaseType e) x -> e
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType e) x
e, x -> ShaderBase (ShaderBaseType f) x -> f
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType f) x
f)
instance (ShaderType a x, ShaderType b x, ShaderType c x, ShaderType d x, ShaderType e x, ShaderType f x, ShaderType g x) => ShaderType (a,b,c,d,e,f,g) x where
type ShaderBaseType (a,b,c,d,e,f,g) = (ShaderBaseType a, (ShaderBaseType b, (ShaderBaseType c, (ShaderBaseType d, (ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g))))))
toBase :: x
-> (a, b, c, d, e, f, g)
-> ShaderBase (ShaderBaseType (a, b, c, d, e, f, g)) x
toBase x
x ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = ShaderBase (ShaderBaseType a) x
-> ShaderBase
(ShaderBaseType b,
(ShaderBaseType c,
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g)))))
x
-> ShaderBase
(ShaderBaseType a,
(ShaderBaseType b,
(ShaderBaseType c,
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g))))))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
a) (ShaderBase (ShaderBaseType b) x
-> ShaderBase
(ShaderBaseType c,
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g))))
x
-> ShaderBase
(ShaderBaseType b,
(ShaderBaseType c,
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g)))))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x b
b) (ShaderBase (ShaderBaseType c) x
-> ShaderBase
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g)))
x
-> ShaderBase
(ShaderBaseType c,
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g))))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> c -> ShaderBase (ShaderBaseType c) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x c
c) (ShaderBase (ShaderBaseType d) x
-> ShaderBase
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g)) x
-> ShaderBase
(ShaderBaseType d,
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g)))
x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> d -> ShaderBase (ShaderBaseType d) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x d
d) (ShaderBase (ShaderBaseType e) x
-> ShaderBase (ShaderBaseType f, ShaderBaseType g) x
-> ShaderBase
(ShaderBaseType e, (ShaderBaseType f, ShaderBaseType g)) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> e -> ShaderBase (ShaderBaseType e) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x e
e) (ShaderBase (ShaderBaseType f) x
-> ShaderBase (ShaderBaseType g) x
-> ShaderBase (ShaderBaseType f, ShaderBaseType g) x
forall a x b.
ShaderBase a x -> ShaderBase b x -> ShaderBase (a, b) x
ShaderBaseProd (x -> f -> ShaderBase (ShaderBaseType f) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x f
f) (x -> g -> ShaderBase (ShaderBaseType g) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x g
g))))))
fromBase :: x
-> ShaderBase (ShaderBaseType (a, b, c, d, e, f, g)) x
-> (a, b, c, d, e, f, g)
fromBase x
x (ShaderBaseProd ShaderBase a x
a (ShaderBaseProd ShaderBase a x
b (ShaderBaseProd ShaderBase a x
c (ShaderBaseProd ShaderBase a x
d (ShaderBaseProd ShaderBase a x
e (ShaderBaseProd ShaderBase a x
f ShaderBase b x
g)))))) = (x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType a) x
a, x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType b) x
b, x -> ShaderBase (ShaderBaseType c) x -> c
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType c) x
c, x -> ShaderBase (ShaderBaseType d) x -> d
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType d) x
d, x -> ShaderBase (ShaderBaseType e) x -> e
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType e) x
e, x -> ShaderBase (ShaderBaseType f) x -> f
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase a x
ShaderBase (ShaderBaseType f) x
f, x -> ShaderBase (ShaderBaseType g) x -> g
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x ShaderBase b x
ShaderBase (ShaderBaseType g) x
g)
ifThenElse' :: forall a x. (ShaderType a x) => S x Bool -> a -> a -> a
ifThenElse' :: S x Bool -> a -> a -> a
ifThenElse' S x Bool
b a
t a
e = S x Bool -> (() -> a) -> (() -> a) -> () -> a
forall a b x.
(ShaderType a x, ShaderType b x) =>
S x Bool -> (a -> b) -> (a -> b) -> a -> b
ifThenElse S x Bool
b (a -> () -> a
forall a b. a -> b -> a
const a
t) (a -> () -> a
forall a b. a -> b -> a
const a
e) ()
ifThenElse :: forall a b x. (ShaderType a x, ShaderType b x) => S x Bool -> (a -> b) -> (a -> b) -> a -> b
ifThenElse :: S x Bool -> (a -> b) -> (a -> b) -> a -> b
ifThenElse S x Bool
c a -> b
t a -> b
e a
i = x -> ShaderBase (ShaderBaseType b) x -> b
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x (ShaderBase (ShaderBaseType b) x -> b)
-> ShaderBase (ShaderBaseType b) x -> b
forall a b. (a -> b) -> a -> b
$ S x Bool
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x)
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x
ifThenElse_ S x Bool
c (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (b -> ShaderBase (ShaderBaseType b) x)
-> (ShaderBase (ShaderBaseType a) x -> b)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
t (a -> b)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x) (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (b -> ShaderBase (ShaderBaseType b) x)
-> (ShaderBase (ShaderBaseType a) x -> b)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
e (a -> b)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
i)
where
x :: x
x = x
forall a. HasCallStack => a
undefined :: x
ifThenElse_
:: S x Bool
-> (ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x)
-> (ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x)
-> ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x
ifThenElse_ :: S x Bool
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x)
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType b) x
ifThenElse_ S x Bool
bool ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x
thn ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x
els ShaderBase (ShaderBaseType a) x
a =
let ifM :: ExprM [Text]
ifM :: SNMapReaderT [Text] (StateT ExprState IO) [Text]
ifM = SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a.
MonadIO m =>
SNMapReaderT a m a -> SNMapReaderT a m a
memoizeM (SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall a b. (a -> b) -> a -> b
$ do
Text
boolStr <- S x Bool -> ExprM Text
forall x a. S x a -> ExprM Text
unS S x Bool
bool
(ShaderBase (ShaderBaseType a) x
lifted, [Text]
aDecls) <- WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text]))
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text])
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
forall a x. ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a
forall a. a
errShaderType :: a))
ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign ShaderBase (ShaderBaseType a) x
a) [Text]
aDecls
[Text]
decls <- WriterT [Text] ExprM (ShaderBase (ShaderBaseType b) x)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT [Text] ExprM (ShaderBase (ShaderBaseType b) x)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType b) x)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType b) x
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType b) x)
forall a x. ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (b
forall a. a
errShaderType :: b))
Text -> ExprM ()
tellIf Text
boolStr
ExprM () -> ExprM ()
forall (m :: * -> *) a x.
MonadIO m =>
SNMapReaderT a m x -> SNMapReaderT a m x
scopedM (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType b) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign (ShaderBase (ShaderBaseType b) x -> StateT [Text] ExprM ())
-> ShaderBase (ShaderBaseType b) x -> StateT [Text] ExprM ()
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x
thn ShaderBase (ShaderBaseType a) x
lifted) [Text]
decls
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"} else {\n"
ExprM () -> ExprM ()
forall (m :: * -> *) a x.
MonadIO m =>
SNMapReaderT a m x -> SNMapReaderT a m x
scopedM (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType b) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign (ShaderBase (ShaderBaseType b) x -> StateT [Text] ExprM ())
-> ShaderBase (ShaderBaseType b) x -> StateT [Text] ExprM ()
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType b) x
els ShaderBase (ShaderBaseType a) x
lifted) [Text]
decls
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"}\n"
[Text] -> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
decls
in State ExprState (ShaderBase (ShaderBaseType b) x)
-> ExprState -> ShaderBase (ShaderBaseType b) x
forall s a. State s a -> s -> a
evalState (ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (ShaderBaseType b) x)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> State ExprState (ShaderBase (ShaderBaseType b) x)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ShaderBase (ShaderBaseType b) x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (ShaderBaseType b) x)
forall a x.
ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
shaderbaseReturn (x -> b -> ShaderBase (ShaderBaseType b) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (b
forall a. a
errShaderType :: b))) SNMapReaderT [Text] (StateT ExprState IO) [Text]
ifM) ExprState
emptyExprState
ifThen :: forall a x. (ShaderType a x) => S x Bool -> (a -> a) -> a -> a
ifThen :: S x Bool -> (a -> a) -> a -> a
ifThen S x Bool
c a -> a
t a
i = x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x -> a
forall a b. (a -> b) -> a -> b
$ S x Bool
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
ifThen_ S x Bool
c (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a -> ShaderBase (ShaderBaseType a) x)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
t (a -> a)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
i)
where
x :: x
x = x
forall a. HasCallStack => a
undefined :: x
ifThen_ :: S x Bool -> (ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x) -> ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
ifThen_ :: S x Bool
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
ifThen_ S x Bool
bool ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
thn ShaderBase (ShaderBaseType a) x
a =
let ifM :: ExprM [Text]
ifM :: SNMapReaderT [Text] (StateT ExprState IO) [Text]
ifM = SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a.
MonadIO m =>
SNMapReaderT a m a -> SNMapReaderT a m a
memoizeM (SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall a b. (a -> b) -> a -> b
$ do
Text
boolStr <- S x Bool -> ExprM Text
forall x a. S x a -> ExprM Text
unS S x Bool
bool
(ShaderBase (ShaderBaseType a) x
lifted, [Text]
decls) <- WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text]))
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text])
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
forall a x. ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a
forall a. a
errShaderType :: a))
ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign ShaderBase (ShaderBaseType a) x
a) [Text]
decls
Text -> ExprM ()
tellIf Text
boolStr
ExprM () -> ExprM ()
forall (m :: * -> *) a x.
MonadIO m =>
SNMapReaderT a m x -> SNMapReaderT a m x
scopedM (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign (ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ())
-> ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ()
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
thn ShaderBase (ShaderBaseType a) x
lifted) [Text]
decls
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"}\n"
[Text] -> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
decls
in State ExprState (ShaderBase (ShaderBaseType a) x)
-> ExprState -> ShaderBase (ShaderBaseType a) x
forall s a. State s a -> s -> a
evalState (ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (ShaderBaseType a) x)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> State ExprState (ShaderBase (ShaderBaseType a) x)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ShaderBase (ShaderBaseType a) x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (ShaderBaseType a) x)
forall a x.
ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
shaderbaseReturn (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a
forall a. a
errShaderType :: a))) SNMapReaderT [Text] (StateT ExprState IO) [Text]
ifM) ExprState
emptyExprState
tellIf :: RValue -> ExprM ()
tellIf :: Text -> ExprM ()
tellIf Text
boolStr = StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST (Text -> StateT ExprState IO ()) -> Text -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"if(", Text
boolStr, Text
"){\n" ]
while :: forall a x. (ShaderType a x) => (a -> S x Bool) -> (a -> a) -> a -> a
while :: (a -> S x Bool) -> (a -> a) -> a -> a
while a -> S x Bool
c a -> a
f a
i = x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x -> a
forall a b. (a -> b) -> a -> b
$ (ShaderBase (ShaderBaseType a) x -> S x Bool)
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
while_ (a -> S x Bool
c (a -> S x Bool)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> S x Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a -> ShaderBase (ShaderBaseType a) x)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
f (a -> a)
-> (ShaderBase (ShaderBaseType a) x -> a)
-> ShaderBase (ShaderBaseType a) x
-> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. x -> ShaderBase (ShaderBaseType a) x -> a
forall a x.
ShaderType a x =>
x -> ShaderBase (ShaderBaseType a) x -> a
fromBase x
x) (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x a
i)
where
x :: x
x = x
forall a. HasCallStack => a
undefined :: x
while_ :: (ShaderBase (ShaderBaseType a) x -> S x Bool) -> (ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x) -> ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
while_ :: (ShaderBase (ShaderBaseType a) x -> S x Bool)
-> (ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x)
-> ShaderBase (ShaderBaseType a) x
-> ShaderBase (ShaderBaseType a) x
while_ ShaderBase (ShaderBaseType a) x -> S x Bool
bool ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
loopF ShaderBase (ShaderBaseType a) x
a =
let whileM :: SNMapReaderT [Text] (StateT ExprState IO) [Text]
whileM = SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a.
MonadIO m =>
SNMapReaderT a m a -> SNMapReaderT a m a
memoizeM (SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall a b. (a -> b) -> a -> b
$ do
(ShaderBase (ShaderBaseType a) x
lifted, [Text]
decls) <- WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text]))
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
-> ExprM (ShaderBase (ShaderBaseType a) x, [Text])
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x
-> WriterT [Text] ExprM (ShaderBase (ShaderBaseType a) x)
forall a x. ShaderBase a x -> WriterT [Text] ExprM (ShaderBase a x)
shaderbaseDeclare (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a
forall a. a
errShaderType :: a))
ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign ShaderBase (ShaderBaseType a) x
a) [Text]
decls
Text
boolDecl <- SType -> ExprM Text -> ExprM Text
tellAssignment SType
STypeBool (S x Bool -> ExprM Text
forall x a. S x a -> ExprM Text
unS (S x Bool -> ExprM Text) -> S x Bool -> ExprM Text
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x -> S x Bool
bool ShaderBase (ShaderBaseType a) x
a)
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST (Text -> StateT ExprState IO ()) -> Text -> StateT ExprState IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"while(", Text
boolDecl, Text
"){\n" ]
let looped :: ShaderBase (ShaderBaseType a) x
looped = ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x
loopF ShaderBase (ShaderBaseType a) x
lifted
ExprM () -> ExprM ()
forall (m :: * -> *) a x.
MonadIO m =>
SNMapReaderT a m x -> SNMapReaderT a m x
scopedM (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ do
ExprM () -> ExprM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExprM () -> ExprM ()) -> ExprM () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ StateT [Text] ExprM () -> [Text] -> ExprM ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShaderBase (ShaderBaseType a) x -> StateT [Text] ExprM ()
forall a x. ShaderBase a x -> StateT [Text] ExprM ()
shaderbaseAssign ShaderBase (ShaderBaseType a) x
looped) [Text]
decls
Text
loopedBoolStr <- S x Bool -> ExprM Text
forall x a. S x a -> ExprM Text
unS (S x Bool -> ExprM Text) -> S x Bool -> ExprM Text
forall a b. (a -> b) -> a -> b
$ ShaderBase (ShaderBaseType a) x -> S x Bool
bool ShaderBase (ShaderBaseType a) x
looped
Text -> Text -> ExprM ()
tellAssignment' Text
boolDecl Text
loopedBoolStr
StateT ExprState IO () -> ExprM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (StateT ExprState IO () -> ExprM ())
-> StateT ExprState IO () -> ExprM ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT ExprState IO ()
tellST Text
"}\n"
[Text] -> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
decls
in State ExprState (ShaderBase (ShaderBaseType a) x)
-> ExprState -> ShaderBase (ShaderBaseType a) x
forall s a. State s a -> s -> a
evalState (ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (ShaderBaseType a) x)
-> SNMapReaderT [Text] (StateT ExprState IO) [Text]
-> State ExprState (ShaderBase (ShaderBaseType a) x)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ShaderBase (ShaderBaseType a) x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase (ShaderBaseType a) x)
forall a x.
ShaderBase a x
-> ReaderT
(SNMapReaderT [Text] (StateT ExprState IO) [Text])
(State ExprState)
(ShaderBase a x)
shaderbaseReturn (x -> a -> ShaderBase (ShaderBaseType a) x
forall a x.
ShaderType a x =>
x -> a -> ShaderBase (ShaderBaseType a) x
toBase x
x (a
forall a. a
errShaderType :: a))) SNMapReaderT [Text] (StateT ExprState IO) [Text]
whileM) ExprState
emptyExprState
errShaderType :: a
errShaderType :: a
errShaderType = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"toBase in an instance of ShaderType is not lazy enough!"
, String
"Make sure you use tilde (~) for each pattern match on a data constructor."
]
bin :: SType -> Text -> S c x -> S c y -> S c z
bin :: SType -> Text -> S c x -> S c y -> S c z
bin SType
typ Text
o (S ExprM Text
a) (S ExprM Text
b) = ExprM Text -> S c z
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c z) -> ExprM Text -> S c z
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
Text
b' <- ExprM Text
b
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
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
fun1 :: SType -> Text -> S c x -> S c y
fun1 :: SType -> Text -> S c x -> S c y
fun1 SType
typ Text
f (S ExprM Text
a) = ExprM Text -> S c y
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c y) -> ExprM Text -> S c y
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
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
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
fun2 :: SType -> Text -> S c x -> S c y -> S c z
fun2 :: SType -> Text -> S c x -> S c y -> S c z
fun2 SType
typ Text
f (S ExprM Text
a) (S ExprM Text
b) = ExprM Text -> S c z
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c z) -> ExprM Text -> S c z
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
Text
b' <- ExprM Text
b
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
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
fun3 :: SType -> Text -> S c x -> S c y -> S c z -> S c w
fun3 :: SType -> Text -> S c x -> S c y -> S c z -> S c w
fun3 SType
typ Text
f (S ExprM Text
a) (S ExprM Text
b) (S ExprM Text
c) = ExprM Text -> S c w
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c w) -> ExprM Text -> S c w
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
Text
b' <- ExprM Text
b
Text
c' <- ExprM Text
c
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
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
")"
fun4 :: SType -> Text -> S c x -> S c y -> S c z -> S c w -> S c r
fun4 :: SType -> Text -> S c x -> S c y -> S c z -> S c w -> S c r
fun4 SType
typ Text
f (S ExprM Text
a) (S ExprM Text
b) (S ExprM Text
c) (S ExprM Text
d) = ExprM Text -> S c r
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c r) -> ExprM Text -> S c r
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
Text
b' <- ExprM Text
b
Text
c' <- ExprM Text
c
Text
d' <- ExprM Text
d
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
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
")"
postop :: SType -> Text -> S c x -> S c y
postop :: SType -> Text -> S c x -> S c y
postop SType
typ Text
f (S ExprM Text
a) = ExprM Text -> S c y
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c y) -> ExprM Text -> S c y
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
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
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
preop :: SType -> Text -> S c x -> S c y
preop :: SType -> Text -> S c x -> S c y
preop SType
typ Text
f (S ExprM Text
a) = ExprM Text -> S c y
forall x a. ExprM Text -> S x a
S (ExprM Text -> S c y) -> ExprM Text -> S c y
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment SType
typ (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
Text
a' <- ExprM Text
a
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
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
binf :: Text -> S c x -> S c y -> S c Float
binf :: Text -> S c x -> S c y -> S c Float
binf = SType -> Text -> S c x -> S c y -> S c Float
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeFloat
fun1f :: Text -> S c x -> S c Float
fun1f :: Text -> S c x -> S c Float
fun1f = SType -> Text -> S c x -> S c Float
forall c x y. SType -> Text -> S c x -> S c y
fun1 SType
STypeFloat
fun2f :: Text -> S c x -> S c y -> S c Float
fun2f :: Text -> S c x -> S c y -> S c Float
fun2f = SType -> Text -> S c x -> S c y -> S c Float
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
fun2 SType
STypeFloat
fun3f :: Text -> S c x -> S c y -> S c z -> S c Float
fun3f :: Text -> S c x -> S c y -> S c z -> S c Float
fun3f = SType -> Text -> S c x -> S c y -> S c z -> S c Float
forall c x y z w. SType -> Text -> S c x -> S c y -> S c z -> S c w
fun3 SType
STypeFloat
preopf :: Text -> S c x -> S c Float
preopf :: Text -> S c x -> S c Float
preopf = SType -> Text -> S c x -> S c Float
forall c x y. SType -> Text -> S c x -> S c y
preop SType
STypeFloat
postopf :: Text -> S c x -> S c Float
postopf :: Text -> S c x -> S c Float
postopf = SType -> Text -> S c x -> S c Float
forall c x y. SType -> Text -> S c x -> S c y
postop SType
STypeFloat
bini :: Text -> S c x -> S c y -> S c Int
bini :: Text -> S c x -> S c y -> S c Int
bini = SType -> Text -> S c x -> S c y -> S c Int
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeInt
fun1i :: Text -> S c x -> S c Int
fun1i :: Text -> S c x -> S c Int
fun1i = SType -> Text -> S c x -> S c Int
forall c x y. SType -> Text -> S c x -> S c y
fun1 SType
STypeInt
preopi :: Text -> S c x -> S c Int
preopi :: Text -> S c x -> S c Int
preopi = SType -> Text -> S c x -> S c Int
forall c x y. SType -> Text -> S c x -> S c y
preop SType
STypeInt
binu :: Text -> S c x -> S c y -> S c Word
binu :: Text -> S c x -> S c y -> S c Word
binu = SType -> Text -> S c x -> S c y -> S c Word
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeUInt
fun1u :: Text -> S c x -> S c Word
fun1u :: Text -> S c x -> S c Word
fun1u = SType -> Text -> S c x -> S c Word
forall c x y. SType -> Text -> S c x -> S c y
fun1 SType
STypeUInt
preopu :: Text -> S c x -> S c Word
preopu :: Text -> S c x -> S c Word
preopu = SType -> Text -> S c x -> S c Word
forall c x y. SType -> Text -> S c x -> S c y
preop SType
STypeUInt
instance Num (S x Float) where
+ :: S x Float -> S x Float -> S x Float
(+) = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
binf Text
"+"
(-) = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
binf Text
"-"
abs :: S x Float -> S x Float
abs = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"abs"
signum :: S x Float -> S x Float
signum = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"sign"
* :: S x Float -> S x Float -> S x Float
(*) = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
binf Text
"*"
fromInteger :: Integer -> S x Float
fromInteger = ExprM Text -> S x Float
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Float)
-> (Integer -> ExprM Text) -> Integer -> S x Float
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> (Integer -> Text) -> Integer -> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Text
forall a. Show a => a -> Text
tshow
negate :: S x Float -> S x Float
negate = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
preopf Text
"-"
instance Num (S x Int) where
+ :: S x Int -> S x Int -> S x Int
(+) = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"+"
(-) = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"-"
abs :: S x Int -> S x Int
abs = Text -> S x Int -> S x Int
forall c x. Text -> S c x -> S c Int
fun1i Text
"abs"
signum :: S x Int -> S x Int
signum = Text -> S x Int -> S x Int
forall c x. Text -> S c x -> S c Int
fun1i Text
"sign"
* :: S x Int -> S x Int -> S x Int
(*) = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"*"
fromInteger :: Integer -> S x Int
fromInteger = ExprM Text -> S x Int
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Int)
-> (Integer -> ExprM Text) -> Integer -> S x Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> (Integer -> Text) -> Integer -> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Text
forall a. Show a => a -> Text
tshow
negate :: S x Int -> S x Int
negate = Text -> S x Int -> S x Int
forall c x. Text -> S c x -> S c Int
preopi Text
"-"
instance Num (S x Word) where
+ :: S x Word -> S x Word -> S x Word
(+) = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"+"
(-) = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"-"
abs :: S x Word -> S x Word
abs = Text -> S x Word -> S x Word
forall c x. Text -> S c x -> S c Word
fun1u Text
"abs"
signum :: S x Word -> S x Word
signum = Text -> S x Word -> S x Word
forall c x. Text -> S c x -> S c Word
fun1u Text
"sign"
* :: S x Word -> S x Word -> S x Word
(*) = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"*"
fromInteger :: Integer -> S x Word
fromInteger Integer
x = ExprM Text -> S x Word
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Word) -> ExprM Text -> S x Word
forall a b. (a -> b) -> a -> b
$ 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
$ Integer -> Text
forall a. Show a => a -> Text
tshow Integer
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"u"
negate :: S x Word -> S x Word
negate = Text -> S x Word -> S x Word
forall c x. Text -> S c x -> S c Word
preopu Text
"-"
instance Fractional (S x Float) where
/ :: S x Float -> S x Float -> S x Float
(/) = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
binf Text
"/"
fromRational :: Rational -> S x Float
fromRational = ExprM Text -> S x Float
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Float)
-> (Rational -> ExprM Text) -> Rational -> S x Float
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text)
-> (Rational -> Text) -> Rational -> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text
"float(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Rational -> Text) -> Rational -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Text -> Text) -> (Rational -> Text) -> Rational -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Float -> Text
forall a. Show a => a -> Text
tshow (Float -> Text) -> (Rational -> Float) -> Rational -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Float -> Float -> Float
forall a. a -> a -> a
`asTypeOf` (Float
forall a. HasCallStack => a
undefined :: Float)) (Float -> Float) -> (Rational -> Float) -> Rational -> Float
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational
class Integral' a where
div' :: a -> a -> a
mod' :: a -> a -> a
instance Integral' Int where
div' :: Int -> Int -> Int
div' = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div
mod' :: Int -> Int -> Int
mod' = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod
instance Integral' Int32 where
div' :: Int32 -> Int32 -> Int32
div' = Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
div
mod' :: Int32 -> Int32 -> Int32
mod' = Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
mod
instance Integral' Int16 where
div' :: Int16 -> Int16 -> Int16
div' = Int16 -> Int16 -> Int16
forall a. Integral a => a -> a -> a
div
mod' :: Int16 -> Int16 -> Int16
mod' = Int16 -> Int16 -> Int16
forall a. Integral a => a -> a -> a
mod
instance Integral' Int8 where
div' :: Int8 -> Int8 -> Int8
div' = Int8 -> Int8 -> Int8
forall a. Integral a => a -> a -> a
div
mod' :: Int8 -> Int8 -> Int8
mod' = Int8 -> Int8 -> Int8
forall a. Integral a => a -> a -> a
mod
instance Integral' Word where
div' :: Word -> Word -> Word
div' = Word -> Word -> Word
forall a. Integral a => a -> a -> a
div
mod' :: Word -> Word -> Word
mod' = Word -> Word -> Word
forall a. Integral a => a -> a -> a
mod
instance Integral' Word32 where
div' :: Word32 -> Word32 -> Word32
div' = Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
div
mod' :: Word32 -> Word32 -> Word32
mod' = Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
mod
instance Integral' Word16 where
div' :: Word16 -> Word16 -> Word16
div' = Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
div
mod' :: Word16 -> Word16 -> Word16
mod' = Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
mod
instance Integral' Word8 where
div' :: Word8 -> Word8 -> Word8
div' = Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
div
mod' :: Word8 -> Word8 -> Word8
mod' = Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
mod
instance Integral' (S x Int) where
div' :: S x Int -> S x Int -> S x Int
div' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"/"
mod' :: S x Int -> S x Int -> S x Int
mod' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"%"
instance Integral' (S x Word) where
div' :: S x Word -> S x Word -> S x Word
div' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"/"
mod' :: S x Word -> S x Word -> S x Word
mod' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"%"
instance Integral' a => Integral' (V0 a) where
div' :: V0 a -> V0 a -> V0 a
div' = (a -> a -> a) -> V0 a -> V0 a -> V0 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
div'
mod' :: V0 a -> V0 a -> V0 a
mod' = (a -> a -> a) -> V0 a -> V0 a -> V0 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
mod'
instance Integral' a => Integral' (V1 a) where
div' :: V1 a -> V1 a -> V1 a
div' = (a -> a -> a) -> V1 a -> V1 a -> V1 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
div'
mod' :: V1 a -> V1 a -> V1 a
mod' = (a -> a -> a) -> V1 a -> V1 a -> V1 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
mod'
instance Integral' a => Integral' (V2 a) where
div' :: V2 a -> V2 a -> V2 a
div' = (a -> a -> a) -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
div'
mod' :: V2 a -> V2 a -> V2 a
mod' = (a -> a -> a) -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
mod'
instance Integral' a => Integral' (V3 a) where
div' :: V3 a -> V3 a -> V3 a
div' = (a -> a -> a) -> V3 a -> V3 a -> V3 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
div'
mod' :: V3 a -> V3 a -> V3 a
mod' = (a -> a -> a) -> V3 a -> V3 a -> V3 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
mod'
instance Integral' a => Integral' (V4 a) where
div' :: V4 a -> V4 a -> V4 a
div' = (a -> a -> a) -> V4 a -> V4 a -> V4 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
div'
mod' :: V4 a -> V4 a -> V4 a
mod' = (a -> a -> a) -> V4 a -> V4 a -> V4 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral' a => a -> a -> a
mod'
class Bits' a where
and' :: a -> a -> a
or' :: a -> a -> a
xor' :: a -> a -> a
complement' :: a -> a
shiftL' :: a -> a -> a
shiftR' :: a -> a -> a
bitSize' :: a -> Int
instance Bits' (S x Int) where
and' :: S x Int -> S x Int -> S x Int
and' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"&"
or' :: S x Int -> S x Int -> S x Int
or' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"|"
xor' :: S x Int -> S x Int -> S x Int
xor' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"^"
complement' :: S x Int -> S x Int
complement' = Text -> S x Int -> S x Int
forall c x. Text -> S c x -> S c Int
fun1i Text
"~"
shiftL' :: S x Int -> S x Int -> S x Int
shiftL' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
"<<"
shiftR' :: S x Int -> S x Int -> S x Int
shiftR' = Text -> S x Int -> S x Int -> S x Int
forall c x y. Text -> S c x -> S c y -> S c Int
bini Text
">>"
bitSize' :: S x Int -> Int
bitSize' = Int -> S x Int -> Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. HasCallStack => a
undefined :: Int))
instance Bits' (S x Word) where
and' :: S x Word -> S x Word -> S x Word
and' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"&"
or' :: S x Word -> S x Word -> S x Word
or' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"|"
xor' :: S x Word -> S x Word -> S x Word
xor' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"^"
complement' :: S x Word -> S x Word
complement' = Text -> S x Word -> S x Word
forall c x. Text -> S c x -> S c Word
fun1u Text
"~"
shiftL' :: S x Word -> S x Word -> S x Word
shiftL' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
"<<"
shiftR' :: S x Word -> S x Word -> S x Word
shiftR' = Text -> S x Word -> S x Word -> S x Word
forall c x y. Text -> S c x -> S c y -> S c Word
binu Text
">>"
bitSize' :: S x Word -> Int
bitSize' = Int -> S x Word -> Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
forall a. HasCallStack => a
undefined :: Word))
instance Floating (S x Float) where
pi :: S x Float
pi = ExprM Text -> S x Float
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Float) -> ExprM Text -> S x Float
forall a b. (a -> b) -> a -> b
$ 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
$ Float -> Text
forall a. Show a => a -> Text
tshow (Float
forall a. Floating a => a
pi :: Float)
sqrt :: S x Float -> S x Float
sqrt = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"sqrt"
exp :: S x Float -> S x Float
exp = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"exp"
log :: S x Float -> S x Float
log = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"log"
** :: S x Float -> S x Float -> S x Float
(**) = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
fun2f Text
"pow"
sin :: S x Float -> S x Float
sin = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"sin"
cos :: S x Float -> S x Float
cos = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"cos"
tan :: S x Float -> S x Float
tan = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"tan"
asin :: S x Float -> S x Float
asin = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"asin"
acos :: S x Float -> S x Float
acos = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"acos"
atan :: S x Float -> S x Float
atan = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"atan"
sinh :: S x Float -> S x Float
sinh = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"sinh"
cosh :: S x Float -> S x Float
cosh = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"cosh"
asinh :: S x Float -> S x Float
asinh = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"asinh"
atanh :: S x Float -> S x Float
atanh = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"atanh"
acosh :: S x Float -> S x Float
acosh = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"acosh"
instance Boolean (S x Bool) where
true :: S x Bool
true = ExprM Text -> S x Bool
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Bool) -> ExprM Text -> S x Bool
forall a b. (a -> b) -> a -> b
$ Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"true"
false :: S x Bool
false = ExprM Text -> S x Bool
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x Bool) -> ExprM Text -> S x Bool
forall a b. (a -> b) -> a -> b
$ Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"false"
notB :: S x Bool -> S x Bool
notB = SType -> Text -> S x Bool -> S x Bool
forall c x y. SType -> Text -> S c x -> S c y
preop SType
STypeBool Text
"!"
&&* :: S x Bool -> S x Bool -> S x Bool
(&&*) = SType -> Text -> S x Bool -> S x Bool -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
"&&"
||* :: S x Bool -> S x Bool -> S x Bool
(||*) = SType -> Text -> S x Bool -> S x Bool -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
"||"
type instance BooleanOf (S x a) = S x Bool
instance Eq a => EqB (S x a) where
==* :: S x a -> S x a -> bool
(==*) = SType -> Text -> S x a -> S x a -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
"=="
/=* :: S x a -> S x a -> bool
(/=*) = SType -> Text -> S x a -> S x a -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
"!="
instance Ord a => OrdB (S x a) where
<* :: S x a -> S x a -> bool
(<*) = SType -> Text -> S x a -> S x a -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
"<"
<=* :: S x a -> S x a -> bool
(<=*) = SType -> Text -> S x a -> S x a -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
"<="
>=* :: S x a -> S x a -> bool
(>=*) = SType -> Text -> S x a -> S x a -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
">="
>* :: S x a -> S x a -> bool
(>*) = SType -> Text -> S x a -> S x a -> S x Bool
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin SType
STypeBool Text
">"
instance IfB (S x Float) where ifB :: bool -> S x Float -> S x Float -> S x Float
ifB = bool -> S x Float -> S x Float -> S x Float
forall a x. ShaderType a x => S x Bool -> a -> a -> a
ifThenElse'
instance IfB (S x Int) where ifB :: bool -> S x Int -> S x Int -> S x Int
ifB = bool -> S x Int -> S x Int -> S x Int
forall a x. ShaderType a x => S x Bool -> a -> a -> a
ifThenElse'
instance IfB (S x Word) where ifB :: bool -> S x Word -> S x Word -> S x Word
ifB = bool -> S x Word -> S x Word -> S x Word
forall a x. ShaderType a x => S x Bool -> a -> a -> a
ifThenElse'
instance IfB (S x Bool) where ifB :: bool -> S x Bool -> S x Bool -> S x Bool
ifB = bool -> S x Bool -> S x Bool -> S x Bool
forall a x. ShaderType a x => S x Bool -> a -> a -> a
ifThenElse'
instance IfB (S x (GenerativeGeometry p b)) where ifB :: bool
-> S x (GenerativeGeometry p b)
-> S x (GenerativeGeometry p b)
-> S x (GenerativeGeometry p b)
ifB = bool
-> S x (GenerativeGeometry p b)
-> S x (GenerativeGeometry p b)
-> S x (GenerativeGeometry p b)
forall a x. ShaderType a x => S x Bool -> a -> a -> a
ifThenElse'
instance Conjugate (S x Float)
instance Conjugate (S x Int)
instance Conjugate (S x Word)
instance TrivialConjugate (S x Float)
instance TrivialConjugate (S x Int)
instance TrivialConjugate (S x Word)
class Floating a => Real' a where
rsqrt :: a -> a
exp2 :: a -> a
log2 :: a -> a
floor' :: a -> a
ceiling' :: a -> a
fract' :: a -> a
mod'' :: a -> a -> a
mix :: a -> a -> a-> a
atan2' :: a -> a -> a
rsqrt = (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/) (a -> a) -> (a -> a) -> a -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
forall a. Floating a => a -> a
sqrt
exp2 = (a
2a -> a -> a
forall a. Floating a => a -> a -> a
**)
log2 = a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
2
mix a
x a
y a
a = a
xa -> a -> a
forall a. Num a => a -> a -> a
*(a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
a)a -> a -> a
forall a. Num a => a -> a -> a
+a
ya -> a -> a
forall a. Num a => a -> a -> a
*a
a
fract' a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall a. Real' a => a -> a
floor' a
x
mod'' a
x a
y = a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
ya -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Real' a => a -> a
floor' (a
xa -> a -> a
forall a. Fractional a => a -> a -> a
/a
y)
floor' a
x = -a -> a
forall a. Real' a => a -> a
ceiling' (-a
x)
ceiling' a
x = -a -> a
forall a. Real' a => a -> a
floor' (-a
x)
{-# MINIMAL (floor' | ceiling') , atan2' #-}
instance Real' Float where
floor' :: Float -> Float
floor' = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor
ceiling' :: Float -> Float
ceiling' = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
atan2' :: Float -> Float -> Float
atan2' = Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2
instance Real' Double where
floor' :: Double -> Double
floor' = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> (Double -> Integer) -> Double -> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor
ceiling' :: Double -> Double
ceiling' = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> (Double -> Integer) -> Double -> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
atan2' :: Double -> Double -> Double
atan2' = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2
instance Real' (S x Float) where
rsqrt :: S x Float -> S x Float
rsqrt = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"inversesqrt"
exp2 :: S x Float -> S x Float
exp2 = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"exp2"
log2 :: S x Float -> S x Float
log2 = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"log2"
floor' :: S x Float -> S x Float
floor' = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"floor"
ceiling' :: S x Float -> S x Float
ceiling' = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"ceil"
fract' :: S x Float -> S x Float
fract' = Text -> S x Float -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"fract"
mod'' :: S x Float -> S x Float -> S x Float
mod'' = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
fun2f Text
"mod"
mix :: S x Float -> S x Float -> S x Float -> S x Float
mix = Text -> S x Float -> S x Float -> S x Float -> S x Float
forall c x y z. Text -> S c x -> S c y -> S c z -> S c Float
fun3f Text
"mix"
atan2' :: S x Float -> S x Float -> S x Float
atan2' = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
fun2f Text
"atan"
instance (Real' a) => Real' (V0 a) where
rsqrt :: V0 a -> V0 a
rsqrt = (a -> a) -> V0 a -> V0 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
rsqrt
exp2 :: V0 a -> V0 a
exp2 = (a -> a) -> V0 a -> V0 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
exp2
log2 :: V0 a -> V0 a
log2 = (a -> a) -> V0 a -> V0 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
log2
floor' :: V0 a -> V0 a
floor' = (a -> a) -> V0 a -> V0 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
floor'
ceiling' :: V0 a -> V0 a
ceiling' = (a -> a) -> V0 a -> V0 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
ceiling'
fract' :: V0 a -> V0 a
fract' = (a -> a) -> V0 a -> V0 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
fract'
mod'' :: V0 a -> V0 a -> V0 a
mod'' = (a -> a -> a) -> V0 a -> V0 a -> V0 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
mod''
mix :: V0 a -> V0 a -> V0 a -> V0 a
mix = (a -> a -> a -> a) -> V0 a -> V0 a -> V0 a -> V0 a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> a -> a -> a
forall a. Real' a => a -> a -> a -> a
mix
atan2' :: V0 a -> V0 a -> V0 a
atan2' = (a -> a -> a) -> V0 a -> V0 a -> V0 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
atan2'
instance (Real' a) => Real' (V1 a) where
rsqrt :: V1 a -> V1 a
rsqrt = (a -> a) -> V1 a -> V1 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
rsqrt
exp2 :: V1 a -> V1 a
exp2 = (a -> a) -> V1 a -> V1 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
exp2
log2 :: V1 a -> V1 a
log2 = (a -> a) -> V1 a -> V1 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
log2
floor' :: V1 a -> V1 a
floor' = (a -> a) -> V1 a -> V1 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
floor'
ceiling' :: V1 a -> V1 a
ceiling' = (a -> a) -> V1 a -> V1 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
ceiling'
fract' :: V1 a -> V1 a
fract' = (a -> a) -> V1 a -> V1 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
fract'
mod'' :: V1 a -> V1 a -> V1 a
mod'' = (a -> a -> a) -> V1 a -> V1 a -> V1 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
mod''
mix :: V1 a -> V1 a -> V1 a -> V1 a
mix = (a -> a -> a -> a) -> V1 a -> V1 a -> V1 a -> V1 a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> a -> a -> a
forall a. Real' a => a -> a -> a -> a
mix
atan2' :: V1 a -> V1 a -> V1 a
atan2' = (a -> a -> a) -> V1 a -> V1 a -> V1 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
atan2'
instance (Real' a) => Real' (V2 a) where
rsqrt :: V2 a -> V2 a
rsqrt = (a -> a) -> V2 a -> V2 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
rsqrt
exp2 :: V2 a -> V2 a
exp2 = (a -> a) -> V2 a -> V2 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
exp2
log2 :: V2 a -> V2 a
log2 = (a -> a) -> V2 a -> V2 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
log2
floor' :: V2 a -> V2 a
floor' = (a -> a) -> V2 a -> V2 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
floor'
ceiling' :: V2 a -> V2 a
ceiling' = (a -> a) -> V2 a -> V2 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
ceiling'
fract' :: V2 a -> V2 a
fract' = (a -> a) -> V2 a -> V2 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
fract'
mod'' :: V2 a -> V2 a -> V2 a
mod'' = (a -> a -> a) -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
mod''
mix :: V2 a -> V2 a -> V2 a -> V2 a
mix = (a -> a -> a -> a) -> V2 a -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> a -> a -> a
forall a. Real' a => a -> a -> a -> a
mix
atan2' :: V2 a -> V2 a -> V2 a
atan2' = (a -> a -> a) -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
atan2'
instance (Real' a) => Real' (V3 a) where
rsqrt :: V3 a -> V3 a
rsqrt = (a -> a) -> V3 a -> V3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
rsqrt
exp2 :: V3 a -> V3 a
exp2 = (a -> a) -> V3 a -> V3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
exp2
log2 :: V3 a -> V3 a
log2 = (a -> a) -> V3 a -> V3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
log2
floor' :: V3 a -> V3 a
floor' = (a -> a) -> V3 a -> V3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
floor'
ceiling' :: V3 a -> V3 a
ceiling' = (a -> a) -> V3 a -> V3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
ceiling'
fract' :: V3 a -> V3 a
fract' = (a -> a) -> V3 a -> V3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
fract'
mod'' :: V3 a -> V3 a -> V3 a
mod'' = (a -> a -> a) -> V3 a -> V3 a -> V3 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
mod''
mix :: V3 a -> V3 a -> V3 a -> V3 a
mix = (a -> a -> a -> a) -> V3 a -> V3 a -> V3 a -> V3 a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> a -> a -> a
forall a. Real' a => a -> a -> a -> a
mix
atan2' :: V3 a -> V3 a -> V3 a
atan2' = (a -> a -> a) -> V3 a -> V3 a -> V3 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
atan2'
instance (Real' a) => Real' (V4 a) where
rsqrt :: V4 a -> V4 a
rsqrt = (a -> a) -> V4 a -> V4 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
rsqrt
exp2 :: V4 a -> V4 a
exp2 = (a -> a) -> V4 a -> V4 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
exp2
log2 :: V4 a -> V4 a
log2 = (a -> a) -> V4 a -> V4 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
log2
floor' :: V4 a -> V4 a
floor' = (a -> a) -> V4 a -> V4 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
floor'
ceiling' :: V4 a -> V4 a
ceiling' = (a -> a) -> V4 a -> V4 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
ceiling'
fract' :: V4 a -> V4 a
fract' = (a -> a) -> V4 a -> V4 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Real' a => a -> a
fract'
mod'' :: V4 a -> V4 a -> V4 a
mod'' = (a -> a -> a) -> V4 a -> V4 a -> V4 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
mod''
mix :: V4 a -> V4 a -> V4 a -> V4 a
mix = (a -> a -> a -> a) -> V4 a -> V4 a -> V4 a -> V4 a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> a -> a -> a
forall a. Real' a => a -> a -> a -> a
mix
atan2' :: V4 a -> V4 a -> V4 a
atan2' = (a -> a -> a) -> V4 a -> V4 a -> V4 a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Real' a => a -> a -> a
atan2'
class (IfB a, OrdB a, Floating a) => FloatingOrd a where
clamp :: a -> a -> a -> a
saturate :: a -> a
step :: a -> a -> a
smoothstep :: a -> a -> a -> a
clamp a
x a
a = a -> a -> a
forall a. (IfB a, OrdB a) => a -> a -> a
minB (a -> a -> a
forall a. (IfB a, OrdB a) => a -> a -> a
maxB a
x a
a)
saturate a
x = a -> a -> a -> a
forall a. FloatingOrd a => a -> a -> a -> a
clamp a
x a
0 a
1
step a
a a
x = BooleanOf a -> a -> a -> a
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (a
x a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
<* a
a) a
0 a
1
smoothstep a
a a
b a
x = let t :: a
t = a -> a
forall a. FloatingOrd a => a -> a
saturate ((a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
a) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
a)) in a
ta -> a -> a
forall a. Num a => a -> a -> a
*a
ta -> a -> a
forall a. Num a => a -> a -> a
*(a
3a -> a -> a
forall a. Num a => a -> a -> a
-a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
t)
instance FloatingOrd Float
instance FloatingOrd Double
instance FloatingOrd (S x Float) where
clamp :: S x Float -> S x Float -> S x Float -> S x Float
clamp = Text -> S x Float -> S x Float -> S x Float -> S x Float
forall c x y z. Text -> S c x -> S c y -> S c z -> S c Float
fun3f Text
"clamp"
step :: S x Float -> S x Float -> S x Float
step = Text -> S x Float -> S x Float -> S x Float
forall c x y. Text -> S c x -> S c y -> S c Float
fun2f Text
"step"
smoothstep :: S x Float -> S x Float -> S x Float -> S x Float
smoothstep = Text -> S x Float -> S x Float -> S x Float -> S x Float
forall c x y z. Text -> S c x -> S c y -> S c z -> S c Float
fun3f Text
"smoothstep"
class Convert a where
type ConvertFloat a
type ConvertInt a
type ConvertWord a
toFloat :: a -> ConvertFloat a
toInt :: a -> ConvertInt a
toWord :: a -> ConvertWord a
instance Convert Float where
type ConvertFloat Float = Float
type ConvertInt Float = Int
type ConvertWord Float = Word
toFloat :: Float -> ConvertFloat Float
toFloat = Float -> ConvertFloat Float
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
toInt :: Float -> ConvertInt Float
toInt = Float -> ConvertInt Float
forall a b. (RealFrac a, Integral b) => a -> b
truncate
toWord :: Float -> ConvertWord Float
toWord = Float -> ConvertWord Float
forall a b. (RealFrac a, Integral b) => a -> b
truncate
instance Convert Int where
type ConvertFloat Int = Float
type ConvertInt Int = Int
type ConvertWord Int = Word
toFloat :: Int -> ConvertFloat Int
toFloat = Int -> ConvertFloat Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toInt :: Int -> ConvertInt Int
toInt = Int -> ConvertInt Int
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
toWord :: Int -> ConvertWord Int
toWord = Int -> ConvertWord Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convert Word where
type ConvertFloat Word = Float
type ConvertInt Word = Int
type ConvertWord Word = Word
toFloat :: Word -> ConvertFloat Word
toFloat = Word -> ConvertFloat Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toInt :: Word -> ConvertInt Word
toInt = Word -> ConvertInt Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toWord :: Word -> ConvertWord Word
toWord = Word -> ConvertWord Word
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance Convert (S x Float) where
type ConvertFloat (S x Float) = S x Float
type ConvertInt (S x Float) = S x Int
type ConvertWord (S x Float) = S x Word
toFloat :: S x Float -> ConvertFloat (S x Float)
toFloat = S x Float -> ConvertFloat (S x Float)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
toInt :: S x Float -> ConvertInt (S x Float)
toInt = Text -> S x Float -> S x Int
forall c x. Text -> S c x -> S c Int
fun1i Text
"int"
toWord :: S x Float -> ConvertWord (S x Float)
toWord = Text -> S x Float -> S x Word
forall c x. Text -> S c x -> S c Word
fun1u Text
"uint"
instance Convert (S x Int) where
type ConvertFloat (S x Int) = S x Float
type ConvertInt (S x Int) = S x Int
type ConvertWord (S x Int) = S x Word
toFloat :: S x Int -> ConvertFloat (S x Int)
toFloat = Text -> S x Int -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"float"
toInt :: S x Int -> ConvertInt (S x Int)
toInt = S x Int -> ConvertInt (S x Int)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
toWord :: S x Int -> ConvertWord (S x Int)
toWord = Text -> S x Int -> S x Word
forall c x. Text -> S c x -> S c Word
fun1u Text
"uint"
instance Convert (S x Word) where
type ConvertFloat (S x Word) = S x Float
type ConvertInt (S x Word) = S x Int
type ConvertWord (S x Word) = S x Word
toFloat :: S x Word -> ConvertFloat (S x Word)
toFloat = Text -> S x Word -> S x Float
forall c x. Text -> S c x -> S c Float
fun1f Text
"float"
toInt :: S x Word -> ConvertInt (S x Word)
toInt = Text -> S x Word -> S x Int
forall c x. Text -> S c x -> S c Int
fun1i Text
"int"
toWord :: S x Word -> ConvertWord (S x Word)
toWord = S x Word -> ConvertWord (S x Word)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
dFdx :: FFloat -> FFloat
dFdy :: FFloat -> FFloat
fwidth :: FFloat -> FFloat
dFdx :: FFloat -> FFloat
dFdx = Text -> FFloat -> FFloat
forall c x. Text -> S c x -> S c Float
fun1f Text
"dFdx"
dFdy :: FFloat -> FFloat
dFdy = Text -> FFloat -> FFloat
forall c x. Text -> S c x -> S c Float
fun1f Text
"dFdy"
fwidth :: FFloat -> FFloat
fwidth = Text -> FFloat -> FFloat
forall c x. Text -> S c x -> S c Float
fun1f Text
"fwidth"
fromV :: Foldable t => (a -> S x b) -> Text -> t a -> S x (t b)
fromV :: (a -> S x b) -> Text -> t a -> S x (t b)
fromV a -> S x b
f Text
s t a
v = ExprM Text -> S x (t b)
forall x a. ExprM Text -> S x a
S (ExprM Text -> S x (t b)) -> ExprM Text -> S x (t b)
forall a b. (a -> b) -> a -> b
$ SType -> ExprM Text -> ExprM Text
tellAssignment (Text -> SType
STypeDyn Text
s) (ExprM Text -> ExprM Text) -> ExprM Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ do
[Text]
params <- (a -> ExprM Text)
-> [a] -> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (S x b -> ExprM Text
forall x a. S x a -> ExprM Text
unS (S x b -> ExprM Text) -> (a -> S x b) -> a -> ExprM Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> S x b
f) ([a] -> SNMapReaderT [Text] (StateT ExprState IO) [Text])
-> [a] -> SNMapReaderT [Text] (StateT ExprState IO) [Text]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
v
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
$ Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
LT.intercalate Text
"," [Text]
params Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
fromVec4 :: V4 (S x Float) -> S x (V4 Float)
fromVec4 :: V4 (S x Float) -> S x (V4 Float)
fromVec4 = (S x Float -> S x Float)
-> Text -> V4 (S x Float) -> S x (V4 Float)
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV S x Float -> S x Float
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Text
"vec4"
fromVec3 :: V3 (S x Float) -> S x (V3 Float)
fromVec3 :: V3 (S x Float) -> S x (V3 Float)
fromVec3 = (S x Float -> S x Float)
-> Text -> V3 (S x Float) -> S x (V3 Float)
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV S x Float -> S x Float
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Text
"vec3"
fromVec2 :: V2 (S x Float) -> S x (V2 Float)
fromVec2 :: V2 (S x Float) -> S x (V2 Float)
fromVec2 = (S x Float -> S x Float)
-> Text -> V2 (S x Float) -> S x (V2 Float)
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV S x Float -> S x Float
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Text
"vec2"
fromMat22 :: V2 (V2 (S x Float)) -> S x (V2 (V2 Float))
fromMat22 :: V2 (V2 (S x Float)) -> S x (V2 (V2 Float))
fromMat22 = (V2 (S x Float) -> S x (V2 Float))
-> Text -> V2 (V2 (S x Float)) -> S x (V2 (V2 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V2 (S x Float) -> S x (V2 Float)
forall x. V2 (S x Float) -> S x (V2 Float)
fromVec2 Text
"mat2x2"
fromMat23 :: V2 (V3 (S x Float)) -> S x (V2 (V3 Float))
fromMat23 :: V2 (V3 (S x Float)) -> S x (V2 (V3 Float))
fromMat23 = (V3 (S x Float) -> S x (V3 Float))
-> Text -> V2 (V3 (S x Float)) -> S x (V2 (V3 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V3 (S x Float) -> S x (V3 Float)
forall x. V3 (S x Float) -> S x (V3 Float)
fromVec3 Text
"mat2x3"
fromMat24 :: V2 (V4 (S x Float)) -> S x (V2 (V4 Float))
fromMat24 :: V2 (V4 (S x Float)) -> S x (V2 (V4 Float))
fromMat24 = (V4 (S x Float) -> S x (V4 Float))
-> Text -> V2 (V4 (S x Float)) -> S x (V2 (V4 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V4 (S x Float) -> S x (V4 Float)
forall x. V4 (S x Float) -> S x (V4 Float)
fromVec4 Text
"mat2x4"
fromMat32 :: V3 (V2 (S x Float)) -> S x (V3 (V2 Float))
fromMat32 :: V3 (V2 (S x Float)) -> S x (V3 (V2 Float))
fromMat32 = (V2 (S x Float) -> S x (V2 Float))
-> Text -> V3 (V2 (S x Float)) -> S x (V3 (V2 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V2 (S x Float) -> S x (V2 Float)
forall x. V2 (S x Float) -> S x (V2 Float)
fromVec2 Text
"mat3x2"
fromMat33 :: V3 (V3 (S x Float)) -> S x (V3 (V3 Float))
fromMat33 :: V3 (V3 (S x Float)) -> S x (V3 (V3 Float))
fromMat33 = (V3 (S x Float) -> S x (V3 Float))
-> Text -> V3 (V3 (S x Float)) -> S x (V3 (V3 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V3 (S x Float) -> S x (V3 Float)
forall x. V3 (S x Float) -> S x (V3 Float)
fromVec3 Text
"mat3x3"
fromMat34 :: V3 (V4 (S x Float)) -> S x (V3 (V4 Float))
fromMat34 :: V3 (V4 (S x Float)) -> S x (V3 (V4 Float))
fromMat34 = (V4 (S x Float) -> S x (V4 Float))
-> Text -> V3 (V4 (S x Float)) -> S x (V3 (V4 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V4 (S x Float) -> S x (V4 Float)
forall x. V4 (S x Float) -> S x (V4 Float)
fromVec4 Text
"mat3x4"
fromMat42 :: V4 (V2 (S x Float)) -> S x (V4 (V2 Float))
fromMat42 :: V4 (V2 (S x Float)) -> S x (V4 (V2 Float))
fromMat42 = (V2 (S x Float) -> S x (V2 Float))
-> Text -> V4 (V2 (S x Float)) -> S x (V4 (V2 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V2 (S x Float) -> S x (V2 Float)
forall x. V2 (S x Float) -> S x (V2 Float)
fromVec2 Text
"mat4x2"
fromMat43 :: V4 (V3 (S x Float)) -> S x (V4 (V3 Float))
fromMat43 :: V4 (V3 (S x Float)) -> S x (V4 (V3 Float))
fromMat43 = (V3 (S x Float) -> S x (V3 Float))
-> Text -> V4 (V3 (S x Float)) -> S x (V4 (V3 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V3 (S x Float) -> S x (V3 Float)
forall x. V3 (S x Float) -> S x (V3 Float)
fromVec3 Text
"mat4x3"
fromMat44 :: V4 (V4 (S x Float)) -> S x (V4 (V4 Float))
fromMat44 :: V4 (V4 (S x Float)) -> S x (V4 (V4 Float))
fromMat44 = (V4 (S x Float) -> S x (V4 Float))
-> Text -> V4 (V4 (S x Float)) -> S x (V4 (V4 Float))
forall (t :: * -> *) a x b.
Foldable t =>
(a -> S x b) -> Text -> t a -> S x (t b)
fromV V4 (S x Float) -> S x (V4 Float)
forall x. V4 (S x Float) -> S x (V4 Float)
fromVec4 Text
"mat4x4"
mulToV4 :: S x (f1 a) -> S x (f2 b) -> V4 (S x Float)
mulToV4 :: S x (f1 a) -> S x (f2 b) -> V4 (S x Float)
mulToV4 S x (f1 a)
a S x (f2 b)
b = S x Float -> V4 (S x Float)
forall c a. S c a -> V4 (S c a)
vec4S'' (S x Float -> V4 (S x Float)) -> S x Float -> V4 (S x Float)
forall a b. (a -> b) -> a -> b
$ SType -> Text -> S x (f1 a) -> S x (f2 b) -> S x Float
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin (Int -> SType
STypeVec Int
4) Text
"*" S x (f1 a)
a S x (f2 b)
b
mulToV3 :: S x (f1 a) -> S x (f2 b) -> V3 (S x Float)
mulToV3 :: S x (f1 a) -> S x (f2 b) -> V3 (S x Float)
mulToV3 S x (f1 a)
a S x (f2 b)
b = S x Float -> V3 (S x Float)
forall c a. S c a -> V3 (S c a)
vec3S'' (S x Float -> V3 (S x Float)) -> S x Float -> V3 (S x Float)
forall a b. (a -> b) -> a -> b
$ SType -> Text -> S x (f1 a) -> S x (f2 b) -> S x Float
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin (Int -> SType
STypeVec Int
3) Text
"*" S x (f1 a)
a S x (f2 b)
b
mulToV2 :: S x (f1 a) -> S x (f2 b) -> V2 (S x Float)
mulToV2 :: S x (f1 a) -> S x (f2 b) -> V2 (S x Float)
mulToV2 S x (f1 a)
a S x (f2 b)
b = S x Float -> V2 (S x Float)
forall c a. S c a -> V2 (S c a)
vec2S'' (S x Float -> V2 (S x Float)) -> S x Float -> V2 (S x Float)
forall a b. (a -> b) -> a -> b
$ SType -> Text -> S x (f1 a) -> S x (f2 b) -> S x Float
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin (Int -> SType
STypeVec Int
2) Text
"*" S x (f1 a)
a S x (f2 b)
b
mulToM :: Functor f => (Int, S c z -> f a) -> (Int, a -> b) -> S c x -> S c y -> f b
mulToM :: (Int, S c z -> f a) -> (Int, a -> b) -> S c x -> S c y -> f b
mulToM (Int
r,S c z -> f a
x) (Int
c,a -> b
y) S c x
a S c y
b = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
y (f a -> f b) -> f a -> f b
forall a b. (a -> b) -> a -> b
$ S c z -> f a
x (S c z -> f a) -> S c z -> f a
forall a b. (a -> b) -> a -> b
$ SType -> Text -> S c x -> S c y -> S c z
forall c x y z. SType -> Text -> S c x -> S c y -> S c z
bin (Int -> Int -> SType
STypeMat Int
c Int
r) Text
"*" S c x
a S c y
b
d2 :: Num a => (a, S x b -> V2 (S x b))
d2 :: (a, S x b -> V2 (S x b))
d2 = (a
2,S x b -> V2 (S x b)
forall c a. S c a -> V2 (S c a)
vec2S'')
d3 :: Num a => (a, S x b -> V3 (S x b))
d3 :: (a, S x b -> V3 (S x b))
d3 = (a
3,S x b -> V3 (S x b)
forall c a. S c a -> V3 (S c a)
vec3S'')
d4 :: Num a => (a, S x b -> V4 (S x b))
d4 :: (a, S x b -> V4 (S x b))
d4 = (a
4,S x b -> V4 (S x b)
forall c a. S c a -> V4 (S c a)
vec4S'')
unV1 :: V1 t -> t
unV1 :: V1 t -> t
unV1 (V1 t
x) = t
x
outerToM :: Functor f => (Int, S c z ->