6 files changed, 108 insertions, 8 deletions

diff --git a/examples/Hello.hs b/examples/Hello.hs
index 3cc8c63..1cba1b5 100644
--- a/examples/Hello.hs
+++ b/examples/Hello.hs
@@ -17,7 +17,7 @@ main = do
       Left err  -> fail $ "compile error:\n" ++ err
       Right pd  -> return pd
 
-    win <- initWindow "LambdaCube 3D DSL Hello World" 640 480
+    win <- initWindow "LambdaCube 3D DSL Hello World" 640 640
 
     -- setup render data
     let inputSchema = makeSchema $ do
@@ -35,7 +35,7 @@ main = do
     LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
 
     -- load image and upload texture
-    Right img <- Juicy.readImage "Panels_Diffuse.png"
+    Right img <- Juicy.readImage "logo.png"
     textureData <- LambdaCubeGL.uploadTexture2DToGPU img
 
     -- allocate GL pipeline
@@ -70,7 +70,7 @@ triangleA :: LambdaCubeGL.Mesh
 triangleA = Mesh
     { mAttributes   = Map.fromList
         [ ("position",  A_V2F $ SV.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)])
-        , ("uv",        A_V2F $ SV.fromList [V2 0 0, V2 0 1, V2 1 1])
+        , ("uv",        A_V2F $ SV.fromList [V2 1 1, V2 0 1, V2 0 0])
         ]
     , mPrimitive    = P_Triangles
     , mGPUData      = Nothing
@@ -80,7 +80,7 @@ triangleB :: LambdaCubeGL.Mesh
 triangleB = Mesh
     { mAttributes   = Map.fromList
         [ ("position",  A_V2F $ SV.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1])
-        , ("uv",        A_V2F $ SV.fromList [V2 0 0, V2 1 1, V2 1 0])
+        , ("uv",        A_V2F $ SV.fromList [V2 1 1, V2 0 0, V2 1 0])
         ]
     , mPrimitive    = P_Triangles
     , mGPUData      = Nothing
diff --git a/examples/HelloJson.hs b/examples/HelloJson.hs
new file mode 100644
index 0000000..a0c8a2d
--- /dev/null
+++ b/examples/HelloJson.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings #-}
+import "GLFW-b" Graphics.UI.GLFW as GLFW
+import qualified Data.Map as Map
+import qualified Data.Vector.Storable as SV
+
+import "lambdacube-gl-ir" LambdaCube.GL as LambdaCubeGL -- renderer
+import "lambdacube-gl-ir" LambdaCube.GL.Mesh as LambdaCubeGL
+
+import Codec.Picture as Juicy
+
+import Data.Aeson
+import qualified Data.ByteString as SB
+
+main :: IO ()
+main = do
+    Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json"
+
+    win <- initWindow "LambdaCube 3D DSL Hello World" 640 640
+
+    -- setup render data
+    let inputSchema = makeSchema $ do
+          defObjectArray "objects" Triangles $ do
+            "position"  @: Attribute_V2F
+            "uv"        @: Attribute_V2F
+          defUniforms $ do
+            "time"           @: Float
+            "diffuseTexture" @: FTexture2D
+
+    storage <- LambdaCubeGL.allocStorage inputSchema
+
+    -- upload geometry to GPU and add to pipeline input
+    LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
+    LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
+
+    -- load image and upload texture
+    Right img <- Juicy.readImage "logo.png"
+    textureData <- LambdaCubeGL.uploadTexture2DToGPU img
+
+    -- allocate GL pipeline
+    renderer <- LambdaCubeGL.allocRenderer pipelineDesc
+    LambdaCubeGL.setStorage renderer storage >>= \case -- check schema compatibility
+      Just err -> putStrLn err
+      Nothing  -> loop
+        where loop = do
+                -- update graphics input
+                GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
+                LambdaCubeGL.updateUniforms storage $ do
+                  "diffuseTexture" @= return textureData
+                  "time" @= do
+                              Just t <- GLFW.getTime
+                              return (realToFrac t :: Float)
+                -- render
+                LambdaCubeGL.renderFrame renderer
+                GLFW.swapBuffers win
+                GLFW.pollEvents
+
+                let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
+                escape <- keyIsPressed Key'Escape
+                if escape then return () else loop
+
+    LambdaCubeGL.disposeRenderer renderer
+    LambdaCubeGL.disposeStorage storage
+    GLFW.destroyWindow win
+    GLFW.terminate
+
+-- geometry data: triangles
+triangleA :: LambdaCubeGL.Mesh
+triangleA = Mesh
+    { mAttributes   = Map.fromList
+        [ ("position",  A_V2F $ SV.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)])
+        , ("uv",        A_V2F $ SV.fromList [V2 1 1, V2 0 1, V2 0 0])
+        ]
+    , mPrimitive    = P_Triangles
+    , mGPUData      = Nothing
+    }
+
+triangleB :: LambdaCubeGL.Mesh
+triangleB = Mesh
+    { mAttributes   = Map.fromList
+        [ ("position",  A_V2F $ SV.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1])
+        , ("uv",        A_V2F $ SV.fromList [V2 1 1, V2 0 0, V2 1 0])
+        ]
+    , mPrimitive    = P_Triangles
+    , mGPUData      = Nothing
+    }
+
+initWindow :: String -> Int -> Int -> IO Window
+initWindow title width height = do
+    GLFW.init
+    GLFW.defaultWindowHints
+    mapM_ GLFW.windowHint
+      [ WindowHint'ContextVersionMajor 3
+      , WindowHint'ContextVersionMinor 3
+      , WindowHint'OpenGLProfile OpenGLProfile'Core
+      , WindowHint'OpenGLForwardCompat True
+      ]
+    Just win <- GLFW.createWindow width height title Nothing Nothing
+    GLFW.makeContextCurrent $ Just win
+    return win
diff --git a/examples/Panels_Diffuse.png b/examples/Panels_Diffuse.png
deleted file mode 100644
index 15b242c..0000000
--- a/examples/Panels_Diffuse.png
+++ /dev/null
diff --git a/examples/hello.json b/examples/hello.json
new file mode 100644
index 0000000..797bfd0
--- /dev/null
+++ b/examples/hello.json
@@ -0,0 +1 @@
+{"textures":[],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4F","arg0":{"w":1,"z":0.4,"x":0.0,"y":0.0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetSamplerUniform","arg0":"diffuseTexture","arg1":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullNone"},"arg1":{"tag":"PolygonFill"},"arg2":{"tag":"NoOffset"}}},{"tag":"SetAccumulationContext","arg0":{"accViewportName":null,"tag":"AccumulationContext","accOperations":[{"tag":"ColorOp","arg0":{"tag":"NoBlending"},"arg1":{"tag":"VV4B","arg0":{"w":true,"z":true,"x":true,"y":true}}}]}},{"tag":"RenderSlot","arg0":0}],"slots":[{"tag":"Slot","slotPrimitive":{"tag":"Triangles"},"slotStreams":{"uv":{"tag":"V2F"},"position":{"tag":"V2F"}},"slotName":"objects","slotUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{"diffuseTexture":{"tag":"FTexture2D"}},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4F"},"name":"f0"}],"programStreams":{"q1":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"position"},"r1":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"uv"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D diffuseTexture ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = texture2D ( diffuseTexture,v0 );\n}\n","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float time ;\nin vec2 q1 ;\nin vec2 r1 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = r1;\ngl_Position = ( mat4 ( vec4 ( cos ( time ),sin ( time ),0.0,0.0 ),vec4 ( ( 0.0 ) - ( sin ( time ) ),cos ( time ),0.0,0.0 ),vec4 ( 0.0,0.0,1.0,0.0 ),vec4 ( 0.0,0.0,0.0,1.0 ) ) ) * ( vec4 ( ( q1 ).x,( q1 ).y,-1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n","geometryShader":null,"programUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Color"}}}]}]}
\ No newline at end of file
diff --git a/examples/hello.lc b/examples/hello.lc
index 4254a69..20f8292 100644
--- a/examples/hello.lc
+++ b/examples/hello.lc
@@ -3,11 +3,11 @@ sampler = Sampler PointFilter MirroredRepeat (Texture2DSlot "diffuseTexture")
 main = let
   emptyFB           = FrameBuffer (colorImage1 (V4 0.0 0.0 0.4 1.0))
   rasterCtx         = TriangleCtx CullNone PolygonFill NoOffset LastVertex
-  fragmentCtx       = AccumulationContext (ColorOp NoBlending (V4 True True True True))
+  fragmentCtx       = (ColorOp NoBlending (V4 True True True True))
   vertexShader (p,uv) = VertexOut (rotMatrixZ time *. (V4 p%x p%y (-1) 1)) 1.0 () (Smooth uv)
-  vertexStream      = Fetch "objects" Triangles (Attribute "position" :: Vec 2 Float, Attribute "uv" :: Vec 2 Float)
+  vertexStream      = Fetch @Triangle "objects" (Attribute "position" :: Vec 2 Float, Attribute "uv" :: Vec 2 Float)
   primitiveStream   = Transform vertexShader vertexStream
   fragmentStream    = Rasterize rasterCtx primitiveStream
-  fragmentShader uv = FragmentOut $ texture2D sampler uv
-  frame             = Accumulate fragmentCtx PassAll fragmentShader fragmentStream emptyFB
+  fragmentShader    = FragmentShader $ \uv -> texture2D sampler uv
+  frame             = accumulate fragmentCtx PassAll fragmentShader fragmentStream emptyFB
  in ScreenOut frame
diff --git a/examples/logo.png b/examples/logo.png
new file mode 100644
index 0000000..4471676
--- /dev/null
+++ b/examples/logo.png