Make cylinders have flat ends

src/Shader/Poke.hs

@@ -181,7 +181,8 @@ pokeCylinder ::
     IO (Int, Int, Int)
 {-# INLINE pokeCylinder #-}
 pokeCylinder sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
-    nv' <- pokeRoundedCurve xdata col ptr tc bc svs nv >>= pokeCylinderCaps xdata col ptr tc bc svs
+    nv' <- pokeRoundedCurve xdata col ptr tc bc svs nv
+         >>= pokeCylinderCaps xdata col ptr tc bc svs
     nsi' <-
         UV.foldM'
             (pokeIndex nv iptr)
@@ -210,12 +211,14 @@ pokeRoundedCurve xdata col ptr tc bc = go True
 
 pokeCylinderCaps :: Float -> Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
 {-# INLINE pokeCylinderCaps #-}
-pokeCylinderCaps xdata col ptr tc bc = go True
+pokeCylinderCaps xdata col ptr tc bc (a:b:as) = go True (a:b:as)
   where
---    go True (x : xs) n = pokeJustVInvNormal xdata tc col ptr n x >>= go False xs
+    n1 = a - b
---    go False (x : xs) n = pokeJustVInvNormal xdata bc col ptr n x >>= go True xs
+    n2 = b - a
-    go True (x : xs) n = pokeFlatV xdata tc col ptr n x >>= go False xs
+    --go True (x : xs) n = pokeJustVInvNormal xdata tc col ptr n x >>= go False xs
-    go False (x : xs) n = pokeFlatV xdata bc col ptr n x >>= go True xs
+    --go False (x : xs) n = pokeJustVInvNormal xdata bc col ptr n x >>= go True xs
+    go True (x : xs) n = pokeFlatV xdata n1 col ptr n x >>= go False xs
+    go False (x : xs) n = pokeFlatV xdata n2 col ptr n x >>= go True xs
     go _ [] n = return n
 
 pokeBox ::
@@ -446,23 +449,23 @@ pokeJustV xdata cp col ptr nv sh = do
     V3 x y z = sh
     V3 nx ny nz = cp
 
---pokeJustVInvNormal ::
+pokeJustVInvNormal ::
---    Float ->
+    Float ->
---    Point3 ->
+    Point3 ->
---    Point4 ->
+    Point4 ->
---    Ptr Float ->
+    Ptr Float ->
---    Int ->
+    Int ->
---    Point3 ->
+    Point3 ->
---    IO Int
+    IO Int
---{-# INLINE pokeJustVInvNormal #-}
+{-# INLINE pokeJustVInvNormal #-}
---pokeJustVInvNormal xdata cp col ptr nv sh = do
+pokeJustVInvNormal xdata cp col ptr nv sh = do
---    pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata)
+    pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata)
---    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col)
+    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col)
---    pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1)
+    pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1)
---    return (nv + 1)
+    return (nv + 1)
---  where
+  where
---    V3 x y z = sh
+    V3 x y z = sh
---    V3 nx ny nz = (2 * sh) - cp
+    V3 nx ny nz = (2 * sh) - cp
 
 pokeFlatV ::
     Float ->
@@ -481,7 +484,6 @@ pokeFlatV xdata norm col ptr nv sh = do
   where
     V3 x y z = sh
     V3 nx ny nz = sh - norm
---    V3 nx ny nz = norm
 
 pokeLayVerxs ::
     MV.MVector (PrimState IO) (Shader, VBO) ->