From 764b311c080480bb66b1096974f62c6d9a1e8ada Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sun, 9 Sep 2018 18:18:15 +0300 Subject: git: some cabal new-build ignores --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 561a774..cf6ea4b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,7 @@ *~ dist +dist-newstyle *.hi *.o .stack-work +.ghc.environment.* -- cgit v1.2.3 From 8c0aa6062a30160f0655d1be767d7ee77b4809ce Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Tue, 18 Sep 2018 01:14:11 +0300 Subject: types: introduce GLOutput into GLRenderer --- src/LambdaCube/GL/Type.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs index 49491ed..bd3f827 100644 --- a/src/LambdaCube/GL/Type.hs +++ b/src/LambdaCube/GL/Type.hs @@ -152,6 +152,7 @@ data GLRenderer , glTextures :: Vector GLTexture , glSamplers :: Vector GLSampler , glTargets :: Vector GLRenderTarget + , glOutputs :: [GLOutput] , glCommands :: [GLCommand] , glSlotPrograms :: Vector [ProgramName] -- programs depend on a slot , glInput :: IORef (Maybe InputConnection) @@ -177,6 +178,16 @@ data GLRenderTarget , framebufferDrawbuffers :: Maybe [GLenum] } deriving Eq +data GLOutput + = GLOutputDrawBuffer + { glOutputFBO :: GLuint + , glOutputDrawBuffer :: GLenum + } + | GLOutputRenderTexture + { glOutputFBO :: GLuint + , glOutputRenderTexture :: GLTexture + } + type GLTextureUnit = Int type GLUniformBinding = GLint -- cgit v1.2.3 From 23937046e4771c32fda6c46e80c593009ce9b769 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Tue, 18 Sep 2018 01:15:09 +0300 Subject: compileRenderTarget/allocRenderer: fill the glOutputs of a GLRenderer --- src/LambdaCube/GL/Backend.hs | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs index 324b3e6..90cb014 100644 --- a/src/LambdaCube/GL/Backend.hs +++ b/src/LambdaCube/GL/Backend.hs @@ -283,6 +283,15 @@ compileProgram p = do , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName] } +renderTargetOutputs :: Vector GLTexture -> RenderTarget -> GLRenderTarget -> [GLOutput] +renderTargetOutputs glTexs (RenderTarget targetItems) (GLRenderTarget fbo bufs) = + let isFB (Framebuffer _) = True + isFB _ = False + images = [img | TargetItem _ (Just img) <- V.toList targetItems] + in case all isFB images of + True -> fromMaybe [] $ (GLOutputDrawBuffer fbo <$>) <$> bufs + False -> (\(TextureImage texIdx _ _)-> GLOutputRenderTexture fbo $ glTexs ! texIdx) <$> images + compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget compileRenderTarget texs glTexs (RenderTarget targets) = do let isFB (Framebuffer _) = True @@ -488,16 +497,25 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s -- constant generic attribute constAttr -> GLSetVertexAttrib i constAttr +outputIsRenderTexture :: GLOutput -> Bool +outputIsRenderTexture GLOutputRenderTexture{..} = True +outputIsRenderTexture _ = False + allocRenderer :: Pipeline -> IO GLRenderer allocRenderer p = do smps <- V.mapM compileSampler $ samplers p texs <- V.mapM compileTexture $ textures p - trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p + let cmds = V.toList $ commands p + finalRenderTargetIdx = head [i | SetRenderTarget i <- reverse $ cmds] + trgs <- traverse (compileRenderTarget (textures p) texs) $ targets p + let finalRenderTarget = targets p ! finalRenderTargetIdx + finalGLRenderTarget = trgs ! finalRenderTargetIdx + outs = renderTargetOutputs texs finalRenderTarget finalGLRenderTarget prgs <- V.mapM compileProgram $ programs p -- texture unit mapping ioref trie -- texUnitMapRefs :: Map UniformName (IORef TextureUnit) texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (Set.toList $ Set.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p) - let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) (V.toList $ commands p)) initCGState + let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) cmds) initCGState input <- newIORef Nothing -- default Vertex Array Object vao <- alloca $! \pvao -> glGenVertexArrays 1 pvao >> peek pvao @@ -515,6 +533,7 @@ allocRenderer p = do , glCommands = reverse $ drawCommands st , glSlotPrograms = V.map (V.toList . slotPrograms) $ IR.slots p , glInput = input + , glOutputs = outs , glSlotNames = V.map slotName $ IR.slots p , glVAO = vao , glTexUnitMapping = texUnitMapRefs @@ -895,4 +914,4 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of case IM.lookup tu tb of Nothing -> fail "internal error (GenerateMipMap)!" Just tex -> return $ GLGenerateMipMap (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) --} \ No newline at end of file +-} -- cgit v1.2.3 From 5c74819ac632f9a746497621064c9bcfab86eb49 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Thu, 20 Sep 2018 03:38:49 +0300 Subject: lambdacube-gl-pickint: new executable to test integer picking --- examples/pickInt.hs | 184 ++++++++++++++++++++++++++++++++++++++++++++++ examples/pickInt.json | 1 + examples/pickInt.lc | 21 ++++++ examples/pickIntDraw.json | 1 + examples/pickIntDraw.lc | 21 ++++++ lambdacube-gl.cabal | 23 ++++++ 6 files changed, 251 insertions(+) create mode 100644 examples/pickInt.hs create mode 100644 examples/pickInt.json create mode 100644 examples/pickInt.lc create mode 100644 examples/pickIntDraw.json create mode 100644 examples/pickIntDraw.lc 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 -- cgit v1.2.3 From 10936a8fa87809917c22bf2a7e1757a339b33bb4 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Thu, 20 Sep 2018 21:30:59 +0300 Subject: Drop the use of (,) syntax --- examples/pickInt.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/examples/pickInt.hs b/examples/pickInt.hs index 2443c8b..5a499d4 100644 --- a/examples/pickInt.hs +++ b/examples/pickInt.hs @@ -20,9 +20,9 @@ import qualified LambdaCube.Linear as LCLin -- See: http://lambdacube3d.com/getting-started ---------------------------------------------------- -screenDim :: (,) Int Int -screenDim = (,) 800 600 -(,) screenW screenH = screenDim +screenDim :: (Int, Int) +screenDim = (800, 600) +(screenW, screenH) = screenDim main :: IO () main = do @@ -59,16 +59,16 @@ main = 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 + 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] + let pickPoints = -- should be fb 0 fb 1 (pick) + [ (0, 0) -- black 0 + , (200, 200) -- ..blue, ffff0000 2 + , (600, 400) -- ..red, ff0000ff 1 + ] :: [(Int, Int)] -- render to render texture LambdaCubeGL.renderFrame pipePick @@ -89,7 +89,7 @@ main = do 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 :: Int -> [(Int, Int)] -> IO [Int] collectPicks fb picks = forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim printPicks pickPoints colorPicks = do @@ -146,8 +146,8 @@ screenM w h = scaleM pickFrameBuffer :: Int -- ^ framebuffer - -> (,) Int Int -- ^ FB dimensions - -> (,) Int Int -- ^ pick coordinates + -> (Int, Int) -- ^ FB dimensions + -> (Int, Int) -- ^ pick coordinates -> IO F.Word32 -- ^ resultant pixel value pickFrameBuffer fb (w, h) (x, y) = do glFinish -- cgit v1.2.3 From 5d0c09aeddd4856758480d48dc33f5eac2ac673e Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:16:43 +0300 Subject: clearRenderTarget: render textures need format-specific treatment --- src/LambdaCube/GL/Backend.hs | 58 ++++++++++++++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 16 deletions(-) diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs index 90cb014..0584a34 100644 --- a/src/LambdaCube/GL/Backend.hs +++ b/src/LambdaCube/GL/Backend.hs @@ -126,7 +126,7 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops glDepthFunc $! comparisonFunctionToGLType df glDepthMask (cvtBool dm) cvtC 0 xs - cvt xs = do + cvt xs = do glDisable GL_DEPTH_TEST glDisable GL_STENCIL_TEST cvtC 0 xs @@ -169,8 +169,8 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops cvtBool True = 1 cvtBool False = 0 -clearRenderTarget :: [ClearImage] -> IO () -clearRenderTarget values = do +clearRenderTarget :: GLRenderTarget -> [ClearImage] -> IO () +clearRenderTarget GLRenderTarget{..} values = do let setClearValue (m,i) value = case value of ClearImage Depth (VFloat v) -> do glDepthMask 1 @@ -180,20 +180,46 @@ clearRenderTarget values = do glClearStencil $ fromIntegral v return (m .|. GL_STENCIL_BUFFER_BIT, i) ClearImage Color c -> do - let (r,g,b,a) = case c of - VFloat r -> (realToFrac r, 0, 0, 1) - VV2F (V2 r g) -> (realToFrac r, realToFrac g, 0, 1) - VV3F (V3 r g b) -> (realToFrac r, realToFrac g, realToFrac b, 1) - VV4F (V4 r g b a) -> (realToFrac r, realToFrac g, realToFrac b, realToFrac a) - _ -> (0,0,0,1) glColorMask 1 1 1 1 - glClearColor r g b a - return (m .|. GL_COLOR_BUFFER_BIT, i+1) + if framebufferObject == 0 + then + clearDefaultFB >> + pure (m .|. GL_COLOR_BUFFER_BIT, i+1) + else + clearFBColorAttachment >> + pure (m, i+1) + where + clearDefaultFB = do + let (r,g,b,a) = case c of + VFloat r -> (realToFrac r, 0, 0, 1) + VV2F (V2 r g) -> (realToFrac r, realToFrac g, 0, 1) + VV3F (V3 r g b) -> (realToFrac r, realToFrac g, realToFrac b, 1) + VV4F (V4 r g b a) -> (realToFrac r, realToFrac g, realToFrac b, realToFrac a) + _ -> (0,0,0,1) + glClearColor r g b a + clearFBColorAttachment = do + let buf = GL_COLOR + case c of -- there must be some clever way to extract the generality here, I'm sure.. + VFloat r -> with (V4 r 0 0 1) $ glClearBufferfv buf i . castPtr + VV2F (V2 r g) -> with (V4 r g 0 1) $ glClearBufferfv buf i . castPtr + VV3F (V3 r g b) -> with (V4 r g b 1) $ glClearBufferfv buf i . castPtr + VV4F (V4 r g b a) -> with (V4 r g b a) $ glClearBufferfv buf i . castPtr + + VInt r -> with (V4 r 0 0 1) $ glClearBufferiv buf i . castPtr + VV2I (V2 r g) -> with (V4 r g 0 1) $ glClearBufferiv buf i . castPtr + VV3I (V3 r g b) -> with (V4 r g b 1) $ glClearBufferiv buf i . castPtr + VV4I (V4 r g b a) -> with (V4 r g b a) $ glClearBufferiv buf i . castPtr + + VWord r -> with (V4 r 0 0 1) $ glClearBufferiv buf i . castPtr + VV2U (V2 r g) -> with (V4 r g 0 1) $ glClearBufferiv buf i . castPtr + VV3U (V3 r g b) -> with (V4 r g b 1) $ glClearBufferiv buf i . castPtr + VV4U (V4 r g b a) -> with (V4 r g b a) $ glClearBufferiv buf i . castPtr + _ -> error $ "internal error: unsupported color attachment format: " <> show c + _ -> error "internal error (clearRenderTarget)" (mask,_) <- foldM setClearValue (0,0) values glClear $ fromIntegral mask - printGLStatus = checkGL >>= print printFBOStatus = checkFBO >>= print @@ -353,7 +379,7 @@ compileRenderTarget texs glTexs (RenderTarget targets) = do | n > 1 -> attachArray | otherwise -> attach2D TextureBuffer _ -> fail "internalError (compileRenderTarget/TextureBuffer)!" - + go a (TargetItem Stencil (Just img)) = do fail "Stencil support is not implemented yet!" return a @@ -462,7 +488,7 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s -- object attribute stream commands streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs] - where + where attrMap = inputStreams prg attrCmd i s = case s of Stream ty (Buffer arrs bo) arrIdx start len -> case ty of @@ -592,7 +618,7 @@ isSubTrie eqFun universe subset = and [isMember a (Map.lookup n universe) | (n,a when (sPrim /= (primitiveToFetchPrimitive prim)) $ throw $ userError $ "Primitive mismatch for slot (" ++ show slotName ++ ") expected " ++ show sPrim ++ " but got " ++ show prim let sType = fmap streamToStreamType attribs - when (sType /= sAttrs) $ throw $ userError $ unlines $ + when (sType /= sAttrs) $ throw $ userError $ unlines $ [ "Attribute stream mismatch for slot (" ++ show slotName ++ ") expected " , show sAttrs , " but got " @@ -809,7 +835,7 @@ renderFrame GLRenderer{..} = do case cmd of GLClearRenderTarget rt vals -> do setupRenderTarget glInput rt - clearRenderTarget vals + clearRenderTarget rt vals modifyIORef glDrawContextRef $ \ctx -> ctx {glRenderTarget = rt} GLRenderStream ctx streamIdx progIdx -> do -- cgit v1.2.3 From 83c56918279a1fa795cc4c8c53af1f6c8c147029 Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:39:02 +0300 Subject: pickInt: glReadBuffer/glReadPixels framebuffer format specificity --- examples/pickInt.hs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/examples/pickInt.hs b/examples/pickInt.hs index 5a499d4..36bc36c 100644 --- a/examples/pickInt.hs +++ b/examples/pickInt.hs @@ -152,20 +152,24 @@ pickFrameBuffer 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 + 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 w + 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) GL_RGBA GL_UNSIGNED_BYTE $ F.castPtr p + glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) format GL_UNSIGNED_BYTE $ F.castPtr p glPixelStorei GL_UNPACK_ROW_LENGTH 0 fn p -- cgit v1.2.3 From 4735792a761d8c352985eb4eb123b100a2da2e2f Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:49:51 +0300 Subject: textureDataTypeToGLType: switch to 8-bit components for integer RGBA textures --- src/LambdaCube/GL/Util.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs index bba322b..7885860 100644 --- a/src/LambdaCube/GL/Util.hs +++ b/src/LambdaCube/GL/Util.hs @@ -403,6 +403,8 @@ blendingFactorToGLType a = case a of SrcColor -> GL_SRC_COLOR Zero -> GL_ZERO +-- XXX: we need to extend IR.TextureDescriptor to carry component bit depth +-- if we want to avoid making arbitrary decisions here textureDataTypeToGLType :: ImageSemantic -> TextureDataType -> GLenum textureDataTypeToGLType Color a = case a of FloatT Red -> GL_R32F @@ -412,8 +414,8 @@ textureDataTypeToGLType Color a = case a of IntT RG -> GL_RG32I WordT RG -> GL_RG32UI FloatT RGBA -> GL_RGBA32F - IntT RGBA -> GL_RGBA32I - WordT RGBA -> GL_RGBA32UI + IntT RGBA -> GL_RGBA8I + WordT RGBA -> GL_RGBA8UI a -> error $ "FIXME: This texture format is not yet supported" ++ show a textureDataTypeToGLType Depth a = case a of FloatT Red -> GL_DEPTH_COMPONENT32F -- cgit v1.2.3 From b0505615355a8e6b91de431ff7ac080b12349c6a Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:52:00 +0300 Subject: textureDataTypeToGLArityType: fix translation for integer textures --- src/LambdaCube/GL/Util.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs index 7885860..b267c7f 100644 --- a/src/LambdaCube/GL/Util.hs +++ b/src/LambdaCube/GL/Util.hs @@ -427,14 +427,14 @@ textureDataTypeToGLType Stencil a = case a of textureDataTypeToGLArityType :: ImageSemantic -> TextureDataType -> GLenum textureDataTypeToGLArityType Color a = case a of FloatT Red -> GL_RED - IntT Red -> GL_RED - WordT Red -> GL_RED + IntT Red -> GL_RED_INTEGER + WordT Red -> GL_RED_INTEGER FloatT RG -> GL_RG - IntT RG -> GL_RG - WordT RG -> GL_RG + IntT RG -> GL_RG_INTEGER + WordT RG -> GL_RG_INTEGER FloatT RGBA -> GL_RGBA - IntT RGBA -> GL_RGBA - WordT RGBA -> GL_RGBA + IntT RGBA -> GL_RGBA_INTEGER + WordT RGBA -> GL_RGBA_INTEGER a -> error $ "FIXME: This texture format is not yet supported" ++ show a textureDataTypeToGLArityType Depth a = case a of FloatT Red -> GL_DEPTH_COMPONENT -- cgit v1.2.3 From f864b47b3a004c05d10ac24e88d192ba5d4465cc Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Fri, 21 Sep 2018 02:01:46 +0300 Subject: cabal: don't build lambdacube-gl-picking unless examples were requested --- lambdacube-gl.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal index 2c82ae5..1df79cb 100644 --- a/lambdacube-gl.cabal +++ b/lambdacube-gl.cabal @@ -85,10 +85,10 @@ executable lambdacube-gl-hello lambdacube-ir == 0.3.* executable lambdacube-gl-pickint - -- if flag(example) - -- Buildable: True - -- else - -- Buildable: False + if flag(example) + Buildable: True + else + Buildable: False hs-source-dirs: examples main-is: pickInt.hs -- cgit v1.2.3 From 91b11accd5c1b3fccd21851b5841d790738b815c Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Fri, 21 Sep 2018 19:59:44 +0300 Subject: cabal: deconflict version requirements of examples --- lambdacube-gl.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal index 1df79cb..1859262 100644 --- a/lambdacube-gl.cabal +++ b/lambdacube-gl.cabal @@ -79,8 +79,8 @@ executable lambdacube-gl-hello bytestring >=0.10 && <0.11, vector >=0.12 && <0.13, JuicyPixels >=3.2 && <3.3, - aeson >= 1.1.2 && <1.3, - GLFW-b >= 1.4 && <1.5, + aeson >= 1.1.2, + GLFW-b >= 1.4, lambdacube-gl, lambdacube-ir == 0.3.* @@ -126,8 +126,8 @@ executable lambdacube-gl-hello-obj bytestring >=0.10 && <0.11, vector >=0.12 && <0.13, JuicyPixels >=3.2 && <3.3, - aeson >= 1.1.2 && <1.3, - GLFW-b >= 1.4 && <1.5, + aeson >= 1.1.2, + GLFW-b >= 1.4, wavefront >= 0.7 && <1, lambdacube-gl, lambdacube-ir == 0.3.* @@ -155,10 +155,10 @@ executable lambdacube-gl-test-client base64-bytestring >=1 && <1.1, vector >=0.12 && <0.13, JuicyPixels >=3.2 && <3.3, - aeson >= 1.1 && <1.3, + aeson >= 1.1.2, websockets >= 0.10 && <1, network >= 2.6 && <2.7, OpenGLRaw >=3.2 && <4, - GLFW-b >= 1.4 && <1.5, + GLFW-b >= 1.4, lambdacube-gl, lambdacube-ir == 0.3.* -- cgit v1.2.3 From a5880684868824b34689df4589106730ad1c7fc0 Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Fri, 21 Sep 2018 20:01:13 +0300 Subject: pickInt: sample from mouse position as well --- examples/pickInt.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/examples/pickInt.hs b/examples/pickInt.hs index 36bc36c..2703e91 100644 --- a/examples/pickInt.hs +++ b/examples/pickInt.hs @@ -64,11 +64,14 @@ main = do 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) - [ (0, 0) -- black 0 + [ (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 @@ -186,3 +189,4 @@ initWindow title width height = do Just win <- GLFW.createWindow width height title Nothing Nothing GLFW.makeContextCurrent $ Just win return win + -- cgit v1.2.3