Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Make 2D export reduce/merge polylines again.

  • Loading branch information...
commit 4695b9fb803cc6fdc10d1b94afa4b26aef96ce28 1 parent 3df20b2
@colah authored
View
6 Graphics/Implicit/Export/Render.hs
@@ -64,6 +64,10 @@ import Control.Parallel.Strategies (using, rdeepseq, parListChunk)
-- the mesh are abstracted into the imported files. They are likely what
-- you are interested in.
+-- For the 2D case, we need one last thing, cleanLoopsFromSegs:
+
+import Graphics.Implicit.Export.Render.HandlePolylines ( cleanLoopsFromSegs )
+
getMesh :: ℝ3 -> ℝ3 ->-> Obj3 -> TriangleMesh
getMesh p1@(x1,y1,z1) p2@(x2,y2,z2) res obj =
let
@@ -248,7 +252,7 @@ getContour p1@(x1, y1) p2@(x2, y2) res obj =
|objY0 <- objV | objY1 <- tail objV
] `using` (parListChunk (max 1 $ div ny 32) rdeepseq)
- in concat $ concat $ segs -- (5) merge squares, etc
+ in cleanLoopsFromSegs $ concat $ concat $ segs -- (5) merge squares, etc
View
108 Graphics/Implicit/Export/Render/HandlePolylines.hs
@@ -0,0 +1,108 @@
+-- Implicit CAD. Copyright (C) 2012, Christopher Olah (chris@colah.ca)
+-- Released under the GNU GPL, see LICENSE
+
+module Graphics.Implicit.Export.Render.HandlePolylines (cleanLoopsFromSegs) where
+
+import Graphics.Implicit.Definitions
+import Graphics.Implicit.Export.Render.Definitions
+import GHC.Exts (groupWith)
+import Data.List (sortBy)
+import Data.VectorSpace
+
+cleanLoopsFromSegs :: [Polyline] -> [Polyline]
+cleanLoopsFromSegs =
+ map reducePolyline
+ . joinSegs
+ . filter polylineNotNull
+
+
+joinSegs :: [Polyline] -> [Polyline]
+joinSegs [] = []
+joinSegs (present:remaining) =
+ let
+ findNext ((p3:ps):segs) = if p3 == last present then (Just (p3:ps), segs) else
+ if last ps == last present then (Just (reverse $ p3:ps), segs) else
+ case findNext segs of (res1,res2) -> (res1,(p3:ps):res2)
+ findNext [] = (Nothing, [])
+ in
+ case findNext remaining of
+ (Nothing, _) -> present:(joinSegs remaining)
+ (Just match, others) -> joinSegs $ (present ++ tail match): others
+
+reducePolyline ((x1,y1):(x2,y2):(x3,y3):others) =
+ if (x1,y1) == (x2,y2) then reducePolyline ((x2,y2):(x3,y3):others) else
+ if abs ( (y2-y1)/(x2-x1) - (y3-y1)/(x3-x1) ) < 0.0001
+ || ( (x2-x1) == 0 && (x3-x1) == 0 && (y2-y1)*(y3-y1) > 0)
+ then reducePolyline ((x1,y1):(x3,y3):others)
+ else (x1,y1) : reducePolyline ((x2,y2):(x3,y3):others)
+reducePolyline ((x1,y1):(x2,y2):others) =
+ if (x1,y1) == (x2,y2) then reducePolyline ((x2,y2):others) else (x1,y1):(x2,y2):others
+reducePolyline l = l
+
+polylineNotNull (a:l) = not (null l)
+polylineNotNull [] = False
+
+
+
+{-cleanLoopsFromSegs =
+ connectPolys
+ -- . joinSegs
+ . filter (not . degeneratePoly)
+
+polylinesFromSegsOnGrid = undefined
+
+degeneratePoly [] = True
+degeneratePoly [a,b] = a == b
+degeneratePoly _ = False
+
+data SegOrPoly = Seg (ℝ2) ℝ ℝ2 -- Basis, shift, interval
+ | Poly [ℝ2]
+
+isSeg (Seg _ _ _) = True
+isSeg _ = False
+
+toSegOrPoly :: Polyline -> SegOrPoly
+toSegOrPoly [a, b] = Seg v (a⋅vp) (a⋅v, b⋅v)
+ where
+ v@(va, vb) = normalized (b ^-^ a)
+ vp = (-vb, va)
+toSegOrPoly ps = Poly ps
+
+fromSegOrPoly :: SegOrPoly -> Polyline
+fromSegOrPoly (Seg v@(va,vb) s (a,b)) = [a*^v ^+^ t, b*^v ^+^ t]
+ where t = s*^(-vb, va)
+fromSegOrPoly (Poly ps) = ps
+
+joinSegs :: [Polyline] -> [Polyline]
+joinSegs = map fromSegOrPoly . joinSegs' . map toSegOrPoly
+
+joinSegs' :: [SegOrPoly] -> [SegOrPoly]
+joinSegs' segsOrPolys = polys ++ concat (map joinAligned aligned) where
+ polys = filter (not.isSeg) segsOrPolys
+ segs = filter isSeg segsOrPolys
+ aligned = groupWith (\(Seg basis p _) -> (basis,p)) segs
+
+joinAligned segs@((Seg b z _):_) = mergeAdjacent orderedSegs where
+ orderedSegs = sortBy (\(Seg _ _ (a1,_)) (Seg _ _ (b1,_)) -> compare a1 b1) segs
+ mergeAdjacent (pres@(Seg _ _ (x1a,x2a)) : next@(Seg _ _ (x1b,x2b)) : others) =
+ if x2a == x1b
+ then mergeAdjacent ((Seg b z (x1a,x2b)): others)
+ else pres : mergeAdjacent (next : others)
+ mergeAdjacent a = a
+joinAligned [] = []
+
+connectPolys :: [Polyline] -> [Polyline]
+connectPolys [] = []
+connectPolys (present:remaining) =
+ let
+ findNext (ps@(p:_):segs) =
+ if p == last present
+ then (Just ps, segs)
+ else (a, ps:b) where (a,b) = findNext segs
+ findNext [] = (Nothing, [])
+ in
+ case findNext remaining of
+ (Nothing, _) -> present:(connectPolys remaining)
+ (Just match, others) -> connectPolys $ (present ++ tail match): others
+
+-}
View
1  implicit.cabal
@@ -105,6 +105,7 @@ Library
Graphics.Implicit.Export.Render.Interpolate
Graphics.Implicit.Export.Render.RefineSegs
Graphics.Implicit.Export.Render.TesselateLoops
+ Graphics.Implicit.Export.Render.HandlePolylines
Executable extopenscad
Please sign in to comment.
Something went wrong with that request. Please try again.