lambdacube-gl-pickint: new executable to test integer picking

6 files changed, 251 insertions, 0 deletions

diff --git a/examples/pickInt.hs b/examples/pickInt.hs
new file mode 100644
index 0000000..2443c8b
--- /dev/null
+++ b/examples/pickInt.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings, StandaloneDeriving, ViewPatterns #-}
+import           Control.Monad
+import           Data.Aeson
+import           Data.Vect                            (Mat4(..), Vec3(..), Vec4(..))
+import           Graphics.GL.Core33                as GL
+import           LambdaCube.GL                     as LambdaCubeGL
+import           LambdaCube.GL.Mesh                as LambdaCubeGL
+import           Text.Printf
+import "GLFW-b"  Graphics.UI.GLFW                  as GLFW
+import qualified Data.ByteString                   as SB
+import qualified Data.Map                          as Map
+import qualified Data.Vect                         as Vc
+import qualified Data.Vector                       as V
+import qualified Foreign                           as F
+import qualified Foreign.C.Types                   as F
+import qualified LambdaCube.GL.Type                as LC
+import qualified LambdaCube.Linear                 as LCLin
+
+----------------------------------------------------
+--  See:  http://lambdacube3d.com/getting-started
+----------------------------------------------------
+
+screenDim :: (,) Int Int
+screenDim = (,) 800 600
+(,) screenW screenH = screenDim
+
+main :: IO ()
+main = do
+    Just pipePickDesc <- decodeStrict <$> SB.readFile "pickInt.json"
+    Just pipeDrawDesc <- decodeStrict <$> SB.readFile "pickIntDraw.json"
+
+    win <- initWindow "LambdaCube 3D integer picking" 800 600
+
+    -- setup render data
+    let inputSchema = makeSchema $ do
+          defObjectArray "objects" Triangles $ do
+            "position"  @: Attribute_V2F
+            "id"        @: Attribute_Int
+            "color"     @: Attribute_V4F
+          defUniforms $ do
+            "viewProj"  @: M44F
+
+    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" []
+
+    -- allocate GL pipeline
+    pipePick <- LambdaCubeGL.allocRenderer pipePickDesc
+    pipeDraw <- LambdaCubeGL.allocRenderer pipeDrawDesc
+    errPick  <- LambdaCubeGL.setStorage pipePick storage
+    errDraw  <- LambdaCubeGL.setStorage pipeDraw storage
+    case (errPick, errDraw) of -- check schema compatibility
+      (Just err, _) -> putStrLn err
+      (_, Just err) -> putStrLn err
+      (Nothing, Nothing) -> loop
+        where loop = do
+                -- update graphics input
+                GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
+                LambdaCubeGL.updateUniforms storage $ do
+                  let (,) x y   = (,) 0 0
+                      cvpos     = Vec3 x (-y) 0
+                      toScreen  = screenM screenW screenH
+                  "viewProj" @= pure (mat4ToM44F $! (Vc.fromProjective $! Vc.translation cvpos) Vc..*. toScreen)
+
+                let pickPoints =
+                      [ (0,   0)   -- should be black 
+                      , (200, 200) --         ..blue, ffff0000
+                      , (600, 400) --         ..red,  ff0000ff
+                      ] :: [(,) Int Int]
+
+                -- render to render texture
+                LambdaCubeGL.renderFrame pipePick
+                case LC.glOutputs pipePick of
+                  [LC.GLOutputRenderTexture (fromIntegral -> fbo) _rendTex] -> do
+                    rtexPicks <- collectPicks fbo pickPoints
+                    printPicks pickPoints rtexPicks
+                  x -> error $ "Unexpected outputs: " <> show x
+
+                -- render to framebuffer & pick
+                LambdaCubeGL.renderFrame pipeDraw
+                colorPicks <- collectPicks 0 pickPoints
+                printPicks pickPoints colorPicks
+
+                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
+              collectPicks :: Int -> [(,) Int Int] -> IO [Int]
+              collectPicks fb picks =
+                forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim
+              printPicks pickPoints colorPicks = do
+                forM_ (zip pickPoints colorPicks) $ \((x,y), col)-> do
+                  printf "%d:%d: %x   " x y col
+                putStrLn ""
+
+    LambdaCubeGL.disposeRenderer pipePick
+    LambdaCubeGL.disposeRenderer pipeDraw
+    LambdaCubeGL.disposeStorage storage
+    GLFW.destroyWindow win
+    GLFW.terminate
+
+deriving instance Show (LC.GLOutput)
+deriving instance Show (LC.GLTexture)
+
+-- geometry data: triangles
+scale = 250.0
+s     = scale
+
+triangleA :: LambdaCubeGL.Mesh
+triangleA = Mesh
+    { mAttributes   = Map.fromList
+        [ ("position",  A_V2F $ V.fromList [V2 s s, V2 s (-s), V2 (-s) (-s)])
+        , ("color",     A_V4F $ V.fromList $ take 4 $ repeat $ V4 1 0 0 1)
+        , ("id",        A_Int $ V.fromList [1, 1, 1])
+        ]
+    , mPrimitive    = P_Triangles
+    }
+
+triangleB :: LambdaCubeGL.Mesh
+triangleB = Mesh
+    { mAttributes   = Map.fromList
+        [ ("position",  A_V2F $ V.fromList [V2 s s, V2 (-s) (-s), V2 (-s) s])
+        , ("color",     A_V4F $ V.fromList $ take 4 $ repeat $ V4 0 0 1 1)
+        , ("id",        A_Int $ V.fromList [2, 2, 2])
+        ]
+    , mPrimitive    = P_Triangles
+    }
+
+vec4ToV4F :: Vec4 -> LCLin.V4F
+vec4ToV4F (Vc.Vec4 x y z w) = LCLin.V4 x y z w
+
+mat4ToM44F :: Mat4 -> LCLin.M44F
+mat4ToM44F (Mat4 a b c d) = LCLin.V4 (vec4ToV4F a) (vec4ToV4F b) (vec4ToV4F c) (vec4ToV4F d)
+
+screenM :: Int -> Int -> Mat4
+screenM w h = scaleM
+  where (fw, fh) = (fromIntegral w, fromIntegral h)
+        scaleM = Vc.Mat4 (Vc.Vec4 (1/fw)  0     0 0)
+                         (Vc.Vec4  0     (1/fh) 0 0)
+                         (Vc.Vec4  0      0     1 0)
+                         (Vc.Vec4  0      0     0 0.5)
+
+pickFrameBuffer
+  :: Int         -- ^ framebuffer
+  -> (,) Int Int -- ^ FB dimensions
+  -> (,) Int Int -- ^ pick coordinates
+  -> IO F.Word32 -- ^ resultant pixel value
+pickFrameBuffer fb (w, h) (x, y) = do
+  glFinish
+  glBindFramebuffer GL_READ_FRAMEBUFFER $ fromIntegral fb
+  glReadBuffer GL_BACK_LEFT
+  withFrameBuffer x (h - y - 1) 1 1 $ \p -> fromIntegral <$> F.peek (F.castPtr p :: F.Ptr F.Word32)
+
+withFrameBuffer :: Int -> Int -> Int -> Int -> (F.Ptr F.Word8 -> IO a) -> IO a
+withFrameBuffer x y w h fn = F.allocaBytes (w*h*4) $ \p -> do
+  glPixelStorei GL_UNPACK_LSB_FIRST    0
+  glPixelStorei GL_UNPACK_SWAP_BYTES   0
+  glPixelStorei GL_UNPACK_ROW_LENGTH   $ fromIntegral w
+  glPixelStorei GL_UNPACK_IMAGE_HEIGHT 0
+  glPixelStorei GL_UNPACK_SKIP_ROWS    0
+  glPixelStorei GL_UNPACK_SKIP_PIXELS  0
+  glPixelStorei GL_UNPACK_SKIP_IMAGES  0
+  glPixelStorei GL_UNPACK_ALIGNMENT    1
+  glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) GL_RGBA GL_UNSIGNED_BYTE $ F.castPtr p
+  glPixelStorei GL_UNPACK_ROW_LENGTH   0
+  fn p
+
+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/pickInt.json b/examples/pickInt.json
new file mode 100644
index 0000000..233cd61
--- /dev/null
+++ b/examples/pickInt.json
@@ -0,0 +1 @@
+{"textures":[{"textureBaseLevel":0,"textureSize":{"tag":"VV2U","arg0":{"x":800,"y":600}},"tag":"TextureDescriptor","textureMaxLevel":0,"textureSampler":{"samplerMaxLod":null,"samplerLodBias":0,"tag":"SamplerDescriptor","samplerBorderColor":{"tag":"VV4F","arg0":{"w":1,"z":0,"x":0,"y":0}},"samplerMinFilter":{"tag":"Nearest"},"samplerWrapT":{"tag":"Repeat"},"samplerMagFilter":{"tag":"Nearest"},"samplerWrapR":null,"samplerCompareFunc":null,"samplerWrapS":{"tag":"Repeat"},"samplerMinLod":null},"textureType":{"tag":"Texture2D","arg0":{"tag":"IntT","arg0":{"tag":"RGBA"}},"arg1":1},"textureSemantic":{"tag":"Color"}}],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4I","arg0":{"w":0,"z":0,"x":0,"y":0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullFront","arg0":{"tag":"CCW"}},"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":{"color":{"tag":"V4F"},"id":{"tag":"Int"},"position":{"tag":"V3F"}},"slotName":"objects","slotUniforms":{"viewProj":{"tag":"M44F"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4I"},"name":"f0"}],"programStreams":{"vi3":{"tag":"Parameter","ty":{"tag":"Int"},"name":"id"},"vi2":{"tag":"Parameter","ty":{"tag":"V4F"},"name":"color"},"vi1":{"tag":"Parameter","ty":{"tag":"V3F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nflat in vec2 vo1;\nflat in ivec4 vo2;\nout ivec4 f0;\nvoid main() {\n    f0 = vo2;\n}","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nuniform mat4 viewProj;\nin vec3 vi1;\nin vec4 vi2;\nin int vi3;\nflat out vec2 vo1;\nflat out ivec4 vo2;\nvoid main() {\n    gl_Position = (viewProj) * (vec4 ((vi1).x,(vi1).y,0.0,1.0));\n    vo1 = vec2 (0.0,0.0);\n    vo2 = ivec4 (0,0,0,vi3);\n}","geometryShader":null,"programUniforms":{"viewProj":{"tag":"M44F"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"TextureImage","arg0":0,"arg1":0,"arg2":null}}]}],"info":"generated by lambdacube-compiler 0.6.1.0"}
\ No newline at end of file
diff --git a/examples/pickInt.lc b/examples/pickInt.lc
new file mode 100644
index 0000000..a75bc19
--- /dev/null
+++ b/examples/pickInt.lc
@@ -0,0 +1,21 @@
+type FB = FrameBuffer 1 '[ 'Color (Vec 4 Int)]
+
+scene :: String -> FB -> FB
+scene name prevFB =
+  Accumulate    ((ColorOp NoBlending (one :: Vec 4 Bool)))
+  (mapFragments (\(uv, rgba) -> ((rgba)))
+   $ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
+   $ mapPrimitives
+    (\(pos, color, id)->
+      ( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
+      , V2 0.0 0.0
+      , V4 0 0 0 id))
+    $ fetch name ( Attribute "position"   :: Vec 3 Float
+                 , Attribute "color"      :: Vec 4 Float
+                 , Attribute "id"         :: Int))
+  prevFB
+
+main :: Output
+main = TextureOut (V2 800 600) $
+       scene "objects" $
+       FrameBuffer ((colorImage1 (V4 0 0 0 0)))
diff --git a/examples/pickIntDraw.json b/examples/pickIntDraw.json
new file mode 100644
index 0000000..610caf3
--- /dev/null
+++ b/examples/pickIntDraw.json
@@ -0,0 +1 @@
+{"textures":[],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4F","arg0":{"w":0,"z":0,"x":0,"y":0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullFront","arg0":{"tag":"CCW"}},"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":{"color":{"tag":"V4F"},"id":{"tag":"Int"},"position":{"tag":"V3F"}},"slotName":"objects","slotUniforms":{"viewProj":{"tag":"M44F"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4F"},"name":"f0"}],"programStreams":{"vi3":{"tag":"Parameter","ty":{"tag":"Int"},"name":"id"},"vi2":{"tag":"Parameter","ty":{"tag":"V4F"},"name":"color"},"vi1":{"tag":"Parameter","ty":{"tag":"V3F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nflat in vec2 vo1;\nflat in vec4 vo2;\nout vec4 f0;\nvoid main() {\n    f0 = vo2;\n}","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nuniform mat4 viewProj;\nin vec3 vi1;\nin vec4 vi2;\nin int vi3;\nflat out vec2 vo1;\nflat out vec4 vo2;\nvoid main() {\n    gl_Position = (viewProj) * (vec4 ((vi1).x,(vi1).y,0.0,1.0));\n    vo1 = vec2 (0.0,0.0);\n    vo2 = vi2;\n}","geometryShader":null,"programUniforms":{"viewProj":{"tag":"M44F"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Color"}}}]}],"info":"generated by lambdacube-compiler 0.6.1.0"}
\ No newline at end of file
diff --git a/examples/pickIntDraw.lc b/examples/pickIntDraw.lc
new file mode 100644
index 0000000..fd1a587
--- /dev/null
+++ b/examples/pickIntDraw.lc
@@ -0,0 +1,21 @@
+type FB = FrameBuffer 1 '[ 'Color (Vec 4 Float)]
+
+scene :: String -> FB -> FB
+scene name prevFB =
+  Accumulate    ((ColorOp NoBlending (one :: Vec 4 Bool)))
+  (mapFragments (\(uv, rgba) -> ((rgba)))
+   $ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
+   $ mapPrimitives
+    (\(pos, color, id)->
+      ( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
+      , V2 0.0 0.0
+      , color))
+    $ fetch name ( Attribute "position"   :: Vec 3 Float
+                 , Attribute "color"      :: Vec 4 Float
+                 , Attribute "id"         :: Int))
+  prevFB
+
+main :: Output
+main = ScreenOut $
+       scene "objects" $
+       FrameBuffer ((colorImage1 (V4 0 0 0 0)))
diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal
index d473889..2c82ae5 100644
--- a/lambdacube-gl.cabal
+++ b/lambdacube-gl.cabal
@@ -84,6 +84,29 @@ executable lambdacube-gl-hello
     lambdacube-gl,
     lambdacube-ir == 0.3.*
 
+executable lambdacube-gl-pickint
+  -- if flag(example)
+  --   Buildable: True
+  -- else
+  --   Buildable: False
+
+  hs-source-dirs:   examples
+  main-is:          pickInt.hs
+  default-language: Haskell2010
+
+  build-depends:
+    GLFW-b >= 1.4,
+    JuicyPixels >=3.2,
+    OpenGLRaw,
+    aeson >= 1.1.2,
+    base,
+    bytestring >=0.10,
+    containers >=0.5,
+    lambdacube-gl,
+    lambdacube-ir,
+    vect,
+    vector >=0.12
+
 executable lambdacube-gl-hello-obj
   if flag(example)
     Buildable: True