Merge pull request #13 from deepfire/master

Keep track of GLRenderer outputs and fix integer render textures
author: Csaba Hruska <csaba.hruska@gmail.com> 2018-09-22 11:26:50 +0200
committer: GitHub <noreply@github.com> 2018-09-22 11:26:50 +0200
commit: 9f6e1725b52ea6f48101a37181f0aa9f7d1494d3 (patch)
tree: 7c10ffae525116bbdcf5a681f755e658078aa5fb /examples
parent: 42bc23db138991343708d14e2b5032d2dabd3d0d (diff)
parent: a5880684868824b34689df4589106730ad1c7fc0 (diff)
5 files changed, 236 insertions, 0 deletions
diff --git a/examples/pickInt.hs b/examples/pickInt.hs
new file mode 100644
index 0000000..2703e91
--- /dev/null
+++ b/examples/pickInt.hs
@@ -0,0 +1,192 @@
+{-# 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)
+                (curX, curY) <- GLFW.getCursorPos win
+                let pickPoints =   -- should be fb 0            fb 1 (pick)
+                      [ (clamp curX 800, clamp curY 600)
+                      , (0,   0)   --           black              0
+                      , (200, 200) --         ..blue, ffff0000     2
+                      , (600, 400) --         ..red,  ff0000ff     1
+                      ] :: [(Int, Int)]
+                    clamp v m = min (pred m) $ max 0 (floor v)
+                -- 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
+  let (fbmode, format) =
+        if fb == 0
+        then (GL_BACK_LEFT,         GL_RGBA)
+        else (GL_COLOR_ATTACHMENT0, GL_RGBA_INTEGER)
+  glReadBuffer fbmode
+  withFrameBuffer w format x (h - y - 1) 1 1 $ \p -> fromIntegral <$> F.peek (F.castPtr p :: F.Ptr F.Word32)
+withFrameBuffer :: Int -> GLenum -> Int -> Int -> Int -> Int -> (F.Ptr F.Word8 -> IO a) -> IO a
+withFrameBuffer rowLen format 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 rowLen
+  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) format 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)))
author	Csaba Hruska <csaba.hruska@gmail.com>	2018-09-22 11:26:50 +0200
committer	GitHub <noreply@github.com>	2018-09-22 11:26:50 +0200
commit	9f6e1725b52ea6f48101a37181f0aa9f7d1494d3 (patch)
tree	7c10ffae525116bbdcf5a681f755e658078aa5fb /examples
parent	42bc23db138991343708d14e2b5032d2dabd3d0d (diff)
parent	a5880684868824b34689df4589106730ad1c7fc0 (diff)

diff --git a/examples/pickInt.hs b/examples/pickInt.hs new file mode 100644 index 0000000..2703e91 --- /dev/null +++ b/examples/pickInt.hs
@@ -0,0 +1,192 @@
	1	{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings, StandaloneDeriving, ViewPatterns #-}
	2	import Control.Monad
	3	import Data.Aeson
	4	import Data.Vect (Mat4(..), Vec3(..), Vec4(..))
	5	import Graphics.GL.Core33 as GL
	6	import LambdaCube.GL as LambdaCubeGL
	7	import LambdaCube.GL.Mesh as LambdaCubeGL
	8	import Text.Printf
	9	import "GLFW-b" Graphics.UI.GLFW as GLFW
	10	import qualified Data.ByteString as SB
	11	import qualified Data.Map as Map
	12	import qualified Data.Vect as Vc
	13	import qualified Data.Vector as V
	14	import qualified Foreign as F
	15	import qualified Foreign.C.Types as F
	16	import qualified LambdaCube.GL.Type as LC
	17	import qualified LambdaCube.Linear as LCLin
	18
	19	----------------------------------------------------
	20	-- See: http://lambdacube3d.com/getting-started
	21	----------------------------------------------------
	22
	23	screenDim :: (Int, Int)
	24	screenDim = (800, 600)
	25	(screenW, screenH) = screenDim
	26
	27	main :: IO ()
	28	main = do
	29	Just pipePickDesc <- decodeStrict <$> SB.readFile "pickInt.json"
	30	Just pipeDrawDesc <- decodeStrict <$> SB.readFile "pickIntDraw.json"
	31
	32	win <- initWindow "LambdaCube 3D integer picking" 800 600
	33
	34	-- setup render data
	35	let inputSchema = makeSchema $ do
	36	defObjectArray "objects" Triangles $ do
	37	"position" @: Attribute_V2F
	38	"id" @: Attribute_Int
	39	"color" @: Attribute_V4F
	40	defUniforms $ do
	41	"viewProj" @: M44F
	42
	43	storage <- LambdaCubeGL.allocStorage inputSchema
	44
	45	-- upload geometry to GPU and add to pipeline input
	46	LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
	47	LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
	48
	49	-- allocate GL pipeline
	50	pipePick <- LambdaCubeGL.allocRenderer pipePickDesc
	51	pipeDraw <- LambdaCubeGL.allocRenderer pipeDrawDesc
	52	errPick <- LambdaCubeGL.setStorage pipePick storage
	53	errDraw <- LambdaCubeGL.setStorage pipeDraw storage
	54	case (errPick, errDraw) of -- check schema compatibility
	55	(Just err, _) -> putStrLn err
	56	(_, Just err) -> putStrLn err
	57	(Nothing, Nothing) -> loop
	58	where loop = do
	59	-- update graphics input
	60	GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
	61	LambdaCubeGL.updateUniforms storage $ do
	62	let (x, y) = (,) 0 0
	63	cvpos = Vec3 x (-y) 0
	64	toScreen = screenM screenW screenH
	65	"viewProj" @= pure (mat4ToM44F $! (Vc.fromProjective $! Vc.translation cvpos) Vc..*. toScreen)
	66
	67	(curX, curY) <- GLFW.getCursorPos win
	68	let pickPoints = -- should be fb 0 fb 1 (pick)
	69	[ (clamp curX 800, clamp curY 600)
	70	, (0, 0) -- black 0
	71	, (200, 200) -- ..blue, ffff0000 2
	72	, (600, 400) -- ..red, ff0000ff 1
	73	] :: [(Int, Int)]
	74	clamp v m = min (pred m) $ max 0 (floor v)
	75
	76	-- render to render texture
	77	LambdaCubeGL.renderFrame pipePick
	78	case LC.glOutputs pipePick of
	79	[LC.GLOutputRenderTexture (fromIntegral -> fbo) _rendTex] -> do
	80	rtexPicks <- collectPicks fbo pickPoints
	81	printPicks pickPoints rtexPicks
	82	x -> error $ "Unexpected outputs: " <> show x
	83
	84	-- render to framebuffer & pick
	85	LambdaCubeGL.renderFrame pipeDraw
	86	colorPicks <- collectPicks 0 pickPoints
	87	printPicks pickPoints colorPicks
	88
	89	GLFW.swapBuffers win
	90	GLFW.pollEvents
	91
	92	let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
	93	escape <- keyIsPressed Key'Escape
	94	if escape then return () else loop
	95	collectPicks :: Int -> [(Int, Int)] -> IO [Int]
	96	collectPicks fb picks =
	97	forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim
	98	printPicks pickPoints colorPicks = do
	99	forM_ (zip pickPoints colorPicks) $ \((x,y), col)-> do
	100	printf "%d:%d: %x " x y col
	101	putStrLn ""
	102
	103	LambdaCubeGL.disposeRenderer pipePick
	104	LambdaCubeGL.disposeRenderer pipeDraw
	105	LambdaCubeGL.disposeStorage storage
	106	GLFW.destroyWindow win
	107	GLFW.terminate
	108
	109	deriving instance Show (LC.GLOutput)
	110	deriving instance Show (LC.GLTexture)
	111
	112	-- geometry data: triangles
	113	scale = 250.0
	114	s = scale
	115
	116	triangleA :: LambdaCubeGL.Mesh
	117	triangleA = Mesh
	118	{ mAttributes = Map.fromList
	119	[ ("position", A_V2F $ V.fromList [V2 s s, V2 s (-s), V2 (-s) (-s)])
	120	, ("color", A_V4F $ V.fromList $ take 4 $ repeat $ V4 1 0 0 1)
	121	, ("id", A_Int $ V.fromList [1, 1, 1])
	122	]
	123	, mPrimitive = P_Triangles
	124	}
	125
	126	triangleB :: LambdaCubeGL.Mesh
	127	triangleB = Mesh
	128	{ mAttributes = Map.fromList
	129	[ ("position", A_V2F $ V.fromList [V2 s s, V2 (-s) (-s), V2 (-s) s])
	130	, ("color", A_V4F $ V.fromList $ take 4 $ repeat $ V4 0 0 1 1)
	131	, ("id", A_Int $ V.fromList [2, 2, 2])
	132	]
	133	, mPrimitive = P_Triangles
	134	}
	135
	136	vec4ToV4F :: Vec4 -> LCLin.V4F
	137	vec4ToV4F (Vc.Vec4 x y z w) = LCLin.V4 x y z w
	138
	139	mat4ToM44F :: Mat4 -> LCLin.M44F
	140	mat4ToM44F (Mat4 a b c d) = LCLin.V4 (vec4ToV4F a) (vec4ToV4F b) (vec4ToV4F c) (vec4ToV4F d)
	141
	142	screenM :: Int -> Int -> Mat4
	143	screenM w h = scaleM
	144	where (fw, fh) = (fromIntegral w, fromIntegral h)
	145	scaleM = Vc.Mat4 (Vc.Vec4 (1/fw) 0 0 0)
	146	(Vc.Vec4 0 (1/fh) 0 0)
	147	(Vc.Vec4 0 0 1 0)
	148	(Vc.Vec4 0 0 0 0.5)
	149
	150	pickFrameBuffer
	151	:: Int -- ^ framebuffer
	152	-> (Int, Int) -- ^ FB dimensions
	153	-> (Int, Int) -- ^ pick coordinates
	154	-> IO F.Word32 -- ^ resultant pixel value
	155	pickFrameBuffer fb (w, h) (x, y) = do
	156	glFinish
	157	glBindFramebuffer GL_READ_FRAMEBUFFER $ fromIntegral fb
	158	let (fbmode, format) =
	159	if fb == 0
	160	then (GL_BACK_LEFT, GL_RGBA)
	161	else (GL_COLOR_ATTACHMENT0, GL_RGBA_INTEGER)
	162	glReadBuffer fbmode
	163	withFrameBuffer w format x (h - y - 1) 1 1 $ \p -> fromIntegral <$> F.peek (F.castPtr p :: F.Ptr F.Word32)
	164
	165	withFrameBuffer :: Int -> GLenum -> Int -> Int -> Int -> Int -> (F.Ptr F.Word8 -> IO a) -> IO a
	166	withFrameBuffer rowLen format x y w h fn = F.allocaBytes (wh4) $ \p -> do
	167	glPixelStorei GL_UNPACK_LSB_FIRST 0
	168	glPixelStorei GL_UNPACK_SWAP_BYTES 0
	169	glPixelStorei GL_UNPACK_ROW_LENGTH $ fromIntegral rowLen
	170	glPixelStorei GL_UNPACK_IMAGE_HEIGHT 0
	171	glPixelStorei GL_UNPACK_SKIP_ROWS 0
	172	glPixelStorei GL_UNPACK_SKIP_PIXELS 0
	173	glPixelStorei GL_UNPACK_SKIP_IMAGES 0
	174	glPixelStorei GL_UNPACK_ALIGNMENT 1
	175	glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) format GL_UNSIGNED_BYTE $ F.castPtr p
	176	glPixelStorei GL_UNPACK_ROW_LENGTH 0
	177	fn p
	178
	179	initWindow :: String -> Int -> Int -> IO Window
	180	initWindow title width height = do
	181	GLFW.init
	182	GLFW.defaultWindowHints
	183	mapM_ GLFW.windowHint
	184	[ WindowHint'ContextVersionMajor 3
	185	, WindowHint'ContextVersionMinor 3
	186	, WindowHint'OpenGLProfile OpenGLProfile'Core
	187	, WindowHint'OpenGLForwardCompat True
	188	]
	189	Just win <- GLFW.createWindow width height title Nothing Nothing
	190	GLFW.makeContextCurrent $ Just win
	191	return win
	192


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 @@
	1	type FB = FrameBuffer 1 '[ 'Color (Vec 4 Int)]
	2
	3	scene :: String -> FB -> FB
	4	scene name prevFB =
	5	Accumulate ((ColorOp NoBlending (one :: Vec 4 Bool)))
	6	(mapFragments (\(uv, rgba) -> ((rgba)))
	7	$ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
	8	$ mapPrimitives
	9	(\(pos, color, id)->
	10	( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
	11	, V2 0.0 0.0
	12	, V4 0 0 0 id))
	13	$ fetch name ( Attribute "position" :: Vec 3 Float
	14	, Attribute "color" :: Vec 4 Float
	15	, Attribute "id" :: Int))
	16	prevFB
	17
	18	main :: Output
	19	main = TextureOut (V2 800 600) $
	20	scene "objects" $
	21	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 @@
	1	type FB = FrameBuffer 1 '[ 'Color (Vec 4 Float)]
	2
	3	scene :: String -> FB -> FB
	4	scene name prevFB =
	5	Accumulate ((ColorOp NoBlending (one :: Vec 4 Bool)))
	6	(mapFragments (\(uv, rgba) -> ((rgba)))
	7	$ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
	8	$ mapPrimitives
	9	(\(pos, color, id)->
	10	( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
	11	, V2 0.0 0.0
	12	, color))
	13	$ fetch name ( Attribute "position" :: Vec 3 Float
	14	, Attribute "color" :: Vec 4 Float
	15	, Attribute "id" :: Int))
	16	prevFB
	17
	18	main :: Output
	19	main = ScreenOut $
	20	scene "objects" $
	21	FrameBuffer ((colorImage1 (V4 0 0 0 0)))