finish switch to vector to take advantage of stream fusion

examples/goat.hs

@@ -26,4 +26,4 @@ main = do
     original = makeRandDNA gen goatDNALength
     goatProps = generateAnimalProperties (makeBoneIdList goatAnimalNode) $ evalGenome goatGenome original
     skelly = animalNodeToSkellyNodeWithProps goatProps goatAnimalNode
-  T.writeFile "wigglygoat.obj" . meshToObj . generateLocalMesh $ skelly
+  T.writeFile "wigglygoat.obj" . potatoMeshToObj . generatePotatoMesh $ skelly

src/AnimalClub/ForeignBindings.hs

@@ -123,7 +123,7 @@ goat_mesh_hs goatPtr = do
   let
     goatProps = generateAnimalProperties (makeBoneIdList goatAnimalNode) $ evalGenome goatGenome dna
     skelly = animalNodeToSkellyNodeWithProps goatProps goatAnimalNode
-    PotatoCMesh v n tc f = toPotatoCMesh . generatePotatoMesh $ skelly
+    PotatoMesh v n tc f = generatePotatoMesh $ skelly
     vl = V.length v
     nl = V.length n
     tcl = V.length tc

src/AnimalClub/Skellygen/Mesh.hs

@@ -5,11 +5,10 @@
 module AnimalClub.Skellygen.Mesh (
 
   PotatoMesh(..),
+  emptyPotatoMesh,
   potatoMeshToObj,
   transformPotatoMeshM44,
-
-  PotatoCMesh(..),
-  toPotatoCMesh,
+  concatPotatoMesh,
 
   -- old stuff prob can delete
   LocalMesh(..),
@@ -46,28 +45,34 @@ type Face = (Int32,Int32,Int32)
 
 -- indices index all the other data in this representation
 data PotatoMesh a = PotatoMesh {
-  positions   :: [V3 a]
-  , normals   :: [V3 a]
-  , texCoords :: [V2 a]
-  , indices   :: [Face]
+  positions   :: V.Vector (V3 a)
+  , normals   :: V.Vector (V3 a)
+  , texCoords :: V.Vector (V2 a)
+  , indices   :: V.Vector Face
 } deriving (Generic, NFData)
 
+emptyPotatoMesh :: (AnimalFloat a) => PotatoMesh a
+emptyPotatoMesh = PotatoMesh V.empty V.empty V.empty V.empty
+
+
+-- this can probably be improved even more to take advantage of stream fusion
+concatPotatoMesh :: (AnimalFloat a) => [PotatoMesh a] -> PotatoMesh a
+concatPotatoMesh pms = r where
+  foldfn (PotatoMesh p n tc i) (pl, nl, tcl, il, offset) =
+    (pl++[p], nl++[n], tcl++[tc], il++[offseti], newOffset) where
+      offseti = V.map (map3Tuple (+ fromIntegral offset)) i
+      newOffset = offset + V.length p
+  (plf,nlf,tclf,ilf,_) = foldr foldfn ([],[],[],[],0) pms
+  r = PotatoMesh {
+      positions = V.concat plf
+      , normals = V.concat nlf
+      , texCoords = V.concat tclf
+      , indices = V.concat ilf
+    }
+
 map3Tuple :: (a->b) -> (a,a,a) -> (b,b,b)
 map3Tuple f (a1,a2,a3) = (f a1, f a2, f a3)
 
--- | semigroup instance offsets triangle indices appropriately
-instance Semigroup (PotatoMesh a) where
-  (<>) (PotatoMesh p1 n1 tc1 i1) (PotatoMesh p2 n2 tc2 i2) =
-    PotatoMesh
-      (p1++p2)
-      (n1++n2)
-      (tc1++tc2)
-      (i1 ++ map (map3Tuple (+fromIntegral (length p1))) i2)
-
-instance Monoid (PotatoMesh a) where
-  mempty = PotatoMesh [] [] [] []
-  mappend = (<>)
-
 showText :: Show a => a -> T.Text
 showText = T.pack . show
 
@@ -77,43 +82,27 @@ tellV key v = do
   mapM_ (\tv -> tell $ showText tv <> " ") $ v
   tell "\n"
 
-potatoMeshToObj :: (Show a) => PotatoMesh a -> T.Text
+potatoMeshToObj :: (AnimalFloat a) => PotatoMesh a -> T.Text
 potatoMeshToObj (PotatoMesh p n tc i) = execWriter $ do
   tell "#beginning of mesh obj file \ng\n"
-  mapM_ (tellV "v") p
-  mapM_ (tellV "vn") n
-  mapM_ (tellV "vt") tc
+  V.mapM_ (tellV "v") p
+  V.mapM_ (tellV "vn") n
+  V.mapM_ (tellV "vt") tc
   let
     st a = showText (a+1)
     sc a = st a <> "/" <> st a <> "/" <> st a
-  mapM_ (\(a1,a2,a3) -> tell $ "f " <> sc a1 <> " " <> sc a2 <> " " <> sc a3 <> "\n") $ i
+  V.mapM_ (\(a1,a2,a3) -> tell $ "f " <> sc a1 <> " " <> sc a2 <> " " <> sc a3 <> "\n") $ i
 
 transformPotatoMeshM44 :: (AnimalFloat a) => M44 a -> PotatoMesh a -> PotatoMesh a
 transformPotatoMeshM44 t (PotatoMesh p n tc i) = r where
   -- transform the normal (drop translation and invert scale)
   nt n' = signorm $ (transpose (inv33 $ conv_M44_M33_droptrans t)) !* n'
   r = PotatoMesh
-    (map (mul_M44_V3 t) p)
-    (map nt n)
+    (V.map (mul_M44_V3 t) p)
+    (V.map nt n)
     tc
     i
 
--- TODO switch to using this type for mesh building
-data PotatoCMesh a = PotatoCMesh {
- pcm_vertices    :: V.Vector (V3 a)
- , pcm_normals   :: V.Vector (V3 a)
- , pcm_texCoords :: V.Vector (V2 a)
- , pcm_faces     :: V.Vector Face
-}
-
-toPotatoCMesh :: (V.Storable a) => PotatoMesh a -> PotatoCMesh a
-toPotatoCMesh (PotatoMesh p n tc i) = PotatoCMesh p' n' tc' i' where
- p' = V.unfoldr uncons p
- n' = V.unfoldr uncons n
- tc' = V.unfoldr uncons tc
- i' = V.unfoldr uncons i
-
-
 -- old LocalMesh stuff, you can delete this
 
 -- TODO maybe get rid of this and use CMesh only

src/AnimalClub/Skellygen/Skellygen.hs

@@ -97,7 +97,7 @@ generateSinglePotatoMesh ::
   -> PotatoMesh a -- ^ output mesh
 generateSinglePotatoMesh pos ct pt =
  if length' < 1e-6
-  then mempty
+  then emptyPotatoMesh
   else r
  where
   end' = view translation pos
@@ -112,11 +112,11 @@ generateSinglePotatoMesh pos ct pt =
 
   divs = 4 :: Int
 
-  startPoints = map mapfn [(fromIntegral i) * pi / 2.0 | i <- [0..(divs-1)]] where
+  startPoints = map mapfn [(fromIntegral x) * pi / 2.0 | x <- [0..(divs-1)]] where
     mapfn a = start ^+^ upAxis npt where
       npt = V3 (pt * cos a) 0 (pt * sin a)
 
-  endPoints = map mapfn [(fromIntegral i) * pi / 2.0 | i <- [0..(divs-1)]] where
+  endPoints = map mapfn [(fromIntegral x) * pi / 2.0 | x <- [0..(divs-1)]] where
     mapfn a = end ^+^ upAxis npt where
       npt = V3 (ct * cos a) 0 (ct * sin a)
 
@@ -127,7 +127,7 @@ generateSinglePotatoMesh pos ct pt =
   allIndices = sides ++ caps
 
   -- per face normals
-  sideNormals = map mapfn [(fromIntegral i) * pi / 2.0 | i <- [0..(divs-1)]] where
+  sideNormals = map mapfn [(fromIntegral x) * pi / 2.0 | x <- [0..(divs-1)]] where
     mapfn a = upAxis npt where
       -- rotate a little more to get normal for face
       a' = a + pi / fromIntegral divs
@@ -140,15 +140,15 @@ generateSinglePotatoMesh pos ct pt =
   p = map (\(a,b,c) -> [(allPoints !! a), (allPoints !! b), (allPoints !! c)]) allIndices
   -- repeat each normal 6x for each point on the 2 tris of each face
   n = map (\x -> [x,x,x,x,x,x]) allNormals
-  --n = [[V3 1 0 0] | x <- [0..35]]
-  --n = map (\(a,b,c) -> [(allNormals !! a), (allNormals !!b), (allNormals !!c)]) allIndices
   tc = take 6 . repeat $ [V2 0 0 , V2 1 0, V2 0 1, V2 1 1, V2 0 1, V2 1 0]
   i = [(x+0, x+1, x+2)| y <- [0..11], let x = y*3]
+
+  -- you can probably make this more efficient by directly building the vector rather than converting from a list
   r = PotatoMesh {
-      positions = mconcat p
-      , normals = mconcat n
-      , texCoords = mconcat tc
-      , indices = i
+      positions = G.fromList $ mconcat p
+      , normals = G.fromList $ mconcat n
+      , texCoords = G.fromList $ mconcat tc
+      , indices = G.fromList $ i
     }
 
 -- TODO parallelize
@@ -160,20 +160,20 @@ _generatePotatoMesh ::
   -> SkellyNode a -- ^ node to generate
   -> NonEmpty (PotatoMesh a) -- ^ output mesh
 _generatePotatoMesh p_snM44 p_thick skn = selfLocalMesh :| (mconcat cmeshes) where
- thick = _snThickness skn
- relm44 = _snM44Rel skn
- selfLocalMesh = if _snIsPhantom skn
-  then mempty
-  else transformPotatoMeshM44 p_snM44 $ generateSinglePotatoMesh relm44 thick p_thick
- absM44 = p_snM44 !*! relm44
- cmeshes = parMap rdeepseq (toList . _generatePotatoMesh absM44 thick) (_snChildren skn)
+  thick = _snThickness skn
+  relm44 = _snM44Rel skn
+  selfLocalMesh = if _snIsPhantom skn
+    then emptyPotatoMesh
+    else transformPotatoMeshM44 p_snM44 $ generateSinglePotatoMesh relm44 thick p_thick
+  absM44 = p_snM44 !*! relm44
+  cmeshes = parMap rdeepseq (toList . _generatePotatoMesh absM44 thick) (_snChildren skn)
 
 -- TODO switch to G.concat
 generatePotatoMesh ::
   (AnimalFloat a)
   => SkellyNode a -- ^ input top level parent node
   -> PotatoMesh a -- ^ output mesh
-generatePotatoMesh skn = mconcat . toList $ _generatePotatoMesh identity 1.0 skn
+generatePotatoMesh skn = concatPotatoMesh . toList $ _generatePotatoMesh identity 1.0 skn
 
 
 

src/AnimalClub/Skellygen/TRS.hs

@@ -58,12 +58,13 @@ import           Relude
 
 import           AnimalClub.Skellygen.Linear
 import           Control.DeepSeq
+import           Foreign.Storable
 import           GHC.Generics                (Generic)
 import           Lens.Micro.Platform
 import           Linear.Conjugate
 
 -- | constraint kind needed for math operations to work properly (just use Float or Double in practice)
-type AnimalFloat a = (NFData a, Conjugate a, RealFloat a, Epsilon a, Show a)
+type AnimalFloat a = (NFData a, Storable a, Conjugate a, RealFloat a, Epsilon a, Show a)
 
 -- TODO you can probably get rid of these
 type Translation a = V3 a