move from normalizePLine2WithErr to normalize.

Graphics/Slicer/Machine/Contour.hs

@@ -19,7 +19,7 @@
 
 module Graphics.Slicer.Machine.Contour (cleanContour, shrinkContour, expandContour) where
 
-import Prelude (($), otherwise, Eq, (<>), show, error, (==), (&&), Bool(True, False), Show)
+import Prelude (($), Eq((==)), (<>), (&&), Show(show), error, fst, not, otherwise)
 
 import Data.List (null, foldl')
 
@@ -31,15 +31,15 @@ import Graphics.Slicer.Math.Contour (lineSegsOfContour, makeLineSegContour)
 
 import Graphics.Slicer.Math.Definitions (Contour, LineSeg, mapWithNeighbors, makeLineSeg)
 
-import Graphics.Slicer.Math.Intersections (noIntersection)
+import Graphics.Slicer.Math.Intersections (noIntersection, intersectionOf)
 
 import Graphics.Slicer.Math.Line (combineLineSegs)
 
-import Graphics.Slicer.Math.Lossy (eToPLine2, translatePLine2)
+import Graphics.Slicer.Math.Lossy (eToPLine2, pToEPoint2)
 
-import Graphics.Slicer.Math.PGA (combineConsecutiveLineSegs, PIntersection(IntersectsIn), plinesIntersectIn, cPToEPoint2)
+import Graphics.Slicer.Math.PGA (combineConsecutiveLineSegs, eToPL, translateL)
 
-import Graphics.Slicer.Definitions(ℝ)
+import Graphics.Slicer.Definitions (ℝ)
 
 ---------------------------------------------------------------
 -------------------- Contour Optimizer ------------------------
@@ -101,29 +101,12 @@ modifyContour pathWidth contour direction
                                        (Just (middleSegs,lastSeg)) -> middleSegs <> if noIntersection (inwardAdjust lastSeg) (inwardAdjust oneSeg)
                                                                                     then maybeToList (combineLineSegs lastSeg oneSeg)
                                                                                     else [lastSeg,oneSeg]
-        inwardAdjust l1 = translatePLine2 (eToPLine2 l1) (if direction == Inward then pathWidth else (-pathWidth))
+        inwardAdjust l1 = translateL (eToPLine2 l1) (if direction == Inward then pathWidth else (-pathWidth))
         findLineSeg :: LineSeg -> LineSeg -> LineSeg -> Maybe LineSeg
         findLineSeg previousln ln nextln
           -- The ideal case.
           | isIntersection previousln ln &&
-            isIntersection ln nextln        = Just $ makeLineSeg (intersectionPoint (inwardAdjust previousln) (inwardAdjust ln)) (intersectionPoint (inwardAdjust ln) (inwardAdjust nextln))
+            isIntersection ln nextln        = Just $ makeLineSeg (pToEPoint2 $ fst $ intersectionOf (inwardAdjust previousln) (inwardAdjust ln)) (pToEPoint2 $ fst $ intersectionOf (inwardAdjust ln) (inwardAdjust nextln))
           | otherwise = error $ "no intersection?\n" <> show (isIntersection previousln ln) <> "\n" <> show (isIntersection ln nextln) <> "\n" <> show previousln <> "\n" <> show ln <> "\n" <> show nextln <> "\n"
           where
-            isIntersection l1 l2 = case plinesIntersectIn (inwardAdjust l1) (inwardAdjust l2) of
-                                     IntersectsIn _ _ -> True
-                                     _other           -> False
-            intersectionPoint pl1 pl2 = case plinesIntersectIn pl1 pl2 of
-                                          IntersectsIn p2 _ -> cPToEPoint2 p2
-                                          a                 -> error $ "impossible result!\nresult: " <> show a <> "\npline 1: " <> show pl1
-                                                               <> "\npline 2: " <> show pl2
-                                                               <> "\nEvaluating line intersections between:\nFirst: " <> show previousln
-                                                               <> "\nSecond: " <> show ln
-                                                               <> "\nThird: " <> show nextln <> "\n"<> show (inwardAdjust previousln)
-                                                               <> "\n" <> show (eToPLine2 previousln)
-                                                               <> "\n" <> show (inwardAdjust ln)
-                                                               <> "\n" <> show (eToPLine2 ln)
-                                                               <> "\n" <> show (inwardAdjust nextln)
-                                                               <> "\n" <> show (eToPLine2 nextln)
-                                                               <> "\n" <> show direction
-                                                               <> "\n" <> show contour
-                                                               <> "\n"
+            isIntersection l1 l2 = not $ noIntersection (eToPL l1) (eToPL l2)

Graphics/Slicer/Machine/GCode.hs

@@ -28,7 +28,7 @@ module Graphics.Slicer.Machine.GCode (GCode(GCMarkOuterWallStart, GCMarkInnerWal
 
 import GHC.Generics (Generic)
 
-import Prelude (Eq, Int, Rational, Show, ($), zipWith, concat, (<>), show, error, otherwise, (==), length, fst, pi, (/), (*), pure, toRational, fromRational, (+), div, Bool, snd)
+import Prelude (Bool, Eq, Int, Rational, Show, ($), (<>), (==), (/), (*), (+), concat, div, error, fromRational, fst, head, length, otherwise, pi, pure, show, snd, tail, toRational, zipWith)
 
 import Data.ByteString (ByteString)
 
@@ -50,9 +50,9 @@ import Control.DeepSeq (NFData)
 
 import Graphics.Slicer.Definitions(ℝ, ℝ2, ℝ3, ℕ, Fastℕ, fromFastℕ)
 
-import Graphics.Slicer.Math.Contour (pointsOfContour, lastPointOfContour)
+import Graphics.Slicer.Math.Contour (lastPointOfContour)
 
-import Graphics.Slicer.Math.Definitions (Point3(Point3), Point2(Point2), Contour, LineSeg(LineSeg), distance, endPoint, roundToFifth)
+import Graphics.Slicer.Math.Definitions (Point3(Point3), Point2(Point2), Contour, LineSeg(LineSeg), distance, endPoint, pointsOfContour, roundToFifth)
 
 import Graphics.Slicer.Math.Slicer (accumulateValues)
 
@@ -205,11 +205,12 @@ gcodeForContour lh pathWidth feedRate contour = addFeedRate feedRate headRes : t
 -- | For each group of lines, generate gcode for the segments, with move commands between them.
 gcodeForInfill :: ℝ -> ℝ -> ℝ -> ℝ -> [[LineSeg]] -> [GCode]
 gcodeForInfill _ _ _ _ [] = []
-gcodeForInfill lh pathWidth infillFeedRate travelFeedRate lineGroups =
-  case lineGroups of
-    [] -> []
-    (headGroup:tailGroups) -> concat $ renderLineSegGroup headGroup : zipWith (\group1 group2 -> moveBetweenLineSegGroups group1 group2 <> renderLineSegGroup group2) lineGroups tailGroups
+gcodeForInfill lh pathWidth infillFeedRate travelFeedRate lineGroups
+  | lineGroups == [] = []
+  | lineGroups == [[]] = []
+  | otherwise = concat $ renderLineSegGroup headGroup : zipWith (\group1 group2 -> moveBetweenLineSegGroups group1 group2 <> renderLineSegGroup group2) lineGroups tailGroups
   where
+    (headGroup, tailGroups) = (head lineGroups, tail lineGroups)
     -- FIXME: this should be a single gcode. why are we getting empty line groups given to us?
     moveBetweenLineSegGroups :: [LineSeg] -> [LineSeg] -> [GCode]
     moveBetweenLineSegGroups g1 g2 = case unsnoc g1 of
@@ -220,7 +221,7 @@ gcodeForInfill lh pathWidth infillFeedRate travelFeedRate lineGroups =
     renderLineSegGroup :: [LineSeg] -> [GCode]
     renderLineSegGroup lineSegSet = case lineSegSet of
                                       [] -> []
-                                      (headGroup:tailGroups) -> renderSegment headGroup : concat (zipWith (\ l1 l2 -> moveBetween l1 l2 : [renderSegment l2]) lineSegSet tailGroups)
+                                      (myHeadGroup:myTailGroups) -> renderSegment myHeadGroup : concat (zipWith (\ l1 l2 -> moveBetween l1 l2 : [renderSegment l2]) lineSegSet myTailGroups)
     moveBetween :: LineSeg -> LineSeg -> GCode
     moveBetween l1 (LineSeg startPointl2 _) = addFeedRate travelFeedRate $ make2DTravelGCode (endPoint l1) startPointl2
     renderSegment :: LineSeg -> GCode

Graphics/Slicer/Machine/Infill.hs

@@ -23,23 +23,23 @@
 
 module Graphics.Slicer.Machine.Infill (makeInfill, InfillType(Diag1, Diag2, Vert, Horiz), infillLineSegInside, coveringPLinesVertical) where
 
-import Prelude ((+), (<$>), ($), (.), (*), sqrt, (-), Ordering(EQ, GT, LT), otherwise, (==), length, concat, not, null, (!!), fromIntegral, ceiling, (/), floor, Integer, compare)
+import Prelude ((+), (<$>), ($), (.), (*), sqrt, (-), Ordering(EQ, GT, LT), otherwise, (==), length, not, null, (!!), fromIntegral, ceiling, (/), floor, Integer, compare)
+
+import Data.List (concatMap)
 
 import Data.List.Ordered (sort)
 
-import Data.Maybe (Maybe(Just, Nothing), catMaybes)
+import Data.Maybe (Maybe(Just, Nothing), mapMaybe)
 
 import Graphics.Slicer.Definitions (ℝ)
 
-import Graphics.Slicer.Math.Definitions (Point2(Point2), Contour, LineSeg, addPoints, distance, makeLineSeg, minMaxPoints, xOf, yOf, roundToFifth)
+import Graphics.Slicer.Math.Definitions (Point2(Point2), Contour, LineSeg, addPoints, distance, minMaxPoints, xOf, yOf, roundToFifth)
 
-import Graphics.Slicer.Math.Intersections (getPLine2Intersections)
+import Graphics.Slicer.Math.ContourIntersections (getLineContourIntersections)
 
 import Graphics.Slicer.Math.Line (makeLineSegs)
 
-import Graphics.Slicer.Math.Lossy (eToPLine2)
-
-import Graphics.Slicer.Math.PGA (PLine2)
+import Graphics.Slicer.Math.PGA (PLine2, PLine2Err, ProjectiveLine2, join2EP)
 
 -- | what direction to put down infill lines.
 data InfillType = Diag1 | Diag2 | Vert | Horiz
@@ -48,33 +48,33 @@ data InfillType = Diag1 | Diag2 | Vert | Horiz
 -- Basically, cover the build plane in lines, then remove the portions of those lines that are not inside of the target contour.
 -- The target contour should be pre-shrunk to the innermost parameter, and the target inside contours should also be the outermost parameters.
 makeInfill :: Contour -> [Contour] -> ℝ -> InfillType -> [[LineSeg]]
-makeInfill contour insideContours ls layerType = catMaybes $ infillLineSegInside contour insideContours <$> infillCover layerType
+makeInfill contour insideContours ls layerType = mapMaybe (infillLineSegInside contour insideContours) $ infillCover layerType
     where
       infillCover Vert = coveringPLinesVertical contour ls
       infillCover Horiz = coveringPLinesHorizontal contour ls
       infillCover Diag1 = coveringPLinesPositive contour ls
       infillCover Diag2 = coveringPLinesNegative contour ls
 
 -- Get the segments of an infill line that are inside of a contour, skipping space occluded by any of the child contours.
-infillLineSegInside :: Contour -> [Contour] -> PLine2 -> Maybe [LineSeg]
+infillLineSegInside :: (ProjectiveLine2 a) => Contour -> [Contour] -> (a, PLine2Err) -> Maybe [LineSeg]
 infillLineSegInside contour childContours line
   | not (null allLines) = Just $ (allLines !!) <$> [0,2..length allLines - 1]
   | otherwise = Nothing
     where
       allLines :: [LineSeg]
       allLines = makeLineSegs allPoints
         where
-          allPoints = filterTooShort . sort . concat $ getPLine2Intersections line <$> contour:childContours
+          allPoints = (filterTooShort . sort) $ concatMap (getLineContourIntersections line) (contour:childContours)
           filterTooShort :: [Point2] -> [Point2]
           filterTooShort [] = []
           filterTooShort [a] = [a]
           filterTooShort (a:b:xs) = if roundToFifth (distance a b) == 0 then filterTooShort xs else a:filterTooShort (b:xs)
 
 -- Generate lines covering the entire contour, where each one is aligned with a +1 slope, which is to say, lines parallel to a line where x = y.
-coveringPLinesPositive :: Contour -> ℝ -> [PLine2]
-coveringPLinesPositive contour ls = eToPLine2 . makeSeg <$> [0,lss..(xMax-xMinRaw)+(yMax-yMin)+lss]
+coveringPLinesPositive :: Contour -> ℝ -> [(PLine2, PLine2Err)]
+coveringPLinesPositive contour ls = makeLine <$> [0,lss..(xMax-xMinRaw)+(yMax-yMin)+lss]
     where
-      makeSeg a = makeLineSeg (f a) $ addPoints (f a) slope
+      makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
       slope = Point2 (1,1)
       f v = Point2 (v-xDiff,0)
@@ -91,10 +91,10 @@ coveringPLinesPositive contour ls = eToPLine2 . makeSeg <$> [0,lss..(xMax-xMinRa
       lss = sqrt $ ls*ls+ls*ls
 
 -- Generate lines covering the entire contour, where each one is aligned with a -1 slope, which is to say, lines parallel to a line where x = -y.
-coveringPLinesNegative :: Contour -> ℝ -> [PLine2]
-coveringPLinesNegative contour ls = eToPLine2 . makeSeg <$> [0,lss..(xMax-xMin)+(yMax-yMin)+lss]
+coveringPLinesNegative :: Contour -> ℝ -> [(PLine2, PLine2Err)]
+coveringPLinesNegative contour ls = makeLine <$> [0,lss..(xMax-xMin)+(yMax-yMin)+lss]
     where
-      makeSeg a = makeLineSeg (f a) $ addPoints (f a) slope
+      makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
       slope =  Point2 (1,-1)
       f v = Point2 (v+yDiff,0)
@@ -111,10 +111,10 @@ coveringPLinesNegative contour ls = eToPLine2 . makeSeg <$> [0,lss..(xMax-xMin)+
       lss = sqrt $ ls*ls+ls*ls
 
 -- Generate lines covering the entire contour, where each line is aligned with the Y axis, which is to say, parallel to the Y basis vector.
-coveringPLinesVertical :: Contour -> ℝ -> [PLine2]
-coveringPLinesVertical contour ls = eToPLine2 . makeSeg <$> [xMin,xMin+ls..xMax]
+coveringPLinesVertical :: Contour -> ℝ -> [(PLine2, PLine2Err)]
+coveringPLinesVertical contour ls = makeLine <$> [xMin,xMin+ls..xMax]
     where
-      makeSeg a = makeLineSeg (f a) $ addPoints (f a) slope
+      makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
       slope = Point2 (0,1)
       f v = Point2 (v,0)
@@ -126,10 +126,10 @@ coveringPLinesVertical contour ls = eToPLine2 . makeSeg <$> [xMin,xMin+ls..xMax]
       xMax = xOf maxPoint
 
 -- Generate lines covering the entire contour, where each line is aligned with the X axis, which is to say, parallel to the X basis vector.
-coveringPLinesHorizontal :: Contour -> ℝ -> [PLine2]
-coveringPLinesHorizontal contour ls = eToPLine2 . makeSeg <$> [yMin,yMin+ls..yMax]
+coveringPLinesHorizontal :: Contour -> ℝ -> [(PLine2, PLine2Err)]
+coveringPLinesHorizontal contour ls = makeLine <$> [yMin,yMin+ls..yMax]
     where
-      makeSeg a = makeLineSeg (f a) $ addPoints (f a) slope
+      makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
       slope = Point2 (1,0)
       f v = Point2 (0,v)