diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index e972477ce..54985f0ad 100644 --- a/src/Shader/Poke.hs +++ b/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 --- go False (x : xs) n = pokeJustVInvNormal xdata bc col ptr n x >>= go True xs - go True (x : xs) n = pokeFlatV xdata tc col ptr n x >>= go False xs - go False (x : xs) n = pokeFlatV xdata bc col ptr n x >>= go True xs + n1 = a - b + n2 = b - a + --go True (x : xs) n = pokeJustVInvNormal xdata tc col ptr n x >>= go False 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 :: --- Float -> --- Point3 -> --- Point4 -> --- Ptr Float -> --- Int -> --- Point3 -> --- IO Int ---{-# INLINE pokeJustVInvNormal #-} ---pokeJustVInvNormal 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 + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1) --- return (nv + 1) --- where --- V3 x y z = sh --- V3 nx ny nz = (2 * sh) - cp +pokeJustVInvNormal :: + Float -> + Point3 -> + Point4 -> + Ptr Float -> + Int -> + Point3 -> + IO Int +{-# INLINE pokeJustVInvNormal #-} +pokeJustVInvNormal 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 + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1) + return (nv + 1) + where + V3 x y z = sh + 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) ->