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

author: Kosyrev Serge <_deepfire@feelingofgreen.ru> 2018-09-20 03:38:49 +0300
committer: Kosyrev Serge <_deepfire@feelingofgreen.ru> 2018-09-20 03:43:38 +0300
commit: 5c74819ac632f9a746497621064c9bcfab86eb49 (patch)
tree: 53f8f96f4f4dfaca16c538660d68175050d93044 /examples
parent: 23937046e4771c32fda6c46e80c593009ce9b769 (diff)
5 files changed, 228 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)))
author	Kosyrev Serge <_deepfire@feelingofgreen.ru>	2018-09-20 03:38:49 +0300
committer	Kosyrev Serge <_deepfire@feelingofgreen.ru>	2018-09-20 03:43:38 +0300
commit	5c74819ac632f9a746497621064c9bcfab86eb49 (patch)
tree	53f8f96f4f4dfaca16c538660d68175050d93044 /examples
parent	23937046e4771c32fda6c46e80c593009ce9b769 (diff)

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 @@
	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	let pickPoints =
	68	[ (0, 0) -- should be black
	69	, (200, 200) -- ..blue, ffff0000
	70	, (600, 400) -- ..red, ff0000ff
	71	] :: [(,) Int Int]
	72
	73	-- render to render texture
	74	LambdaCubeGL.renderFrame pipePick
	75	case LC.glOutputs pipePick of
	76	[LC.GLOutputRenderTexture (fromIntegral -> fbo) _rendTex] -> do
	77	rtexPicks <- collectPicks fbo pickPoints
	78	printPicks pickPoints rtexPicks
	79	x -> error $ "Unexpected outputs: " <> show x
	80
	81	-- render to framebuffer & pick
	82	LambdaCubeGL.renderFrame pipeDraw
	83	colorPicks <- collectPicks 0 pickPoints
	84	printPicks pickPoints colorPicks
	85
	86	GLFW.swapBuffers win
	87	GLFW.pollEvents
	88
	89	let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
	90	escape <- keyIsPressed Key'Escape
	91	if escape then return () else loop
	92	collectPicks :: Int -> [(,) Int Int] -> IO [Int]
	93	collectPicks fb picks =
	94	forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim
	95	printPicks pickPoints colorPicks = do
	96	forM_ (zip pickPoints colorPicks) $ \((x,y), col)-> do
	97	printf "%d:%d: %x " x y col
	98	putStrLn ""
	99
	100	LambdaCubeGL.disposeRenderer pipePick
	101	LambdaCubeGL.disposeRenderer pipeDraw
	102	LambdaCubeGL.disposeStorage storage
	103	GLFW.destroyWindow win
	104	GLFW.terminate
	105
	106	deriving instance Show (LC.GLOutput)
	107	deriving instance Show (LC.GLTexture)
	108
	109	-- geometry data: triangles
	110	scale = 250.0
	111	s = scale
	112
	113	triangleA :: LambdaCubeGL.Mesh
	114	triangleA = Mesh
	115	{ mAttributes = Map.fromList
	116	[ ("position", A_V2F $ V.fromList [V2 s s, V2 s (-s), V2 (-s) (-s)])
	117	, ("color", A_V4F $ V.fromList $ take 4 $ repeat $ V4 1 0 0 1)
	118	, ("id", A_Int $ V.fromList [1, 1, 1])
	119	]
	120	, mPrimitive = P_Triangles
	121	}
	122
	123	triangleB :: LambdaCubeGL.Mesh
	124	triangleB = Mesh
	125	{ mAttributes = Map.fromList
	126	[ ("position", A_V2F $ V.fromList [V2 s s, V2 (-s) (-s), V2 (-s) s])
	127	, ("color", A_V4F $ V.fromList $ take 4 $ repeat $ V4 0 0 1 1)
	128	, ("id", A_Int $ V.fromList [2, 2, 2])
	129	]
	130	, mPrimitive = P_Triangles
	131	}
	132
	133	vec4ToV4F :: Vec4 -> LCLin.V4F
	134	vec4ToV4F (Vc.Vec4 x y z w) = LCLin.V4 x y z w
	135
	136	mat4ToM44F :: Mat4 -> LCLin.M44F
	137	mat4ToM44F (Mat4 a b c d) = LCLin.V4 (vec4ToV4F a) (vec4ToV4F b) (vec4ToV4F c) (vec4ToV4F d)
	138
	139	screenM :: Int -> Int -> Mat4
	140	screenM w h = scaleM
	141	where (fw, fh) = (fromIntegral w, fromIntegral h)
	142	scaleM = Vc.Mat4 (Vc.Vec4 (1/fw) 0 0 0)
	143	(Vc.Vec4 0 (1/fh) 0 0)
	144	(Vc.Vec4 0 0 1 0)
	145	(Vc.Vec4 0 0 0 0.5)
	146
	147	pickFrameBuffer
	148	:: Int -- ^ framebuffer
	149	-> (,) Int Int -- ^ FB dimensions
	150	-> (,) Int Int -- ^ pick coordinates
	151	-> IO F.Word32 -- ^ resultant pixel value
	152	pickFrameBuffer fb (w, h) (x, y) = do
	153	glFinish
	154	glBindFramebuffer GL_READ_FRAMEBUFFER $ fromIntegral fb
	155	glReadBuffer GL_BACK_LEFT
	156	withFrameBuffer x (h - y - 1) 1 1 $ \p -> fromIntegral <$> F.peek (F.castPtr p :: F.Ptr F.Word32)
	157
	158	withFrameBuffer :: Int -> Int -> Int -> Int -> (F.Ptr F.Word8 -> IO a) -> IO a
	159	withFrameBuffer x y w h fn = F.allocaBytes (wh4) $ \p -> do
	160	glPixelStorei GL_UNPACK_LSB_FIRST 0
	161	glPixelStorei GL_UNPACK_SWAP_BYTES 0
	162	glPixelStorei GL_UNPACK_ROW_LENGTH $ fromIntegral w
	163	glPixelStorei GL_UNPACK_IMAGE_HEIGHT 0
	164	glPixelStorei GL_UNPACK_SKIP_ROWS 0
	165	glPixelStorei GL_UNPACK_SKIP_PIXELS 0
	166	glPixelStorei GL_UNPACK_SKIP_IMAGES 0
	167	glPixelStorei GL_UNPACK_ALIGNMENT 1
	168	glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) GL_RGBA GL_UNSIGNED_BYTE $ F.castPtr p
	169	glPixelStorei GL_UNPACK_ROW_LENGTH 0
	170	fn p
	171
	172	initWindow :: String -> Int -> Int -> IO Window
	173	initWindow title width height = do
	174	GLFW.init
	175	GLFW.defaultWindowHints
	176	mapM_ GLFW.windowHint
	177	[ WindowHint'ContextVersionMajor 3
	178	, WindowHint'ContextVersionMinor 3
	179	, WindowHint'OpenGLProfile OpenGLProfile'Core
	180	, WindowHint'OpenGLForwardCompat True
	181	]
	182	Just win <- GLFW.createWindow width height title Nothing Nothing
	183	GLFW.makeContextCurrent $ Just win
	184	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 @@
	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)))