Add shading for shapes and the floor

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

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)