Cleanup

src/Shader/Poke.hs

@@ -3,7 +3,6 @@ module Shader.Poke (
     pokeLayVerxs,
     pokeArrayOff,
     pokeShape,
-    pokeShape',
     pokeWallsWindows,
     memoTopPrismEdgeIndices,
     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
     return $ i' + 1
 
-pokeShape' ::
-    Ptr Float ->
-    Ptr GLushort ->
-    Ptr GLushort ->
-    (Int, Int, Int) ->
-    [Surface] ->
-    IO (Int, Int, Int)
-pokeShape' = pokeShape $ const False
+--pokeShape' ::
+--    Ptr Float ->
+--    Ptr GLushort ->
+--    Ptr GLushort ->
+--    (Int, Int, Int) ->
+--    [Surface] ->
+--    IO (Int, Int, Int)
+--pokeShape' = pokeShape $ const False
 
 pokeShape ::
     (Surface -> Bool) ->
@@ -117,6 +116,7 @@ pokeShape ::
     (Int, Int, Int) ->
     [Surface] ->
     IO (Int, Int, Int)
+{-# INLINE pokeShape #-}
 pokeShape shadowtest ptr iptr ieptr is =
     VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
         . VFSM.fromList
@@ -228,12 +228,15 @@ pokeBox ::
     IO (Int, Int, Int)
 {-# INLINE pokeBox #-}
 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' <-
         UV.foldM'
             (pokeIndex nv iptr)
             nsi
             (memoFlatIndices V.! (size -3))
+--        VFSM.foldM' (pokeIndex nv iptr) nsi 
+--            (VFSM.fromList . concatMap polyToTris $ boxSurfacesIndices size)
     nei' <-
         if sfid
             then return nei
@@ -264,6 +267,7 @@ pokeBoxSurface xdata col ptr vs n is =
 
 -- should probably memoize this
 boxSurfaces :: Int -> [[Int]]
+{-# INLINE boxSurfaces #-}
 boxSurfaces size =
     [0, 2 .. size * 2 -1] :
     [1, 3 .. size * 2] :
@@ -271,7 +275,12 @@ boxSurfaces size =
   where
     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]]
+{-# INLINE boxSurfacesIndices #-}
 boxSurfacesIndices n =
     [0 .. n -1] :
     reverse [n .. n * 2 -1] :
@@ -304,11 +313,13 @@ memoTopPrismIndices =
         UV.fromList . topPrismIndices . (+ 3)
 
 memoCylinderIndices :: V.Vector (UV.Vector Int)
+{-# INLINE memoCylinderIndices #-}
 memoCylinderIndices =
     V.generate 10 $
         UV.fromList . cylinderIndices . (+ 3)
 
 memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
+{-# INLINE memoTopPrismEdgeIndices #-}
 memoTopPrismEdgeIndices =
     V.generate 10 $
         UV.fromList . topPrismEdgeIndices . (+ 3)
@@ -317,28 +328,21 @@ topPrismEdgeIndices ::
     -- | the number of vertices on the top surface, ie. half the total
     Int ->
     [Int]
+{-# INLINE topPrismEdgeIndices #-}
 topPrismEdgeIndices n = concatMap f [0 .. n -1]
   where
     f i =
         map
             g
-            [ 0
-            , 2
-            , 1
-            , 4
-            , 0
-            , 1
-            , -2
-            , 3
-            , 1
-            , 3
-            , -1
-            , 2
+            [ 0 , 2 , 1 , 4
+            , 0 , 1 , -2 , 3
+            , 1 , 3 , -1 , 2
             ]
       where
         g j = (2 * i + j) `mod` (2 * n)
 
 memoBoxEdgeIndices :: V.Vector (UV.Vector Int)
+{-# INLINE memoBoxEdgeIndices #-}
 memoBoxEdgeIndices =
     V.generate 10 $
         UV.fromList . boxEdgeIndices . (+ 3)
@@ -347,6 +351,7 @@ boxEdgeIndices ::
     -- | the number of vertices on the top surface, ie. half the total
     Int ->
     [Int]
+{-# INLINE boxEdgeIndices #-}
 boxEdgeIndices n = concatMap f [0 .. n -1]
   where
     f i =
@@ -367,12 +372,14 @@ boxEdgeIndices n = concatMap f [0 .. n -1]
         g j = (i + j) `mod` n
 
 cylinderIndices :: Int -> [Int]
+{-# INLINE cylinderIndices #-}
 cylinderIndices n =
     cylinderRoundIndices n
         ++ polyToTris [2 * n, 2 * n + 2 .. 4 * n - 1]
         ++ polyToTris [2 * n + 1, 2 * n + 3 .. 4 * n - 1]
 
 cylinderRoundIndices :: Int -> [Int]
+{-# INLINE cylinderRoundIndices #-}
 cylinderRoundIndices n =
     [ 2 * n -2
     , 2 * n -1
@@ -393,6 +400,7 @@ cylinderRoundIndices n =
         ]
 
 topPrismIndices :: Int -> [Int]
+{-# INLINE topPrismIndices #-}
 topPrismIndices n =
     concatMap f [1 .. n -2] -- triangles on top face
         ++ concatMap f' [1 .. n -2] -- triangles on bottom face