Refactor, move towards adding cylinders
This commit is contained in:
+52
-41
@@ -100,34 +100,53 @@ pokeShapeObj
|
||||
{-# INLINE pokeShapeObj #-}
|
||||
pokeShapeObj ptr iptr ieptr counts (Surface shtype shVerts col) = case shtype of
|
||||
TopPrism size -> pokeTopPrism midp col size ptr iptr ieptr counts (VFSM.fromList shVerts)
|
||||
TopBox size -> pokeBox col size ptr iptr ieptr counts shVerts
|
||||
TopCylinder size -> pokeCylinder col size ptr iptr ieptr counts shVerts
|
||||
-- TopCylinder size -> pokeTopPrism midp (size - 2) ptr iptr ieptr counts (VFSM.fromList shVerts)
|
||||
FlatFaces size -> pokeBox col size ptr iptr ieptr counts shVerts
|
||||
RoundedFaces size -> pokeRoundedFaces col size ptr iptr ieptr counts shVerts
|
||||
Cylinder size -> pokeCylinder col size ptr iptr ieptr counts shVerts
|
||||
where
|
||||
midp = centroidNum shVerts
|
||||
|
||||
pokeRoundedFaces :: Point4 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort
|
||||
-> (Int,Int,Int)
|
||||
-> [Point3]
|
||||
-> IO (Int,Int,Int)
|
||||
pokeRoundedFaces col size ptr iptr ieptr (nv,nshapeindices,nei) (tc:bc:svs) = do
|
||||
nv' <- pokeRoundedCurve col ptr tc bc svs nv
|
||||
nsi' <- UV.foldM' (pokeIndex nv iptr) nshapeindices
|
||||
--(memoTopPrismIndices V.! (size - 2))
|
||||
(memoTopPrismIndices V.! (size - 3))
|
||||
nei' <- UV.foldM' (pokeIndex nv ieptr) nei
|
||||
$ memoTopPrismEdgeIndices V.! (size - 3)
|
||||
return (nv',nsi',nei')
|
||||
pokeRoundedFaces _ _ _ _ _ _ _ = undefined
|
||||
|
||||
pokeCylinder :: Point4 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort
|
||||
-> (Int,Int,Int)
|
||||
-> [Point3]
|
||||
-> IO (Int,Int,Int)
|
||||
pokeCylinder col size ptr iptr ieptr (nv,nshapeindices,nei) (tc:bc:svs) = do
|
||||
nv' <- pokeCylinderCurve col size ptr tc bc svs nv
|
||||
--nv' <- VFSM.foldlM' (pokeJustV tc col ptr) nv $ VFSM.fromList svs
|
||||
nsi' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices
|
||||
--(memoCylinderIndices V.! (size - 2))
|
||||
(memoTopPrismIndices V.! (size - 2))
|
||||
nei' <- UV.foldM' (pokeTopPrismEdgeIndex nv ieptr) nei
|
||||
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))
|
||||
nei' <- UV.foldM' (pokeIndex nv ieptr) nei
|
||||
$ memoTopPrismEdgeIndices V.! (size - 3)
|
||||
return (nv',nsi',nei')
|
||||
pokeCylinder _ _ _ _ _ _ _ = undefined
|
||||
|
||||
pokeCylinderCurve col size ptr tc bc svs nv = go True svs nv
|
||||
pokeRoundedCurve :: Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
|
||||
pokeRoundedCurve 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
|
||||
|
||||
pokeCylinderEnds = undefined
|
||||
pokeCylinderCaps :: Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO 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
|
||||
|
||||
pokeBox :: Point4 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort
|
||||
-> (Int,Int,Int)
|
||||
@@ -136,9 +155,9 @@ pokeBox :: Point4 -> Int -> Ptr Float -> Ptr GLushort -> Ptr GLushort
|
||||
{-# INLINE pokeBox #-}
|
||||
pokeBox col size ptr iptr ieptr (nv,nshapeindices,nei) svs = do
|
||||
nv' <- VFSM.foldM' (pokeBoxSurface col ptr svs) nv $ VFSM.fromList $ boxSurfaces size
|
||||
nshapeindices' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices
|
||||
nshapeindices' <- UV.foldM' (pokeIndex nv iptr) nshapeindices
|
||||
(memoFlatIndices V.! (size -3))
|
||||
nei' <- UV.foldM' (pokeTopPrismEdgeIndex nv ieptr) nei
|
||||
nei' <- UV.foldM' (pokeIndex nv ieptr) nei
|
||||
$ memoBoxEdgeIndices V.! (size - 3)
|
||||
return (nv', nshapeindices', nei')
|
||||
|
||||
@@ -166,9 +185,6 @@ boxSurfaces' :: Int -> [[Int]]
|
||||
boxSurfaces' n = [0 .. n -1]
|
||||
: reverse [n .. n * 2-1]
|
||||
: map (map ((2*n)+)) [[4*i,4*i+1,4*i+2,4*i+3] | i <- [0..n-1]]
|
||||
-- : map f [0,1 .. n - 1]
|
||||
where
|
||||
f x = map (`mod` (n *2)) [x, x+n, x+n+1, x+1]
|
||||
|
||||
pokeTopPrism :: Point3 -> Point4 -> Int -> Ptr Float -> Ptr GLushort
|
||||
-> Ptr GLushort
|
||||
@@ -179,17 +195,20 @@ 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))
|
||||
nedgeindices' <- UV.foldM' (pokeTopPrismEdgeIndex nv ieptr) nedgeindices
|
||||
--(memoTopPrismIndices V.! (size - 2))
|
||||
(memoTopPrismIndices V.! (size - 3))
|
||||
nedgeindices' <- UV.foldM' (pokeIndex nv ieptr) nedgeindices
|
||||
(memoTopPrismEdgeIndices V.! (size - 3))
|
||||
return (nv', nshapeindices', nedgeindices')
|
||||
|
||||
pokeTopPrismEdgeIndex :: Int -> Ptr GLushort
|
||||
-> Int
|
||||
-> Int
|
||||
pokeIndex
|
||||
:: Int -- ^ base index
|
||||
-> Ptr GLushort
|
||||
-> Int -- ^ number poked
|
||||
-> Int -- ^ index offset
|
||||
-> IO Int
|
||||
--{-# INLINE pokeTopPrismEdgeIndex #-}
|
||||
pokeTopPrismEdgeIndex nv eiptr nedgeindices ioff = do
|
||||
{-# INLINE pokeIndex #-}
|
||||
pokeIndex nv eiptr nedgeindices ioff = do
|
||||
pokeElemOff eiptr nedgeindices (fromIntegral $ nv + ioff)
|
||||
return $ nedgeindices + 1
|
||||
|
||||
@@ -209,7 +228,7 @@ triangulateIndices :: Int -> [Int]
|
||||
triangulateIndices i = concatMap f [0..i-3]
|
||||
where
|
||||
f x | even x = [0,(x+1),(x+2)]
|
||||
| odd x = [0,(x+2),(x+1)]
|
||||
| otherwise = [0,(x+2),(x+1)]
|
||||
|
||||
memoFlatIndices :: V.Vector (UV.Vector Int)
|
||||
memoFlatIndices = V.generate 10
|
||||
@@ -217,12 +236,7 @@ memoFlatIndices = V.generate 10
|
||||
|
||||
memoTopPrismIndices :: V.Vector (UV.Vector Int)
|
||||
memoTopPrismIndices = V.generate 10
|
||||
$ UV.fromList . topPrismIndices . (+ 2)
|
||||
|
||||
memoCylinderIndices :: V.Vector (UV.Vector Int)
|
||||
memoCylinderIndices = V.generate 10
|
||||
$ UV.fromList . cylinderIndices . (+ 2)
|
||||
-- $ UV.fromList . topPrismIndices . (+ 2)
|
||||
$ UV.fromList . topPrismIndices . (+ 3)
|
||||
|
||||
memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
|
||||
memoTopPrismEdgeIndices = V.generate 10
|
||||
@@ -258,6 +272,12 @@ 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
|
||||
|
||||
topPrismIndices :: Int -> [Int]
|
||||
topPrismIndices n = concatMap f [1..n-2] -- triangles on top face
|
||||
++ concatMap f' [1..n-2] -- triangles on bottom face
|
||||
@@ -271,20 +291,11 @@ topPrismIndices n = concatMap f [1..n-2] -- triangles on top face
|
||||
g x = [2*x,2*x+1,2*x+3
|
||||
,2*x,2*x+3,2*x+2]
|
||||
|
||||
cylinderIndices :: Int -> [Int]
|
||||
cylinderIndices 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
|
||||
f x = [0,2*x,2*x+2]
|
||||
f' x = [1,2*x+3,2*x+1]
|
||||
g x = [2*x,2*x+1,2*x+3
|
||||
,2*x,2*x+3,2*x+2]
|
||||
|
||||
-- consider changing the position to a vec4
|
||||
-- and just doing two pokes rather than seven
|
||||
-- (especially if adding normal data)
|
||||
pokeJustV :: Point3
|
||||
pokeJustV
|
||||
:: Point3
|
||||
-> Point4
|
||||
-> Ptr Float
|
||||
-> Int
|
||||
|
||||
Reference in New Issue
Block a user