updates to the ply writer

noinia · Nov 23, 2024 · a506cd6 · a506cd6
1 parent fe98c9d
commit a506cd6
Show file tree

Hide file tree

Showing 2 changed files with 64 additions and 35 deletions.
diff --git a/hgeometry-examples/lowerEnv/Main.hs b/hgeometry-examples/lowerEnv/Main.hs
@@ -3,19 +3,25 @@ module Main(main) where
 
 import           Control.Lens
 import qualified Data.Foldable as F
+import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Map as Map
+import           HGeometry.Box
 import           HGeometry.Ext
+import           HGeometry.HyperPlane.NonVertical
 import           HGeometry.Number.Real.Rational
 import           HGeometry.Plane.LowerEnvelope
+import           HGeometry.Plane.LowerEnvelope.Connected
 import           HGeometry.PlaneGraph
 import           HGeometry.PlaneGraph.Instances
 import           HGeometry.Point
-import           HGeometry.Triangle
-import           HGeometry.VoronoiDiagram.ViaLowerEnvelope
+import           HGeometry.Transformation
+import           HGeometry.Vector
+import           HGeometry.VoronoiDiagram.ViaLowerEnvelope (pointToPlane)
 import           Ipe
 import           PLY.Writer
 import           System.OsPath
-import           Test.QuickCheck
+-- import           Test.QuickCheck
 
 --------------------------------------------------------------------------------
 
@@ -32,16 +38,37 @@ myPlanes = NonEmpty.fromList $ zipWith (\i p -> pointToPlane p :+ (i,p)) [0..]
            , Point2 48 144
            ]
 
-verticesOf = NonEmpty.fromList . foldMap F.toList . trianglesOf
-trianglesOf _ = [ Triangle (origin :+ 0) (Point3 10 0 1  :+ 1) (Point3 0 10 2  :+ 2) ]
+-- verticesOf    = NonEmpty.fromList . foldMap F.toList . trianglesOf
+-- trianglesOf _ = [ Triangle (origin :+ 0) (Point3 10 0 1  :+ 1) (Point3 0 10 2  :+ 2) ]
 
 
-  -- \case
-  -- ParallelStrips _      -> undefined
-  -- ConnectedEnvelope env -> undefined
-
--- trianglesOf env = []
+-- | Render a minimization diagram
+renderMinimizationDiagram     :: (Plane_ plane r, Ord r, Fractional r)
+                              => MinimizationDiagram r plane
+                              -> ( NonEmpty (Point 3 r :+ Int)
+                                 , NonEmpty (NonEmpty Int)
+                                 )
+renderMinimizationDiagram env = (NonEmpty.fromList vs, NonEmpty.fromList fs)
+  where
+    (_,vs,fs) = foldr f (0,[],[]) . Map.toAscList . asMap $ env
+    f (h,reg) acc@(i,vsAcc,fsAcc) = case reg of
+        Bounded pts     -> let k     = length pts
+                               vs'   = zipWith (\q@(Point2 x y) j ->
+                                                  let z = evalAt q h
+                                                  in  Point3 x y z :+ j) pts face'
+                               face' = take k [i,(i+1)..]
+                           in ( i+k
+                              , vs' <> vsAcc
+                              , NonEmpty.fromList face' : fsAcc
+                              )
+        Unbounded _ _ _ -> acc
 
 main :: IO ()
-main = renderOutputToFile [osp|myLowerEnv.ply|] (verticesOf $ lowerEnvelope myPlanes)
-                                                (trianglesOf $ lowerEnvelope myPlanes)
+main = case lowerEnvelope myPlanes of
+         ParallelStrips _      -> pure ()
+         ConnectedEnvelope env -> renderOutputToFile [osp|myLowerEnv.ply|] vs' fs
+           where
+             m       = 20
+             maxP    = Point3 m m m
+             vs'     = fitToBox (Box (maxP&vector %~ negated) maxP) vs
+             (vs,fs) = renderMinimizationDiagram env
diff --git a/hgeometry/ply/src/PLY/Writer.hs b/hgeometry/ply/src/PLY/Writer.hs
@@ -21,48 +21,50 @@ import qualified Data.Foldable as F
 import           Data.Foldable1
 import           HGeometry.Ext
 import           HGeometry.Point
-import           HGeometry.Triangle
 import qualified System.File.OsPath as File
 import           System.OsPath
 
 --------------------------------------------------------------------------------
 
 -- | Writes the the points and triangles to a file in PLY format.
-renderOutputToFile           :: (Foldable1 f, Point_ point 3 r, Show r)
-                             => OsPath -> f (point :+ Int)
-                             -> [Triangle (point :+ Int)]
-                             -> IO ()
+renderOutputToFile           :: ( Foldable1 f, Foldable1 g, Foldable1 face
+                                , Point_ point 3 r, Show r)
+                             => OsPath -> f (point :+ Int) -> g (face Int) -> IO ()
 renderOutputToFile fp pts ts = File.writeFile fp $ renderOutput pts ts
 
--- | Generates the content of the PLY file for the given non-empty list of points and the
--- list of triangles
---  assumes points are 0 indexed.
-renderOutput                             :: (Foldable1 f, Point_ point 3 r, Show r)
-                                         => f (point :+ Int) -> [Triangle (point :+ Int)]
-                                         -> Char8.ByteString
-renderOutput (F.toList -> pts) ts =
-    Char8.unlines $ hdr <> map renderPt pts <> map renderTri ts
+-- | Generates the content of the PLY file for the given non-empty list of vertices and
+-- the non-empty list of convex faces.
+--
+-- Each face is given by a non-empty list of vertexId's, which are assumed to be
+-- 0-indexed.
+--
+renderOutput                :: ( Foldable1 f, Foldable1 g
+                               , Foldable1 face
+                               , Point_ point 3 r
+                               , Show r)
+                            => f (point :+ Int) -> g (face Int) -> Char8.ByteString
+renderOutput vertices faces =
+    Char8.unlines $ hdr <> map renderVtx (F.toList vertices) <> map renderFace (F.toList faces)
   where
     hdr = ["ply"
           , "format ascii 1.0"
-          ,"element vertex " <> (showT $ length pts)
+          ,"element vertex " <> (showT $ F.length vertices)
           ,"property float32 x"
           ,"property float32 y"
           ,"property float32 z"
-          ,"element face " <> (showT $ length ts)
+          ,"element face " <> (showT $ F.length faces)
           ,"property list uchar int vertex_index"
           ,"end_header"
           ]
 
--- | Writes a Point to ply format
-renderPt          :: (Point_ point 3 r, Show r) => (point :+ extra) -> Char8.ByteString
-renderPt (p :+ _) = let Point3 x y z = over coordinates showT $ p^.asPoint
-                    in Char8.unwords [x,y,z]
+-- | Writes a vertex to ply format
+renderVtx          :: (Point_ point 3 r, Show r) => (point :+ extra) -> Char8.ByteString
+renderVtx (p :+ _) = let Point3 x y z = over coordinates showT $ p^.asPoint
+                     in Char8.unwords [x,y,z]
 
--- | Writes a triangle to ply format
-renderTri                  :: (Point_ point 3 r, Show r)
-                           => Triangle (point :+ Int) -> Char8.ByteString
-renderTri (Triangle p q r) = let i a = showT $ a^.extra in Char8.unwords ["3",i p, i q, i r]
+-- | Writes a face to ply format.
+renderFace      :: Foldable1 face => face Int -> Char8.ByteString
+renderFace face = Char8.unwords . map showT $ (F.length face) : (F.toList face)
 
 -- | Helper to output stuff to bytestrings
 showT :: Show a => a -> Char8.ByteString