Add shading for shapes and the floor

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)