uniform-tagged shaders with gpipe

[xax]

okay, two week projects

i didn't do something for february 1-14 since i was sick for that entire stretch (i was sick for like three weeks and it sucked), but i did get some stuff done for the 15-28 period.

gpipe has this enormous infrastructure for type-safe shaders, so that you can never write the wrong kind of vertex pipeline to a shader, or write the wrong thing to a buffer generally, and all of its weird internal types are instanced to a mess of typeclasses so that they get marshaled correctly automatically. it's real nice. but what they don't do for you is handle uniforms. or rather, they handle uniforms (you can write to them and use them just find) but they don't have any kind of construction for "this shader uses uniforms of type x y and z and so before you run the shader you have to provide x y and z values". basically they don't really surface the shader dependency on uniforms into the type system at all; a shader is just a shader and if you need to write uniforms for it then you need to manage that yourself.

in my existing code, the only uniform i really used was the camera, which was updated per-frame at the start of each frame, and while i had lots of ideas for useful shaders i could write, i basically had no way to store or structure them. my code ran using a list of RenderUpdate os values (where os is a phantom type value that represents which rendering context the render event came from), and what that means is that if i wanted to keep that same basic infrastructure of having a render cache full of render actions, i would need to hide all the shader information, since haskell doesn't have heterogeneous lists -- i couldn't have a list of like, RenderUpdate os ShaderFoo and RenderUpdate os ShaderBar.

so already i was thinking this would have to be an existentially-quantified thing: have something like

data RenderObject os = forall s. RenderObject
    { shader :: CompiledShader os s
    , chunks :: [RenderChunk os s]
    }

so that the shader could vary based on the type of the chunks, but that would be hidden inside the type so that the overall type is still just RenderObject os, so i could continue using a simple list of render updates. additionally, i'd need some way to attach uniforms to shaders, which would be an entire other step that would need to be done in a similar fashion -- stuff the uniform type in an existential somewhere, so that i could automatically set them in some fashion.

(i should also say that i put off working on this for a while since i only had a hazy idea of how this would work, and i figured it would be really complicated and involve a lot of weird type stuff.)

so with all that being said let's talk about the code i wrote.

---

first, i recognized that it would require way too much work to fully attach uniforms to shaders, like, on the type level of "if this shader uses this uniform, it should be type-level impossible to expose that shader without the uniform attached as an argument". that would require a pretty deep level of restructuring the gpipe setup, and also, there are absolutely cases where a given uniform doesn't need to be set or only needs to be set once across a number of different shaders, and having to set it each time would be unnecessary (like with a camera uniform). so my first idea was some kind of UArg type:

data UArg os a b where
  UArg :: Buffer os (Uniform a) -> b -> UArg os a b

infixl 4 #$#
(#$#) :: (ContextHandler ctx, MonadIO m) => UArg os a b -> HostFormat a -> ContextT ctx os m b

which is just a general-purpose, like, 'deferred' type almost? when you make a shader, you expose it wrapped in however many layers of UArg you have uniforms. the UArg takes the uniform buffer used in the shader, as well as a terminal value, and then to get out the terminal value afterwards you need to apply a matching buffer arg (a Uniform a requires a matching HostFormat a; this is where gpipe's data marshalling comes into play). then, you repeatedly apply UArg for each uniform to wrap the shader, and use #$# repeatedly in order to unwrap the layers of uniform writes until you finally get the terminal value, which is the actual shader.

there are a few problems with that. the most important one is that that's impossible to existentially quantify in the general case with more than one uniform: it's possible to have a UArg b s value with a matching HostFormat b that gets hidden in an existential, but once you have more than one it doesn't generalize at all -- UArg b1 (UArg b2 s) would mean having two separate HostFormat values. basically you'd have to write a separate constructor for every arity of shader, and that would get real tedious real quick.

but if that works for one uniform, well... there are HostFormat instances for tuples. (HostFormat a, HostFormat b) => HostFormat (a, b). this means we could curry the uniforms together to keep them in a single block, which can be existentially quantified.

so here's the actual code, in chunks:

data UArg os a b where
  UArg :: BufferAbstraction os a -> b -> UArg os a b

data BufferAbstraction os a where
  BNil :: BufferAbstraction os ()
  BOne :: Buffer os (Uniform a) -> BufferAbstraction os a
  BPair :: Buffer os (Uniform a) -> BufferAbstraction os b -> BufferAbstraction os (a, b)
  BConst :: Buffer os (Uniform a) -> [HostFormat a] -> BufferAbstraction os b -> BufferAbstraction os b

upure :: a -> UArg os () a
upure a = UArg BNil a

infixl 4 $#$
($#$) :: b -> Buffer os (Uniform a) -> UArg os a b
b $#$ ua = UArg (BOne ua) b

infixl 4 *#*
(*#*) :: UArg os b r -> Buffer os (Uniform a) -> UArg os (a, b) r
(UArg ub r) *#* ua = UArg (BPair ua ub) r

-- lol three-arg infix function; that'll be fun to use
(###) :: UArg os b r -> Buffer os (Uniform a) -> [HostFormat a] -> UArg os b r
(###) (UArg ub r) ua ha = UArg (BConst ua ha ub) r

this has a bit of a messy interface, but you can hopefully see how it works: you figure out which uniforms you need, and you compose them together with those function operators to make a BufferAbstraction os a value, where its a value will always match the HostFormat a needed to actually write to the uniforms.

writeBufferAbstract :: (ContextHandler ctx, MonadIO m) => BufferAbstraction os a -> [HostFormat a] -> ContextT ctx os m ()
writeBufferAbstract b hs = case b of
  BNil -> pure ()
  BOne ua -> writeBuffer ua 0 hs
  BPair ua rs -> let (has, ras) = unzip hs
    in do
      writeBuffer ua 0 has
      writeBufferAbstract rs ras
  BConst ux x rs -> do
    writeBuffer ux 0 x
    writeBufferAbstract rs hs

infixl 4 #$#
(#$#) :: (ContextHandler ctx, MonadIO m) => UArg os a b -> HostFormat a -> ContextT ctx os m b
uarg #$# arg = case uarg of
  UArg uni b -> do
    writeBufferAbstract uni [arg]
    return b

this is how we actually write to a buffer abstraction. this... i am not gonna lie, i haven't actually used this code in practice yet, so i don't really know how tedious it'll be to produce a matching HostFormat a that will have to be a weird annoying nested tuple like (a, (b, (c, d))). as you can see with some of these new operators, this code still needs some polish.

(this also assumes the uniforms will all be single values, which might not be reasonable. but it's good enough for now)

that brings us to the actual render values

data RenderChunk os a b = Chunk
  { vertices :: Buffer os a
  , statics :: b
  }

data RenderObject os
  = forall a b. RenderObject
    { shader :: CompiledShader os (PrimitiveArray Triangles a, b)
    , chunks :: [RenderChunk os a b]
    }
  | forall us a b. RenderObjectUniforms
    { ushader :: UArg os us ((PrimitiveArray Triangles a, b) -> Render os ())
    , uniforms :: HostFormat us
    , chunks :: [RenderChunk os a b]
    }

so as you can see, these nicely hide all the messy shader values inside an existential, leaving only a nice neat RenderObject os at the top level, which can happily be merged together into a single render cache of events that run different shaders. finally:

renderObjectCache :: Map Integer [RenderObject os] -> GLFWContext os ()
renderObjectCache objs =
  (\r -> case r of
    RenderObject shader chunks -> render $ renderAction shader chunks
    RenderObjectUniforms ushader uniforms chunks -> do
      shader <- ushader #$# uniforms
      render $ renderAction shader chunks
    ) `mapM_` fold objs

renderAction :: CompiledShader os (PrimitiveArray Triangles a, b) -> [RenderChunk os a b] -> Render os ()
renderAction shader chunks = (\(Chunk vertices statics) -> do
    vertexArray <- newVertexArray vertices
    let primitiveArray = toPrimitiveArray TriangleList vertexArray
    shader (primitiveArray, statics)
  ) `mapM_` chunks

is how we actually render all these render objects. this is actually a place where i could make some improvements: RenderObjects without uniforms don't really need to be rendered in separate render calls, but batching them would mean reordering renders, which could break all sorts of stuff (e.g., translucency due to depth-sorting). likewise, if we have two shaders that use all different uniforms, it's safe to write both of their uniforms at once and then run the shaders together in the same render block. but there's no information available to determine when that's possible, and it will frequently be not possible.

so all together this code compiles and works and does what i need it to do -- which, to be fair, is a lot -- but there are a few major spots for improvement that i should look at fixing down the line. still, it means i can finally use more than one shader in my rendering code, which is going to help stuff enormously, so i'm pretty pleased with it all.