Consider supporting OverloadedRecordDot
As far as I can tell, one of the biggest disadvantages that using FIR has compared to going with GLSL is the verbosity of shaders. With FIR now supporting GHC 9.2, there is an opportunity to mitigate this by providing instances for -XOverloadedRecordDot
.
For example, with a couple of instances, I was able to take this shader code
vertex :: ShaderModule "main" VertexShader VertexDefs _
vertex = shader do
time <- use @(Name "ubo" :.: Name "time")
windowWidth <- use @(Name "ubo" :.: Name "windowWidth")
windowHeight <- use @(Name "ubo" :.: Name "windowHeight")
floatWidth <- let' $ fromIntegral windowWidth
floatHeight <- let' $ fromIntegral windowHeight
phi <- let' $ time / 100
position <- #position
scl <- let' if floatHeight < floatWidth
then Mat22 (floatHeight / floatWidth) 0 0 1
else Mat22 1 0 0 (floatWidth / floatHeight)
rot <- let' $ Mat22 (cos phi) (sin phi) (-(sin phi)) (cos phi)
pos' <- let' $ (scl !*! rot) !*^ position
#gl_Position .= Vec4 (view @(Swizzle "x") pos') (view @(Swizzle "y") pos') 0 1
color <- #color
#vertColor .=
Vec4 (view @(Swizzle "r") color) (view @(Swizzle "g") color) (view @(Swizzle "b") color) 0.3
#gl_PointSize .= 40
And reduce it to a somewhat more concise
vertex :: ShaderModule "main" VertexShader VertexDefs _
vertex = shader do
ubo <- #ubo
floatWidth <- let' $ fromIntegral ubo.windowWidth
floatHeight <- let' $ fromIntegral ubo.windowHeight
phi <- let' $ ubo.time / 100
position <- #position
scl <- let' if floatHeight < floatWidth
then Mat22 (floatHeight / floatWidth) 0 0 1
else Mat22 1 0 0 (floatWidth / floatHeight)
rot <- let' $ Mat22 (cos phi) (sin phi) (-(sin phi)) (cos phi)
pos' <- let' $ (scl !*! rot) !*^ position
#gl_Position .= Vec4 pos'.x pos'.y 0 1
color <- #color
#vertColor .=
Vec4 color.r color.g color.b 0.3
#gl_PointSize .= 40
As an added benefit, color.r
is much easier to read to someone new to the library compared to view @(Swizzle "r") color
, since it's exactly the same syntax as in GLSL.
The instances I used for this (this requires -XUndecidableInstances
) are
instance {-# OVERLAPPING #-}
(PrimTy a, PrimTyMap r, KnownSymbol x)
=> HasField x (Code (Struct ((x ':-> a) : r))) (Code a) where
getField = view @(Name x)
instance {-# OVERLAPPABLE #-}
( ReifiedGetter (Name x :: Optic '[] (Code (Struct ((t ':-> t'):s))) (Code a))
, HasField x (Code (Struct s)) (Code a))
=> HasField x (Code (Struct ((t ':-> t'):s))) (Code a) where
getField = view @(Name x)
type family SymbolIndex s where
SymbolIndex "x" = 0
SymbolIndex "y" = 1
SymbolIndex "z" = 2
SymbolIndex "w" = 3
SymbolIndex "r" = 0
SymbolIndex "g" = 1
SymbolIndex "b" = 2
SymbolIndex "a" = 3
SymbolIndex "s" = 0
SymbolIndex "t" = 1
SymbolIndex "p" = 2
SymbolIndex "q" = 3
instance (i ~ SymbolIndex s, PrimTy a, KnownNat n, KnownNat i, CmpNat i n ~ LT)
=> HasField s (Code (V n a)) (Code a) where
getField = view @(Index i)
Though it's probably possible to make a shorter and non-overlapping struct instance with access to some of FIR's hidden modules.
It might also to be possible to support general Swizzles like color.gb
by exploiting the existing optics mechanisms.