packages feed

juicy-gcode 0.1.0.9 → 0.1.0.10

raw patch · 11 files changed

+109/−104 lines, 11 files

Files

ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for juicy-gcode
 
+## 0.1.0.10 -- 2020-08-19
+
+- Improve algorithmic stability at small details
+- Fix issue with SVG Line element
+
 ## 0.1.0.9 -- 2020-05-27
 
 - Add option to generate bezier curves instead of arcs
README.md view
@@ -24,18 +24,23 @@ ```
 juicy-gcode - The SVG to G-Code converter
 
-Usage: juicy-gcode.exe SVGFILE [-f|--flavor CONFIGFILE] [-o|--output OUTPUTFILE]
-                       [-d|--dpi DPI] [-m|--mirror-y-axis]
+Usage: juicy-gcode SVGFILE [-f|--flavor CONFIGFILE] [-o|--output OUTPUTFILE]
+                   [-d|--dpi DPI] [-r|--resolution RESOLUTION]
+                   [-m|--mirror-y-axis] [-b|--generate-bezier]
   Convert SVGFILE to G-Code
 
 Available options:
-  -h,--help                Show this help text
-  SVGFILE                  The SVG file to be converted
-  -f,--flavor CONFIGFILE   Configuration of G-Code flavor
-  -o,--output OUTPUTFILE   The output G-Code file (default is standard output)
-  -d,--dpi DPI             Density of the SVG file (default is 72 DPI)
-  -m,--mirror-y-axis       Mirror Y axis to have the result in G-Code coordinate system
-  -b,--generate-bezier     Generate bezier curves (G5) instead of arcs (G2,G3)
+  -h,--help                   Show this help text
+  SVGFILE                     The SVG file to be converted
+  -f,--flavor CONFIGFILE      Configuration of G-Code flavor
+  -o,--output OUTPUTFILE      The output G-Code file (default is standard output)
+  -d,--dpi DPI                Used to determine the size of the SVG when it does
+                              not contain any units; dot per inch (default is 72)
+  -r,--resolution RESOLUTION  Shorter paths are replaced by line segments; mm
+                              (default is 0.1)
+  -m,--mirror-y-axis          Mirror Y axis to have the result in G-Code coordinate
+                              system
+  -b,--generate-bezier        Generate bezier curves (G5) instead of arcs (G2,G3)
 ```
 
 ## Configuration
juicy-gcode.cabal view
@@ -1,5 +1,5 @@ name:                juicy-gcode
-version:             0.1.0.9
+version:             0.1.0.10
 license:             BSD3
 license-file:        LICENSE
 author:              dlacko
src/Approx.hs view
@@ -1,28 +1,32 @@ module Approx ( bezier2biarc
               ) where
 
-import Debug.Trace
-
 import qualified CubicBezier as B
 import qualified BiArc as BA          
 import qualified Line as L 
           
 import Data.Bool (bool)
-
 import Linear    
 import Data.Complex
 
 import Types
 
+-- Approximate a bezier curve with biarcs (Left) and line segments (Right)
 bezier2biarc :: B.CubicBezier 
              -> Double
-             -> Double
-             -> [BA.BiArc]
-bezier2biarc mbezier samplingStep tolerance
+             -> [Either BA.BiArc (V2 Double)]
+bezier2biarc mbezier resolution 
+    -- Edge case: all points on the same line -> it is a line 
+    | (L.isOnLine (L.fromPoints (B._p2 mbezier) (B._p1 mbezier)) (B._c1 mbezier)) && 
+      (L.isOnLine (L.fromPoints (B._p2 mbezier) (B._p1 mbezier)) (B._c2 mbezier)) 
+        = [Right (B._p2 mbezier)]
+    -- Edge case: p1 == c1, don't split
     | (B._p1 mbezier) == (B._c1 mbezier)
         = approxOne mbezier
+    -- Edge case: p2 == c2, don't split
     | (B._p2 mbezier) == (B._c2 mbezier)
         = approxOne mbezier
+    -- Split by the inflexion points (if any)
     | otherwise 
         = byInflection (B.realInflectionPoint i1) (B.realInflectionPoint i2)
     where
@@ -53,19 +57,30 @@         byInflection False False = approxOne mbezier
          
         -- TODO: make it tail recursive
-        approxOne :: B.CubicBezier -> [BA.BiArc]
+        approxOne :: B.CubicBezier -> [Either BA.BiArc (V2 Double)]
         approxOne bezier
+            -- Approximate bezier length. if smaller than resolution, do not approximate
+            | (distance (B._p1 bezier) (B._c1 bezier)) + 
+              (distance (B._c1 bezier) (B._c2 bezier)) + 
+              (distance (B._c2 bezier) (B._p2 bezier)) < resolution
+                = [Right (B._p2 bezier)]
             -- Edge case: start- and endpoints are the same
             | (B._p1 bezier) == (B._p2 bezier)
                 = splitAndRecur 0.5
             -- Edge case: control lines are parallel
-            | (L._m t1) == (L._m t2)
+            | (L._m t1) == (L._m t2) || (isNaN (L._m t1) && isNaN (L._m t2)) 
                 = splitAndRecur 0.5
             -- Approximation is not close enough yet, refine
-            | maxDistance > 0.5
+            | BA.isStable biarc && maxDistance > resolution
                 = splitAndRecur maxDistanceAt
+            -- Desired case: approximation is stable and close enough
+            | BA.isStable biarc
+                = [Left biarc]
+            -- Unstable approximation: split the bezier into half, basically switching to
+            -- linear approximation mode
             | otherwise
-                = Debug.Trace.trace (show error) [biarc] 
+                = splitAndRecur 0.5
+
             where
                 -- Edge case: P1==C1 or P2==C2
                 -- there is no derivative at P1 or P2, use the other control point
@@ -86,21 +101,21 @@                 -- Calculate the BiArc
                 biarc = BA.create (B._p1 bezier) (B._p1 bezier - c1) (B._p2 bezier) (B._p2 bezier - c2) g
                 
-                -- calculate the error
-                nrPointsToCheck = 10
-                parameterStep = 1 / nrPointsToCheck
+                -- Calculate the error
+                -- TODO: we only calculate the distance at 8 points (first and last skipped as 
+                --       they should be precise), seems a resonable approximation as for now
+                parameterStep = 1 / 10
                                 
-                (error, maxDistance, maxDistanceAt) = maxDistance' 0 0 0 0
+                (maxDistance, maxDistanceAt) = maxDistance' 0 0 parameterStep
                 
-                maxDistance' e m mt t 
-                    | t <= 1
-                        = if' (d > m) (maxDistance' ne d t nt) (maxDistance' ne m mt nt)
+                maxDistance' m mt t 
+                    | t < 1
+                        = if' (d > m) (maxDistance' d t nt) (maxDistance' m mt nt)
                     | otherwise
-                        = (e / nrPointsToCheck, m, mt)
+                        = (m, mt)
                     where
                         d = distance (BA.pointAt biarc t) (B.pointAt bezier t)
                         nt = t + parameterStep
-                        ne = e + d
 
                 splitAndRecur t = let (b1, b2) = B.bezierSplitAt bezier t
                                    in approxOne b1 ++ approxOne b2  
src/BiArc.hs view
@@ -2,6 +2,7 @@              , create
              , pointAt
              , arcLength
+             , isStable
              ) where
       
 import qualified CircularArc as CA
@@ -20,7 +21,8 @@        -> V2 Double -- Tangent vector at end point
        -> V2 Double -- Transition point (connection point of the arcs)    
        -> BiArc 
-create p1 t1 p2 t2 t = BiArc (CA.CircularArc c1 r1 startAngle1 sweepAngle1 p1 t) (CA.CircularArc c2 r2 startAngle2 sweepAngle2 t p2)
+create p1 t1 p2 t2 t 
+    = BiArc (CA.CircularArc c1 r1 startAngle1 sweepAngle1 p1 t) (CA.CircularArc c2 r2 startAngle2 sweepAngle2 t p2)
     where
         -- Calculate the orientation
         osum = (t ^. _x - p1 ^. _x) * (t ^. _y + p1 ^. _y)
@@ -78,4 +80,11 @@ 
 arcLength :: BiArc -> Double
 arcLength arc = CA.arcLength (_a1 arc) + CA.arcLength (_a2 arc)
+
+-- Heuristics for unstable biarc: the radius of at least one of the arcs 
+-- is too big or too small 
+isStable :: BiArc -> Bool
+isStable biarc
+    = not (CA._r (_a1 biarc) > 99999 || CA._r (_a1 biarc) < 0.001 ||
+           CA._r (_a2 biarc) > 99999 || CA._r (_a2 biarc) < 0.001)
         
src/GCode.hs view
@@ -42,12 +42,7 @@ 
                 cmd = if' cw "G03" "G02"
 
-                arcStr
-                    -- avoid tiny arcs
-                    | (mm $ abs i) < 1 && (mm $ abs j) < 1
-                        = printf "G01 X%.4f Y%.4f" (mm x) (mm y)
-                    | otherwise
-                        = printf "%s X%.4f Y%.4f I%.4f J%.4f" cmd (mm x) (mm y) (mm i) (mm j)
+                arcStr = printf "%s X%.4f Y%.4f I%.4f J%.4f" cmd (mm x) (mm y) (mm i) (mm j)
         toString' (GBezierTo (c1x,c1y) (c2x,c2y) p2@(p2x,p2y) : gs) (p1x,p1y) True
             = bStr : toString' gs p2 True
             where
src/Line.hs view
@@ -4,11 +4,13 @@             , createPerpendicularAt
             , slope
             , intersection
+            , isOnLine
             ) where
           
 import Linear    
 import Control.Lens
 
+-- TODO: letting _p to be NaN is actually a really bad idea
 data Line = Line { _m :: Double
                  , _p :: V2 Double
                  } deriving Show
@@ -41,14 +43,14 @@ nan :: Double   
 nan = 0/0   
    
--- If the solution is not unique it actually return +/-infinity
+-- If the solution is not found it actually returns +/-infinity
 intersection :: Line -> Line -> V2 Double
 intersection line1 line2 
     | isNaN (_m line1)
         = verticalIntersection line1 line2 
     | isNaN (_m line2)
-        = verticalIntersection line2 line1     
-    |otherwise
+        = verticalIntersection line2 line1  
+    | otherwise
         = V2 x y
     where
         x = (_m line1 * _p line1 ^. _x - _m line2 * _p line2 ^. _x - _p line1 ^. _y + _p line2 ^. _y) / (_m line1 - _m line2) 
@@ -61,3 +63,11 @@         x = _p vline ^. _x
         y = _m line * (x - _p line ^. _x) + _p line ^. _y
 
+isOnLine :: Line -> V2 Double -> Bool
+isOnLine l p2 
+    | isNaN (_m l)
+        = p1 ^. _x == p2 ^. _x
+    | otherwise 
+        = (p2 ^. _x - p1 ^. _x) * (_m l) == (p2 ^. _y - p1 ^. _y) 
+    where
+        p1 = _p l
src/Main.hs view
@@ -14,6 +14,7 @@                        , _cfgfile        :: Maybe String
                        , _outfile        :: Maybe String
                        , _dpi            :: Int
+                       , _resolution     :: Double
                        , _mirrorYAxis    :: Bool
                        , _generateBezier :: Bool
                        }
@@ -38,7 +39,13 @@      <> value 72
      <> short 'd'
      <> metavar "DPI"
-     <> help "Density of the SVG file (default is 72 DPI)" ))
+     <> help "Used to determine the size of the SVG when it does not contain any units; dot per inch (default is 72)" ))
+ <*> (option auto
+      ( long "resolution"
+     <> value 0.1
+     <> short 'r'
+     <> metavar "RESOLUTION"
+     <> help "Shorter paths are replaced by line segments; mm (default is 0.1)" ))
   <*> (switch
       ( long "mirror-y-axis"
      <> short 'm'
@@ -49,12 +56,12 @@       <> help "Generate bezier curves (G5) instead of arcs (G2,G3)" ))
 
 runWithOptions :: Options -> IO ()
-runWithOptions (Options svgFile mbCfg mbOut dpi mirrorYAxis generateBezier) =
+runWithOptions (Options svgFile mbCfg mbOut dpi resolution mirrorYAxis generateBezier) =
     do
         mbDoc <- SVG.loadSvgFile svgFile
         flavor <- maybe (return defaultFlavor) readFlavor mbCfg
         case mbDoc of
-            (Just doc) -> writer (toString flavor dpi $ renderDoc mirrorYAxis generateBezier dpi doc)
+            (Just doc) -> writer (toString flavor dpi $ renderDoc mirrorYAxis generateBezier dpi resolution doc)
             Nothing    -> putStrLn "juicy-gcode: error during opening the SVG file"
     where
         writer = maybe putStrLn (\fn -> writeFile fn) mbOut
@@ -77,4 +84,4 @@     opts = info (helper <*> options)
       ( fullDesc
      <> progDesc "Convert SVGFILE to G-Code"
-     <> header "juicy-gcode - The SVG to G-Code converter" )
+     <> header "juicy-gcode - The SVG to G-Code converter" )
src/Render.hs view
@@ -44,16 +44,9 @@ -- convert a quadratic bezier to a cubic one
 bezierQ2C :: Point -> Point -> Point -> DrawOp
 bezierQ2C (qp0x, qp0y) (qp1x, qp1y) (qp2x, qp2y)
-    = createBezier (qp0x + 2.0 / 3.0 * (qp1x - qp0x), qp0y + 2.0 / 3.0 * (qp1y - qp0y))
-                   (qp2x + 2.0 / 3.0 * (qp1x - qp2x), qp2y + 2.0 / 3.0 * (qp1y - qp2y))
-                   (qp2x, qp2y)
-
--- create a cubic bezier dta constructor from two control and one endpoints
--- tries to simplify as well. it happens that the points actually describe a line, converting it to arcs would fail later on
-createBezier :: Point -> Point -> Point -> DrawOp
-createBezier c1 c2 e
-    | (c1 == c2) && (c2 == e) = DMoveTo e
-    | otherwise = DBezierTo c1 c2 e
+    = DBezierTo (qp0x + 2.0 / 3.0 * (qp1x - qp0x), qp0y + 2.0 / 3.0 * (qp1y - qp0y))
+                (qp2x + 2.0 / 3.0 * (qp1x - qp2x), qp2y + 2.0 / 3.0 * (qp1y - qp2y))
+                (qp2x, qp2y)
 
 toAbsolute :: (Double, Double) -> SVG.Origin -> (Double, Double) -> (Double, Double)
 toAbsolute _ SVG.OriginAbsolute p = p
@@ -73,10 +66,12 @@ 
         (w, h) = (documentSize dpi doc)
 
-renderDoc :: Bool -> Bool -> Int -> SVG.Document -> [GCodeOp]
-renderDoc mirrorYAxis generateBezier dpi doc
+renderDoc :: Bool -> Bool -> Int -> Double -> SVG.Document -> [GCodeOp]
+renderDoc mirrorYAxis generateBezier dpi resolution doc
     = stage2 $ renderTrees (docTransform mirrorYAxis dpi doc) (SVG._elements doc)
     where
+        pxresolution = (fromIntegral dpi) / 2.45 / 10 * resolution
+
         -- TODO: make it tail recursive
         stage2 :: [DrawOp] -> [GCodeOp]
         stage2 dops = convert dops (Linear.V2 0 0)
@@ -85,11 +80,16 @@                 convert (DMoveTo p:ds) _ = GMoveTo p : convert ds (fromPoint p)
                 convert (DLineTo p:ds) _ = GLineTo p : convert ds (fromPoint p)
                 convert (DBezierTo c1 c2 p2:ds) cp
-                    | generateBezier = [GBezierTo c1 c2 p2] ++ convert ds (fromPoint p2)
-                    | otherwise      = concatMap biarc2garc biarcs ++ convert ds (fromPoint p2)
+                    | generateBezier 
+                        = [GBezierTo c1 c2 p2] ++ convert ds (fromPoint p2)
+                    | otherwise      
+                        = concatMap biarc2garc biarcs ++ convert ds (fromPoint p2)
                     where
-                        biarcs = bezier2biarc (B.CubicBezier cp (fromPoint c1) (fromPoint c2) (fromPoint p2)) 5 1
-                        biarc2garc biarc = [arc2garc (BA._a1 biarc), arc2garc (BA._a2 biarc)]
+                        biarcs = bezier2biarc (B.CubicBezier cp (fromPoint c1) (fromPoint c2) (fromPoint p2)) pxresolution
+                        biarc2garc (Left biarc) 
+                            = [arc2garc (BA._a1 biarc), arc2garc (BA._a2 biarc)]
+                        biarc2garc (Right (Linear.V2 x y)) 
+                            = [GLineTo (x,y)]
                         arc2garc arc = GArcTo (toPoint (CA._c arc)) (toPoint (CA._p2 arc)) (CA.isClockwise arc)
 
         renderPathCommands :: Point -> Point -> Maybe Point -> [SVG.PathCommand] -> [DrawOp]
@@ -142,7 +142,7 @@                 cont dys' = SVG.VerticalTo SVG.OriginRelative dys' : ds
 
         renderPathCommands firstp currentp _ (SVG.CurveTo origin ((c1,c2,p):ps):ds)
-            = createBezier ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps)
+            = DBezierTo ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps)
             where
                 ap = toAbsolute currentp origin (fromRPoint p)
                 ac1 = toAbsolute currentp origin (fromRPoint c1)
@@ -152,7 +152,7 @@                 cont ps' = SVG.CurveTo origin ps' : ds
 
         renderPathCommands firstp currentp mbControlp (SVG.SmoothCurveTo origin ((c2,p):ps):ds)
-            = createBezier ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps)
+            = DBezierTo ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps)
             where
                 ap = toAbsolute currentp origin (fromRPoint p)
                 ac1 = maybe ac2 (mirrorControlPoint currentp) mbControlp
@@ -225,7 +225,7 @@         renderTree m (SVG.LineTree l) = [DMoveTo p1, DLineTo p2]
             where
                 p1 = transformPoint tr (fromSvgPoint dpi (SVG._linePoint1 l))
-                p2 = transformPoint tr (fromSvgPoint dpi (SVG._linePoint1 l))
+                p2 = transformPoint tr (fromSvgPoint dpi (SVG._linePoint2 l))
                 tr = applyTransformations m (SVG._transform (SVG._lineDrawAttributes l))
 
         renderTree m (SVG.PolyLineTree l) = map (transformDrawOp tr) (DMoveTo p0:map DLineTo ps)
src/SvgArcSegment.hs view
@@ -80,44 +80,4 @@                 dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)
                 dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)
 
-{-                
--- ported from: http://www.java2s.com/Code/Java/2D-Graphics-GUI/AgeometricpathconstructedfromstraightlinesquadraticandcubicBeziercurvesandellipticalarc.htm   
--- works without angle and with circle segments only             
-convertArc :: Double -> Double -> Double -> Bool -> Bool -> Double -> Double -> Arc
-convertArc x0 y0 radius largeArcFlag sweepFlag x y = Arc (x0,y0) (x,y) (cx,cy) dir
-    where
-        x1 = (x0 - x) / 2.0
-        y1 = (y0 - y) / 2.0
-                
-        pr' = radius * radius
-        px1 = x1 * x1
-        py1 = y1 * y1
-
-        radiiCheck = px1 / pr' + py1 / pr'
-        
-        r = if' (radiiCheck > 1) (sqrt radiiCheck * abs radius) (abs radius)
-        pr = r * r
-        
-        sign = if' (largeArcFlag == sweepFlag) (-1) 1
-        sq' = ((pr * pr) - (pr * py1) - (pr * px1)) / ((pr * py1) + (pr * px1))
-        coef = sign * sqrt (max 0.0 sq')
-        cx1 = coef * y1
-        cy1 = coef * (-x1)
-        
-        sx2 = (x0 + x) / 2.0
-        sy2 = (y0 + y) / 2.0            
-        cx = sx2 + cx1
-        cy = sy2 + cy1
-        
-        ux = (x1 - cx1) / r
-        uy = (y1 - cy1) / r
-        vx = (-x1 - cx1) / r
-        vy = (-y1 - cy1) / r
-        
-        -- compute direction. True -> Clockwise
-        dir' = ux * vy - uy * vx >= 0
-        dir = if' (not sweepFlag && dir') 
-                  False 
-                  (if' (sweepFlag && not dir') True dir')
--}  
   
src/Types.hs view
@@ -4,8 +4,7 @@              , if'
              ) where
 
--- type Command = String
-type Point = (Double,Double) -- A point in the plane, absolute coordinates
+type Point = (Double, Double) -- A point in the plane, absolute coordinates
 
 -- all of them are invariant under affine transformation
 data DrawOp = DMoveTo Point