justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2023-04-15 10:55:59 +01:00
parent 44f64f4b47
commit 8ab75fb24a
11 changed files with 64 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/DisplayInventory.hs
+1
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
--{-# OPTIONS_GHC -fno-full-laziness #-}
module Dodge.DisplayInventory ( module Dodge.DisplayInventory (
toggleCombineInv, toggleCombineInv,
src/Dodge/Floor.hs
+5 -5
View File
@@ -20,11 +20,11 @@ initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
initialRoomTree = annoToRoomTree initialAnoTree initialRoomTree = annoToRoomTree initialAnoTree
--initialRoomTree = annoToRoomTree startWorldTreeTest --initialRoomTree = annoToRoomTree startWorldTreeTest
startWorldTreeTest :: Annotation --startWorldTreeTest :: Annotation
startWorldTreeTest = --startWorldTreeTest =
OnwardList $ -- OnwardList $
[ IntAnno $ AnTree . startRoom -- [ IntAnno $ AnTree . startRoom
] -- ]
initialAnoTree :: Annotation initialAnoTree :: Annotation
initialAnoTree = initialAnoTree =
src/Dodge/Update.hs
-3
View File
@@ -341,9 +341,6 @@ zoneCreatures w =
w & crZoning w & crZoning
.~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures) .~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
-- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
-- zn (_creatures w)
updateCreatureSoundPositions :: World -> World updateCreatureSoundPositions :: World -> World
updateCreatureSoundPositions w = updateCreatureSoundPositions w =
M.foldlWithKey' insertSound w M.foldlWithKey' insertSound w
src/Dodge/Zoning/Base.hs
-5
View File
@@ -6,7 +6,6 @@ module Dodge.Zoning.Base
, zoneOfRect , zoneOfRect
, zoneMonoid , zoneMonoid
, deZoneIX , deZoneIX
, zoneOfPoint''
, zoneOfCirc , zoneOfCirc
, zonesAroundPoint , zonesAroundPoint
, xIntercepts , xIntercepts
@@ -87,10 +86,6 @@ zoneMonoid (V2 x y) a = IM.insertWith f x $! IM.singleton y a
deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet) deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet)
deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i
zoneOfPoint'' :: Float -> Point2 -> Int2
{-# INLINE zoneOfPoint'' #-}
zoneOfPoint'' s = fmap (divTo s)
zonesAroundPoint :: Float -> Point2 -> [Int2] zonesAroundPoint :: Float -> Point2 -> [Int2]
zonesAroundPoint s p = [V2 a b | a <- [x -1 .. x + 1], b <- [y -1 .. y + 1]] zonesAroundPoint s p = [V2 a b | a <- [x -1 .. x + 1], b <- [y -1 .. y + 1]]
where where
src/Dodge/Zoning/Cloud.hs
+4 -4
View File
@@ -7,13 +7,13 @@ import qualified IntMapHelp as IM
import Dodge.Zoning.Common import Dodge.Zoning.Common
clsNearPoint :: Point2 -> World -> [Cloud] clsNearPoint :: Point2 -> World -> [Cloud]
clsNearPoint = nearPoint' clZoneSize _clZoning clsNearPoint = nearPoint clZoneSize _clZoning
clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
clsNearSeg = nearSeg' clZoneSize _clZoning clsNearSeg = nearSeg clZoneSize _clZoning
clsNearRect :: Point2 -> Point2 -> World -> [Cloud] clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
clsNearRect = nearRect' clZoneSize _clZoning clsNearRect = nearRect clZoneSize _clZoning
clsNearCirc :: Point2 -> Float -> World -> [Cloud] clsNearCirc :: Point2 -> Float -> World -> [Cloud]
clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r) clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -22,7 +22,7 @@ clZoneSize :: Float
clZoneSize = 20 clZoneSize = 20
zoneOfCl :: Cloud -> Int2 zoneOfCl :: Cloud -> Int2
zoneOfCl = zoneOfPoint'' clZoneSize . xyV3 . _clPos zoneOfCl = zoneOfPoint clZoneSize . xyV3 . _clPos
zoneCloud :: Cloud -> IM.IntMap (IM.IntMap [Cloud]) -> IM.IntMap (IM.IntMap [Cloud]) zoneCloud :: Cloud -> IM.IntMap (IM.IntMap [Cloud]) -> IM.IntMap (IM.IntMap [Cloud])
zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl] zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl]
src/Dodge/Zoning/Common.hs
+9 -9
View File
@@ -5,14 +5,14 @@ import Dodge.Zoning.Base
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
nearPoint' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m nearPoint :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
{-# INLINE nearPoint' #-} {-# INLINE nearPoint #-}
nearPoint' size f p w = zoneExtract (zoneOfPoint size p) (f w) nearPoint size f p = zoneExtract (zoneOfPoint size p) . f
nearSeg' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m nearSeg :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearSeg' #-} {-# INLINE nearSeg #-}
nearSeg' size f sp ep w = zonesExtract (f w) (zoneOfSeg size sp ep) nearSeg size f sp ep w = zonesExtract (f w) (zoneOfSeg size sp ep)
nearRect' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m nearRect :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearRect' #-} {-# INLINE nearRect #-}
nearRect' size f sp ep w = zonesExtract (f w) (zoneOfRect size sp ep) nearRect size f sp ep w = zonesExtract (f w) (zoneOfRect size sp ep)
src/Dodge/Zoning/Creature.hs
+4 -3
View File
@@ -12,7 +12,7 @@ import Dodge.Zoning.Common
crIXsNearPoint :: Point2 -> World -> IS.IntSet crIXsNearPoint :: Point2 -> World -> IS.IntSet
--crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning) --crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
crIXsNearPoint = nearPoint' crZoneSize _crZoning crIXsNearPoint = nearPoint crZoneSize _crZoning
crsNearPoint :: Point2 -> World -> [Creature] crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
@@ -24,7 +24,7 @@ crsNearSeg sp ep w =
$ crixsNearSeg sp ep w $ crixsNearSeg sp ep w
crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crixsNearSeg = nearSeg' crZoneSize _crZoning crixsNearSeg = nearSeg crZoneSize _crZoning
--crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep) --crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
@@ -34,7 +34,7 @@ crsNearCirc :: Point2 -> Float -> World -> [Creature]
crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
crsNearRect = nearRect' crZoneSize _crZoning crsNearRect = nearRect crZoneSize _crZoning
crZoneSize :: Float crZoneSize :: Float
crZoneSize = 15 crZoneSize = 15
@@ -50,6 +50,7 @@ minCrIXOn f is w = fst <$> IS.foldl' g Nothing is
h cr = (cr, f cr) h cr = (cr, f cr)
zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet) zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
{-# INLINE zoneCreature #-}
zoneCreature cr im = foldl' f im (zoneOfCr cr) zoneCreature cr im = foldl' f im (zoneOfCr cr)
where where
f im' i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im' f im' i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im'
src/Dodge/Zoning/Pathing.hs
+7 -7
View File
@@ -10,13 +10,13 @@ import qualified Data.Set as Set
import Dodge.Zoning.Common import Dodge.Zoning.Common
pnsNearPoint :: Point2 -> World -> [(Int, Point2)] pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
pnsNearPoint = nearPoint' pnZoneSize _pnZoning pnsNearPoint = nearPoint pnZoneSize _pnZoning
pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)] pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearSeg = nearSeg' pnZoneSize _pnZoning pnsNearSeg = nearSeg pnZoneSize _pnZoning
pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)] pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearRect = nearRect' pnZoneSize _pnZoning pnsNearRect = nearRect pnZoneSize _pnZoning
pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)] pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)]
pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r) pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -25,20 +25,20 @@ pnZoneSize :: Float
pnZoneSize = 50 pnZoneSize = 50
zoneOfPn :: (Int, Point2) -> Int2 zoneOfPn :: (Int, Point2) -> Int2
zoneOfPn = zoneOfPoint'' pnZoneSize . snd zoneOfPn = zoneOfPoint pnZoneSize . snd
zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (IM.IntMap [(Int, Point2)]) zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (IM.IntMap [(Int, Point2)])
zonePn pn = zoneMonoid (zoneOfPn pn) [pn] zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
pesNearPoint :: Point2 -> World -> Set PathEdgeNodes pesNearPoint :: Point2 -> World -> Set PathEdgeNodes
pesNearPoint = nearPoint' peZoneSize _peZoning pesNearPoint = nearPoint peZoneSize _peZoning
--pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning) --pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning)
pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
pesNearSeg = nearSeg' peZoneSize _peZoning pesNearSeg = nearSeg peZoneSize _peZoning
pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes
pesNearRect = nearRect' peZoneSize _peZoning pesNearRect = nearRect peZoneSize _peZoning
pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes
pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r) pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
src/Dodge/Zoning/Wall.hs
+3 -3
View File
@@ -20,14 +20,14 @@ import qualified IntMapHelp as IM
import Dodge.Zoning.Common import Dodge.Zoning.Common
wlIXsNearPoint :: Point2 -> World -> IS.IntSet wlIXsNearPoint :: Point2 -> World -> IS.IntSet
wlIXsNearPoint = nearPoint' wlZoneSize _wlZoning wlIXsNearPoint = nearPoint wlZoneSize _wlZoning
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
{-# INLINE wlIXsNearSeg #-} {-# INLINE wlIXsNearSeg #-}
wlIXsNearSeg = nearSeg' wlZoneSize _wlZoning wlIXsNearSeg = nearSeg wlZoneSize _wlZoning
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
wlIXsNearRect = nearRect' wlZoneSize _wlZoning wlIXsNearRect = nearRect wlZoneSize _wlZoning
wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r) wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)
src/Render.hs
+1 -1
View File
@@ -150,7 +150,7 @@ renderShadows ::
RenderData -> RenderData ->
IO () IO ()
renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture lightPoints pdata = do renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture lightPoints pdata = do
glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboLighting . _1 . unFBO --(_unFBO (fst (_fboLighting pdata))) glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboLighting . _1 . unFBO
let llinesShad = _lightingLineShadowShader pdata let llinesShad = _lightingLineShadowShader pdata
lcapShad = _lightingCapShader pdata lcapShad = _lightingCapShader pdata
lwallShad = _lightingWallShadShader pdata lwallShad = _lightingWallShadShader pdata
src/Shader/Poke.hs
+30 -22
View File
@@ -3,7 +3,6 @@ module Shader.Poke (
pokeLayVerxs, pokeLayVerxs,
pokeArrayOff, pokeArrayOff,
pokeShape, pokeShape,
pokeShape',
pokeWallsWindows, pokeWallsWindows,
memoTopPrismEdgeIndices, memoTopPrismEdgeIndices,
pokeFloors, pokeFloors,
@@ -100,14 +99,14 @@ pokeW ptr i' ((V2 a b, V2 c d), V4 e f g h) = do
pokeElemOff ptr (i + 7) h pokeElemOff ptr (i + 7) h
return $ i' + 1 return $ i' + 1
pokeShape' :: --pokeShape' ::
Ptr Float -> -- Ptr Float ->
Ptr GLushort -> -- Ptr GLushort ->
Ptr GLushort -> -- Ptr GLushort ->
(Int, Int, Int) -> -- (Int, Int, Int) ->
[Surface] -> -- [Surface] ->
IO (Int, Int, Int) -- IO (Int, Int, Int)
pokeShape' = pokeShape $ const False --pokeShape' = pokeShape $ const False
pokeShape :: pokeShape ::
(Surface -> Bool) -> (Surface -> Bool) ->
@@ -117,6 +116,7 @@ pokeShape ::
(Int, Int, Int) -> (Int, Int, Int) ->
[Surface] -> [Surface] ->
IO (Int, Int, Int) IO (Int, Int, Int)
{-# INLINE pokeShape #-}
pokeShape shadowtest ptr iptr ieptr is = pokeShape shadowtest ptr iptr ieptr is =
VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
. VFSM.fromList . VFSM.fromList
@@ -228,12 +228,15 @@ pokeBox ::
IO (Int, Int, Int) IO (Int, Int, Int)
{-# INLINE pokeBox #-} {-# INLINE pokeBox #-}
pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do
nv' <- VFSM.foldM' (pokeBoxSurface xdata col ptr svsv) nv $ VFSM.fromList $ boxSurfaces size nv' <- VFSM.foldM' (pokeBoxSurface xdata col ptr svsv) nv $ VFSM.fromList $ memoBoxSurfaces V.! size
-- nv' <- VFSM.foldM' (pokeBoxSurface xdata col ptr svsv) nv $ VFSM.fromList $ boxSurfaces size
nsi' <- nsi' <-
UV.foldM' UV.foldM'
(pokeIndex nv iptr) (pokeIndex nv iptr)
nsi nsi
(memoFlatIndices V.! (size -3)) (memoFlatIndices V.! (size -3))
-- VFSM.foldM' (pokeIndex nv iptr) nsi
-- (VFSM.fromList . concatMap polyToTris $ boxSurfacesIndices size)
nei' <- nei' <-
if sfid if sfid
then return nei then return nei
@@ -264,6 +267,7 @@ pokeBoxSurface xdata col ptr vs n is =
-- should probably memoize this -- should probably memoize this
boxSurfaces :: Int -> [[Int]] boxSurfaces :: Int -> [[Int]]
{-# INLINE boxSurfaces #-}
boxSurfaces size = boxSurfaces size =
[0, 2 .. size * 2 -1] : [0, 2 .. size * 2 -1] :
[1, 3 .. size * 2] : [1, 3 .. size * 2] :
@@ -271,7 +275,12 @@ boxSurfaces size =
where where
f x = map (`mod` (size * 2)) [x, x + 1, x + 3, x + 2] f x = map (`mod` (size * 2)) [x, x + 1, x + 3, x + 2]
memoBoxSurfaces :: V.Vector [[Int]]
{-# INLINE memoBoxSurfaces #-}
memoBoxSurfaces = V.generate 10 $ boxSurfaces
boxSurfacesIndices :: Int -> [[Int]] boxSurfacesIndices :: Int -> [[Int]]
{-# INLINE boxSurfacesIndices #-}
boxSurfacesIndices n = boxSurfacesIndices n =
[0 .. n -1] : [0 .. n -1] :
reverse [n .. n * 2 -1] : reverse [n .. n * 2 -1] :
@@ -304,11 +313,13 @@ memoTopPrismIndices =
UV.fromList . topPrismIndices . (+ 3) UV.fromList . topPrismIndices . (+ 3)
memoCylinderIndices :: V.Vector (UV.Vector Int) memoCylinderIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoCylinderIndices #-}
memoCylinderIndices = memoCylinderIndices =
V.generate 10 $ V.generate 10 $
UV.fromList . cylinderIndices . (+ 3) UV.fromList . cylinderIndices . (+ 3)
memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int) memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoTopPrismEdgeIndices #-}
memoTopPrismEdgeIndices = memoTopPrismEdgeIndices =
V.generate 10 $ V.generate 10 $
UV.fromList . topPrismEdgeIndices . (+ 3) UV.fromList . topPrismEdgeIndices . (+ 3)
@@ -317,28 +328,21 @@ topPrismEdgeIndices ::
-- | the number of vertices on the top surface, ie. half the total -- | the number of vertices on the top surface, ie. half the total
Int -> Int ->
[Int] [Int]
{-# INLINE topPrismEdgeIndices #-}
topPrismEdgeIndices n = concatMap f [0 .. n -1] topPrismEdgeIndices n = concatMap f [0 .. n -1]
where where
f i = f i =
map map
g g
[ 0 [ 0 , 2 , 1 , 4
, 2 , 0 , 1 , -2 , 3
, 1 , 1 , 3 , -1 , 2
, 4
, 0
, 1
, -2
, 3
, 1
, 3
, -1
, 2
] ]
where where
g j = (2 * i + j) `mod` (2 * n) g j = (2 * i + j) `mod` (2 * n)
memoBoxEdgeIndices :: V.Vector (UV.Vector Int) memoBoxEdgeIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoBoxEdgeIndices #-}
memoBoxEdgeIndices = memoBoxEdgeIndices =
V.generate 10 $ V.generate 10 $
UV.fromList . boxEdgeIndices . (+ 3) UV.fromList . boxEdgeIndices . (+ 3)
@@ -347,6 +351,7 @@ boxEdgeIndices ::
-- | the number of vertices on the top surface, ie. half the total -- | the number of vertices on the top surface, ie. half the total
Int -> Int ->
[Int] [Int]
{-# INLINE boxEdgeIndices #-}
boxEdgeIndices n = concatMap f [0 .. n -1] boxEdgeIndices n = concatMap f [0 .. n -1]
where where
f i = f i =
@@ -367,12 +372,14 @@ boxEdgeIndices n = concatMap f [0 .. n -1]
g j = (i + j) `mod` n g j = (i + j) `mod` n
cylinderIndices :: Int -> [Int] cylinderIndices :: Int -> [Int]
{-# INLINE cylinderIndices #-}
cylinderIndices n = cylinderIndices n =
cylinderRoundIndices n cylinderRoundIndices n
++ polyToTris [2 * n, 2 * n + 2 .. 4 * n - 1] ++ polyToTris [2 * n, 2 * n + 2 .. 4 * n - 1]
++ polyToTris [2 * n + 1, 2 * n + 3 .. 4 * n - 1] ++ polyToTris [2 * n + 1, 2 * n + 3 .. 4 * n - 1]
cylinderRoundIndices :: Int -> [Int] cylinderRoundIndices :: Int -> [Int]
{-# INLINE cylinderRoundIndices #-}
cylinderRoundIndices n = cylinderRoundIndices n =
[ 2 * n -2 [ 2 * n -2
, 2 * n -1 , 2 * n -1
@@ -393,6 +400,7 @@ cylinderRoundIndices n =
] ]
topPrismIndices :: Int -> [Int] topPrismIndices :: Int -> [Int]
{-# INLINE topPrismIndices #-}
topPrismIndices n = topPrismIndices n =
concatMap f [1 .. n -2] -- triangles on top face concatMap f [1 .. n -2] -- triangles on top face
++ concatMap f' [1 .. n -2] -- triangles on bottom face ++ concatMap f' [1 .. n -2] -- triangles on bottom face