drawing polygons :)

noinia · Jun 26, 2024 · 73c8fff · 73c8fff
1 parent 7fa3845
commit 73c8fff
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 19 deletions.
diff --git a/hgeometry-examples/skia/Main.hs b/hgeometry-examples/skia/Main.hs
@@ -685,9 +685,7 @@ myDraw m = do
           in renderPartialPolyLine (m^.canvas) current'
         PolygonMode mData ->
           let current' = extendPolygonWith (m^.canvas.mouseCoordinates) (mData^.currentPolygon)
-          in renderPartialPolyLine (m^.canvas) (coerce $ current')
-          -- TODO
-
+          in renderPartialPolygon (m^.canvas) current'
 
         RectangleMode mData -> forM_ (asRectangleWith (m^.canvas.mouseCoordinates) mData) $ \rect ->
                                   let ats = RectangleAttributes def Normal
@@ -789,6 +787,7 @@ withColor' c render = do canvasKit <- asks (^.theCanvasKit)
                            liftR $ setColor paint c'
                            render paint
 
+-- | Renders the partial polyline
 renderPartialPolyLine                     :: SkCanvas_ skCanvas
                                           => Canvas R
                                           -> Maybe (PartialPolyLine R)
@@ -800,4 +799,15 @@ renderPartialPolyLine canvas' partialPoly = case partialPoly of
   where
     ats = def
 
+-- | Renders the partial polygon
+renderPartialPolygon             :: SkCanvas_ skCanvas
+                                 => Canvas R
+                                 -> Maybe (PartialPolygon R)
+                                 -> Render skCanvas ()
+renderPartialPolygon canvas' mpp = case mpp >>= completePolygon of
+    Just pg -> renderColoring (Render.simplePolygon canvas' pg) (ats^.coloring)
+    Nothing -> pure ()
+  where
+    ats = def :: Attributes (SimplePolygon' R)
+
 --------------------------------------------------------------------------------
diff --git a/hgeometry-examples/skia/PolygonMode.hs b/hgeometry-examples/skia/PolygonMode.hs
@@ -27,6 +27,7 @@ import           PolyLineMode
 
 --------------------------------------------------------------------------------
 
+-- | By default the vertices of a simple polygon are just 'Point 2 r's.
 type SimplePolygon' r = SimplePolygon (Point 2 r)
 
 -- | Just reuse whatever is in PolyLine mode.
@@ -63,6 +64,7 @@ completePolygon (coerce -> poly) = case poly of
 newtype PolygonModeData = PolygonModeData (Maybe (PartialPolygon R))
   deriving (Show,Read,Eq)
 
+-- | Lens to access the current partial polygon
 currentPolygon :: Lens' PolygonModeData (Maybe (PartialPolygon R))
 currentPolygon = coerced
 

diff --git a/hgeometry/src/HGeometry/Polygon/Simple.hs b/hgeometry/src/HGeometry/Polygon/Simple.hs
@@ -143,22 +143,13 @@ instance ( Point_ point 2 r
   uncheckedFromCCWPoints = MkSimplePolygon . fromFoldable1
                          . NonEmpty.fromList . F.toList
 
-  fromPoints = Just
-             . toCounterClockwiseOrder
-             . uncheckedFromCCWPoints
-             . requireThree "fromPoints" . F.toList
-  -- TODO: verify that:
-  --      we have no repeated vertices,
-  --      no self intersections, and
-  --      not all vertices are colinear
-
-
--- | Validate that we have at least three points
-requireThree :: String -> [a] -> [a]
-requireThree _ lst@(_:_:_:_) = lst
-requireThree label _ = error $
-  "HGeometry.Polygon." ++ label ++ ": Polygons must have at least three points."
-
+  fromPoints pts = case F.toList pts of
+    pts'@(_ : _ : _ : _ ) -> Just . toCounterClockwiseOrder . uncheckedFromCCWPoints $ pts'
+                             -- TODO: verify that:
+                              --      we have no repeated vertices,
+                             --      no self intersections, and
+                             --      not all vertices are colinear
+    _                     -> Nothing -- we need at least three vertices
 
 instance ( Show point
          , SimplePolygon_ (SimplePolygonF f point) point r