From 989140d46e74d526306f455258d85e4b7e8f9d50 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 15 Mar 2023 18:24:09 +0000 Subject: [PATCH] Add shading for shapes and the floor --- shader/lighting/texture.frag | 13 ++++++-- shader/shape/basic.frag | 6 +++- shader/shape/basic.vert | 3 ++ shader/texture/arrayPos.frag | 3 ++ shader/wall/texture.frag | 2 ++ shader/wall/texture.geom | 12 +++----- src/Data/Preload/Render.hs | 2 +- src/Dodge/Render.hs | 59 +++++++++++++++++++----------------- src/Framebuffer/Setup.hs | 13 ++++++++ src/Framebuffer/Update.hs | 51 ++++++++++++++++++++++++++++++- src/Geometry/Polygon.hs | 3 ++ src/Preload/Render.hs | 4 +-- src/Render.hs | 4 ++- src/Shader/Compile.hs | 17 ++++++----- src/Shader/Poke.hs | 32 ++++++++++--------- src/Shape/Data.hs | 3 +- 16 files changed, 158 insertions(+), 69 deletions(-) diff --git a/shader/lighting/texture.frag b/shader/lighting/texture.frag index d4998858b..e56e35eea 100644 --- a/shader/lighting/texture.frag +++ b/shader/lighting/texture.frag @@ -1,17 +1,24 @@ #version 450 core uniform vec3 lightPos; uniform vec4 lumRad; -uniform sampler2D screenTexture; +layout (binding = 0) uniform sampler2D screenTexture; +layout (binding = 1) uniform sampler2D normals; in vec2 vTexPos; out vec4 fColor; float rad = lumRad.a; void main() { - vec3 distVec = texture(screenTexture, vTexPos).xyz - lightPos; + vec3 pos = texture(screenTexture, vTexPos).xyz; + vec3 distVec = pos - lightPos; + vec4 normbit = texture(normals, vTexPos); + vec3 norm = normbit.xyz - pos; + float y1 = float(normbit.w == 0 ? 1 : dot(normalize(norm), normalize(distVec))); + float y = float(y1 > 0 ? 1 : 0); +// float y = float(normbit.w == 1 ? 1 : 0); float dist = dot(distVec, distVec); if (dist > rad) { discard; } float x = 1 - dist / rad; - vec3 c = (x * x * x) * lumRad.rgb; + vec3 c = y* (x * x * x) * lumRad.rgb; fColor = vec4(c, 0); } diff --git a/shader/shape/basic.frag b/shader/shape/basic.frag index d4882cdb3..6c0798cc2 100644 --- a/shader/shape/basic.frag +++ b/shader/shape/basic.frag @@ -1,10 +1,14 @@ #version 450 core in vec4 vCol; in vec4 vPos; +in vec4 vNorm; layout (location=0) out vec4 fCol; layout (location=1) out vec4 fPos; +layout (location=2) out vec4 fNorm; void main() { fCol = vCol; - fPos = vec4(vPos.xyz,1); + fPos = vPos; + fNorm = vNorm; + //fNorm = vec4(vPos.x,vPos.y+2,vPos.z,1); } diff --git a/shader/shape/basic.vert b/shader/shape/basic.vert index b7511a478..1e8ce601f 100644 --- a/shader/shape/basic.vert +++ b/shader/shape/basic.vert @@ -1,11 +1,14 @@ #version 450 core layout (location = 0) in vec4 pos; layout (location = 1) in vec4 col; +layout (location = 2) in vec4 norm; layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ; out vec4 vCol; out vec4 vPos; +out vec4 vNorm; void main() { gl_Position = theMat * vec4(pos.xyz,1); vCol = col; vPos = pos; + vNorm = norm; } diff --git a/shader/texture/arrayPos.frag b/shader/texture/arrayPos.frag index 5a1cba671..e0adc5ba2 100644 --- a/shader/texture/arrayPos.frag +++ b/shader/texture/arrayPos.frag @@ -3,9 +3,12 @@ in vec3 vTexPos; in vec3 vPos; layout (location=0) out vec4 fCol; layout (location=1) out vec4 fPos; +layout (location=2) out vec4 normal; uniform sampler2DArray tilesetSampler; void main() { fCol = texture(tilesetSampler, vTexPos); fPos = vec4(vPos,1); + //normal = vec4(vPos.xy,vPos.z-1,1); + normal = vec4(vPos.xy,vPos.z-1,1); } diff --git a/shader/wall/texture.frag b/shader/wall/texture.frag index 7b0b7dfbe..c19a59d6d 100644 --- a/shader/wall/texture.frag +++ b/shader/wall/texture.frag @@ -1,6 +1,7 @@ #version 450 core layout (location=0) out vec4 fCol; layout (location=1) out vec4 fPos; +layout (location=2) out vec4 fNorm; in vec2 tPos; in vec4 gPos; in vec4 gColor; @@ -9,4 +10,5 @@ void main() { fCol = gColor * texture(tex,tPos); fPos = gPos; + fNorm = gPos + vec4(1,0,0,0); } diff --git a/shader/wall/texture.geom b/shader/wall/texture.geom index 7d8e93c8f..f6d01eb92 100644 --- a/shader/wall/texture.geom +++ b/shader/wall/texture.geom @@ -15,13 +15,9 @@ void main() vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1); vec4 p3 = vec4 (p1.xy,100,1); vec4 p4 = vec4 (p2.xy,100,1); - vec4 a1 = theMat * p1; - vec4 a2 = theMat * p2; - vec4 a3 = theMat * p3; - vec4 a4 = theMat * p4; - gPos = p1; tPos = vec2 ( 1,-1) ; gl_Position = a1; EmitVertex(); - gPos = p3; tPos = vec2 ( 1, 1) ; gl_Position = a3; EmitVertex(); - gPos = p2; tPos = vec2 (-1,-1) ; gl_Position = a2; EmitVertex(); - gPos = p4; tPos = vec2 (-1, 1) ; gl_Position = a4; EmitVertex(); + gPos = p1; tPos = vec2 ( 1,-1) ; gl_Position = vec4(theMat * p1); EmitVertex(); + gPos = p3; tPos = vec2 ( 1, 1) ; gl_Position = vec4(theMat * p3); EmitVertex(); + gPos = p2; tPos = vec2 (-1,-1) ; gl_Position = vec4(theMat * p2); EmitVertex(); + gPos = p4; tPos = vec2 (-1, 1) ; gl_Position = vec4(theMat * p4); EmitVertex(); EndPrimitive(); } diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index e0e85fce2..7254e742f 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -44,7 +44,7 @@ data RenderData = RenderData , _fboHalf1 :: (FBO, TO) , _fboHalf2 :: (FBO, TO) , _fboHalf3 :: (FBO, TO) - , _fboBase :: (FBO, (TO, TO)) + , _fboBase :: (FBO, (TO, TO, TO)) , _fboCloud :: (FBO, (TO, TO)) , _fboBloom :: (FBO, TO) , _fboColor :: (FBO, TO) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 6b40b0c68..6355cbb63 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -125,7 +125,12 @@ doDrawing' win pdata u = do (marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim') 0 (fromIntegral nWalls) --- glDisable GL_CULL_FACE + -- clear normals + withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv + (pdata ^. fboBase . _1 . unFBO) + GL_COLOR + 2 + ptr --draw walls onto base buffer if cfig ^. graphics_wall_textured then renderTextureWalls pdata nWalls @@ -152,7 +157,7 @@ doDrawing' win pdata u = do nSilIndices nIndices (u ^. uvConfig . graphics_object_shadows) - (snd $ snd $ pdata ^. fboBase) + (pdata ^. fboBase . _2 . _2) (drawCPUShadows pdata ws) glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glClearColor 0 0 0 0 @@ -196,29 +201,29 @@ doDrawing' win pdata u = do glClear GL_COLOR_BUFFER_BIT renderLayer MidLayer shadV layerCounts drawShader (_windowShader pdata) nWins - when (_graphics_cloud_shadows cfig) $ do - ----render transparency depths - glDepthMask GL_TRUE - glDisable GL_BLEND - withArray [GL_NONE, GL_COLOR_ATTACHMENT1] $ \ptr -> glDrawBuffers 2 ptr - renderLayer MidLayer shadV layerCounts - drawShader (_windowShader pdata) nWins - ----draw lightmap for cloud buffer - glDepthMask GL_FALSE - glEnable GL_BLEND - glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata))) - createLightMap - cfig - pdata - lightPoints - nWalls - nSilIndices - nIndices - (_graphics_object_shadows $ _uvConfig u) - (snd $ snd $ _fboCloud pdata) - (drawCPUShadows pdata ws) - glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE - glClearColor 0 0 0 0 +-- when (_graphics_cloud_shadows cfig) $ do +-- ----render transparency depths +-- glDepthMask GL_TRUE +-- glDisable GL_BLEND +-- withArray [GL_NONE, GL_COLOR_ATTACHMENT1] $ \ptr -> glDrawBuffers 2 ptr +-- renderLayer MidLayer shadV layerCounts +-- drawShader (_windowShader pdata) nWins +-- ----draw lightmap for cloud buffer +-- glDepthMask GL_FALSE +-- glEnable GL_BLEND +-- glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata))) +-- createLightMap +-- cfig +-- pdata +-- lightPoints +-- nWalls +-- nSilIndices +-- nIndices +-- (_graphics_object_shadows $ _uvConfig u) +-- (snd $ snd $ _fboCloud pdata) +-- (drawCPUShadows pdata ws) +-- glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE +-- glClearColor 0 0 0 0 glInvalidateBufferData (pdata ^. vboShapes . vboName) --apply lightmap to cloud buffer glClearColor 0 0 0 0 @@ -249,7 +254,7 @@ doDrawing' win pdata u = do -- perform any radial distortion case w ^. cWorld . lWorld . distortions of [] -> do - bindTO $ fst $ snd $ _fboBase pdata + bindTO $ pdata ^. fboBase . _2 . _1 glBindFramebuffer GL_FRAMEBUFFER 0 drawShader (fst $ _fullscreenShader pdata) 4 rds -> do @@ -261,7 +266,7 @@ doDrawing' win pdata u = do fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) ++ [FBO 0] - toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata]) + toList = (pdata ^. fboBase . _2 . _1) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata]) bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList) glActiveTexture GL_TEXTURE1 zipWithM_ (>>) bindings $ map bindDrawDist rds diff --git a/src/Framebuffer/Setup.hs b/src/Framebuffer/Setup.hs index 9959d96e2..7867de174 100644 --- a/src/Framebuffer/Setup.hs +++ b/src/Framebuffer/Setup.hs @@ -3,6 +3,7 @@ module Framebuffer.Setup ( setupTextureFramebuffer, setupFramebufferGivenStencil, setupFramebuffer2GivenStencil, + setupFramebuffer3GivenStencil, setupShadowFramebuffer, ) where @@ -75,3 +76,15 @@ setupFramebuffer2GivenStencil rboName = do glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName checkFBO $ FBO fboName return (FBO fboName, (TO to1, TO to2)) + +setupFramebuffer3GivenStencil :: + GLuint -> -- RenderbufferObject + IO (FBO, (TO, TO, TO)) +setupFramebuffer3GivenStencil rboName = do + fboName <- mglCreate glCreateFramebuffers + to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D) + to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D) + to3 <- mglCreate (glCreateTextures GL_TEXTURE_2D) + glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName + checkFBO $ FBO fboName + return (FBO fboName, (TO to1, TO to2, TO to3)) diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index e460e2242..8b431d8fc 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -29,8 +29,9 @@ sizeFBOs :: IO RenderData sizeFBOs xsize ysize xfull yfull rdata = do resizeRBO (_rboBaseBloom rdata) xsize ysize + rdata1 <- updateFBOTO3 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F GL_RGBA16F rdata fboBase rdata' <- - foldM (updateFBOTO2 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F) rdata [fboBase, fboCloud] + foldM (updateFBOTO2 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F) rdata1 [fboCloud] >>= flip (foldM (updateFBOTO xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8)) [fboColor, fboLighting] @@ -101,6 +102,26 @@ updateFBOTO2 xsize ysize minfilt magfilt inFormat1 inFormat2 pdata target = do newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2 return $ storing target newfbo2 pdata +updateFBOTO3 :: + Int -> + Int -> + -- | minification filter + GLenum -> + -- | magnification filter + GLenum -> + -- | internal color format texture1 + GLenum -> + -- | internal color format texture2 + GLenum -> + -- | internal color format texture3 + GLenum -> + RenderData -> + ALens' RenderData (FBO, (TO, TO, TO)) -> + IO RenderData +updateFBOTO3 xsize ysize minfilt magfilt inFormat1 inFormat2 inFormat3 pdata target = do + newfbo2 <- resizeFBOTO3 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2 inFormat3 + return $ storing target newfbo2 pdata + -- note we only really "change" the texture objects resizeShadowFBO :: (FBO, (TO, TO)) -> @@ -141,6 +162,34 @@ resizeFBOTO2 (fbo, (toOld1, toOld2)) xsize ysize minfilt magfilt inFormat1 inFor checkFBO fbo return (fbo, (TO to1, TO to2)) +resizeFBOTO3 :: + (FBO, (TO, TO,TO)) -> + Int -> + Int -> + -- | minification filter + GLenum -> + -- | magnification filter + GLenum -> + -- | internal color format1 + GLenum -> + -- | internal color format2 + GLenum -> + -- | internal color format3 + GLenum -> + IO (FBO, (TO, TO,TO)) +resizeFBOTO3 (fbo, (toOld1, toOld2,told3)) xsize ysize minfilt magfilt inFormat1 inFormat2 inform3 = do + glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo) + mglDelete glDeleteTextures $ _unTO toOld1 + mglDelete glDeleteTextures $ _unTO toOld2 + mglDelete glDeleteTextures $ _unTO told3 + to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 xsize ysize minfilt magfilt inFormat1 + to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 xsize ysize minfilt magfilt inFormat2 + to3 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT2 xsize ysize minfilt magfilt inform3 + withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> + glNamedFramebufferDrawBuffers (_unFBO fbo) 3 ptr + checkFBO fbo + return (fbo, (TO to1, TO to2,TO to3)) + resizeFBOTO :: (FBO, TO) -> Int -> diff --git a/src/Geometry/Polygon.hs b/src/Geometry/Polygon.hs index fa2a68a37..444505256 100644 --- a/src/Geometry/Polygon.hs +++ b/src/Geometry/Polygon.hs @@ -113,6 +113,9 @@ grahamEliminate xs = xs centroid :: Foldable t => t Point2 -> Point2 centroid = L.fold $ (/) <$> L.Fold (+.+) (V2 0 0) id <*> L.genericLength +centroidNum :: (Fractional a ,Foldable t) => t a -> a +centroidNum = L.fold $ (/) <$> L.Fold (+) 0 id <*> L.genericLength + shrinkPolyOnEdges :: Float -> [Point2] -> [Point2] shrinkPolyOnEdges x (p:q:ps) = map (shrinkVert x) . slideWindow 3 $ (p:q:ps) ++ [p,q] shrinkPolyOnEdges _ _ = error "too few vertices in polygon" diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index b19fb6bd4..0dd20c516 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -141,7 +141,7 @@ preloadRender = do positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles -- 2D draw shaders bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles - bslista <- makeShader4 "shape/basic" [vert, frag] [4, 4] ETriangles shVBO + bslista <- makeShader4 "shape/basic" [vert, frag] [4, 4, 4] nShapeVerxComp ETriangles shVBO glVertexArrayElementBuffer (bslista ^. shadVAO . vaoName) shEBOname aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] ETriangles eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] ETriangles @@ -194,7 +194,7 @@ preloadRender = do 800 600 - fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName + fboBaseName <- setupFramebuffer3GivenStencil rboBaseBloomName fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName fboColorName <- setupFramebufferGivenStencil rboBaseBloomName diff --git a/src/Render.hs b/src/Render.hs index fe70be159..56a166dce 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -100,7 +100,8 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra glClear $ GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT -- glClearDepth 1 glDisable GL_CULL_FACE - bindTO toPos + --bindTO toPos + glBindTextureUnit 0 (toPos ^. unTO) glDepthFunc GL_ALWAYS glDepthMask GL_FALSE _ -> do @@ -173,6 +174,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra -- bind world position texture glDisable GL_CULL_FACE bindTO toPos + glBindTextureUnit 1 (pdata ^. fboBase . _2 . _3 . unTO) glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 glUseProgram (ltextShad ^. shadName) --Just (_shadProg ltextShad) diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 14008770c..f97bee91c 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -53,12 +53,14 @@ makeShader4 :: [GLenum] -> -- | The input vertex sizes [Int] -> + -- | The stride + Int -> EPrimitiveMode -> VBO -> IO FullShader -makeShader4 s shaderlist sizes pm vbo = do +makeShader4 s shaderlist sizes strd pm vbo = do prog <- makeSourcedShader s shaderlist - vao <- setupVAOvbo sizes vbo + vao <- setupVAOvbo sizes strd vbo return $ FullShader { _shadName = prog , _shadVAO = vao @@ -163,11 +165,11 @@ shaderTypeExt' _ = undefined setupVAO :: [Int] -> IO (VAO,VBO) setupVAO = setupVAOSized numDrawableElements -setupVAOvbo :: [Int] -> VBO -> IO VAO -setupVAOvbo sizes vbo = do +setupVAOvbo :: [Int] -> Int -> VBO -> IO VAO +setupVAOvbo sizes strd vbo = do vaoname <- mglCreate glCreateVertexArrays glBindVertexArray vaoname - setupVertexAttribs vbo vaoname sizes + setupVertexAttribs vbo vaoname sizes strd return $ VAO { _vaoName = vaoname } @@ -206,13 +208,12 @@ setupVBOSized ndraw vao sizes = do strd = sum sizes offs = scanl (+) 0 sizes -setupVertexAttribs :: VBO -> GLuint -> [Int] -> IO () -setupVertexAttribs vbo vao sizes = do +setupVertexAttribs :: VBO -> GLuint -> [Int] -> Int -> IO () +setupVertexAttribs vbo vao sizes strd = do glVertexArrayVertexBuffer vao 0 (vbo ^. vboName) 0 (fromIntegral $ floatSize * strd) forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do setupVertexAttribPointer vao loc siz off where - strd = sum sizes offs = scanl (+) 0 sizes -- | Assumes the correct VBO is bound diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 5d35b7c4a..1b9fe4bd6 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -6,11 +6,13 @@ module Shader.Poke , pokeWallsWindowsFloor , memoTopPrismEdgeIndices ) where +import Geometry.Polygon import Shader.Data import Shader.Parameters import Picture.Data import Shape.Data import Geometry.Data +import Control.Monad --import ShapePicture import Graphics.GL.Core45 @@ -96,16 +98,18 @@ pokeShapeObj -> IO (Int,Int,Int) {-# INLINE pokeShapeObj #-} pokeShapeObj ptr iptr ieptr counts (ShapeObj shtype shVerts) = case shtype of - TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts (VFSM.fromList shVerts) + TopPrism size -> pokeTopPrism midp (size - 2) ptr iptr ieptr counts (VFSM.fromList shVerts) + where + midp = centroidNum $ map _svPos shVerts -pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort +pokeTopPrism :: Point3 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort -> (Int,Int,Int) -> VFSM.Stream IO ShapeV -> IO (Int,Int,Int) {-# INLINE pokeTopPrism #-} -pokeTopPrism size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do - nv' <- VFSM.foldlM' (pokeJustV ptr) nv svs +pokeTopPrism cp size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do + nv' <- VFSM.foldlM' (pokeJustV cp ptr) nv svs nshapeindices' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices (memoTopPrismIndices V.! size) nedgeindices' <- UV.foldM' (pokeTopPrismEdgeIndex nv ieptr) nedgeindices @@ -165,25 +169,23 @@ topPrismIndices n = concatMap f [1..n-2] -- triangles on top face -- consider changing the position to a vec4 -- and just doing two pokes rather than seven -- (especially if adding normal data) -pokeJustV :: Ptr Float +pokeJustV :: Point3 + -> Ptr Float -> Int -> ShapeV -> IO Int {-# INLINE pokeJustV #-} -pokeJustV ptr nv sh = do - pokeElemOff ptr (off 0) x - pokeElemOff ptr (off 1) y - pokeElemOff ptr (off 2) z - pokeElemOff ptr (off 3) 0 - pokeElemOff ptr (off 4) r - pokeElemOff ptr (off 5) g - pokeElemOff ptr (off 6) b - pokeElemOff ptr (off 7) a +pokeJustV cp ptr nv sh = do + zipWithM_ f [0..] [x,y,z,1,r,g,b,a,nx,ny,nz,1] return (nv + 1) where - off i = nv*nShapeVerxComp + i + f i = pokeElemOff ptr (nv*nShapeVerxComp + i) V3 x y z = _svPos sh V4 r g b a = _svCol sh + V3 nx ny nz = cp + --nx = x + --ny = y + --nz = z - 1 pokeLayVerxs :: MV.MVector (PrimState IO) (FullShader ,VBO) diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index e15c0bd36..664a25903 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -44,12 +44,11 @@ pairToSV = uncurry ShapeV makeLenses ''ShapeV makeLenses ''ShapeObj makeLenses ''ShapeType ---type Shape' = Stream (Of ShapeObj) IO () type Shape = [ShapeObj] nShapeVerxComp :: Int -nShapeVerxComp = 8 +nShapeVerxComp = 12 deriveJSON defaultOptions ''ShapeType deriveJSON defaultOptions ''ShapeV