LambdaCube logo in LambdaCube

gistfile1.hs

clear = FrameBuffer $ (DepthImage @1 1000, ColorImage @1 navy)   -- ...

triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
colorFragmentCtx = AccumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))

rasterizeWith = Rasterize
triangles = triangleRasterCtx

cubeVertexStream = Fetch "stream4" Triangles (Attribute "position4" :: Vec 4 Float)
mapFragments s fs = Accumulate colorFragmentCtx PassAll (\a -> FragmentOutRastDepth $ fs a) s clear
transform s f =  Transform (\v -> VertexOut (f v) 1 () (Smooth v)) s

deg45 = 0.78539816339
deg60 = 1.0471975512
deg360 = 6.28318530718

phase = fract (time *! 0.2)
smoothPhase = phase *! phase *! (3 -! 2 *! phase)

rotate' v = rotMatrixY (4.1 +! smoothPhase *! deg360) *. rotMatrixZ (deg45 *! 3) *. v

-- x = right, y = up
leftSide p = V4 0 1 blue (if p%y > 0.75 then 0 else 1)
  where
    blue = dot p (V2 0.5 (-0.5)) +! 0.4

-- x = up, y = left
rightSide p = V4 (p%x *! p%x) 1 ((1 -! p%x) *! (1 -! p%x))  (if p%y > 0.75 then 0 else 1)

-- x = left, y = down
topSide p = V4 red 1 0  (if line > (-0.25) && line < 0 then 0 else 1)
  where
    red = dot p (V2 (-0.5) 0.5) +! 0.4
    line = dot p (V2 1 (-1))

logo pos =
    if abs pos%x > 0.99999 then rightSide (pos%yz *! sign pos%x *! 0.5 +! 0.5) else
    if abs pos%y > 0.99999 then topSide (pos%zx *! sign pos%y *! 0.5 +! 0.5) else
    if abs pos%z > 0.99999 then leftSide (pos%xy *! sign pos%z *! 0.5 +! 0.5) else black

main =             cubeVertexStream
    `transform`    (scale (0.2 +! abs (0.5 -! smoothPhase) *! 0.6) . rotate')
     &             rasterizeWith triangles
    `mapFragments` logo
     &             ScreenOut