| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
Geometry.Algorithms.Clipping
Description
Functions to cut things into pieces.
(image code)
>>>import Draw>>>import qualified Graphics.Rendering.Cairo as C>>>:{haddockRender "Geometry/Algorithms/Clipping/complicated_intersection.svg" 200 160 $ \_ -> do let p1 = Polygon [ Vec2 40 30, Vec2 140 30, Vec2 140 140, Vec2 120 140, Vec2 120 80, Vec2 100 80 , Vec2 100 140, Vec2 80 140, Vec2 80 60, Vec2 60 60, Vec2 60 140, Vec2 40 140 ] p2 = Polygon [ Vec2 180 20, Vec2 130 20, Vec2 130 35, Vec2 120 35, Vec2 120 20, Vec2 110 20 , Vec2 110 35, Vec2 100 35, Vec2 100 20, Vec2 90 20, Vec2 90 35, Vec2 80 35 , Vec2 80 20, Vec2 70 20, Vec2 70 35, Vec2 60 35, Vec2 60 20, Vec2 20 20 , Vec2 20 40, Vec2 170 60, Vec2 50 80, Vec2 170 100, Vec2 10 120, Vec2 180 140 ] cutResult = intersectionPP p1 p2 setLineJoin LineJoinRound cairoScope $ do setLineWidth 1 setColor (mma 0) sketch p1 stroke cairoScope $ do setLineWidth 1 setColor (mma 1) sketch p2 stroke for_ (zip [2..] cutResult) $ \(i, (polygon, _islandOrHole)) -> cairoScope $ do setLineWidth 2 sketch polygon setColor (mma i `withOpacity` 0.2) fillPreserve setColor (mma i) stroke :} Generated file: size 5KB, crc32: 0xd81cbd60
Synopsis
- cutLineWithLine :: Line -> Line -> CutLine
- data CutLine
- cutPolygon :: Line -> Polygon -> [Polygon]
- cohenSutherland :: BoundingBox -> Line -> Maybe Line
- data LineType
- clipPolygonWithLine :: Polygon -> Line -> [(Line, LineType)]
- clipPolygonWithLineSegment :: Polygon -> Line -> [(Line, LineType)]
- sutherlandHodgman :: Polygon -> Polygon -> Polygon
- data IslandOrHole
- intersectionPP :: Polygon -> Polygon -> [(Polygon, IslandOrHole)]
- unionPP :: Polygon -> Polygon -> [(Polygon, IslandOrHole)]
- differencePP :: Polygon -> Polygon -> [(Polygon, IslandOrHole)]
- hatch :: Polygon -> Angle -> Double -> Double -> [Line]
Documentation
cutLineWithLine :: Line -> Line -> CutLine Source #
Cut a finite piece of paper in one or two parts with an infinite scissors line (depending on whether the scissors miss the line or not).
Constructors
| NoCut Vec2 Vec2 | (start, end). No cut has occurred, i.e. the cutting line did not intersect with the object. |
| Cut Vec2 Vec2 Vec2 | (start, cut, end). The input was divided in two lines. |
cutPolygon :: Line -> Polygon -> [Polygon] Source #
Cut a polygon in multiple pieces with a line.
For convex polygons, the result is either just the polygon (if the line misses) or two pieces. Concave polygons can in general be divided in arbitrarily many pieces.
cohenSutherland :: BoundingBox -> Line -> Maybe Line Source #
Constrain a line to the inside of a box with the Cohen-Sutherland clipping algorithm.
(image code)
>>>:{haddockRender "Geometry/Algorithms/Clipping/CohenSutherland/cohenSutherland.svg" 300 200 $ \_ -> do let viewport = boundingBox [zero, Vec2 300 200] mask = shrinkBoundingBox 20 viewport lines = runST $ do gen <- MWC.create ps <- poissonDisc gen mask 20 4 for ps $ \p -> do angle <- MWC.uniformM gen let makeLooong = resizeLineSymmetric (const 500) pure (makeLooong (Line p (p +. polar angle 1))) clippedLines = mapMaybe (cohenSutherland mask) lines for_ clippedLines $ \line -> cairoScope $ do setColor (mma 1) sketch line C.stroke cairoScope $ do C.setLineWidth 2 setColor (mma 0) sketch (boundingBoxPolygon mask) C.stroke :} Generated file: size 22KB, crc32: 0xa5dc883f
Constructors
| LineInsidePolygon | |
| LineOutsidePolygon |
clipPolygonWithLine :: Polygon -> Line -> [(Line, LineType)] Source #
Classify lines on the scissors as being inside or outside the polygon.
Clip a polygon with a convex clipping mask using the Sutherland-Hodgman algorithm.
Note: The precondition (convexity) is not checked!
(image code)
>>>:{haddockRender "Geometry/Algorithms/Clipping/SutherlandHodgman/sutherland_hodgman.svg" 110 100 $ \_ -> do let subject = Polygon [Vec2 10 10, Vec2 10 90, Vec2 50 50, Vec2 90 90, Vec2 90 10] Polygon scissors' = boundingBoxPolygon [Vec2 40 30, Vec2 100 80] scissors = Polygon ( scissors') clipped = sutherlandHodgman subject scissors sketch clipped >> setColor (mma 0 `withOpacity` 0.5) >> fill sketch subject >> setColor (mma 1) >> stroke sketch scissors >> setColor (mma 3) >> setDash [3,3] 0 >> stroke :} Generated file: size 2KB, crc32: 0x722cb97a
data IslandOrHole Source #
Type of polygons, used to distinguish results of polygon clipping.
Constructors
| Island | An ordinary polygon. It has finite interior and infinite exterior area. |
| Hole | A hole has a finite exterior, and infinite interior. |
Instances
| Show IslandOrHole Source # | |
Defined in Geometry.Algorithms.Clipping.MargalitKnott Methods showsPrec :: Int -> IslandOrHole -> ShowS # show :: IslandOrHole -> String # showList :: [IslandOrHole] -> ShowS # | |
| Eq IslandOrHole Source # | |
Defined in Geometry.Algorithms.Clipping.MargalitKnott | |
| Ord IslandOrHole Source # | |
Defined in Geometry.Algorithms.Clipping.MargalitKnott Methods compare :: IslandOrHole -> IslandOrHole -> Ordering # (<) :: IslandOrHole -> IslandOrHole -> Bool # (<=) :: IslandOrHole -> IslandOrHole -> Bool # (>) :: IslandOrHole -> IslandOrHole -> Bool # (>=) :: IslandOrHole -> IslandOrHole -> Bool # max :: IslandOrHole -> IslandOrHole -> IslandOrHole # min :: IslandOrHole -> IslandOrHole -> IslandOrHole # | |
intersectionPP :: Polygon -> Polygon -> [(Polygon, IslandOrHole)] Source #
Intersection of two polygons.
The union will always be Islands, but for homogenity of types with
intersectionPP etc. the type is included anyway.
(image code)
>>>:{haddockRender "Geometry/Algorithms/Clipping/MargalitKnott/intersection.svg" 150 150 $ \_ -> do let p1 = boundingBoxPolygon [Vec2 10 10, Vec2 100 100] p2 = boundingBoxPolygon [Vec2 50 50, Vec2 140 140] for_ (intersectionPP p1 p2) $ \(polygon, _ty) -> cairoScope $ do sketch polygon setColor (mma 1 `withOpacity` 0.2) fill sketch (p1, p2) >> stroke :} Generated file: size 2KB, crc32: 0xdaf13db5
unionPP :: Polygon -> Polygon -> [(Polygon, IslandOrHole)] Source #
Union of two polygons.
(image code)
>>>:{haddockRender "Geometry/Algorithms/Clipping/MargalitKnott/union.svg" 150 150 $ \_ -> do let p1 = boundingBoxPolygon [Vec2 10 10, Vec2 100 100] p2 = boundingBoxPolygon [Vec2 50 50, Vec2 140 140] for_ (unionPP p1 p2) $ \(polygon, _ty) -> cairoScope $ do sketch polygon setColor (mma 1 `withOpacity` 0.2) fill sketch (p1, p2) >> stroke :} Generated file: size 2KB, crc32: 0xcc4c9f5e
Arguments
| :: Polygon | A |
| -> Polygon | B |
| -> [(Polygon, IslandOrHole)] | A-B |
Difference of two polygons: anything that is in the first argument, but not in the second.
(image code)
>>>:{haddockRender "Geometry/Algorithms/Clipping/MargalitKnott/difference.svg" 150 150 $ \_ -> do let p1 = boundingBoxPolygon [Vec2 10 10, Vec2 100 100] p2 = boundingBoxPolygon [Vec2 50 50, Vec2 140 140] for_ (differencePP p1 p2) $ \(polygon, _ty) -> cairoScope $ do sketch polygon setColor (mma 1 `withOpacity` 0.2) fill sketch (p1, p2) >> stroke :} Generated file: size 2KB, crc32: 0x9388b325
Arguments
| :: Polygon | |
| -> Angle | Direction in which the lines will point. |
| -> Double | Distance between shading lines |
| -> Double | An offset of 0 means a line will go through the center of the polygon's |
| -> [Line] |
Add shading lines to a polygon. This is especially useful for a pen plotter to do shading, hence the name.
(image code)
>>>:{haddockRender "Geometry/Algorithms/Clipping/hatched_polygon.svg" 100 100 $ \_ -> do let polygon = Polygon [Vec2 10 10, Vec2 70 45, Vec2 90 10, Vec2 90 90, Vec2 50 55, Vec2 10 90] let hatching = hatch polygon (deg 30) 10 0 cairoScope $ do for_ hatching sketch setColor (mma 1) stroke sketch polygon stroke :} Generated file: size 2KB, crc32: 0x81dce6d7