Shader Pipeline: PrimShader and Random Face Colours

It took all bloody day but I’ve finally done it.

mapAccumL is an AWESOME function. It is annoying to have to unwrap tuples tho but oh well.

objShaderPipeline s@(Shader vertexShader primShader _ fragmentShader _) modelTransform projection camera obj (Face p1 p2 p3 pn) =
  let faceInfoList = p1 : p2 : p3 : pn
      vs = objVertices obj
      out@(endShad, points) =
        (\(projSpace, shad) -> fragShaderHandler shad projSpace)
        . (\(coords, newShad) -> (fmap (toProjection projection) coords, newShad))
        . Debug.traceShowWith (fmap (getVertexColour . getViewSpace). fst)
        . primShaderHandling vertShaderOut
        $
          faceVertices
      (vertShaderOut,faceVertices) =
        mapAccumL vertInvoker s . fmap
          ( toViewSpace camera
            . toModelView modelTransform
            . (vs V.!)
            . subtract 1
            . objFaceVertexIndex
          ) $
          faceInfoList
   in (endShad, points)
   where vertInvoker shad vert = (newShader, transformed)
            where (transformed, newShader) = invokeVertShader shad (getShaderStdGen shad) vert
         primShaderHandling shadState faceVerts = invokePrimShader shadState (getShaderStdGen shadState) faceVerts
         fragShaderHandler shadState projVerts = mapAccumL fragger shadState projVerts
         fragger shad pix = let
          (newShad, newPix) = invokeFragmentShader shad (getShaderStdGen shad) pix
          in (newPix, newShad)

getObjFaces dims modelTransform projection camera shader obj =
  let allFaces = snd <$> Map.elems (objFaces obj)
      allVerts = snd . builder shader $ (concatMap V.toList allFaces)
      builder oldShad faces = mapAccumL buildHelper oldShad faces
      buildHelper shad face = objShaderPipeline shad modelTransform projection camera obj face


   in [toScreenSpace dims <$> verts | verts <- allVerts, all pointIsVisible verts]

and Shaders look something like this:

type VertexShader = StdGen -> ViewSpace -> ViewSpace
type PrimShader = forall f. Functor f => StdGen -> f ViewSpace -> f ViewSpace
type MeshShader = forall t f. (Traversable t, Functor f) => StdGen -> t (f ViewSpace) -> t (f ViewSpace)
type FragmentShader = StdGen -> ProjectionSpace -> ProjectionSpace

data Shader = Shader {
    getVertexShader :: VertexShader,
    getPrimShader :: PrimShader,
    getMeshShader :: MeshShader,
    getFragmentShader :: FragmentShader,
    getShaderStdGen :: StdGen
  }


baseShader :: StdGen -> Shader
baseShader gen = Shader (const id) (const id) (const id) (const id) gen

invokeVertShader :: Shader -> StdGen -> ViewSpace -> (ViewSpace, Shader)
invokeVertShader s gen v = (getVertexShader s gen v, s {getShaderStdGen = newGen})
  where (_, newGen) = random gen :: (Int, StdGen)


invokePrimShader :: Functor f => Shader -> StdGen -> f ViewSpace -> (f ViewSpace, Shader)
invokePrimShader s gen vs = (getPrimShader s gen vs, s {getShaderStdGen = newGen})
  where (_, newGen) = random gen :: (Int, StdGen)

invokeMeshShader :: (Traversable t, Functor f) => Shader -> StdGen -> t (f ViewSpace) -> (t (f ViewSpace), Shader)
invokeMeshShader s gen vs  = (getMeshShader s gen vs, s {getShaderStdGen = newGen})
  where (_, newGen) = random gen :: (Int, StdGen)

invokeFragmentShader :: Shader -> StdGen -> ProjectionSpace -> (ProjectionSpace, Shader)
invokeFragmentShader s gen vs  = (getFragmentShader s gen vs, s {getShaderStdGen = newGen})
  where (_, newGen) = random gen :: (Int, StdGen)

-- genCol :: IO VertexColour
-- genCol :: RandomGen p => p -> VertexColour
genCol gen =  (g2, VertexColour r g b 255)
  where (r, g0) = randomR (0, 255) gen
        (g, g1) = randomR (0, 255) g0
        (b, g2) = randomR (0, 255) g1

randomFaceColourShader gen = colourFaces
  where colourFaces vs = fmap (toGeneratedColour newCol) vs
        (newGen, newCol) = genCol gen
        toGeneratedColour col (ViewSpace (Vertex pos _ vnorm)) = ViewSpace (Vertex pos (Just col) vnorm)

I will obviously clean this up and make it more manageable, maybe even give myself a nice little wrapper type to keep track of things better but I’m just happy it works.