time = Uniform "Time" :: Float
clear = FrameBuffer $ (DepthImage @1 1, ColorImage @1 red)

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

toFrameBuffer s = clear `overlay` accumulateWith colorFragmentCtx s

rotate' v = (Uniform "MVP" :: Mat 4 4 Float) *. v

cubeVertexStream = fetch "stream4" Triangle (Attribute "position4" :: Vec 4 Float, Attribute "vertexUV" :: Vec 2 Float)

texImage = PrjImageColor $
        cubeVertexStream
     &  mapPrimitives (\(x, y) -> (scale 1.0 x, V2 y%x (1-y%y)))
     &  rasterize
     &  mapFragments (\xy -> let
                x = xy%x - 0.85
                y = xy%y - 0.85
                t   = (0.0005 * sin (3 * atan2 x y + 15 * time))
                t'  = (0.002  * sin (5 * atan2 x y - 5  * time))
                t'' = (0.002  * sin (7 * atan2 x y + 3  * time))
                ti = abs (sin (time * 4) - 0.37)
        in if x*x + y*y + t   < 0.005 * ti then navy else
           if x*x + y*y + t'  < 0.02  * ti then blue else
           if x*x + y*y + t'' < 0.05  * ti then white else yellow
        )
     &  toFrameBuffer

sampler = Sampler LinearFilter MirroredRepeat $ Texture2D (V2 128 128) texImage

main = cubeVertexStream
     & mapPrimitives (\(x, y) -> (scale 0.5 . rotate' $ x, y))
     & rasterize
     & mapFragments (texture2D sampler)
     &  toFrameBuffer
     & renderFrame