From 3c43caee9cad15e72299dea0e4e32ce53c66a7a8 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 13 Apr 2023 02:30:23 +0100 Subject: [PATCH] Poke word8 colors for shapes --- src/Color.hs | 4 ++-- src/Color/Data.hs | 2 +- src/Preload/Render.hs | 9 +++++++-- src/Shader/Parameters.hs | 5 +++++ src/Shader/Poke.hs | 16 ++++++++++------ src/Shape/Data.hs | 12 ++++++++---- 6 files changed, 33 insertions(+), 15 deletions(-) diff --git a/src/Color.hs b/src/Color.hs index e5cf9ff67..e9c229710 100644 --- a/src/Color.hs +++ b/src/Color.hs @@ -141,5 +141,5 @@ numColor _ = toV4 (1, 1, 1, 1) light4 :: Color -> Color light4 = light . light . light . light -toColor256 :: Color -> Color256 -toColor256 = over each floor . (255 *) . normalizeColor +toColor8 :: Color -> Color8 +toColor8 = over each floor . (255 *) . normalizeColor diff --git a/src/Color/Data.hs b/src/Color/Data.hs index 9b9c2b7f3..422dc4892 100644 --- a/src/Color/Data.hs +++ b/src/Color/Data.hs @@ -32,6 +32,6 @@ type RGBA = Point4 type Color = Point4 -type Color256 = V4 Word8 +type Color8 = V4 Word8 deriveJSON defaultOptions ''PaletteColor diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 36e00a483..5f2a204de 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -67,12 +67,17 @@ preloadRender = do -- setup shape geometry/cap VBO and two VAOs putStrLn "Setup shape VBO, VAO, EBO" - shVBO <- setupVBO (floatSize * nShapeVerxComp) + shVBO <- setupVBO shapeVerxSize shPosVAO <- setupVAOUsingVBO [VertexAttribute 4 GL_FLOAT GL_FALSE 0] shVBO shEBO <- setupEBO shPosVAO -- note the shape shader vao is distinct from the position vao, but they -- share an EBO - shapeshader <- makeShaderUsingVBO "shape/basic" [vert, frag] (toFloatVAs shapeVerxSizes) pmTriangles shVBO + shapeshader <- makeShaderUsingVBO "shape/basic" [vert, frag] + [VertexAttribute 4 GL_FLOAT GL_FALSE 0 + ,VertexAttribute 4 GL_UNSIGNED_BYTE GL_TRUE (fromIntegral 4 * fromIntegral floatSize) + ,VertexAttribute 4 GL_FLOAT GL_FALSE (fromIntegral 4 * fromIntegral (floatSize + ubyteSize)) + ] + pmTriangles shVBO glVertexArrayElementBuffer (shapeshader ^. shaderVAO . vaoName) (shEBO ^. eboName) --setup silhouette edge VAO diff --git a/src/Shader/Parameters.hs b/src/Shader/Parameters.hs index eb5055397..3320b250e 100644 --- a/src/Shader/Parameters.hs +++ b/src/Shader/Parameters.hs @@ -1,5 +1,6 @@ module Shader.Parameters ( floatSize + , ubyteSize , numDrawableElements , numSubElements , glushortSize @@ -8,6 +9,10 @@ module Shader.Parameters import Graphics.GL.Core45 import Foreign +ubyteSize :: Int +ubyteSize = sizeOf (5 :: Word8) +{-# INLINE ubyteSize #-} + floatSize :: Int floatSize = sizeOf (0.5 :: GLfloat) {-# INLINE floatSize #-} diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index c5995921a..7773f19e7 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -9,6 +9,7 @@ module Shader.Poke ( pokeFloors, ) where +import Color import Control.Monad.Primitive import qualified Data.Vector as V import qualified Data.Vector.Fusion.Stream.Monadic as VFSM @@ -426,10 +427,11 @@ pokeJustV :: IO Int {-# INLINE pokeJustV #-} pokeJustV xdata cp col ptr nv sh = do - UV.imapM_ f $ UV.fromList [x, y, z, xdata, r, g, b, a, nx, ny, nz, 1] + pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata) + pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col) + pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1) return (nv + 1) where - f i = pokeElemOff ptr (nv * nShapeVerxComp + i) V3 x y z = sh V4 r g b a = col V3 nx ny nz = cp @@ -444,10 +446,11 @@ pokeJustVInvNormal :: IO Int {-# INLINE pokeJustVInvNormal #-} pokeJustVInvNormal xdata cp col ptr nv sh = do - UV.imapM_ f $ UV.fromList [x, y, z, xdata, r, g, b, a, nx, ny, nz, 1] + pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata) + pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col) + pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1) return (nv + 1) where - f i = pokeElemOff ptr (nv * nShapeVerxComp + i) V3 x y z = sh V4 r g b a = col V3 nx ny nz = (2 * sh) - cp @@ -462,10 +465,11 @@ pokeFlatV :: IO Int {-# INLINE pokeFlatV #-} pokeFlatV xdata norm col ptr nv sh = do - UV.imapM_ f $ UV.fromList [x, y, z, xdata, r, g, b, a, nx, ny, nz, 1] + pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata) + pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col) + pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1) return (nv + 1) where - f i = pokeElemOff ptr (nv * nShapeVerxComp + i) V3 x y z = sh V4 r g b a = col V3 nx ny nz = sh - norm diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index aa70fe75a..259643386 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -8,10 +8,12 @@ module Shape.Data where +import Foreign.Storable import Control.Lens import Data.Aeson import Data.Aeson.TH import Geometry.Data +import Data.Word data ShapeType = FlatFaces { _topBoxSize :: Int } @@ -52,11 +54,13 @@ makeLenses ''ShapeType type Shape = [Surface] -nShapeVerxComp :: Int -nShapeVerxComp = sum shapeVerxSizes +shapeVerxSize = sizeOf (0 :: Float) * 8 + 4 * sizeOf (0 :: Word8) -shapeVerxSizes :: [Int] -shapeVerxSizes = [4,4,4] +--nShapeVerxComp :: Int +--nShapeVerxComp = sum shapeVerxSizes +-- +--shapeVerxSizes :: [Int] +--shapeVerxSizes = [4,4,4] deriveJSON defaultOptions ''ShadowFidelity deriveJSON defaultOptions ''ShapeType