lambdacube-gl 0.4.0.2 → 0.5.0.1
raw patch · 10 files changed
+614/−98 lines, 10 filesdep +GLFW-bdep +aesondep +base64-bytestringdep ~JuicyPixelsdep ~basedep ~lambdacube-irnew-component:exe:lambdacube-gl-hellonew-component:exe:lambdacube-gl-test-client
Dependencies added: GLFW-b, aeson, base64-bytestring, exceptions, lambdacube-gl, network, text, time, websockets
Dependency ranges changed: JuicyPixels, base, lambdacube-ir
Files
- examples/HelloEmbedded.hs +1/−1
- examples/hello.json +1/−1
- examples/hello.lc +5/−5
- lambdacube-gl.cabal +69/−8
- src/LambdaCube/GL/Backend.hs +27/−39
- src/LambdaCube/GL/Data.hs +11/−20
- src/LambdaCube/GL/Type.hs +1/−1
- src/LambdaCube/GL/Util.hs +66/−23
- testclient/TestData.hs +242/−0
- testclient/client.hs +191/−0
examples/HelloEmbedded.hs view
@@ -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
examples/hello.json view
@@ -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"}
examples/hello.lc view
@@ -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"))
lambdacube-gl.cabal view
@@ -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
src/LambdaCube/GL/Backend.hs view
@@ -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
src/LambdaCube/GL/Data.hs view
@@ -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
src/LambdaCube/GL/Type.hs view
@@ -163,7 +163,7 @@ data GLSampler = GLSampler- { samplerObject :: GLuint+ { glSamplerObject :: GLuint } data GLRenderTarget
src/LambdaCube/GL/Util.hs view
@@ -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
+ testclient/TestData.hs view
@@ -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+
+ testclient/client.hs view
@@ -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