module LambdaCube.Language.HOAS where
import GHC.TypeLits
import Data.ByteString.Char8
import Data.Int
import LambdaCube.Core.Type hiding (FetchPrimitive, OutputPrimitive, Blending, RasterContext, Blend, TriangleCtx, Image, FragmentOperation, MipMap, TextureDataType, TextureType)
import LambdaCube.Language.Type
import LambdaCube.Language.ReifyType
import LambdaCube.Language.PrimFun
import Data.Typeable
import Data.Dynamic
import qualified LambdaCube.Core.DeBruijn as U (N)
data Exp :: Frequency -> * -> * where
Tag :: GPU t
=> Int
-> String
-> Exp stage t
Shr :: U.N
-> Exp stage t
Let :: (GPU a, GPU b)
=> Exp stage a
-> (Exp stage a -> Exp stage b)
-> Exp stage b
Var :: GPU t
=> Dynamic
-> Exp stage t
Const :: (GPU t,IsScalar t)
=> t
-> Exp stage t
PrimVar :: GPU t
=> Input t
-> Exp stage t
Uni :: GPU t
=> Input t
-> Exp stage t
Cond :: GPU t
=> Exp stage Bool
-> Exp stage t
-> Exp stage t
-> Exp stage t
PrimApp :: (GPU a, GPU r)
=> PrimFun stage (a -> r)
-> Exp stage a
-> Exp stage r
Tup :: (GPU t, IsTuple t)
=> Tuple (Exp stage) (TupleRepr t)
-> Exp stage t
Prj :: (GPU e, GPU t, IsTuple t)
=> TupleIdx (TupleRepr t) e
-> Exp stage t
-> Exp stage e
Sampler :: GPU (Sampler dim arr t ar)
=> Filter
-> EdgeMode
-> Exp Obj (Texture dim arr t ar)
-> Exp stage (Sampler dim arr t ar)
TextureSlot :: (IsValidTextureSlot t)
=> ByteString
-> TextureType dim mip arr layerCount t ar
-> Exp Obj (Texture dim arr t ar)
Texture :: (IsScalar (TexSizeRepr dim), IsMipValid canMip mip )
=> TextureType dim canMip arr layerCount t ar
-> TexSizeRepr dim
-> MipMap mip
-> [Exp Obj (Image layerCount (TexDataRepr ar t))]
-> Exp Obj (Texture dim arr t ar)
Loop :: (GPU s, GPU a)
=> (Exp stage s -> Exp stage s)
-> (Exp stage s -> Exp stage Bool)
-> (Exp stage s -> Exp stage a)
-> Exp stage s
-> Exp stage a
Fetch :: (InputTuple a, SGPU (InputTupleRepr a))
=> ByteString
-> FetchPrimitive primitive
-> a
-> Exp Obj (VertexStream primitive (InputTupleRepr a))
Transform :: (GPU a, GPU b)
=> (Exp V a -> VertexOut clipDistances b)
-> Exp Obj (VertexStream primitive a)
-> Exp Obj (PrimitiveStream primitive clipDistances 1 V b)
Reassemble :: GeometryShader inputPrimitive outputPrimitive inputClipDistances outputClipDistances layerCount a b
-> Exp Obj (PrimitiveStream inputPrimitive inputClipDistances 1 V a)
-> Exp Obj (PrimitiveStream outputPrimitive outputClipDistances layerCount G b)
Rasterize :: RasterContext primitive
-> Exp Obj (PrimitiveStream primitive clipDistances layerCount freq a)
-> Exp Obj (FragmentStream layerCount a)
FrameBuffer :: FrameBuffer layerCount t
-> Exp Obj (FrameBuffer layerCount (FTRepr' t))
Accumulate :: (GPU a, GPU (FTRepr' b), IsValidOutput b)
=> AccumulationContext b
-> FragmentFilter a
-> (Exp F a -> FragmentOut (NoStencilRepr b))
-> Exp Obj (FragmentStream layerCount a)
-> Exp Obj (FrameBuffer layerCount (FTRepr' b))
-> Exp Obj (FrameBuffer layerCount (FTRepr' b))
PrjFrameBuffer :: ByteString
-> TupleIdx (EltRepr b) t
-> Exp Obj (FrameBuffer layerCount b)
-> Exp Obj (Image layerCount t)
PrjImage :: ((idx + 1) <= layerCount, 2 <= layerCount, KnownNat idx)
=> ByteString
-> NatNum idx
-> Exp Obj (Image layerCount t)
-> Exp Obj (Image 1 t)
type InterpolatedFlatExp stage a = FlatTuple GPU (Interpolated (Exp stage)) a
type FlatExp stage a = FlatTuple GPU (Exp stage) a
data VertexOut clipDistances t where
VertexOut :: IsFloatTuple clipDistances
=> Exp V V4F
-> Exp V Float
-> FlatExp V clipDistances
-> InterpolatedFlatExp V a
-> VertexOut (FTRepr clipDistances) (FTRepr a)
data GeometryShader (inPrimitive :: PrimitiveType) (outPrimitive :: PrimitiveType) inClipDistances outClipDistances (layerCount :: Nat) a b where
GeometryShader :: (GPU j, GPU i, GPU b, GPU outputClipDistances, GPU input, KnownNat layerCount
, inputVertex ~ (V4F,Float,inputClipDistances,a)
, input ~ PrimitiveVertices inputPrimitive inputVertex
)
=> NatNum layerCount
-> OutputPrimitive outputPrimitive
-> Int
-> (Exp G input -> Exp G (i,Int32))
-> (Exp G i -> Exp G (Int32,Int32,i,j,Int32))
-> (Exp G j -> GeometryOut j outputClipDistances b)
-> GeometryShader inputPrimitive outputPrimitive inputClipDistances outputClipDistances layerCount a b
data GeometryOut i clipDistances t where
GeometryOut :: IsFloatTuple clipDistances
=> Exp G i
-> Exp G V4F
-> Exp G Float
-> FlatExp G clipDistances
-> InterpolatedFlatExp G a
-> GeometryOut i (FTRepr clipDistances) (FTRepr a)
data FragmentOut t where
FragmentOut :: FlatExp F a
-> FragmentOut (ColorRepr a)
FragmentOutDepth :: Exp F Float
-> FlatExp F a
-> FragmentOut (Depth Float :+: ColorRepr a)
FragmentOutRastDepth :: FlatExp F a
-> FragmentOut (Depth Float :+: ColorRepr a)
data FragmentFilter a where
PassAll :: FragmentFilter a
Filter :: (Exp F a -> Exp F Bool)
-> FragmentFilter a
data GPOutput (o :: OutputType) where
SamplerOut :: GPU (Sampler dim arr t ar)
=> ByteString
-> Exp Obj (Sampler dim arr t ar)
-> GPOutput SingleOutput
ScreenOut :: Exp Obj (Image 1 t)
-> GPOutput SingleOutput
MultiOut :: [GPOutput SingleOutput]
-> GPOutput MultiOutput
data AccumulationContext t
= AccumulationContext
{ accViewportSize :: Maybe (Exp Obj V4U)
, accOperations :: FlatTuple NoConstraint FragmentOperation t
}