diff --git a/examples/HelloEmbedded.hs b/examples/HelloEmbedded.hs --- a/examples/HelloEmbedded.hs +++ b/examples/HelloEmbedded.hs @@ -17,7 +17,7 @@ main :: IO () main = do -- compile hello.lc to graphics pipeline description - pipelineDesc <- LambdaCube.compileMain ["."] OpenGL33 "hello" >>= \case + pipelineDesc <- LambdaCube.compileMain ["."] OpenGL33 "hello.lc" >>= \case Left err -> fail $ "compile error:\n" ++ err Right pd -> return pd diff --git a/examples/hello.json b/examples/hello.json --- a/examples/hello.json +++ b/examples/hello.json @@ -1,1 +1,1 @@ -{"textures":[],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4F","arg0":{"w":1,"z":0.4,"x":0.0,"y":0.0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetSamplerUniform","arg0":"diffuseTexture","arg1":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullNone"},"arg1":{"tag":"PolygonFill"},"arg2":{"tag":"NoOffset"}}},{"tag":"SetAccumulationContext","arg0":{"accViewportName":null,"tag":"AccumulationContext","accOperations":[{"tag":"ColorOp","arg0":{"tag":"NoBlending"},"arg1":{"tag":"VV4B","arg0":{"w":true,"z":true,"x":true,"y":true}}}]}},{"tag":"RenderSlot","arg0":0}],"slots":[{"tag":"Slot","slotPrimitive":{"tag":"Triangles"},"slotStreams":{"uv":{"tag":"V2F"},"position":{"tag":"V2F"}},"slotName":"objects","slotUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{"diffuseTexture":{"tag":"FTexture2D"}},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4F"},"name":"f0"}],"programStreams":{"d2":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"uv"},"c2":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D diffuseTexture ;\nsmooth in vec2 vv0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = texture2D ( diffuseTexture,vv0 );\n}\n","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float time ;\nin vec2 c2 ;\nin vec2 d2 ;\nsmooth out vec2 vv0 ;\nvoid main() {\nvv0 = d2;\ngl_Position = ( mat4 ( vec4 ( cos ( time ),sin ( time ),0.0,0.0 ),vec4 ( ( 0.0 ) - ( sin ( time ) ),cos ( time ),0.0,0.0 ),vec4 ( 0.0,0.0,1.0,0.0 ),vec4 ( 0.0,0.0,0.0,1.0 ) ) ) * ( vec4 ( ( c2 ).x,( c2 ).y,-1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n","geometryShader":null,"programUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Color"}}}]}]} +{"textures":[],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4F","arg0":{"w":1,"z":0.4,"x":0.0,"y":0.0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetSamplerUniform","arg0":"diffuseTexture","arg1":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullNone"},"arg1":{"tag":"PolygonFill"},"arg2":{"tag":"NoOffset"}}},{"tag":"SetAccumulationContext","arg0":{"accViewportName":null,"tag":"AccumulationContext","accOperations":[{"tag":"ColorOp","arg0":{"tag":"NoBlending"},"arg1":{"tag":"VV4B","arg0":{"w":true,"z":true,"x":true,"y":true}}}]}},{"tag":"RenderSlot","arg0":0}],"slots":[{"tag":"Slot","slotPrimitive":{"tag":"Triangles"},"slotStreams":{"uv":{"tag":"V2F"},"position":{"tag":"V2F"}},"slotName":"objects","slotUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{"diffuseTexture":{"tag":"FTexture2D"}},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4F"},"name":"f0"}],"programStreams":{"vi2":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"uv"},"vi1":{"tag":"Parameter","ty":{"tag":"V2F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s\n ,vec2 uv) {\n return texture(s,uv);\n}\nuniform sampler2D diffuseTexture;\nsmooth in vec2 vo1;\nout vec4 f0;\nvoid main() {\n f0 = texture2D (diffuseTexture\n ,vo1);\n}","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s\n ,vec2 uv) {\n return texture(s,uv);\n}\nuniform float time;\nin vec2 vi1;\nin vec2 vi2;\nsmooth out vec2 vo1;\nmat4 rotMatrixZ(float z0) {\n return mat4 (vec4 (cos (z0)\n ,sin (z0)\n ,0.0\n ,0.0)\n ,vec4 ((0.0) - (sin (z0))\n ,cos (z0)\n ,0.0\n ,0.0)\n ,vec4 (0.0,0.0,1.0,0.0)\n ,vec4 (0.0,0.0,0.0,1.0));\n}\nvoid main() {\n gl_Position = (rotMatrixZ\n (time)) * (vec4 ((vi1).x\n ,(vi1).y\n ,-1.0\n ,1.0));\n vo1 = vi2;\n}","geometryShader":null,"programUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Color"}}}]}],"info":"generated by lambdacube-compiler 0.5.0.0"} diff --git a/examples/hello.lc b/examples/hello.lc --- a/examples/hello.lc +++ b/examples/hello.lc @@ -2,15 +2,15 @@ (texture :: Texture) (prims :: PrimitiveStream Triangle (Vec 2 Float, Vec 2 Float)) - = imageFrame (emptyColorImage (V4 0 0 0.4 1)) + = imageFrame ((emptyColorImage (V4 0 0 0.4 1))) `overlay` prims & mapPrimitives (\(p,uv) -> (rotMatrixZ time *. (V4 p%x p%y (-1) 1), uv)) - & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) Smooth - & mapFragments (\uv -> texture2D (Sampler PointFilter MirroredRepeat texture) uv) - & accumulateWith (ColorOp NoBlending (V4 True True True True)) + & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth)) + & mapFragments (\((uv)) -> ((texture2D (Sampler PointFilter MirroredRepeat texture) uv))) + & accumulateWith ((ColorOp NoBlending (V4 True True True True))) main = renderFrame $ makeFrame (Uniform "time") (Texture2DSlot "diffuseTexture") - (fetch_ "objects" (Attribute "position", Attribute "uv")) + (fetch "objects" (Attribute "position", Attribute "uv")) diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal --- a/lambdacube-gl.cabal +++ b/lambdacube-gl.cabal @@ -1,5 +1,5 @@ name: lambdacube-gl -version: 0.4.0.2 +version: 0.5.0.1 synopsis: OpenGL 3.3 Core Profile backend for LambdaCube 3D description: OpenGL 3.3 Core Profile backend for LambdaCube 3D homepage: http://lambdacube3d.com @@ -19,6 +19,14 @@ cabal-version: >=1.10 +Flag example + Description: Build with example + Default: False + +Flag testclient + Description: Build with backend test client + Default: False + source-repository head type: git location: https://github.com/lambdacube3d/lambdacube-gl @@ -36,13 +44,66 @@ -- other-extensions: build-depends: base >=4.7 && <4.9, - containers >=0.5 && <0.6, - mtl >=2.2 && <2.3, - bytestring >=0.10 && <0.11, - vector >=0.11 && <0.12, - vector-algorithms >=0.7 && <0.8, + containers >=0.5 && <0.6, + mtl >=2.2 && <2.3, + bytestring >=0.10 && <0.11, + vector >=0.11 && <0.12, + vector-algorithms >=0.7 && <0.8, JuicyPixels >=3.2.7 && <3.3, - OpenGLRaw >=3.1 && <3.2, - lambdacube-ir == 0.2.* + OpenGLRaw >=3.1 && <3.2, + lambdacube-ir == 0.3.* hs-source-dirs: src default-language: Haskell2010 + +executable lambdacube-gl-hello + hs-source-dirs: examples + main-is: Hello.hs + default-language: Haskell2010 + + -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository + build-depends: + base < 4.9, + containers >=0.5 && <0.6, + bytestring >=0.10 && <0.11, + vector >=0.11 && <0.12, + JuicyPixels >=3.2 && <3.3, + aeson >= 0.9 && <1, + GLFW-b >= 1.4 && <1.5, + lambdacube-gl, + lambdacube-ir == 0.3.* + + if flag(example) + Buildable: True + else + Buildable: False + +executable lambdacube-gl-test-client + hs-source-dirs: testclient + main-is: client.hs + default-language: Haskell2010 + + other-modules: TestData + + -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository + build-depends: + base < 4.9, + containers >=0.5 && <0.6, + text >= 1.2 && <1.3, + time >= 1.5 && <1.6, + exceptions >= 0.8 && <0.9, + bytestring >=0.10 && <0.11, + base64-bytestring >=1 && <1.1, + vector >=0.11 && <0.12, + JuicyPixels >=3.2 && <3.3, + aeson >= 0.9 && <1, + websockets >= 0.9 && <1, + network >= 2.6 && <2.7, + OpenGLRaw >=3.1 && <3.2, + GLFW-b >= 1.4 && <1.5, + lambdacube-gl, + lambdacube-ir == 0.3.* + + if flag(testclient) + Buildable: True + else + Buildable: False diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs --- a/src/LambdaCube/GL/Backend.hs +++ b/src/LambdaCube/GL/Backend.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections, MonadComprehensions, RecordWildCards #-} +{-# LANGUAGE TupleSections, MonadComprehensions, RecordWildCards, LambdaCase #-} module LambdaCube.GL.Backend where import Control.Applicative @@ -196,8 +196,8 @@ printGLStatus = checkGL >>= print printFBOStatus = checkFBO >>= print -compileProgram :: Map String InputType -> Program -> IO GLProgram -compileProgram uniTrie p = do +compileProgram :: Program -> IO GLProgram +compileProgram p = do po <- glCreateProgram --putStrLn $ "compile program: " ++ show po let createAndAttach src t = do @@ -217,11 +217,11 @@ --putStr " + setup shader output mapping: " >> printGLStatus glLinkProgram po - printProgramLog po + log <- printProgramLog po -- check link status status <- glGetProgramiv1 GL_LINK_STATUS po - when (status /= fromIntegral GL_TRUE) $ fail "link program failed!" + when (status /= fromIntegral GL_TRUE) $ fail $ unlines ["link program failed:",log] -- check program input (uniforms,uniformsType) <- queryUniforms po @@ -245,7 +245,7 @@ inUniforms = L.filter (\(n,v) -> Map.member n inUniNames) $ Map.toList $ uniforms inTextureNames = programInTextures p inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms - texUnis = [n | (n,_) <- inTextures, Map.member n uniTrie] + texUnis = [n | (n,_) <- inTextures, Map.member n (programUniforms p)] --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie) --putStrLn $ "inUniNames: " ++ show inUniNames --putStrLn $ "inUniforms: " ++ show inUniforms @@ -267,9 +267,6 @@ , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName] } -compileSampler :: SamplerDescriptor -> IO GLSampler -compileSampler s = return $ GLSampler {} -- TODO - compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget compileRenderTarget texs glTexs (RenderTarget targets) = do let isFB (Framebuffer _) = True @@ -477,11 +474,10 @@ allocRenderer :: Pipeline -> IO GLRenderer allocRenderer p = do - let uniTrie = uniforms $ schemaFromPipeline p smps <- V.mapM compileSampler $ samplers p texs <- V.mapM compileTexture $ textures p trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p - prgs <- V.mapM (compileProgram uniTrie) $ programs p + prgs <- V.mapM compileProgram $ programs p -- texture unit mapping ioref trie -- texUnitMapRefs :: Map UniformName (IORef TextureUnit) texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p) @@ -514,6 +510,8 @@ withArray (map framebufferObject $ V.toList targets) $ (glDeleteFramebuffers $ fromIntegral $ V.length targets) let textures = glTextures p withArray (map glTextureObject $ V.toList textures) $ (glDeleteTextures $ fromIntegral $ V.length textures) + let samplers = glSamplers p + withArray (map glSamplerObject $ V.toList samplers) $ (glDeleteSamplers . fromIntegral . V.length $ glSamplers p) with (glVAO p) $ (glDeleteVertexArrays 1) {- @@ -561,7 +559,7 @@ setStorage p input' = setStorage' p (Just input') setStorage' :: GLRenderer -> Maybe GLStorage -> IO (Maybe String) -setStorage' p input' = do +setStorage' p@GLRenderer{..} input' = do -- TODO: check matching input schema {- case input' of @@ -573,19 +571,15 @@ - remove pipeline's object commands from used objectArrays - remove pipeline from attached pipelines vector -} - ic' <- readIORef $ glInput p - case ic' of + readIORef glInput >>= \case Nothing -> return () - Just ic -> do - let idx = icId ic - oldInput = icInput ic - slotMask = icSlotMapPipelineToInput ic - slotRefs = slotVector oldInput - modifyIORef (pipelines oldInput) $ \v -> v // [(idx,Nothing)] - V.forM_ slotMask $ \slotIdx -> do + Just InputConnection{..} -> do + let slotRefs = slotVector icInput + modifyIORef (pipelines icInput) $ \v -> v // [(icId,Nothing)] + V.forM_ icSlotMapPipelineToInput $ \slotIdx -> do slot <- readIORef (slotRefs ! slotIdx) forM_ (IM.elems $ objectMap slot) $ \obj -> do - modifyIORef (objCommands obj) $ \v -> v // [(idx,V.empty)] + modifyIORef (objCommands obj) $ \v -> v // [(icId,V.empty)] {- addition: - get an id from pipeline input @@ -594,7 +588,7 @@ - update used objectArrays, and generate object commands for objects in the related objectArrays -} case input' of - Nothing -> writeIORef (glInput p) Nothing >> return Nothing + Nothing -> writeIORef glInput Nothing >> return Nothing Just input -> do let pipelinesRef = pipelines input oldPipelineV <- readIORef pipelinesRef @@ -609,9 +603,9 @@ return (i,Nothing) -- create input connection let sm = slotMap input - pToI = [i | n <- glSlotNames p, let Just i = Map.lookup n sm] + pToI = [i | n <- glSlotNames, let Just i = Map.lookup n sm] iToP = V.update (V.replicate (Map.size sm) Nothing) (V.imap (\i v -> (v, Just i)) pToI) - writeIORef (glInput p) $ Just $ InputConnection idx input pToI iToP + writeIORef glInput $ Just $ InputConnection idx input pToI iToP -- generate object commands for related objectArrays {- @@ -622,21 +616,21 @@ generate object commands -} let slotV = slotVector input - progV = glPrograms p - texUnitMap = glTexUnitMapping p + progV = glPrograms + --texUnitMap = glTexUnitMapping p topUnis = uniformSetup input emptyV = V.replicate (V.length progV) [] extend v = case shouldExtend of Nothing -> v Just l -> V.concat [v,V.replicate l V.empty] - V.forM_ (V.zip pToI (glSlotPrograms p)) $ \(slotIdx,prgs) -> do + V.forM_ (V.zip pToI glSlotPrograms) $ \(slotIdx,prgs) -> do slot <- readIORef $ slotV ! slotIdx forM_ (IM.elems $ objectMap slot) $ \obj -> do - let cmdV = emptyV // [(prgIdx,createObjectCommands texUnitMap topUnis obj (progV ! prgIdx)) | prgIdx <- prgs] + let cmdV = emptyV // [(prgIdx,createObjectCommands glTexUnitMapping topUnis obj (progV ! prgIdx)) | prgIdx <- prgs] modifyIORef (objCommands obj) $ \v -> extend v // [(idx,cmdV)] -- generate stream commands - V.forM_ (glStreams p) $ \s -> do - writeIORef (glStreamCommands s) $ createStreamCommands texUnitMap topUnis (glStreamAttributes s) (glStreamPrimitive s) (progV ! glStreamProgram s) + V.forM_ glStreams $ \s -> do + writeIORef (glStreamCommands s) $ createStreamCommands glTexUnitMapping topUnis (glStreamAttributes s) (glStreamPrimitive s) (progV ! glStreamProgram s) return Nothing {- track state: @@ -730,6 +724,7 @@ GLSetProgram p -> glUseProgram p GLSetSamplerUniform i tu ref -> glUniform1i i tu >> writeIORef ref tu GLSetTexture tu target tx -> glActiveTexture tu >> glBindTexture target tx + GLSetSampler tu s -> glBindSampler tu s GLClearRenderTarget vals -> clearRenderTarget vals GLGenerateMipMap tu target -> glActiveTexture tu >> glGenerateMipmap target GLRenderStream streamIdx progIdx -> do @@ -759,13 +754,11 @@ = CGState { currentProgram :: ProgramName , textureBinding :: IntMap GLTexture - , samplerUniforms :: Map UniformName TextureUnit } initCGState = CGState { currentProgram = error "CGState: empty currentProgram" , textureBinding = IM.empty - , samplerUniforms = mempty } type CG a = State CGState a @@ -779,7 +772,6 @@ modify (\s -> s {currentProgram = p}) return $ GLSetProgram $ programObject $ programs ! p SetSamplerUniform n tu -> do - modify (\s@CGState{..} -> s {samplerUniforms = Map.insert n tu samplerUniforms}) p <- currentProgram <$> get case Map.lookup n (inputTextures $ programs ! p) of Nothing -> fail $ "internal error (SetSamplerUniform)! - " ++ show cmd @@ -790,12 +782,8 @@ let tex = textures ! t modify (\s -> s {textureBinding = IM.insert tu tex $ textureBinding s}) return $ GLSetTexture (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) (glTextureObject tex) -{- - SetSampler tu s -> liftIO $ do - glBindSampler (fromIntegral tu) (samplerObject $ glSamplers glp ! s) --} + SetSampler tu s -> return $ GLSetSampler (GL_TEXTURE0 + fromIntegral tu) (maybe 0 (glSamplerObject . (samplers !)) s) RenderSlot slot -> do - smpUnis <- samplerUniforms <$> get p <- currentProgram <$> get return $ GLRenderSlot slot p RenderStream stream -> do diff --git a/src/LambdaCube/GL/Data.hs b/src/LambdaCube/GL/Data.hs --- a/src/LambdaCube/GL/Data.hs +++ b/src/LambdaCube/GL/Data.hs @@ -63,25 +63,15 @@ -- FIXME: Temporary implemenation uploadTexture2DToGPU :: DynamicImage -> IO TextureData -uploadTexture2DToGPU = uploadTexture2DToGPU' False True False +uploadTexture2DToGPU = uploadTexture2DToGPU' True False True False -uploadTexture2DToGPU' :: Bool -> Bool -> Bool -> DynamicImage -> IO TextureData -uploadTexture2DToGPU' isSRGB isMip isClamped bitmap' = do +uploadTexture2DToGPU' :: Bool -> Bool -> Bool -> Bool -> DynamicImage -> IO TextureData +uploadTexture2DToGPU' isFiltered isSRGB isMip isClamped bitmap' = do let bitmap = case bitmap' of - ImageRGB8 i@(Image w h _) -> bitmap' -- pixelFoldMap (\(PixelRGB8 r g b) -> [PixelRGBA8 r g b maxBound]) i - ImageRGBA8 i@(Image w h _) -> bitmap' -- pixelFoldMap (\(PixelRGBA8 r g b a) -> [PixelRGBA8 r g b a]) i - ImageYCbCr8 i@(Image w h _) -> ImageRGB8 $ convertImage i -- $ Image w h $ SV.fromList $ pixelFoldMap (\p -> let PixelRGB8 r g b = convertPixel p in [PixelRGBA8 r g b maxBound]) i - ImageCMYK16 _ -> error "uploadTexture2DToGPU: ImageCMYK16" - ImageCMYK8 _ -> error "uploadTexture2DToGPU: ImageCMYK8" - ImageRGBA16 _ -> error "uploadTexture2DToGPU: ImageRGBA16" - ImageRGBF _ -> error "uploadTexture2DToGPU: ImageRGBF" - ImageRGB16 _ -> error "uploadTexture2DToGPU: ImageRGB16" - ImageYA16 _ -> error "uploadTexture2DToGPU: ImageYA16" - ImageYA8 _ -> error "uploadTexture2DToGPU: ImageYA8" - ImageYF _ -> error "uploadTexture2DToGPU: ImageYF" - ImageY16 _ -> error "uploadTexture2DToGPU: ImageY16" - ImageY8 _ -> error "uploadTexture2DToGPU: ImageY8" - _ -> error "uploadTexture2DToGPU: unknown image" + ImageRGB8 i@(Image w h _) -> bitmap' + ImageRGBA8 i@(Image w h _) -> bitmap' + ImageYCbCr8 i@(Image w h _) -> ImageRGB8 $ convertImage i + di -> ImageRGBA8 $ convertRGBA8 di glPixelStorei GL_UNPACK_ALIGNMENT 1 to <- alloca $! \pto -> glGenTextures 1 pto >> peek pto @@ -93,16 +83,17 @@ withBitmap (ImageRGB8 (Image w h v)) f = SV.unsafeWith v $ f (w,h) 3 0 withBitmap (ImageRGBA8 (Image w h v)) f = SV.unsafeWith v $ f (w,h) 4 0 withBitmap _ _ = error "unsupported image type :(" + texFilter = if isFiltered then GL_LINEAR else GL_NEAREST wrapMode = case isClamped of True -> GL_CLAMP_TO_EDGE False -> GL_REPEAT - (minFilter,maxLevel) = case isMip of - False -> (GL_LINEAR,0) + (minFilter,maxLevel) = case isFiltered && isMip of + False -> (texFilter,0) True -> (GL_LINEAR_MIPMAP_LINEAR, floor $ log (fromIntegral $ max width height) / log 2) glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral wrapMode glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral wrapMode glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $ fromIntegral minFilter - glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $ fromIntegral GL_LINEAR + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $ fromIntegral texFilter glTexParameteri GL_TEXTURE_2D GL_TEXTURE_BASE_LEVEL 0 glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAX_LEVEL $ fromIntegral maxLevel withBitmap bitmap $ \(w,h) nchn 0 ptr -> do diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs --- a/src/LambdaCube/GL/Type.hs +++ b/src/LambdaCube/GL/Type.hs @@ -163,7 +163,7 @@ data GLSampler = GLSampler - { samplerObject :: GLuint + { glSamplerObject :: GLuint } data GLRenderTarget diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs --- a/src/LambdaCube/GL/Util.hs +++ b/src/LambdaCube/GL/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module LambdaCube.GL.Util ( queryUniforms, queryStreams, @@ -23,6 +24,7 @@ glGetIntegerv1, setSampler, checkFBO, + compileSampler, compileTexture, primitiveToFetchPrimitive, primitiveToGLType, @@ -260,15 +262,18 @@ | otherwise = error "Failed fromGLType" fromGLUniformType _ = error "Failed fromGLType" -printShaderLog :: GLuint -> IO () +printShaderLog :: GLuint -> IO String printShaderLog o = do - i <- glGetShaderiv1 GL_INFO_LOG_LENGTH o - when (i > 0) $ + i <- glGetShaderiv1 GL_INFO_LOG_LENGTH o + case (i > 0) of + False -> return "" + True -> do alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do glGetShaderInfoLog o (fromIntegral i) sizePtr ps size <- peek sizePtr log <- peekCStringLen (castPtr ps, fromIntegral size) putStrLn log + return log glGetShaderiv1 :: GLenum -> GLuint -> IO GLint glGetShaderiv1 pname o = alloca $! \pi -> glGetShaderiv o pname pi >> peek pi @@ -276,23 +281,26 @@ glGetProgramiv1 :: GLenum -> GLuint -> IO GLint glGetProgramiv1 pname o = alloca $! \pi -> glGetProgramiv o pname pi >> peek pi -printProgramLog :: GLuint -> IO () +printProgramLog :: GLuint -> IO String printProgramLog o = do - i <- glGetProgramiv1 GL_INFO_LOG_LENGTH o - when (i > 0) $ + i <- glGetProgramiv1 GL_INFO_LOG_LENGTH o + case (i > 0) of + False -> return "" + True -> do alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do glGetProgramInfoLog o (fromIntegral i) sizePtr ps size <- peek sizePtr log <- peekCStringLen (castPtr ps, fromIntegral size) unless (null log) $ putStrLn log + return log compileShader :: GLuint -> [String] -> IO () compileShader o srcl = withMany withCString srcl $! \l -> withArray l $! \p -> do glShaderSource o (fromIntegral $! length srcl) (castPtr p) nullPtr glCompileShader o - printShaderLog o + log <- printShaderLog o status <- glGetShaderiv1 GL_COMPILE_STATUS o - when (status /= fromIntegral GL_TRUE) $ fail "compileShader failed!" + when (status /= fromIntegral GL_TRUE) $ fail $ unlines ["compileShader failed:",log] checkGL :: IO String checkGL = do @@ -503,21 +511,48 @@ ClampToEdge -> GL_CLAMP_TO_EDGE ClampToBorder -> GL_CLAMP_TO_BORDER +data ParameterSetup + = ParameterSetup + { setParameteri :: GLenum -> GLint -> IO () + , setParameterfv :: GLenum -> Ptr GLfloat -> IO () + , setParameterIiv :: GLenum -> Ptr GLint -> IO () + , setParameterIuiv :: GLenum -> Ptr GLuint -> IO () + , setParameterf :: GLenum -> GLfloat -> IO () + } + setTextureSamplerParameters :: GLenum -> SamplerDescriptor -> IO () -setTextureSamplerParameters t s = do - glTexParameteri t GL_TEXTURE_WRAP_S $ fromIntegral $ edgeModeToGLType $ samplerWrapS s +setTextureSamplerParameters target = setParameters $ ParameterSetup + { setParameteri = glTexParameteri target + , setParameterfv = glTexParameterfv target + , setParameterIiv = glTexParameterIiv target + , setParameterIuiv = glTexParameterIuiv target + , setParameterf = glTexParameterf target + } + +setSamplerParameters :: GLuint -> SamplerDescriptor -> IO () +setSamplerParameters samplerObj = setParameters $ ParameterSetup + { setParameteri = glSamplerParameteri samplerObj + , setParameterfv = glSamplerParameterfv samplerObj + , setParameterIiv = glSamplerParameterIiv samplerObj + , setParameterIuiv = glSamplerParameterIuiv samplerObj + , setParameterf = glSamplerParameterf samplerObj + } + +setParameters :: ParameterSetup -> SamplerDescriptor -> IO () +setParameters ParameterSetup{..} s = do + setParameteri GL_TEXTURE_WRAP_S $ fromIntegral $ edgeModeToGLType $ samplerWrapS s case samplerWrapT s of Nothing -> return () - Just a -> glTexParameteri t GL_TEXTURE_WRAP_T $ fromIntegral $ edgeModeToGLType a + Just a -> setParameteri GL_TEXTURE_WRAP_T $ fromIntegral $ edgeModeToGLType a case samplerWrapR s of Nothing -> return () - Just a -> glTexParameteri t GL_TEXTURE_WRAP_R $ fromIntegral $ edgeModeToGLType a - glTexParameteri t GL_TEXTURE_MIN_FILTER $ fromIntegral $ filterToGLType $ samplerMinFilter s - glTexParameteri t GL_TEXTURE_MAG_FILTER $ fromIntegral $ filterToGLType $ samplerMagFilter s + Just a -> setParameteri GL_TEXTURE_WRAP_R $ fromIntegral $ edgeModeToGLType a + setParameteri GL_TEXTURE_MIN_FILTER $ fromIntegral $ filterToGLType $ samplerMinFilter s + setParameteri GL_TEXTURE_MAG_FILTER $ fromIntegral $ filterToGLType $ samplerMagFilter s - let setBColorV4F a = with a $ \p -> glTexParameterfv t GL_TEXTURE_BORDER_COLOR $ castPtr p - setBColorV4I a = with a $ \p -> glTexParameterIiv t GL_TEXTURE_BORDER_COLOR $ castPtr p - setBColorV4U a = with a $ \p -> glTexParameterIuiv t GL_TEXTURE_BORDER_COLOR $ castPtr p + let setBColorV4F a = with a $ \p -> setParameterfv GL_TEXTURE_BORDER_COLOR $ castPtr p + setBColorV4I a = with a $ \p -> setParameterIiv GL_TEXTURE_BORDER_COLOR $ castPtr p + setBColorV4U a = with a $ \p -> setParameterIuiv GL_TEXTURE_BORDER_COLOR $ castPtr p case samplerBorderColor s of -- float, word, int, red, rg, rgb, rgba VFloat a -> setBColorV4F $ V4 a 0 0 0 @@ -538,16 +573,24 @@ case samplerMinLod s of Nothing -> return () - Just a -> glTexParameterf t GL_TEXTURE_MIN_LOD $ realToFrac a + Just a -> setParameterf GL_TEXTURE_MIN_LOD $ realToFrac a case samplerMaxLod s of Nothing -> return () - Just a -> glTexParameterf t GL_TEXTURE_MAX_LOD $ realToFrac a - glTexParameterf t GL_TEXTURE_LOD_BIAS $ realToFrac $ samplerLodBias s + Just a -> setParameterf GL_TEXTURE_MAX_LOD $ realToFrac a + setParameterf GL_TEXTURE_LOD_BIAS $ realToFrac $ samplerLodBias s case samplerCompareFunc s of - Nothing -> glTexParameteri t GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_NONE + Nothing -> setParameteri GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_NONE Just a -> do - glTexParameteri t GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_COMPARE_REF_TO_TEXTURE - glTexParameteri t GL_TEXTURE_COMPARE_FUNC $ fromIntegral $ comparisonFunctionToGLType a + setParameteri GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_COMPARE_REF_TO_TEXTURE + setParameteri GL_TEXTURE_COMPARE_FUNC $ fromIntegral $ comparisonFunctionToGLType a + +compileSampler :: SamplerDescriptor -> IO GLSampler +compileSampler s = do + so <- alloca $! \po -> glGenSamplers 1 po >> peek po + setSamplerParameters so s + return $ GLSampler + { glSamplerObject = so + } compileTexture :: TextureDescriptor -> IO GLTexture compileTexture txDescriptor = do diff --git a/testclient/TestData.hs b/testclient/TestData.hs new file mode 100644 --- /dev/null +++ b/testclient/TestData.hs @@ -0,0 +1,242 @@ +-- generated file, do not modify! +-- 2016-02-12T16:05:13.383716000000Z + +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +module TestData where + +import Data.Int +import Data.Word +import Data.Map +import Data.Vector (Vector(..)) +import LambdaCube.Linear + +import Data.Text +import Data.Aeson hiding (Value,Bool) +import Data.Aeson.Types hiding (Value,Bool) +import Control.Monad + +import LambdaCube.IR +import LambdaCube.Mesh +import LambdaCube.PipelineSchema + +data ClientInfo + = ClientInfo + { clientName :: String + , clientBackend :: Backend + } + + deriving (Show, Eq, Ord) + +data Frame + = Frame + { renderCount :: Int + , frameUniforms :: Map String Value + , frameTextures :: Map String Int + } + + deriving (Show, Eq, Ord) + +data Scene + = Scene + { objectArrays :: Map String (Vector Int) + , renderTargetWidth :: Int + , renderTargetHeight :: Int + , frames :: Vector Frame + } + + deriving (Show, Eq, Ord) + +data PipelineInfo + = PipelineInfo + { pipelineName :: String + , pipeline :: Pipeline + } + + deriving (Show, Eq, Ord) + +data RenderJob + = RenderJob + { meshes :: Vector Mesh + , textures :: Vector String + , schema :: PipelineSchema + , scenes :: Vector Scene + , pipelines :: Vector PipelineInfo + } + + deriving (Show, Eq, Ord) + +data FrameResult + = FrameResult + { frRenderTimes :: Vector Float + , frImageWidth :: Int + , frImageHeight :: Int + } + + deriving (Show, Eq, Ord) + +data RenderJobResult + = RenderJobResult FrameResult + | RenderJobError String + deriving (Show, Eq, Ord) + + +instance ToJSON ClientInfo where + toJSON v = case v of + ClientInfo{..} -> object + [ "tag" .= ("ClientInfo" :: Text) + , "clientName" .= clientName + , "clientBackend" .= clientBackend + ] + +instance FromJSON ClientInfo where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "ClientInfo" -> do + clientName <- obj .: "clientName" + clientBackend <- obj .: "clientBackend" + pure $ ClientInfo + { clientName = clientName + , clientBackend = clientBackend + } + parseJSON _ = mzero + +instance ToJSON Frame where + toJSON v = case v of + Frame{..} -> object + [ "tag" .= ("Frame" :: Text) + , "renderCount" .= renderCount + , "frameUniforms" .= frameUniforms + , "frameTextures" .= frameTextures + ] + +instance FromJSON Frame where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "Frame" -> do + renderCount <- obj .: "renderCount" + frameUniforms <- obj .: "frameUniforms" + frameTextures <- obj .: "frameTextures" + pure $ Frame + { renderCount = renderCount + , frameUniforms = frameUniforms + , frameTextures = frameTextures + } + parseJSON _ = mzero + +instance ToJSON Scene where + toJSON v = case v of + Scene{..} -> object + [ "tag" .= ("Scene" :: Text) + , "objectArrays" .= objectArrays + , "renderTargetWidth" .= renderTargetWidth + , "renderTargetHeight" .= renderTargetHeight + , "frames" .= frames + ] + +instance FromJSON Scene where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "Scene" -> do + objectArrays <- obj .: "objectArrays" + renderTargetWidth <- obj .: "renderTargetWidth" + renderTargetHeight <- obj .: "renderTargetHeight" + frames <- obj .: "frames" + pure $ Scene + { objectArrays = objectArrays + , renderTargetWidth = renderTargetWidth + , renderTargetHeight = renderTargetHeight + , frames = frames + } + parseJSON _ = mzero + +instance ToJSON PipelineInfo where + toJSON v = case v of + PipelineInfo{..} -> object + [ "tag" .= ("PipelineInfo" :: Text) + , "pipelineName" .= pipelineName + , "pipeline" .= pipeline + ] + +instance FromJSON PipelineInfo where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "PipelineInfo" -> do + pipelineName <- obj .: "pipelineName" + pipeline <- obj .: "pipeline" + pure $ PipelineInfo + { pipelineName = pipelineName + , pipeline = pipeline + } + parseJSON _ = mzero + +instance ToJSON RenderJob where + toJSON v = case v of + RenderJob{..} -> object + [ "tag" .= ("RenderJob" :: Text) + , "meshes" .= meshes + , "textures" .= textures + , "schema" .= schema + , "scenes" .= scenes + , "pipelines" .= pipelines + ] + +instance FromJSON RenderJob where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "RenderJob" -> do + meshes <- obj .: "meshes" + textures <- obj .: "textures" + schema <- obj .: "schema" + scenes <- obj .: "scenes" + pipelines <- obj .: "pipelines" + pure $ RenderJob + { meshes = meshes + , textures = textures + , schema = schema + , scenes = scenes + , pipelines = pipelines + } + parseJSON _ = mzero + +instance ToJSON FrameResult where + toJSON v = case v of + FrameResult{..} -> object + [ "tag" .= ("FrameResult" :: Text) + , "frRenderTimes" .= frRenderTimes + , "frImageWidth" .= frImageWidth + , "frImageHeight" .= frImageHeight + ] + +instance FromJSON FrameResult where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "FrameResult" -> do + frRenderTimes <- obj .: "frRenderTimes" + frImageWidth <- obj .: "frImageWidth" + frImageHeight <- obj .: "frImageHeight" + pure $ FrameResult + { frRenderTimes = frRenderTimes + , frImageWidth = frImageWidth + , frImageHeight = frImageHeight + } + parseJSON _ = mzero + +instance ToJSON RenderJobResult where + toJSON v = case v of + RenderJobResult arg0 -> object [ "tag" .= ("RenderJobResult" :: Text), "arg0" .= arg0] + RenderJobError arg0 -> object [ "tag" .= ("RenderJobError" :: Text), "arg0" .= arg0] + +instance FromJSON RenderJobResult where + parseJSON (Object obj) = do + tag <- obj .: "tag" + case tag :: Text of + "RenderJobResult" -> RenderJobResult <$> obj .: "arg0" + "RenderJobError" -> RenderJobError <$> obj .: "arg0" + parseJSON _ = mzero + diff --git a/testclient/client.hs b/testclient/client.hs new file mode 100644 --- /dev/null +++ b/testclient/client.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings, RecordWildCards #-} + +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Monad +import Control.Monad.Catch +import Data.Text (Text) +import Data.Vector (Vector,(!)) +import Data.ByteString.Char8 (unpack,pack) +import qualified Data.ByteString as SB +import qualified Data.Vector as V +import qualified Data.Map as Map +import qualified Data.ByteString.Base64 as B64 + +import System.Exit +import Data.Time.Clock +import Data.Aeson +import Foreign + +import qualified Network.WebSockets as WS +import Network.Socket + +import "GLFW-b" Graphics.UI.GLFW as GLFW +import "OpenGLRaw" Graphics.GL.Core33 +import Codec.Picture as Juicy + +import LambdaCube.IR +import LambdaCube.PipelineSchema +import LambdaCube.Mesh +import LambdaCube.GL +import LambdaCube.GL.Mesh +import TestData + +main = do + win <- initWindow "LambdaCube 3D OpenGL 3.3 Backend" 256 256 + + GLFW.setWindowCloseCallback win $ Just $ \_ -> do + GLFW.destroyWindow win + GLFW.terminate + exitSuccess + + -- connect to the test server + forever $ catchAll (setupConnection win) $ \_ -> do + GLFW.pollEvents + threadDelay 100000 + +setupConnection win = withSocketsDo $ WS.runClient "192.168.0.12" 9160 "/" $ \conn -> catchAll (execConnection win conn) $ \e -> do + WS.sendTextData conn . encode $ RenderJobError $ displayException e + +execConnection win conn = do + putStrLn "Connected!" + -- register backend + WS.sendTextData conn . encode $ ClientInfo + { clientName = "Haskell OpenGL 3.3" + , clientBackend = OpenGL33 + } + chan <- newEmptyMVar :: IO (MVar RenderJob) + -- wait for incoming render jobs + _ <- forkIO $ forever $ do + -- get the pipeline from the server + decodeStrict <$> WS.receiveData conn >>= \case + Nothing -> putStrLn "unknown message" + Just renderJob -> putMVar chan renderJob + -- process render jobs + forever $ do + tryTakeMVar chan >>= \case + Nothing -> return () + Just rj -> processRenderJob win conn rj + WS.sendPing conn ("hello" :: Text) + GLFW.pollEvents + threadDelay 100000 + putStrLn "disconnected" + WS.sendClose conn ("Bye!" :: Text) + +doAfter = flip (>>) + +processRenderJob win conn renderJob@RenderJob{..} = do + putStrLn "got render job" + gpuData@GPUData{..} <- allocateGPUData renderJob + -- foreach pipeline + doAfter (disposeGPUData gpuData) $ forM_ pipelines $ \PipelineInfo{..} -> do + putStrLn $ "use pipeline: " ++ pipelineName + renderer <- allocRenderer pipeline + -- foreach scene + doAfter (disposeRenderer renderer) $ forM_ scenes $ \Scene{..} -> do + storage <- allocStorage schema + -- add objects + forM_ (Map.toList objectArrays) $ \(name,objs) -> forM_ objs $ addMeshToObjectArray storage name [] . (gpuMeshes !) + -- set render target size + GLFW.setWindowSize win renderTargetWidth renderTargetHeight + setScreenSize storage (fromIntegral renderTargetWidth) (fromIntegral renderTargetHeight) + -- connect renderer with storage + doAfter (disposeStorage storage) $ setStorage renderer storage >>= \case + Just err -> putStrLn err + Nothing -> do + -- foreach frame + forM_ frames $ \Frame{..} -> do + -- setup uniforms + updateUniforms storage $ do + forM_ (Map.toList frameTextures) $ \(name,tex) -> pack name @= return (gpuTextures ! tex) + forM_ (Map.toList frameUniforms) $ uncurry setUniformValue + -- rendering + renderTimes <- V.replicateM renderCount . timeDiff $ do + renderFrame renderer + GLFW.swapBuffers win + GLFW.pollEvents + -- send render job result to server + WS.sendTextData conn . encode . RenderJobResult $ FrameResult + { frRenderTimes = renderTimes + , frImageWidth = renderTargetWidth + , frImageHeight = renderTargetHeight + } + -- send the last render result using Base64 encoding + WS.sendBinaryData conn . B64.encode =<< getFrameBuffer renderTargetWidth renderTargetHeight + +-- utility code + +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 + +getFrameBuffer w h = do + glFinish + glBindFramebuffer GL_READ_FRAMEBUFFER 0 + glReadBuffer GL_FRONT_LEFT + glBlitFramebuffer 0 0 (fromIntegral w) (fromIntegral h) 0 (fromIntegral h) (fromIntegral w) 0 GL_COLOR_BUFFER_BIT GL_NEAREST + glReadBuffer GL_BACK_LEFT + withFrameBuffer 0 0 w h $ \p -> SB.packCStringLen (castPtr p,w*h*4) + +withFrameBuffer :: Int -> Int -> Int -> Int -> (Ptr Word8 -> IO a) -> IO a +withFrameBuffer x y w h fn = allocaBytes (w*h*4) $ \p -> do + glPixelStorei GL_UNPACK_LSB_FIRST 0 + glPixelStorei GL_UNPACK_SWAP_BYTES 0 + glPixelStorei GL_UNPACK_ROW_LENGTH 0 + 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 -- normally 4! + glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) GL_RGBA GL_UNSIGNED_BYTE $ castPtr p + fn p + +data GPUData + = GPUData + { gpuTextures :: Vector TextureData + , gpuMeshes :: Vector GPUMesh + } + +allocateGPUData RenderJob{..} = GPUData <$> mapM uploadTex2D textures <*> mapM uploadMeshToGPU meshes + where uploadTex2D = uploadTexture2DToGPU . either error id . decodeImage . either error id . B64.decode . pack + +disposeGPUData GPUData{..} = mapM_ disposeTexture gpuTextures >> mapM_ disposeMesh gpuMeshes + +timeDiff m = (\s e -> realToFrac $ diffUTCTime e s) <$> getCurrentTime <* m <*> getCurrentTime + +setUniformValue name = \case + VBool v -> pack name @= return v + VV2B v -> pack name @= return v + VV3B v -> pack name @= return v + VV4B v -> pack name @= return v + VWord v -> pack name @= return v + VV2U v -> pack name @= return v + VV3U v -> pack name @= return v + VV4U v -> pack name @= return v + VInt v -> pack name @= return v + VV2I v -> pack name @= return v + VV3I v -> pack name @= return v + VV4I v -> pack name @= return v + VFloat v -> pack name @= return v + VV2F v -> pack name @= return v + VV3F v -> pack name @= return v + VV4F v -> pack name @= return v + VM22F v -> pack name @= return v + VM23F v -> pack name @= return v + VM24F v -> pack name @= return v + VM32F v -> pack name @= return v + VM33F v -> pack name @= return v + VM34F v -> pack name @= return v + VM42F v -> pack name @= return v + VM43F v -> pack name @= return v + VM44F v -> pack name @= return v