add editor examples to backend test system

6 files changed, 271 insertions, 55 deletions

diff --git a/backendtest/EditorExamplesTest.hs b/backendtest/EditorExamplesTest.hs
new file mode 100644
index 00000000..2fe861c2
--- /dev/null
+++ b/backendtest/EditorExamplesTest.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE LambdaCase #-}
+module EditorExamplesTest (getRenderJob) where
+
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Map as Map
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import Data.ByteString.Char8 (unpack)
+import System.FilePath
+import System.Directory
+
+import Data.Aeson
+import Data.Vect
+
+import TestData as TD
+import LambdaCube.Linear
+import LambdaCube.IR
+import LambdaCube.PipelineSchema
+import LambdaCube.PipelineSchemaUtil
+import LambdaCube.Mesh
+
+import LambdaCube.Compiler as LambdaCube -- compiler
+
+{-
+  ../test-data/editor-examples
+
+  let inputSchema = 
+        { slots : fromArray [ Tuple "stream4" {primitive: Triangles, attributes: fromArray [Tuple "position4" TV4F, Tuple "vertexUV" TV2F]}
+                            ]
+        , uniforms : fromArray
+          +[ Tuple "MVP" M44F
+          +, Tuple "Time" Float
+          +, Tuple "Diffuse" FTexture2D
+          ]
+        }
+-}
+
+inputSchema = makeSchema $ do
+  defObjectArray "stream4" Triangles $ do
+    "position4" @: Attribute_V4F
+    "vertexUV"  @: Attribute_V2F
+  defUniforms $ do
+    "Time"    @: Float
+    "MVP"     @: M44F
+    "Diffuse" @: FTexture2D
+
+frame t m = Frame
+  { renderCount   = 10
+  , frameUniforms = Map.fromList [("Time",VFloat t), ("MVP",VM44F m)]
+  , frameTextures = Map.fromList [("Diffuse",0)]
+  }
+
+scene wh = Scene
+  { TD.objectArrays     = Map.fromList [("stream4", V.fromList [0])]
+  , renderTargetWidth   = wh
+  , renderTargetHeight  = wh
+  , frames              = V.fromList [frame t (mvp t) | t <- [0..10]]
+  }
+  where
+    mvp t =
+      let camPos = Vec3 3.0 1.3 0.3
+          camTarget = Vec3 0.0 0.0 0.0
+          camUp = Vec3 0.0 1.0 0.0
+          near = 0.1
+          far = 100.0
+          fovDeg = 30.0
+
+          angle = pi / 24.0 * t
+
+          cm = fromProjective $ lookat camPos camTarget camUp
+          mm = fromProjective $ orthogonal $ toOrthoUnsafe $ rotMatrixY angle
+          pm = perspective near far (fovDeg / 180 * pi) (fromIntegral wh / fromIntegral wh)
+      in mat4ToM44F $ mm .*. cm .*. pm
+
+getRenderJob = do
+  let path = "../testdata/editor-examples"
+  tests <- filter ((".lc" ==) . takeExtension) <$> getDirectoryContents path
+  print tests
+  ppls <- forM tests $ \name -> do
+    putStrLn $ "compile: " ++ name
+    LambdaCube.compileMain [path] OpenGL33 (dropExtension name) >>= \case
+      Left err  -> fail $ "compile error:\n" ++ err
+      Right ppl -> return $ PipelineInfo
+        { pipelineName = path </> name
+        , pipeline = ppl
+        }
+
+  img <- unpack . B64.encode <$> BS.readFile "logo256x256.png"
+
+  return $ RenderJob
+    { meshes      = V.fromList [cubeMesh]
+    , TD.textures = V.fromList [img]
+    , schema      = inputSchema
+    , scenes      = V.fromList [scene 64]
+    , pipelines   = V.fromList ppls
+    }
+
+g_vertex_buffer_data =
+    [ V4   1.0    1.0  (-1.0) 1.0
+    , V4   1.0  (-1.0) (-1.0) 1.0
+    , V4 (-1.0) (-1.0) (-1.0) 1.0
+
+    , V4   1.0    1.0  (-1.0) 1.0
+    , V4 (-1.0) (-1.0) (-1.0) 1.0
+    , V4 (-1.0)   1.0  (-1.0) 1.0
+
+    , V4   1.0    1.0  (-1.0) 1.0
+    , V4   1.0    1.0    1.0  1.0
+    , V4   1.0  (-1.0)   1.0  1.0
+
+    , V4   1.0    1.0  (-1.0) 1.0
+    , V4   1.0  (-1.0)   1.0  1.0
+    , V4   1.0  (-1.0) (-1.0) 1.0
+
+    , V4   1.0    1.0    1.0  1.0
+    , V4 (-1.0) (-1.0)   1.0  1.0
+    , V4   1.0  (-1.0)   1.0  1.0
+
+    , V4   1.0    1.0    1.0  1.0
+    , V4 (-1.0)   1.0    1.0  1.0
+    , V4 (-1.0) (-1.0)   1.0  1.0
+
+    , V4 (-1.0)   1.0    1.0  1.0
+    , V4 (-1.0) (-1.0) (-1.0) 1.0
+    , V4 (-1.0) (-1.0)   1.0  1.0
+
+    , V4 (-1.0)   1.0    1.0  1.0
+    , V4 (-1.0)   1.0  (-1.0) 1.0
+    , V4 (-1.0) (-1.0) (-1.0) 1.0
+
+    , V4   1.0    1.0  (-1.0) 1.0
+    , V4 (-1.0)   1.0  (-1.0) 1.0
+    , V4 (-1.0)   1.0    1.0  1.0
+
+    , V4   1.0    1.0  (-1.0) 1.0
+    , V4 (-1.0)   1.0    1.0  1.0
+    , V4   1.0    1.0    1.0  1.0
+
+    , V4   1.0    (-1.0)  (-1.0) 1.0
+    , V4   1.0    (-1.0)    1.0  1.0
+    , V4 (-1.0)   (-1.0)    1.0  1.0
+
+    , V4   1.0    (-1.0)  (-1.0) 1.0
+    , V4 (-1.0)   (-1.0)    1.0  1.0
+    , V4 (-1.0)   (-1.0)  (-1.0) 1.0
+    ]
+
+--  Two UV coordinatesfor each vertex. They were created with Blender.
+g_uv_buffer_data =
+    [ V2 0.0 1.0
+    , V2 0.0 0.0
+    , V2 1.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 0.0
+    , V2 1.0 1.0
+    , V2 0.0 1.0
+    , V2 1.0 1.0
+    , V2 1.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 0.0
+    , V2 0.0 0.0
+    , V2 1.0 1.0
+    , V2 0.0 0.0
+    , V2 1.0 0.0
+    , V2 1.0 1.0
+    , V2 0.0 1.0
+    , V2 0.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 0.0
+    , V2 0.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 1.0
+    , V2 1.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 1.0
+    , V2 1.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 0.0
+    , V2 0.0 0.0
+    , V2 0.0 1.0
+    , V2 0.0 0.0
+    , V2 1.0 0.0
+    , V2 0.0 1.0
+    , V2 1.0 0.0
+    , V2 1.0 1.0
+    ]
+
+cubeMesh = Mesh
+  { mAttributes = Map.fromList
+        [ ("position4", A_V4F $ V.fromList g_vertex_buffer_data)
+        , ("vertexUV",  A_V2F $ V.fromList g_uv_buffer_data)
+        ]
+  , mPrimitive = P_Triangles
+  }
+
+vec4ToV4F (Vec4 x y z w) = V4 x y z w
+mat4ToM44F (Mat4 a b c d) = V4 (vec4ToV4F a) (vec4ToV4F b) (vec4ToV4F c) (vec4ToV4F d)
+
+-- | Camera transformation matrix.
+lookat :: Vec3   -- ^ Camera position.
+       -> Vec3   -- ^ Target position.
+       -> Vec3   -- ^ Upward direction.
+       -> Proj4
+lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r)
+  where
+    w = normalize $ pos &- target
+    u = normalize $ up &^ w
+    v = w &^ u
+    r = transpose $ Mat3 u v w
+
+-- | Perspective transformation matrix in row major order.
+perspective :: Float  -- ^ Near plane clipping distance (always positive).
+            -> Float  -- ^ Far plane clipping distance (always positive).
+            -> Float  -- ^ Field of view of the y axis, in radians.
+            -> Float  -- ^ Aspect ratio, i.e. screen's width\/height.
+            -> Mat4
+perspective n f fovy aspect = transpose $
+    Mat4 (Vec4 (2*n/(r-l))       0       (-(r+l)/(r-l))        0)
+         (Vec4     0        (2*n/(t-b))  ((t+b)/(t-b))         0)
+         (Vec4     0             0       (-(f+n)/(f-n))  (-2*f*n/(f-n)))
+         (Vec4     0             0            (-1)             0)
+  where
+    t = n*tan(fovy/2)
+    b = -t
+    r = aspect*t
+    l = -r
diff --git a/backendtest/TestData.hs b/backendtest/TestData.hs
index a48dc42b..d6d8e381 100644
--- a/backendtest/TestData.hs
+++ b/backendtest/TestData.hs
@@ -1,5 +1,5 @@
 -- generated file, do not modify!
--- 2016-01-28T13:15:31.27456Z
+-- 2016-02-12T16:05:13.383716000000Z
 
 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 module TestData where
@@ -46,13 +46,21 @@ data Scene
 
   deriving (Show, Eq, Ord)
 
+data PipelineInfo
+  = PipelineInfo
+  { pipelineName :: String
+  , pipeline :: Pipeline
+  }
+
+  deriving (Show, Eq, Ord)
+
 data RenderJob
   = RenderJob
   { meshes :: Vector Mesh
   , textures :: Vector String
   , schema :: PipelineSchema
   , scenes :: Vector Scene
-  , pipelines :: Vector Pipeline
+  , pipelines :: Vector PipelineInfo
   }
 
   deriving (Show, Eq, Ord)
@@ -144,6 +152,27 @@ instance FromJSON Scene where
           } 
   parseJSON _ = mzero
 
+instance ToJSON PipelineInfo where
+  toJSON v = case v of
+    PipelineInfo{..} -> object
+      [ "tag" .= ("PipelineInfo" :: Text)
+      , "pipelineName" .= pipelineName
+      , "pipeline" .= pipeline
+      ]
+
+instance FromJSON PipelineInfo where
+  parseJSON (Object obj) = do
+    tag <- obj .: "tag"
+    case tag :: Text of
+      "PipelineInfo" -> do
+        pipelineName <- obj .: "pipelineName"
+        pipeline <- obj .: "pipeline"
+        pure $ PipelineInfo
+          { pipelineName = pipelineName
+          , pipeline = pipeline
+          } 
+  parseJSON _ = mzero
+
 instance ToJSON RenderJob where
   toJSON v = case v of
     RenderJob{..} -> object
diff --git a/backendtest/hello.json b/backendtest/hello.json
deleted file mode 100644
index 56de2470..00000000
--- a/backendtest/hello.json
+++ /dev/null
@@ -1 +0,0 @@
-{"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":{"z1":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"position"},"a2":{"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 z1 ;\nin vec2 a2 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = a2;\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 ( ( z1 ).x,( z1 ).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/backendtest/logo.png b/backendtest/logo.png
deleted file mode 100644
index 44716763..00000000
--- a/backendtest/logo.png
+++ /dev/null
diff --git a/backendtest/logo256x256.png b/backendtest/logo256x256.png
new file mode 100644
index 00000000..2c0c985c
--- /dev/null
+++ b/backendtest/logo256x256.png
diff --git a/backendtest/server.hs b/backendtest/server.hs
index 79d873f5..c2d13555 100644
--- a/backendtest/server.hs
+++ b/backendtest/server.hs
@@ -13,6 +13,7 @@ import qualified Data.Vector.Storable as SV
 import qualified Network.WebSockets as WS
 import qualified Data.Map as Map
 import Text.Printf
+import System.FilePath
 import System.Directory
 
 import TestData
@@ -22,6 +23,8 @@ import LambdaCube.PipelineSchema
 import LambdaCube.PipelineSchemaUtil
 import LambdaCube.Mesh
 
+import qualified EditorExamplesTest
+
 main :: IO ()
 main = do
   putStrLn "listening"
@@ -31,23 +34,27 @@ application pending = do
   conn <- WS.acceptRequest pending
   WS.forkPingThread conn 30
   let disconnect = return ()
+      one = 1 :: Int
   flip finally disconnect $ do
     -- receive client info
     decodeStrict <$> WS.receiveData conn >>= \case
       Nothing -> putStrLn "invalid client info"
       Just ci@ClientInfo{..} -> print ci
     -- send pipeline
-    renderJob@RenderJob{..} <- testRenderJob
+    --renderJob@RenderJob{..} <- testRenderJob
+    renderJob@RenderJob{..} <- EditorExamplesTest.getRenderJob -- TODO
     WS.sendTextData conn . encode $ renderJob
     -- TODO: get render result: pipeline x scene x frame
-    forM_ [1..length pipelines] $ \pIdx ->
-      forM_ (zip [1..] $ V.toList scenes) $ \(sIdx,Scene{..}) ->
-        forM_ [1..length frames] $ \fIdx -> do
+    forM_ [one..length pipelines] $ \pIdx -> do
+      putStrLn $ "pipeline: " ++ pipelineName (pipelines V.! (pIdx - 1))
+      forM_ (zip [one..] $ V.toList scenes) $ \(sIdx,Scene{..}) ->
+        forM_ [one..length frames] $ \fIdx -> do
           decodeStrict <$> WS.receiveData conn >>= \case
             Nothing -> putStrLn "invalid RenderJobResult"
-            Just (RenderJobError e) -> putStrLn $ "render error: " ++ e -- TODO: test failed
+            Just (RenderJobError e) -> fail $ "render error:\n" ++ e -- TODO: test failed
             Just (RenderJobResult FrameResult{..}) -> do
-              let name = "out/output_ppl" ++ show pIdx ++ "_scn" ++ show sIdx ++ "_" ++ show fIdx ++ ".png"
+              let name = "out/output_ppl" ++ printf "%02d" pIdx ++ "_scn" ++ printf "%02d" sIdx ++ "_" ++ printf "%02d" fIdx ++ ".png"
+              createDirectoryIfMissing True (takeDirectory name)
               compareOrSaveImage name =<< toImage frImageWidth frImageHeight . either error id . B64.decode =<< WS.receiveData conn
               putStrLn $ name ++ "\t" ++ unwords (map showTime . V.toList $ frRenderTimes)
     putStrLn "render job done"
@@ -114,49 +121,3 @@ showTime delta
         collect pipelines
     - create render job list
 -}
-testRenderJob = do
-  let triangleA = Mesh
-        { mAttributes   = Map.fromList
-            [ ("position",  A_V2F $ V.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)])
-            , ("uv",        A_V2F $ V.fromList [V2 1 1, V2 0 1, V2 0 0])
-            ]
-        , mPrimitive    = P_Triangles
-        }
-
-      triangleB = Mesh
-        { mAttributes   = Map.fromList
-            [ ("position",  A_V2F $ V.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1])
-            , ("uv",        A_V2F $ V.fromList [V2 1 1, V2 0 0, V2 1 0])
-            ]
-        , mPrimitive    = P_Triangles
-        }
-      inputSchema = makeSchema $ do
-          defObjectArray "objects" Triangles $ do
-            "position"  @: Attribute_V2F
-            "uv"        @: Attribute_V2F
-          defUniforms $ do
-            "time"           @: Float
-            "diffuseTexture" @: FTexture2D
-      frame t = Frame
-                  { renderCount   = 10
-                  , frameUniforms = Map.fromList [("time",VFloat t)]
-                  , frameTextures = Map.fromList [("diffuseTexture",0)]
-                  }
-
-      scene wh = Scene
-        { objectArrays        = Map.fromList [("objects", V.fromList [0,1])]
-        , renderTargetWidth   = wh
-        , renderTargetHeight  = wh
-        , frames              = V.fromList [frame t | t <- [0,0.3..6]]
-        }
-
-  img <- unpack . B64.encode <$> BS.readFile "logo.png"
-  Just ppl <- decodeStrict <$> BS.readFile "hello.json"
-
-  return $ RenderJob
-    { meshes      = V.fromList [triangleA,triangleB]
-    , textures    = V.fromList [img]
-    , schema      = inputSchema
-    , scenes      = V.fromList [scene (2^s) | s <- [1..9]]
-    , pipelines   = V.fromList [ppl]
-    }