module Rasterizer (
Rasterizer(),
VertexOutput(..),
rasterizeFront,
rasterizeBack,
rasterizeFrontAndBack,
) where
import Shader
import Data.Vec ((:.)(..), Vec2, Vec3, Vec4)
import GPUStream
import Data.Functor.Identity
newtype Rasterizer a = Rasterizer {fromRasterizer :: Identity a} deriving (Functor, Monad)
class GPU a => VertexOutput a where
type FragmentInput a
toFragment :: a -> Rasterizer (FragmentInput a)
instance VertexOutput (Vertex Float) where
type FragmentInput (Vertex Float) = Fragment Float
toFragment = Rasterizer . return . rasterizeVertex
instance VertexOutput () where
type FragmentInput () = ()
toFragment () = return ()
instance (VertexOutput a,VertexOutput b) => VertexOutput (a,b) where
type FragmentInput (a,b) = (FragmentInput a, FragmentInput b)
toFragment (a, b) = do a' <- toFragment a
b' <- toFragment b
return (a', b')
instance (VertexOutput a,VertexOutput b,VertexOutput c) => VertexOutput (a,b,c) where
type FragmentInput (a,b,c) = (FragmentInput a, FragmentInput b, FragmentInput c)
toFragment (a, b, c) = do a' <- toFragment a
b' <- toFragment b
c' <- toFragment c
return (a', b', c')
instance (VertexOutput a,VertexOutput b,VertexOutput c,VertexOutput d) => VertexOutput (a,b,c,d) where
type FragmentInput (a,b,c,d) = (FragmentInput a, FragmentInput b, FragmentInput c, FragmentInput d)
toFragment (a, b, c, d) = do a' <- toFragment a
b' <- toFragment b
c' <- toFragment c
d' <- toFragment d
return (a', b', c', d')
instance (VertexOutput a, VertexOutput b) => VertexOutput (a:.b) where
type FragmentInput (a:.b) = FragmentInput a :. FragmentInput b
toFragment (a:.b) = do a' <- toFragment a
b' <- toFragment b
return $ a':.b'
rasterizeFront :: VertexOutput a
=> PrimitiveStream p (VertexPosition, a)
-> FragmentStream (FragmentInput a)
rasterizeFront x = case x of
(PrimitiveStreamShader xs) -> FragmentStream $ map rasterizeOne xs
(PrimitiveStreamNoShader [] _) -> FragmentStream []
(PrimitiveStreamNoShader xs a) -> FragmentStream [rasterizeOne (xs, a)]
where rasterizeOne (pdesc, (pos, va)) = ((pdesc, CullBack, pos), true, getFragmentInput va)
rasterizeFrontAndBack :: VertexOutput a
=> PrimitiveStream Triangle (VertexPosition, a)
-> FragmentStream (Fragment Bool, FragmentInput a)
rasterizeFrontAndBack x = case x of
(PrimitiveStreamShader xs) -> FragmentStream $ map rasterizeOne xs
(PrimitiveStreamNoShader [] _) -> FragmentStream []
(PrimitiveStreamNoShader xs a) -> FragmentStream [rasterizeOne (xs, a)]
where rasterizeOne (pdesc, (pos, va)) = ((pdesc, CullNone, pos), true, (fragmentFrontFacing, getFragmentInput va))
rasterizeBack :: VertexOutput a
=> PrimitiveStream Triangle (VertexPosition, a)
-> FragmentStream (FragmentInput a)
rasterizeBack x = case x of
(PrimitiveStreamShader xs) -> FragmentStream $ map rasterizeOne xs
(PrimitiveStreamNoShader [] _) -> FragmentStream []
(PrimitiveStreamNoShader xs a) -> FragmentStream [rasterizeOne (xs, a)]
where rasterizeOne (pdesc, (pos, va)) = ((pdesc, CullFront, pos), true, getFragmentInput va)
getFragmentInput :: VertexOutput a => a -> FragmentInput a
getFragmentInput = runIdentity . fromRasterizer . toFragment