Poke word8 colors for shapes

src/Color.hs

@@ -141,5 +141,5 @@ numColor _ = toV4 (1, 1, 1, 1)
 light4 :: Color -> Color
 light4 = light . light . light . light
 
-toColor256 :: Color -> Color256
+toColor8 :: Color -> Color8
-toColor256 = over each floor . (255 *) . normalizeColor
+toColor8 = over each floor . (255 *) . normalizeColor

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

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

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 #-}

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

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
+shapeVerxSize = sizeOf (0 :: Float) * 8 + 4 * sizeOf (0 :: Word8)
-nShapeVerxComp = sum shapeVerxSizes
 
-shapeVerxSizes :: [Int]
+--nShapeVerxComp :: Int
-shapeVerxSizes = [4,4,4]
+--nShapeVerxComp = sum shapeVerxSizes
+--
+--shapeVerxSizes :: [Int]
+--shapeVerxSizes = [4,4,4]
 
 deriveJSON defaultOptions ''ShadowFidelity
 deriveJSON defaultOptions ''ShapeType