Pack shape normals into a word8

src/Shader/Poke.hs

@@ -8,6 +8,8 @@ module Shader.Poke (
     pokeFloors,
 ) where
 
+import Control.Lens
+import Linear
 import Shape.Parameters
 import Color
 import Control.Monad.Primitive
@@ -22,7 +24,6 @@ import Geometry.Data
 import Geometry.Triangulate
 import Geometry.Vector
 import Graphics.GL.Core45
-import Linear.V3 (cross)
 import Picture.Data
 import Shader.Data
 import Shader.Parameters
@@ -263,7 +264,7 @@ pokeBoxSurface :: Float -> Point4 -> Ptr Float -> UV.Vector Point3 -> Int -> [In
 {-# INLINE pokeBoxSurface #-}
 pokeBoxSurface xdata col ptr vs n is =
     UV.foldM'
-        (pokeFlatV xdata norm col ptr)
+        (pokeFlatV xdata pnorm col ptr)
         n
         v
   where
@@ -271,7 +272,7 @@ pokeBoxSurface xdata col ptr vs n is =
     x = v UV.! 0
     y = v UV.! 1
     z = v UV.! 2
-    norm = negate $ cross (x - y) (z - y)
+    pnorm = negate $ cross (x - y) (z - y)
 
 -- should probably memoize this
 boxSurfaces :: Int -> [[Int]]
@@ -434,23 +435,16 @@ topPrismIndices n =
         ]
 
 -- consider changing the position to a vec4
-pokeJustV ::
-    Float ->
-    Point3 ->
-    Point4 ->
-    Ptr Float ->
-    Int ->
-    Point3 ->
-    IO Int
+pokeJustV :: Float -> Point3 -> Point4 -> Ptr Float -> Int -> Point3 -> IO Int
 {-# INLINE pokeJustV #-}
 pokeJustV xdata cp col ptr nv sh = do
     pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata)
-    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col)
-    pokeByteOff ptr (nv *shapeVerxSize + 8 * floatSize) (V4 nx ny nz 1)
+    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (normalToColor8 $ V4 nx ny nz 1)
+    pokeByteOff ptr (nv *shapeVerxSize + 8 * floatSize) (toColor8 col)
     return (nv + 1)
   where
     V3 x y z = sh
-    V3 nx ny nz = cp
+    V3 nx ny nz = cp - sh
 
 pokeFlatV ::
     Float ->
@@ -461,14 +455,19 @@ pokeFlatV ::
     Point3 ->
     IO Int
 {-# INLINE pokeFlatV #-}
-pokeFlatV xdata norm col ptr nv sh = do
+pokeFlatV xdata pnorm col ptr nv sh = do
     pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata)
-    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col)
-    pokeByteOff ptr (nv *shapeVerxSize + 8 * floatSize) (V4 nx ny nz 1)
+    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (normalToColor8 $ V4 nx ny nz 1)
+    pokeByteOff ptr (nv *shapeVerxSize + 8 * floatSize) (toColor8 col)
     return (nv + 1)
   where
     V3 x y z = sh
-    V3 nx ny nz = sh - norm
+    V3 nx ny nz = (sh - pnorm) - V3 x y z
+
+normalToColor8 :: Point4 -> Color8
+normalToColor8 = over each f . normalize
+  where
+    f x = floor $ (x + 1) * 127.5
 
 pokeLayVerxs ::
     MV.MVector (PrimState IO) (Shader, VBO) ->