module Rasterizer (
Rasterizer(),
VertexOutput(..),
rasterizeFront,
rasterizeBack,
rasterizeFrontAndBack,
) where
import Shader
import Data.Vec ((:.)(..), Vec2, Vec3, Vec4)
import GPUStream
import Control.Monad.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 (PrimitiveStream []) = FragmentStream []
rasterizeFront (PrimitiveStream xs) = FragmentStream $ map rasterizeOne xs
where rasterizeOne (pdesc, (pos, va)) = ((pdesc, CullBack, pos), true, getFragmentInput va)
rasterizeFrontAndBack :: VertexOutput a
=> PrimitiveStream Triangle (VertexPosition, a)
-> FragmentStream (Fragment Bool, FragmentInput a)
rasterizeFrontAndBack (PrimitiveStream []) = FragmentStream []
rasterizeFrontAndBack (PrimitiveStream xs) = FragmentStream $ map rasterizeOne xs
where rasterizeOne (pdesc, (pos, va)) = ((pdesc, CullNone, pos), true, (fragmentFrontFacing, getFragmentInput va))
rasterizeBack :: VertexOutput a
=> PrimitiveStream Triangle (VertexPosition, a)
-> FragmentStream (FragmentInput a)
rasterizeBack (PrimitiveStream []) = FragmentStream []
rasterizeBack (PrimitiveStream xs) = FragmentStream $ map rasterizeOne xs
where rasterizeOne (pdesc, (pos, va)) = ((pdesc, CullFront, pos), true, getFragmentInput va)
getFragmentInput :: VertexOutput a => a -> FragmentInput a
getFragmentInput = runIdentity . fromRasterizer . toFragment