adjust heartbeat example

1 files changed, 40 insertions, 0 deletions

diff --git a/testdata/editor-examples/Heartbeat.lc b/testdata/editor-examples/Heartbeat.lc
new file mode 100644
index 00000000..3fb4bf02
--- /dev/null
+++ b/testdata/editor-examples/Heartbeat.lc
@@ -0,0 +1,40 @@
+time = Uniform "Time" :: Float
+
+clear = FrameBuffer $ (DepthImage @1 1000, ColorImage @1 red)   -- ...
+clear' = FrameBuffer $ (DepthImage @1 1000, ColorImage @1 blue)   -- ...
+
+triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+triangles = triangleRasterCtx
+colorFragmentCtx = (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+
+rasterizeWith s = rasterizePrimitives triangles ((Smooth)) s
+
+cubeVertexStream = fetch "stream4" Triangle (Attribute "position4" :: Vec 4 Float, Attribute "vertexUV" :: Vec 2 Float)
+mapFragments2 s fs = accumulate colorFragmentCtx (\((a)) -> ((fs a))) s clear
+
+rotate' v = (Uniform "MVP" :: Mat 4 4 Float) `PrimMulMatVec` v
+
+texImage = PrjImageColor $
+            cubeVertexStream         -- cube vertices
+     &      mapPrimitives (\(x, y) -> (scale 1.0 x, V2 y%x (1-y%y)))
+     &      rasterizeWith  -- rasterize
+    `mapFragments2`
+    (\xy -> let
+                x = ((xy :: Vec 2 Float)%x :: Float) -! 0.85
+                y = ((xy :: Vec 2 Float)%y :: Float) -! 0.85
+                t = (0.0005 *! sin (3 *! PrimATan2 x y +! 15 *! time))
+                t' = (0.002 *! sin (5 *! PrimATan2 x y -! 5 *! time))
+                t'' = (0.002 *! sin (7 *! PrimATan2 x y +! 3 *! time))
+                ti = (PrimAbs $ 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
+    )
+
+sampler = Sampler LinearFilter MirroredRepeat $ Texture2D (V2 128 128) texImage
+
+main =             cubeVertexStream         -- cube vertices
+     &      mapPrimitives (\(x, y) -> (scale 0.5 . rotate' $ x, y))
+     &             rasterizeWith -- rasterize
+    `mapFragments2` (texture2D sampler)
+     &             ScreenOut                --  draw into screen