Add cylinder shapes

src/Shader/Poke.hs

@@ -127,8 +127,7 @@ pokeCylinder :: Point4 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort
 pokeCylinder col size ptr iptr ieptr (nv,nshapeindices,nei) (tc:bc:svs) = do
     nv' <- pokeRoundedCurve col ptr tc bc svs nv >>= pokeCylinderCaps col ptr tc bc svs
     nsi' <- UV.foldM' (pokeIndex nv iptr) nshapeindices 
-        --(memoTopPrismIndices     V.! (size - 2))
-        (memoTopPrismIndices     V.! (size - 3))
+        (memoCylinderIndices     V.! (size - 3))
     nei' <- UV.foldM' (pokeIndex nv ieptr) nei
         $ memoTopPrismEdgeIndices V.! (size - 3)
     return (nv',nsi',nei')
@@ -145,8 +144,8 @@ pokeCylinderCaps :: Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -
 pokeCylinderCaps col ptr tc bc svs nv = go True svs nv
   where
     go _ [] n = return n
-    go True (x:xs) n = pokeJustV tc col ptr n x >>= go False xs
-    go False (x:xs) n = pokeJustV bc col ptr n x >>= go True xs
+    go True (x:xs) n = pokeJustVInvNormal tc col ptr n x >>= go False xs
+    go False (x:xs) n = pokeJustVInvNormal bc col ptr n x >>= go True xs
 
 pokeBox :: Point4 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort
     -> (Int,Int,Int)
@@ -195,7 +194,6 @@ pokeTopPrism :: Point3 -> Point4 -> Int -> Ptr Float -> Ptr GLushort
 pokeTopPrism cp col size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
     nv' <- VFSM.foldlM' (pokeJustV cp col ptr) nv svs
     nshapeindices' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices 
-        --(memoTopPrismIndices     V.! (size - 2))
         (memoTopPrismIndices     V.! (size - 3))
     nedgeindices' <- UV.foldM' (pokeIndex nv ieptr) nedgeindices
         (memoTopPrismEdgeIndices V.! (size - 3))
@@ -238,6 +236,10 @@ memoTopPrismIndices :: V.Vector (UV.Vector Int)
 memoTopPrismIndices = V.generate 10 
     $ UV.fromList . topPrismIndices . (+ 3)
 
+memoCylinderIndices :: V.Vector (UV.Vector Int)
+memoCylinderIndices = V.generate 10 
+    $ UV.fromList . cylinderIndices . (+ 3)
+
 memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
 memoTopPrismEdgeIndices = V.generate 10
     $ UV.fromList . topPrismEdgeIndices . (+3)
@@ -272,11 +274,18 @@ boxEdgeIndices n = concatMap f [0..n-1]
       where
         g j = (i + j) `mod` (2*n)
 
---cylinderIndices :: Int -> [Int]
---cylinderIndices n = topPrismIndices n
---    ++ 
---  where
---    x = length $ topPrismIndices n
+cylinderIndices :: Int -> [Int]
+cylinderIndices n = cylinderRoundIndices n
+    ++ triangulate [2*n, 2*n+2 .. 4*n - 1]
+    ++ triangulate [2*n+1, 2*n+3 .. 4*n - 1]
+
+cylinderRoundIndices :: Int -> [Int]
+cylinderRoundIndices n = [2*n-2,2*n-1,1
+        ,2*n-2,1,0]                         -- last side triangle (applies mod 2n)
+    ++ concatMap g [0..n-2]                 -- other triangles on sides
+  where
+    g x = [2*x,2*x+1,2*x+3
+            ,2*x,2*x+3,2*x+2]
 
 topPrismIndices :: Int -> [Int]
 topPrismIndices n = concatMap f [1..n-2]    -- triangles on top face
@@ -311,6 +320,23 @@ pokeJustV cp col ptr nv sh = do
     V4 r g b a  = col
     V3 nx ny nz = cp
 
+pokeJustVInvNormal
+    :: Point3
+    -> Point4
+    -> Ptr Float
+    -> Int
+    -> Point3 
+    -> IO Int
+{-# INLINE pokeJustVInvNormal #-}
+pokeJustVInvNormal cp col ptr nv sh = do
+    zipWithM_ f [0..] [x,y,z,1,r,g,b,a,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
+
 pokeFlatV :: Point3
     -> Point4
     -> Ptr Float