{
  "$type": "site.standard.document",
  "bskyPostRef": {
    "cid": "bafyreibbqqasncchezqrkowgm6tyt6bjaxep4gwtcuqlzpdp2qxkar6v5y",
    "uri": "at://did:plc:pi6woz4d47bkuws673w2il2r/app.bsky.feed.post/3mixbaxka37g2"
  },
  "path": "/t/shader-pipeline-primshader-and-random-face-colours/13904#post_4",
  "publishedAt": "2026-04-07T22:44:27.000Z",
  "site": "https://discourse.haskell.org",
  "textContent": "It took all bloody day but I’ve finally done it.\n\n`mapAccumL` is an AWESOME function. It is annoying to have to unwrap tuples tho but oh well.\n\n\n    objShaderPipeline s@(Shader vertexShader primShader _ fragmentShader _) modelTransform projection camera obj (Face p1 p2 p3 pn) =\n      let faceInfoList = p1 : p2 : p3 : pn\n          vs = objVertices obj\n          out@(endShad, points) =\n            (\\(projSpace, shad) -> fragShaderHandler shad projSpace)\n            . (\\(coords, newShad) -> (fmap (toProjection projection) coords, newShad))\n            . Debug.traceShowWith (fmap (getVertexColour . getViewSpace). fst)\n            . primShaderHandling vertShaderOut\n            $\n              faceVertices\n          (vertShaderOut,faceVertices) =\n            mapAccumL vertInvoker s . fmap\n              ( toViewSpace camera\n                . toModelView modelTransform\n                . (vs V.!)\n                . subtract 1\n                . objFaceVertexIndex\n              ) $\n              faceInfoList\n       in (endShad, points)\n       where vertInvoker shad vert = (newShader, transformed)\n                where (transformed, newShader) = invokeVertShader shad (getShaderStdGen shad) vert\n             primShaderHandling shadState faceVerts = invokePrimShader shadState (getShaderStdGen shadState) faceVerts\n             fragShaderHandler shadState projVerts = mapAccumL fragger shadState projVerts\n             fragger shad pix = let\n              (newShad, newPix) = invokeFragmentShader shad (getShaderStdGen shad) pix\n              in (newPix, newShad)\n\n    getObjFaces dims modelTransform projection camera shader obj =\n      let allFaces = snd <$> Map.elems (objFaces obj)\n          allVerts = snd . builder shader $ (concatMap V.toList allFaces)\n          builder oldShad faces = mapAccumL buildHelper oldShad faces\n          buildHelper shad face = objShaderPipeline shad modelTransform projection camera obj face\n\n\n       in [toScreenSpace dims <$> verts | verts <- allVerts, all pointIsVisible verts]\n\n\nand Shaders look something like this:\n\n\n    type VertexShader = StdGen -> ViewSpace -> ViewSpace\n    type PrimShader = forall f. Functor f => StdGen -> f ViewSpace -> f ViewSpace\n    type MeshShader = forall t f. (Traversable t, Functor f) => StdGen -> t (f ViewSpace) -> t (f ViewSpace)\n    type FragmentShader = StdGen -> ProjectionSpace -> ProjectionSpace\n\n    data Shader = Shader {\n        getVertexShader :: VertexShader,\n        getPrimShader :: PrimShader,\n        getMeshShader :: MeshShader,\n        getFragmentShader :: FragmentShader,\n        getShaderStdGen :: StdGen\n      }\n\n\n    baseShader :: StdGen -> Shader\n    baseShader gen = Shader (const id) (const id) (const id) (const id) gen\n\n    invokeVertShader :: Shader -> StdGen -> ViewSpace -> (ViewSpace, Shader)\n    invokeVertShader s gen v = (getVertexShader s gen v, s {getShaderStdGen = newGen})\n      where (_, newGen) = random gen :: (Int, StdGen)\n\n\n    invokePrimShader :: Functor f => Shader -> StdGen -> f ViewSpace -> (f ViewSpace, Shader)\n    invokePrimShader s gen vs = (getPrimShader s gen vs, s {getShaderStdGen = newGen})\n      where (_, newGen) = random gen :: (Int, StdGen)\n\n    invokeMeshShader :: (Traversable t, Functor f) => Shader -> StdGen -> t (f ViewSpace) -> (t (f ViewSpace), Shader)\n    invokeMeshShader s gen vs  = (getMeshShader s gen vs, s {getShaderStdGen = newGen})\n      where (_, newGen) = random gen :: (Int, StdGen)\n\n    invokeFragmentShader :: Shader -> StdGen -> ProjectionSpace -> (ProjectionSpace, Shader)\n    invokeFragmentShader s gen vs  = (getFragmentShader s gen vs, s {getShaderStdGen = newGen})\n      where (_, newGen) = random gen :: (Int, StdGen)\n\n    -- genCol :: IO VertexColour\n    -- genCol :: RandomGen p => p -> VertexColour\n    genCol gen =  (g2, VertexColour r g b 255)\n      where (r, g0) = randomR (0, 255) gen\n            (g, g1) = randomR (0, 255) g0\n            (b, g2) = randomR (0, 255) g1\n\n    randomFaceColourShader gen = colourFaces\n      where colourFaces vs = fmap (toGeneratedColour newCol) vs\n            (newGen, newCol) = genCol gen\n            toGeneratedColour col (ViewSpace (Vertex pos _ vnorm)) = ViewSpace (Vertex pos (Just col) vnorm)\n\n\n\nI 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.",
  "title": "Shader Pipeline: PrimShader and Random Face Colours"
}