coordmap (cam::Mat 4 4 Float) (p::Vec 4 Float) = cam *. p blendplane = -- NoBlending -- BlendLogicOp Xor Blend (FuncAdd,FuncAdd) ((OneBF,SrcAlpha),(DstAlpha,DstAlpha)) (V4 0 0 0 0) makeFrame (cameraPosition :: Vec 3 Float) (cam :: Mat 4 4 Float) (color :: Vec 4 Float) (texture :: Texture) (prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float)) (plane :: PrimitiveStream Triangle ((Vec 4 Float))) = imageFrame (emptyDepthImage 1, emptyColorImage (V4 0 0 0.4 1)) `overlay` prims & mapPrimitives (\(p,n,uvw) -> ( coordmap cam p, V2 uvw%x (1 - uvw%y) )) & rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) ((Smooth)) & mapFragments (\((uv)) -> ((color * texture2D (Sampler PointFilter MirroredRepeat texture) uv ))) & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True)) `overlay` plane & mapPrimitives (\((p)) -> let p' = coordmap cam p in (p', p%xz)) & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth)) & mapFragments (\((uv)) -> let c = mixB zero one (fract uv >= (one *! (0.95::Float))) r = V4 1 1 1 0 *! (max c%x c%y) in ((r + V4 0 0 0 (0.8)))) & accumulateWith (DepthOp Less True, ColorOp blendplane (V4 True True True True)) main = renderFrame $ makeFrame (Uniform "CameraPosition") (Uniform "ViewProjection") (Uniform "diffuseColor") (Texture2DSlot "diffuseTexture") (fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw")) (fetch "plane" ((Attribute "position")))