juicy-gcode 0.2.0.1 → 0.2.0.2
raw patch · 17 files changed
+1226/−1218 lines, 17 filessetup-changed
Files
- ChangeLog.md +64/−60
- LICENSE +20/−20
- README.md +106/−107
- Setup.hs +2/−2
- juicy-gcode.cabal +40/−40
- src/Approx.hs +115/−122
- src/BiArc.hs +90/−90
- src/CircularArc.hs +28/−28
- src/CubicBezier.hs +68/−60
- src/GCode.hs +63/−57
- src/Line.hs +72/−72
- src/Main.hs +89/−91
- src/Render.hs +266/−266
- src/SVGExt.hs +30/−30
- src/SvgArcSegment.hs +82/−82
- src/Transformation.hs +66/−66
- src/Types.hs +25/−25
ChangeLog.md view
@@ -1,60 +1,64 @@-# Revision history for juicy-gcode - -## 0.2.0.1 -- 2020-08-24 - -- Breaking change: change default DPI to 96 instead of 72 -- Breaking change: the option to mirror the Y axis is removed (it is always mirrored now for correct result) -- Add --version flag - -## 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 - -## 0.1.0.8 -- 2020-05-19 - -- Fix unhandled bezier edge cases resulting NaNs in GCode - -## 0.1.0.7 -- 2020-05-15 - -- Add support for the viewBox attribute - -## 0.1.0.6 -- 2020-05-11 - -- Add option to mirror Y axis - -## 0.1.0.5.2 -- 2020-04-11 - -- Update dependencies - -## 0.1.0.5.1 -- 2018-08-08 - -- Update documentation - -## 0.1.0.5 -- 2018-08-08 - -- Simplify special bezier curves to lines - -## 0.1.0.4 -- 2017-12-30 - -- Update LICENSE - -## 0.1.0.3 -- 2017-03-19 - -- Fix typo in cabal file - -## 0.1.0.2 -- 2017-03-18 - -- Fix generating arcs with negative I or J - -## 0.1.0.1 -- 2016-10-31 - -- Minor changes to the package description and README. - -## 0.1.0.0 -- 2016-10-30 - -- First version. Mostly feature complete, but not well tested. +# Revision history for juicy-gcode++## 0.2.0.2 -- 2022-10-31++- Fix a problem triggered by non-quadratic inflexion point equations++## 0.2.0.1 -- 2020-08-24++- Breaking change: change default DPI to 96 instead of 72+- Breaking change: the option to mirror the Y axis is removed (it is always mirrored now for correct result)+- Add --version flag++## 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++## 0.1.0.8 -- 2020-05-19++- Fix unhandled bezier edge cases resulting NaNs in GCode++## 0.1.0.7 -- 2020-05-15++- Add support for the viewBox attribute++## 0.1.0.6 -- 2020-05-11++- Add option to mirror Y axis++## 0.1.0.5.2 -- 2020-04-11++- Update dependencies++## 0.1.0.5.1 -- 2018-08-08++- Update documentation++## 0.1.0.5 -- 2018-08-08++- Simplify special bezier curves to lines++## 0.1.0.4 -- 2017-12-30++- Update LICENSE++## 0.1.0.3 -- 2017-03-19++- Fix typo in cabal file++## 0.1.0.2 -- 2017-03-18++- Fix generating arcs with negative I or J++## 0.1.0.1 -- 2016-10-31++- Minor changes to the package description and README.++## 0.1.0.0 -- 2016-10-30++- First version. Mostly feature complete, but not well tested.
LICENSE view
@@ -1,21 +1,21 @@-The MIT License - -Copyright (c) 2010-2017 Google, Inc., dlacko - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +The MIT License++Copyright (c) 2010-2017 Google, Inc., dlacko++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
README.md view
@@ -1,107 +1,106 @@-# Juicy-gcode: A lightweight SVG to GCode converter for maximal curve fitting - -[](https://hackage.haskell.org/package/juicy-gcode) -[](http://travis-ci.org/domoszlai/juicy-gcode) - - -## Overview - -Juicy-gcode is a configurable SVG to G-code converter that approximates bezier curves with [biarcs](http://dlacko.org/blog/2016/10/19/approximating-bezier-curves-by-biarcs/) for maximal curve fitting. - -## Installation - -The easiest way is to download one of the pre-built binaries from the [releases page](https://github.com/domoszlai/juicy-gcode/releases). -Alternatively, you can build from source code as follows: - -- Install [Stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/) if you do not have it yet -- `$ git clone https://github.com/domoszlai/juicy-gcode.git` -- `$ stack build` -- `$ stack install` -- `$ juicy-gcode --help` - -## Usage - -> :warning: **Breaking change**: Since version 0.2.0.1, default DPI is changed to 96 and the option to mirror the Y axis is removed (it is always mirrored now for correct result) - -The easier way to use juicy-gcode is to simply provide an SVG file name. The generated GCode will be written to standard output. - -``` -$ juicy-gcode SVGFILE -``` - -Alternativly, you can provide an output file name as well. - -``` -$ juicy-gcode SVGFILE -o OUTPUT -``` - -Sometimes you want to overwrite some default settings. These are the - -* *--dpi* (default 96 DPI) [the resolution of the SVG file](https://developer.mozilla.org/en-US/docs/Web/CSS/resolution) that is used to determine the size of the SVG when it does not contain explicit units -* *--resolution* (default is 0.1 mm) the resolution of the generated GCode. Paths smaller than this are replaced by line segments instead of further approximated by biarcs - -``` -$ juicy-gcode SVGFILE --dpi 72 --resolution 0.01 -``` - -Some firmwares (e.g. [Marlin](https://marlinfw.org/docs/gcode/G005.html)) can handle bezier curves directly. In this case -you can command juicy-gcode not to approximate bezier-curves but emit them unchanged. - -``` -$ juicy-gcode SVGFILE --generate-bezier -``` - -## Configuration - -The generated GCode is highly dependent on the actual device it will be executed by. In juicy-gcode these settings are called -GCode *flavor* and consists of the following: - -- Begin GCode routine (commands that are executed *before* the actual print job) -- End GCode routine (commands that are executed *after* the actual print job) -- Tool on (commands to switch the tool on, e.g. lower pen) -- Tool off (commands to switch the tool off e.g. lift pen) - -These settings can be provided by a configuration file. The default settings -are made for being able to test the generated GCode in an emulator e.g. with [LaserWeb](https://laserweb.yurl.ch/) -or [my hanging plotter simulator](https://github.com/domoszlai/hanging-plotter-simulator). - -``` -gcode -{ - begin = "G17;G90;G0 Z1;G0 X0 Y0" - end = "G0 Z1" - toolon = "G00 Z1" - tooloff = "G01 Z0 F10.00" -} -``` - -In the case you want to overwrite it, copy this favor to a text file and modify it according to your need. Then use juicy-gcode as follows: - -``` -$ juicy-gcode SVGFILE -f FLAVORFILE -``` - -## Future development - -Juicy-gcode was originally developed as a testbed for my hanging plotter project, but over the years -it reached maturity and became a really usuable tool. My main idea for further development is to turn it -into a tool that can drive CNCs in 2.5 dimensions (e.g. carving, engraving) with just one colored SVG file. - -To be able to test and enjoy that software, I need a proper CNC. Please consider donating a small amount for that purpose, -or donate an actual CNC if you have a spare one for whatever reason. - -**[Donate for a CNC](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=UGFZYDQSTF58L&source=https://github.com/domoszlai/juicy-gcode/)** - -Collected so far: 102.47€ -Target: >= 209€ - -Thank you so much for all people supporting the development! - -## Limitations - -SVG features that are not supported: - -- texts -- filling -- clipping -- images +# Juicy-gcode: A lightweight SVG to GCode converter for maximal curve fitting++[](https://hackage.haskell.org/package/juicy-gcode)+[](https://ci.appveyor.com/project/domoszlai/juicy-gcode)++## Overview++Juicy-gcode is a configurable SVG to G-code converter that approximates bezier curves with [biarcs](http://dlacko.org/blog/2016/10/19/approximating-bezier-curves-by-biarcs/) for maximal curve fitting.++## Installation++The easiest way is to download one of the pre-built binaries from the [releases page](https://github.com/domoszlai/juicy-gcode/releases).+Alternatively, you can build from source code as follows:++- Install [Stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/) if you do not have it yet+- `$ git clone https://github.com/domoszlai/juicy-gcode.git`+- `$ stack build`+- `$ stack install`+- `$ juicy-gcode --help`++## Usage++> :warning: **Breaking change**: Since version 0.2.0.1, default DPI is changed to 96 and the option to mirror the Y axis is removed (it is always mirrored now for correct result)++The easier way to use juicy-gcode is to simply provide an SVG file name. The generated GCode will be written to standard output.++```+$ juicy-gcode SVGFILE+```++Alternativly, you can provide an output file name as well.++```+$ juicy-gcode SVGFILE -o OUTPUT+```++Sometimes you want to overwrite some default settings. These are the ++* *--dpi* (default 96 DPI) [the resolution of the SVG file](https://developer.mozilla.org/en-US/docs/Web/CSS/resolution) that is used to determine the size of the SVG when it does not contain explicit units+* *--resolution* (default is 0.1 mm) the resolution of the generated GCode. Paths smaller than this are replaced by line segments instead of further approximated by biarcs+ +```+$ juicy-gcode SVGFILE --dpi 72 --resolution 0.01 +```++Some firmwares (e.g. [Marlin](https://marlinfw.org/docs/gcode/G005.html)) can handle bezier curves directly. In this case+you can command juicy-gcode not to approximate bezier-curves but emit them unchanged. ++```+$ juicy-gcode SVGFILE --generate-bezier+```++## Configuration++The generated GCode is highly dependent on the actual device it will be executed by. In juicy-gcode these settings are called+GCode *flavor* and consists of the following:++- Begin GCode routine (commands that are executed *before* the actual print job)+- End GCode routine (commands that are executed *after* the actual print job)+- Tool on (commands to switch the tool on, e.g. lower pen)+- Tool off (commands to switch the tool off e.g. lift pen)++These settings can be provided by a configuration file. The default settings+are made for being able to test the generated GCode in an emulator e.g. with [LaserWeb](https://laserweb.yurl.ch/)+or [my hanging plotter simulator](https://github.com/domoszlai/hanging-plotter-simulator). ++```+gcode+{+ begin = "G17;G90;G0 Z1;G0 X0 Y0"+ end = "G0 Z1"+ toolon = "G00 Z1"+ tooloff = "G01 Z0 F10.00"+}+```++In the case you want to overwrite it, copy this favor to a text file and modify it according to your need. Then use juicy-gcode as follows:++```+$ juicy-gcode SVGFILE -f FLAVORFILE+```++## Future development++Juicy-gcode was originally developed as a testbed for my hanging plotter project, but over the years+it reached maturity and became a really usuable tool. My main idea for further development is to turn it+into a tool that can drive CNCs in 2.5 dimensions (e.g. carving, engraving) with just one colored SVG file.++To be able to test and enjoy that software, I need a proper CNC. Please consider donating a small amount for that purpose,+or donate an actual CNC if you have a spare one for whatever reason.++**[Donate for a CNC](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=UGFZYDQSTF58L&source=https://github.com/domoszlai/juicy-gcode/)**++Collected so far: 229.47€+Target: >= 209€++Thank you so much for all people supporting the development!++## Limitations++SVG features that are not supported:++- texts+- filling+- clipping+- images
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
juicy-gcode.cabal view
@@ -1,40 +1,40 @@-name: juicy-gcode -version: 0.2.0.1 -license: BSD3 -license-file: LICENSE -author: dlacko -maintainer: dlacko@gmail.com -stability: experimental -synopsis: SVG to G-Code converter -category: Graphics -homepage: https://github.com/domoszlai/juicy-gcode -bug-reports: https://github.com/domoszlai/juicy-gcode/issues -build-type: Simple -description: - SVG to G-code converter that aims to support most SVG features. The flavor of the generated G-Code can be influenced providing a configuration file. - -extra-source-files: ChangeLog.md, README.md -cabal-version: >=1.10 -executable juicy-gcode - hs-source-dirs: src - main-is: Main.hs - - other-modules: Approx BiArc CircularArc CubicBezier GCode Line Render SvgArcSegment Transformation Types SVGExt Paths_juicy_gcode - - build-depends: - base >=4.8 && <5, - lens >=4.15.4 && <4.20, - linear >=1.20 && <1.22, - optparse-applicative >=0.13 && <0.20, - configurator >=0.3 && <0.4, - text >=1.2.2 && <1.3, - matrix >=0.3.5 && <0.4, - svg-tree >=0.6 && <0.7, - gitrev >=1.3.0 && <1.4 - - GHC-Options: -Wall - default-language: Haskell2010 - -Source-repository head - Type: git - Location: https://github.com/domoszlai/juicy-gcode +name: juicy-gcode+version: 0.2.0.2+license: BSD3+license-file: LICENSE+author: dlacko+maintainer: dlacko@gmail.com+stability: experimental+synopsis: SVG to G-Code converter+category: Graphics+homepage: https://github.com/domoszlai/juicy-gcode+bug-reports: https://github.com/domoszlai/juicy-gcode/issues+build-type: Simple+description:+ SVG to G-code converter that aims to support most SVG features. The flavor of the generated G-Code can be influenced providing a configuration file.++extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10+executable juicy-gcode+ hs-source-dirs: src+ main-is: Main.hs++ other-modules: Approx BiArc CircularArc CubicBezier GCode Line Render SvgArcSegment Transformation Types SVGExt Paths_juicy_gcode++ build-depends:+ base >=4.8 && <5,+ lens >=4.15.4 && <4.20,+ linear >=1.20 && <1.22,+ optparse-applicative >=0.13 && <0.20,+ configurator >=0.3 && <0.4,+ text >=1.2.2 && <1.3,+ matrix >=0.3.5 && <0.4,+ svg-tree >=0.6 && <0.7,+ gitrev >=1.3.0 && <1.4++ GHC-Options: -Wall+ default-language: Haskell2010++Source-repository head+ Type: git+ Location: https://github.com/domoszlai/juicy-gcode
src/Approx.hs view
@@ -1,122 +1,115 @@-module Approx ( bezier2biarc - ) where - -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 - -> [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 - (i1, i2) = B.inflectionPoints mbezier - - order a b | b < a = (b, a) - | otherwise = (a, b) - - byInflection True False = approxOne b1 ++ approxOne b2 - where - (b1, b2) = B.bezierSplitAt mbezier (realPart i1) - - byInflection False True = approxOne b1 ++ approxOne b2 - where - (b1, b2) = B.bezierSplitAt mbezier (realPart i2) - - byInflection True True = approxOne b1 ++ approxOne b2 ++ approxOne b3 - where - (it1, it2') = order (realPart i1) (realPart i2) - - -- Make the first split and save the first new curve. The second one has to be splitted again - -- at the recalculated t2 (it is on a new curve) - it2 = (1 - it1) * it2' - - (b1, toSplit) = B.bezierSplitAt mbezier it1 - (b2, b3) = B.bezierSplitAt toSplit it2 - - byInflection False False = approxOne mbezier - - -- TODO: make it tail recursive - 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) || (isNaN (L._m t1) && isNaN (L._m t2)) - = splitAndRecur 0.5 - -- Approximation is not close enough yet, refine - | 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 - = splitAndRecur 0.5 - - where - -- Edge case: P1==C1 or P2==C2 - -- there is no derivative at P1 or P2, use the other control point - c1 = bool (B._c1 bezier) (B._c2 bezier) ((B._p1 bezier) == (B._c1 bezier)) - c2 = bool (B._c2 bezier) (B._c1 bezier) ((B._p2 bezier) == (B._c2 bezier)) - - -- V: Intersection point of tangent lines - t1 = L.fromPoints (B._p1 bezier) c1 - t2 = L.fromPoints (B._p2 bezier) c2 - v = L.intersection t1 t2 - - -- G: incenter point of the triangle (P1, V, P2) - dP2V = distance (B._p2 bezier) v - dP1V = distance (B._p1 bezier) v - dP1P2 = distance (B._p1 bezier) (B._p2 bezier) - g = (dP2V *^ B._p1 bezier + dP1V *^ B._p2 bezier + dP1P2 *^ v) ^/ (dP2V + dP1V + dP1P2) - - -- Calculate the BiArc - biarc = BA.create (B._p1 bezier) (B._p1 bezier - c1) (B._p2 bezier) (B._p2 bezier - c2) g - - -- 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 - - (maxDistance, maxDistanceAt) = maxDistance' 0 0 parameterStep - - maxDistance' m mt t - | t < 1 - = if' (d > m) (maxDistance' d t nt) (maxDistance' m mt nt) - | otherwise - = (m, mt) - where - d = distance (BA.pointAt biarc t) (B.pointAt bezier t) - nt = t + parameterStep - - splitAndRecur t = let (b1, b2) = B.bezierSplitAt bezier t - in approxOne b1 ++ approxOne b2 - +module Approx ( bezier2biarc+ ) where++import qualified CubicBezier as B+import qualified BiArc as BA +import qualified Line as L + +import Data.Bool (bool)+import Linear++import Types++-- Approximate a bezier curve with biarcs (Left) and line segments (Right)+bezier2biarc :: B.CubicBezier + -> Double+ -> [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.inflectionPoints mbezier)+ where+ order a b | b < a = (b, a)+ | otherwise = (a, b)+ + byInflection [t] = approxOne b1 ++ approxOne b2+ where+ (b1, b2) = B.bezierSplitAt mbezier t+ + byInflection [t1, t2] = approxOne b1 ++ approxOne b2 ++ approxOne b3+ where+ (it1, it2') = order t1 t2+ + -- Make the first split and save the first new curve. The second one has to be splitted again+ -- at the recalculated t2 (it is on a new curve) + it2 = (1 - it1) * it2' + + (b1, toSplit) = B.bezierSplitAt mbezier it1+ (b2, b3) = B.bezierSplitAt toSplit it2++ byInflection _ = approxOne mbezier+ + -- TODO: make it tail recursive+ 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) || (isNaN (L._m t1) && isNaN (L._m t2)) + = splitAndRecur 0.5+ -- Approximation is not close enough yet, refine+ | 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+ = splitAndRecur 0.5++ where+ -- Edge case: P1==C1 or P2==C2+ -- there is no derivative at P1 or P2, use the other control point+ c1 = bool (B._c1 bezier) (B._c2 bezier) ((B._p1 bezier) == (B._c1 bezier))+ c2 = bool (B._c2 bezier) (B._c1 bezier) ((B._p2 bezier) == (B._c2 bezier))++ -- V: Intersection point of tangent lines+ t1 = L.fromPoints (B._p1 bezier) c1+ t2 = L.fromPoints (B._p2 bezier) c2+ v = L.intersection t1 t2++ -- G: incenter point of the triangle (P1, V, P2)+ dP2V = distance (B._p2 bezier) v+ dP1V = distance (B._p1 bezier) v+ dP1P2 = distance (B._p1 bezier) (B._p2 bezier)+ g = (dP2V *^ B._p1 bezier + dP1V *^ B._p2 bezier + dP1P2 *^ v) ^/ (dP2V + dP1V + dP1P2)++ -- Calculate the BiArc+ biarc = BA.create (B._p1 bezier) (B._p1 bezier - c1) (B._p2 bezier) (B._p2 bezier - c2) g+ + -- 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+ + (maxDistance, maxDistanceAt) = maxDistance' 0 0 parameterStep+ + maxDistance' m mt t + | t < 1+ = if' (d > m) (maxDistance' d t nt) (maxDistance' m mt nt)+ | otherwise+ = (m, mt)+ where+ d = distance (BA.pointAt biarc t) (B.pointAt bezier t)+ nt = t + parameterStep++ splitAndRecur t = let (b1, b2) = B.bezierSplitAt bezier t+ in approxOne b1 ++ approxOne b2 +
src/BiArc.hs view
@@ -1,90 +1,90 @@-module BiArc ( BiArc (..) - , create - , pointAt - , arcLength - , isStable - ) where - -import qualified CircularArc as CA -import qualified Line as L - -import Linear hiding (angle) -import Control.Lens - -data BiArc = BiArc { _a1 :: CA.CircularArc - , _a2 :: CA.CircularArc - } deriving Show - -create :: V2 Double -- Start point - -> V2 Double -- Tangent vector at start point - -> V2 Double -- End point - -> 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) - where - -- Calculate the orientation - osum = (t ^. _x - p1 ^. _x) * (t ^. _y + p1 ^. _y) - + (p2 ^. _x - t ^. _x) * (p2 ^. _y + t ^. _y) - + (p1 ^. _x - p2 ^. _x) * (p1 ^. _y + p2 ^. _y) - cw = osum < 0 - - -- Calculate perpendicular lines to the tangent at P1 and P2 - tl1 = L.createPerpendicularAt p1 (p1 + t1) - tl2 = L.createPerpendicularAt p2 (p2 + t2) - - -- Calculate the perpendicular bisector of P1T and P2T - p1t2 = (p1 + t) ^/ 2 - pb_p1t = L.createPerpendicularAt p1t2 t - - p2t2 = (p2 + t) ^/ 2 - pb_p2t = L.createPerpendicularAt p2t2 t - - -- The origo of the circles are at the intersection points - c1 = L.intersection tl1 pb_p1t - c2 = L.intersection tl2 pb_p2t - - -- Calculate the radii - r1 = distance c1 p1 - r2 = distance c2 p2 - - -- Calculate start and sweep angles - startVector1 = p1 - c1; - endVector1 = t - c1; - startAngle1 = atan2 (startVector1 ^. _y) (startVector1 ^. _x) - sweepAngle1' = (atan2 (endVector1 ^. _y) (endVector1 ^. _x)) - startAngle1 - - startVector2 = t - c2 - endVector2 = p2 - c2 - startAngle2 = atan2 (startVector2 ^. _y) (startVector2 ^. _x) - sweepAngle2' = (atan2 (endVector2 ^. _y) (endVector2 ^. _x)) - startAngle2 - - -- Adjust angles according to the orientation of the curve - sweepAngle1 = adjustSweepAngle cw sweepAngle1' - sweepAngle2 = adjustSweepAngle cw sweepAngle2' - -adjustSweepAngle :: Bool -> Double -> Double -adjustSweepAngle True angle | angle < 0 = 2 * pi + angle -adjustSweepAngle False angle | angle > 0 = angle - 2 * pi -adjustSweepAngle _ angle = angle - -pointAt :: BiArc -> Double -> V2 Double -pointAt arc t - | t <= s - = CA.pointAt (_a1 arc) (t / s) - | otherwise - = CA.pointAt (_a2 arc) ((t - s) / (1 - s)) - where - s = CA.arcLength (_a1 arc) / (arcLength arc) - -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) - +module BiArc ( BiArc (..)+ , create+ , pointAt+ , arcLength+ , isStable+ ) where+ +import qualified CircularArc as CA+import qualified Line as L++import Linear hiding (angle) +import Control.Lens++data BiArc = BiArc { _a1 :: CA.CircularArc+ , _a2 :: CA.CircularArc+ } deriving Show+ +create :: V2 Double -- Start point+ -> V2 Double -- Tangent vector at start point+ -> V2 Double -- End point+ -> 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)+ where+ -- Calculate the orientation+ osum = (t ^. _x - p1 ^. _x) * (t ^. _y + p1 ^. _y)+ + (p2 ^. _x - t ^. _x) * (p2 ^. _y + t ^. _y)+ + (p1 ^. _x - p2 ^. _x) * (p1 ^. _y + p2 ^. _y)+ cw = osum < 0+ + -- Calculate perpendicular lines to the tangent at P1 and P2+ tl1 = L.createPerpendicularAt p1 (p1 + t1)+ tl2 = L.createPerpendicularAt p2 (p2 + t2)+ + -- Calculate the perpendicular bisector of P1T and P2T+ p1t2 = (p1 + t) ^/ 2+ pb_p1t = L.createPerpendicularAt p1t2 t+ + p2t2 = (p2 + t) ^/ 2+ pb_p2t = L.createPerpendicularAt p2t2 t + + -- The origo of the circles are at the intersection points+ c1 = L.intersection tl1 pb_p1t+ c2 = L.intersection tl2 pb_p2t + + -- Calculate the radii+ r1 = distance c1 p1+ r2 = distance c2 p2 + + -- Calculate start and sweep angles+ startVector1 = p1 - c1;+ endVector1 = t - c1;+ startAngle1 = atan2 (startVector1 ^. _y) (startVector1 ^. _x)+ sweepAngle1' = (atan2 (endVector1 ^. _y) (endVector1 ^. _x)) - startAngle1++ startVector2 = t - c2+ endVector2 = p2 - c2+ startAngle2 = atan2 (startVector2 ^. _y) (startVector2 ^. _x)+ sweepAngle2' = (atan2 (endVector2 ^. _y) (endVector2 ^. _x)) - startAngle2+ + -- Adjust angles according to the orientation of the curve+ sweepAngle1 = adjustSweepAngle cw sweepAngle1'+ sweepAngle2 = adjustSweepAngle cw sweepAngle2'+ +adjustSweepAngle :: Bool -> Double -> Double+adjustSweepAngle True angle | angle < 0 = 2 * pi + angle+adjustSweepAngle False angle | angle > 0 = angle - 2 * pi+adjustSweepAngle _ angle = angle + +pointAt :: BiArc -> Double -> V2 Double+pointAt arc t+ | t <= s+ = CA.pointAt (_a1 arc) (t / s)+ | otherwise+ = CA.pointAt (_a2 arc) ((t - s) / (1 - s))+ where+ s = CA.arcLength (_a1 arc) / (arcLength arc)++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/CircularArc.hs view
@@ -1,29 +1,29 @@-module CircularArc ( CircularArc (..) - , isClockwise - , pointAt - , arcLength - ) where - -import Linear -import Control.Lens - -data CircularArc = CircularArc { _c :: V2 Double - , _r :: Double - , _startAngle :: Double - , _sweepAngle :: Double - , _p1 :: V2 Double - , _p2 :: V2 Double - } deriving Show - -isClockwise :: CircularArc -> Bool -isClockwise arc = _sweepAngle arc > 0 - -pointAt :: CircularArc -> Double -> V2 Double -pointAt arc t = V2 x y - where - x = _c arc ^. _x + _r arc * cos (_startAngle arc + t * _sweepAngle arc) - y = _c arc ^. _y + _r arc * sin (_startAngle arc + t * _sweepAngle arc) - -arcLength :: CircularArc -> Double -arcLength arc = _r arc * abs(_sweepAngle arc) +module CircularArc ( CircularArc (..)+ , isClockwise+ , pointAt+ , arcLength+ ) where+ +import Linear +import Control.Lens++data CircularArc = CircularArc { _c :: V2 Double+ , _r :: Double+ , _startAngle :: Double+ , _sweepAngle :: Double+ , _p1 :: V2 Double+ , _p2 :: V2 Double+ } deriving Show++isClockwise :: CircularArc -> Bool+isClockwise arc = _sweepAngle arc > 0+ +pointAt :: CircularArc -> Double -> V2 Double+pointAt arc t = V2 x y+ where+ x = _c arc ^. _x + _r arc * cos (_startAngle arc + t * _sweepAngle arc)+ y = _c arc ^. _y + _r arc * sin (_startAngle arc + t * _sweepAngle arc)++arcLength :: CircularArc -> Double+arcLength arc = _r arc * abs(_sweepAngle arc)
src/CubicBezier.hs view
@@ -1,60 +1,68 @@-module CubicBezier ( CubicBezier (..) - , pointAt - , bezierSplitAt - , isClockwise - , inflectionPoints - , realInflectionPoint - ) where - -import Linear -import Control.Lens -import Data.Complex - -data CubicBezier = CubicBezier { _p1 :: V2 Double - , _c1 :: V2 Double - , _c2 :: V2 Double - , _p2 :: V2 Double - } deriving Show - -pointAt :: CubicBezier -> Double -> V2 Double -pointAt bezier t = ((1 - t) ** 3) *^ _p1 bezier + - ((1 - t) ** 2) * 3 * t *^ _c1 bezier + - (t ** 2) * (1 - t) * 3 *^ _c2 bezier + - (t ** 3) *^ _p2 bezier - -bezierSplitAt :: CubicBezier -> Double -> (CubicBezier, CubicBezier) -bezierSplitAt bezier t = (CubicBezier (_p1 bezier) p0 p01 dp, CubicBezier dp p12 p2 (_p2 bezier)) - where - p0 = _p1 bezier + t *^ (_c1 bezier - _p1 bezier) - p1 = _c1 bezier + t *^ (_c2 bezier - _c1 bezier) - p2 = _c2 bezier + t *^ (_p2 bezier - _c2 bezier) - - p01 = p0 + t *^ (p1 - p0) - p12 = p1 + t *^ (p2 - p1) - - dp = p01 + t *^ (p12 - p01) - -isClockwise :: CubicBezier -> Bool -isClockwise bezier = s < 0 - where - s = (_c1 bezier ^. _x - _p1 bezier ^. _x) * (_c1 bezier ^. _y + _p1 bezier ^. _y) - + (_c2 bezier ^. _x - _c1 bezier ^. _x) * (_c2 bezier ^. _y + _c1 bezier ^. _y) - + (_p2 bezier ^. _x - _c2 bezier ^. _x) * (_p2 bezier ^. _y + _c2 bezier ^. _y) - + (_p1 bezier ^. _x - _p2 bezier ^. _x) * (_p1 bezier ^. _y + _p2 bezier ^. _y) - -inflectionPoints :: CubicBezier -> (Complex Double, Complex Double) -inflectionPoints bezier = (t1, t2) - where - pa = _c1 bezier - _p1 bezier - pb = _c2 bezier - _c1 bezier - pa - pc = _p2 bezier - _c2 bezier - pa - 2 *^ pb - - a = (pb ^. _x * pc ^. _y - pb ^. _y * pc ^. _x) :+ 0 - b = (pa ^. _x * pc ^. _y - pa ^. _y * pc ^. _x) :+ 0 - c = (pa ^. _x * pb ^. _y - pa ^. _y * pb ^. _x) :+ 0 - - t1 = (-b + sqrt (b * b - 4 * a * c)) / (2 * a) - t2 = (-b - sqrt (b * b - 4 * a * c)) / (2 * a) - -realInflectionPoint :: Complex Double -> Bool -realInflectionPoint c = imagPart c == 0 && realPart c > 0 && realPart c < 1 +module CubicBezier ( CubicBezier (..)+ , pointAt+ , bezierSplitAt+ , isClockwise+ , inflectionPoints+ ) where++import Linear +import Control.Lens+import Data.Complex+ +data CubicBezier = CubicBezier { _p1 :: V2 Double+ , _c1 :: V2 Double+ , _c2 :: V2 Double+ , _p2 :: V2 Double+ } deriving Show+ +pointAt :: CubicBezier -> Double -> V2 Double+pointAt bezier t = ((1 - t) ** 3) *^ _p1 bezier + + ((1 - t) ** 2) * 3 * t *^ _c1 bezier ++ (t ** 2) * (1 - t) * 3 *^ _c2 bezier ++ (t ** 3) *^ _p2 bezier+ +bezierSplitAt :: CubicBezier -> Double -> (CubicBezier, CubicBezier)+bezierSplitAt bezier t = (CubicBezier (_p1 bezier) p0 p01 dp, CubicBezier dp p12 p2 (_p2 bezier))+ where+ p0 = _p1 bezier + t *^ (_c1 bezier - _p1 bezier)+ p1 = _c1 bezier + t *^ (_c2 bezier - _c1 bezier) + p2 = _c2 bezier + t *^ (_p2 bezier - _c2 bezier) + + p01 = p0 + t *^ (p1 - p0) + p12 = p1 + t *^ (p2 - p1) ++ dp = p01 + t *^ (p12 - p01) + +isClockwise :: CubicBezier -> Bool+isClockwise bezier = s < 0+ where+ s = (_c1 bezier ^. _x - _p1 bezier ^. _x) * (_c1 bezier ^. _y + _p1 bezier ^. _y)+ + (_c2 bezier ^. _x - _c1 bezier ^. _x) * (_c2 bezier ^. _y + _c1 bezier ^. _y)+ + (_p2 bezier ^. _x - _c2 bezier ^. _x) * (_p2 bezier ^. _y + _c2 bezier ^. _y)+ + (_p1 bezier ^. _x - _p2 bezier ^. _x) * (_p1 bezier ^. _y + _p2 bezier ^. _y)+ +inflectionPoints :: CubicBezier -> [Double]+inflectionPoints bezier+ | a /= 0 = realInflectionPoints [t1, t2]+ | otherwise = realInflectionPoints [t]+ where+ pa = _c1 bezier - _p1 bezier+ pb = _c2 bezier - _c1 bezier - pa+ pc = _p2 bezier - _c2 bezier - pa - 2 *^ pb+ + a = (pb ^. _x * pc ^. _y - pb ^. _y * pc ^. _x) :+ 0+ b = (pa ^. _x * pc ^. _y - pa ^. _y * pc ^. _x) :+ 0+ c = (pa ^. _x * pb ^. _y - pa ^. _y * pb ^. _x) :+ 0+ + -- linear case+ t = -c / b++ -- quadratic case+ t1 = (-b + sqrt (b * b - 4 * a * c)) / (2 * a)+ t2 = (-b - sqrt (b * b - 4 * a * c)) / (2 * a)++realInflectionPoints :: [Complex Double] -> [Double]+realInflectionPoints = map realPart . filter isInflectionPoint++isInflectionPoint :: Complex Double -> Bool+isInflectionPoint c = imagPart c == 0 && realPart c > 0 && realPart c < 1
src/GCode.hs view
@@ -1,57 +1,63 @@-module GCode ( GCodeFlavor(..) - , defaultFlavor - , toString - ) where - -import Data.List -import Text.Printf - -import Types - -data GCodeFlavor = GCodeFlavor { _begin :: String - , _end :: String - , _toolon :: String - , _tooloff :: String - } - -defaultFlavor :: GCodeFlavor -defaultFlavor = GCodeFlavor "G17\nG90\nG0 Z1\nG0 X0 Y0\n" "G0 Z1" "G01 Z0 F10.00" "G00 Z1" - -toString :: GCodeFlavor -> Int -> [GCodeOp] -> String -toString (GCodeFlavor begin end on off) dpi gops = begin ++ "\n" ++ intercalate "\n" (toString' gops (0,0) True) ++ "\n" ++ end - where - dd :: Double - dd = fromIntegral dpi - - mm :: Double -> Double - mm px = (px * 2.54 * 10) / dd - - toString' (GMoveTo p@(x,y) : gs) _ False - = printf "G00 X%.4f Y%.4f" (mm x) (mm y) : toString' gs p False - toString' (GMoveTo p@(x,y) : gs) _ True - = off : printf "G00 X%.4f Y%.4f" (mm x) (mm y) : toString' gs p False - toString' gs cp False - = on : toString' gs cp True - toString' (GLineTo p@(x,y) : gs) _ True - = printf "G01 X%.4f Y%.4f" (mm x) (mm y) : toString' gs p True - toString' (GArcTo (ox,oy) p@(x,y) cw : gs) (cx,cy) True - = arcStr : toString' gs p True - where - i = ox - cx - j = oy - cy - - cmd = if' cw "G03" "G02" - - 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 - i = c1x - p1x - j = c1y - p1y - p = c2x - p2x - q = c2y - p2y - - bStr = printf "G05 I%.4f J%.4f P%.4f Q%.4f X%.4f Y%.4f" - (mm i) (mm j) (mm p) (mm q) (mm p2x) (mm p2y) - - toString' [] _ _ = [] +module GCode ( GCodeFlavor(..)+ , defaultFlavor+ , toString+ ) where++import Data.List+import Text.Printf++import Types++data GCodeFlavor = GCodeFlavor { _begin :: String+ , _end :: String+ , _toolon :: String+ , _tooloff :: String+ }++defaultFlavor :: GCodeFlavor+defaultFlavor = GCodeFlavor "G17\nG90\nG0 Z1\nG0 X0 Y0" "G0 Z1" "G01 Z0 F10.00" "G00 Z1"++toString :: GCodeFlavor -> Int -> [GCodeOp] -> String+toString (GCodeFlavor begin end on off) dpi gops + = begin +++ "\n" ++ + intercalate "\n" (toString' gops (0,0) True) ++ + "\n" ++ + end +++ "\n"+ where+ dd :: Double+ dd = fromIntegral dpi++ mm :: Double -> Double+ mm px = (px * 2.54 * 10) / dd++ toString' (GMoveTo p@(x,y) : gs) _ False+ = printf "G00 X%.4f Y%.4f" (mm x) (mm y) : toString' gs p False+ toString' (GMoveTo p@(x,y) : gs) _ True+ = off : printf "G00 X%.4f Y%.4f" (mm x) (mm y) : toString' gs p False+ toString' gs cp False+ = on : toString' gs cp True+ toString' (GLineTo p@(x,y) : gs) _ True+ = printf "G01 X%.4f Y%.4f" (mm x) (mm y) : toString' gs p True+ toString' (GArcTo (ox,oy) p@(x,y) cw : gs) (cx,cy) True+ = arcStr : toString' gs p True+ where+ i = ox - cx+ j = oy - cy++ cmd = if' cw "G03" "G02"++ 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+ i = c1x - p1x+ j = c1y - p1y+ p = c2x - p2x+ q = c2y - p2y++ bStr = printf "G05 I%.4f J%.4f P%.4f Q%.4f X%.4f Y%.4f"+ (mm i) (mm j) (mm p) (mm q) (mm p2x) (mm p2y)++ toString' [] _ _ = []
src/Line.hs view
@@ -1,73 +1,73 @@-module Line ( Line (..) - , throughPoint - , fromPoints - , 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 - -throughPoint :: V2 Double -> Double -> Line -throughPoint p m = Line m p - -fromPoints :: V2 Double -> V2 Double -> Line -fromPoints p1 p2 = throughPoint p1 (slope p1 p2) - --- Creates a a line which is perpendicular to the line defined by P and P1 and goes through P -createPerpendicularAt :: V2 Double -> V2 Double -> Line -createPerpendicularAt p p1 - | m == 0 - = throughPoint p nan - | isNaN m - = throughPoint p 0 - | otherwise - = throughPoint p (-1 / m) - where - m = slope p p1 - -slope :: V2 Double -> V2 Double -> Double -slope p1 p2 - | p2 ^. _x == p1 ^. _x - = nan - | otherwise - = (p2 ^. _y - p1 ^. _y) / (p2 ^. _x - p1 ^. _x) - -nan :: Double -nan = 0/0 - --- 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 - = 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) - y = _m line1 * x - _m line1 * _p line1 ^. _x + _p line1 ^. _y - --- First line is vertical -verticalIntersection :: Line -> Line -> V2 Double -verticalIntersection vline line = V2 x y - where - 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 +module Line ( Line (..)+ , throughPoint+ , fromPoints+ , 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+ +throughPoint :: V2 Double -> Double -> Line+throughPoint p m = Line m p+ +fromPoints :: V2 Double -> V2 Double -> Line+fromPoints p1 p2 = throughPoint p1 (slope p1 p2)+ +-- Creates a a line which is perpendicular to the line defined by P and P1 and goes through P +createPerpendicularAt :: V2 Double -> V2 Double -> Line+createPerpendicularAt p p1+ | m == 0+ = throughPoint p nan+ | isNaN m+ = throughPoint p 0+ | otherwise + = throughPoint p (-1 / m)+ where+ m = slope p p1+ +slope :: V2 Double -> V2 Double -> Double+slope p1 p2 + | p2 ^. _x == p1 ^. _x+ = nan+ | otherwise+ = (p2 ^. _y - p1 ^. _y) / (p2 ^. _x - p1 ^. _x)+ +nan :: Double +nan = 0/0 + +-- 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+ = 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) + y = _m line1 * x - _m line1 * _p line1 ^. _x + _p line1 ^. _y+ +-- First line is vertical+verticalIntersection :: Line -> Line -> V2 Double +verticalIntersection vline line = V2 x y+ where+ 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
@@ -1,92 +1,90 @@-{-# LANGUAGE TemplateHaskell #-} - -import qualified Graphics.Svg as SVG - -import Options.Applicative -import Paths_juicy_gcode (version) -import Data.Version (showVersion) -import Development.GitRev (gitHash) - -import Data.Text (Text, pack, unpack, replace) -import qualified Data.Configurator as C - -import Data.Monoid - -import Render -import GCode - -data Options = Options { _svgfile :: String - , _cfgfile :: Maybe String - , _outfile :: Maybe String - , _dpi :: Int - , _resolution :: Double - , _generateBezier :: Bool - } - -options :: Parser Options -options = Options - <$> argument str - ( metavar "SVGFILE" - <> help "The SVG file to be converted" ) - <*> (optional $ strOption - ( long "flavor" - <> short 'f' - <> metavar "CONFIGFILE" - <> help "Configuration of G-Code flavor" )) - <*> (optional $ strOption - ( long "output" - <> short 'o' - <> metavar "OUTPUTFILE" - <> help "The output G-Code file (default is standard output)" )) - <*> (option auto - ( long "dpi" - <> value 96 - <> short 'd' - <> metavar "DPI" - <> help "Used to determine the size of the SVG when it does not contain any units; dot per inch (default is 96)" )) - <*> (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 "generate-bezier" - <> short 'b' - <> help "Generate bezier curves (G5) instead of arcs (G2,G3)" )) - -runWithOptions :: Options -> IO () -runWithOptions (Options svgFile mbCfg mbOut dpi resolution generateBezier) = - do - mbDoc <- SVG.loadSvgFile svgFile - flavor <- maybe (return defaultFlavor) readFlavor mbCfg - case mbDoc of - (Just doc) -> writer (toString flavor dpi $ renderDoc generateBezier dpi resolution doc) - Nothing -> putStrLn "juicy-gcode: error during opening the SVG file" - where - writer = maybe putStrLn (\fn -> writeFile fn) mbOut - -toLines :: Text -> String -toLines t = unpack $ replace (pack ";") (pack "\n") t - -readFlavor :: FilePath -> IO GCodeFlavor -readFlavor cfgFile = do - cfg <- C.load [C.Required cfgFile] - begin <- C.require cfg (pack "gcode.begin") - end <- C.require cfg (pack "gcode.end") - toolon <- C.require cfg (pack "gcode.toolon") - tooloff <- C.require cfg (pack "gcode.tooloff") - return $ GCodeFlavor (toLines begin) (toLines end) (toLines toolon) (toLines tooloff) - -versionOption :: Parser (a -> a) -versionOption = infoOption - (concat ["juicy-gcode ", showVersion version, ", git revision ", $(gitHash)]) - (long "version" <> short 'v' <> help "Show version") - -main :: IO () -main = execParser opts >>= runWithOptions - where - opts = info (helper <*> versionOption <*> options) - ( fullDesc - <> progDesc "Convert SVGFILE to G-Code" +{-# LANGUAGE TemplateHaskell #-}++import qualified Graphics.Svg as SVG++import Options.Applicative+import Paths_juicy_gcode (version)+import Data.Version (showVersion)+import Development.GitRev (gitHash)++import Data.Text (Text, pack, unpack, replace)+import qualified Data.Configurator as C++import Render+import GCode++data Options = Options { _svgfile :: String+ , _cfgfile :: Maybe String+ , _outfile :: Maybe String+ , _dpi :: Int+ , _resolution :: Double+ , _generateBezier :: Bool+ }++options :: Parser Options+options = Options+ <$> argument str+ ( metavar "SVGFILE"+ <> help "The SVG file to be converted" )+ <*> (optional $ strOption+ ( long "flavor"+ <> short 'f'+ <> metavar "CONFIGFILE"+ <> help "Configuration of G-Code flavor" ))+ <*> (optional $ strOption+ ( long "output"+ <> short 'o'+ <> metavar "OUTPUTFILE"+ <> help "The output G-Code file (default is standard output)" ))+ <*> (option auto+ ( long "dpi"+ <> value 96+ <> short 'd'+ <> metavar "DPI"+ <> help "Used to determine the size of the SVG when it does not contain any units; dot per inch (default is 96)" ))+ <*> (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 "generate-bezier"+ <> short 'b'+ <> help "Generate bezier curves (G5) instead of arcs (G2,G3)" ))++runWithOptions :: Options -> IO ()+runWithOptions (Options svgFile mbCfg mbOut dpi resolution generateBezier) =+ do+ mbDoc <- SVG.loadSvgFile svgFile+ flavor <- maybe (return defaultFlavor) readFlavor mbCfg+ case mbDoc of+ (Just doc) -> writer (toString flavor dpi $ renderDoc generateBezier dpi resolution doc)+ Nothing -> putStrLn "juicy-gcode: error during opening the SVG file"+ where+ writer = maybe putStr (\fn -> writeFile fn) mbOut++toLines :: Text -> String+toLines t = unpack $ replace (pack ";") (pack "\n") t++readFlavor :: FilePath -> IO GCodeFlavor+readFlavor cfgFile = do+ cfg <- C.load [C.Required cfgFile]+ begin <- C.require cfg (pack "gcode.begin")+ end <- C.require cfg (pack "gcode.end")+ toolon <- C.require cfg (pack "gcode.toolon")+ tooloff <- C.require cfg (pack "gcode.tooloff")+ return $ GCodeFlavor (toLines begin) (toLines end) (toLines toolon) (toLines tooloff)++versionOption :: Parser (a -> a)+versionOption = infoOption + (concat ["juicy-gcode ", showVersion version, ", git revision ", $(gitHash)])+ (long "version" <> short 'v' <> help "Show version")++main :: IO ()+main = execParser opts >>= runWithOptions+ where+ opts = info (helper <*> versionOption <*> options)+ ( fullDesc+ <> progDesc "Convert SVGFILE to G-Code" <> header "juicy-gcode - The SVG to G-Code converter" )
src/Render.hs view
@@ -1,266 +1,266 @@-module Render ( renderDoc - ) where - -import qualified Graphics.Svg as SVG -import qualified Graphics.Svg.CssTypes as CSS -import qualified Linear - -import Types -import Transformation -import SvgArcSegment -import Approx -import SVGExt - -import qualified CircularArc as CA -import qualified BiArc as BA -import qualified CubicBezier as B - -mapTuple :: (a -> b) -> (a, a) -> (b, b) -mapTuple f (a1, a2) = (f a1, f a2) - -fromSvgPoint :: Int -> SVG.Point -> Point -fromSvgPoint dpi (x,y) = (fromSvgNumber dpi x, fromSvgNumber dpi y) - -fromRPoint :: SVG.RPoint -> Point -fromRPoint (Linear.V2 x y) = (x, y) - -toPoint :: Linear.V2 Double -> Point -toPoint (Linear.V2 x y) = (x, y) - -fromPoint :: Point -> Linear.V2 Double -fromPoint (x, y) = (Linear.V2 x y) - --- TODO: em, percentage -fromSvgNumber :: Int -> SVG.Number -> Double -fromSvgNumber dpi num = fromNumber' (CSS.toUserUnit dpi num) - where - fromNumber' (SVG.Num n) = n - fromNumber' _ = error "TODO: unhandled em or percentage" - --- current point + control point -> mirrored control point -mirrorControlPoint :: Point -> Point -> Point -mirrorControlPoint (cx, cy) (cpx, cpy) = (cx + cx - cpx, cy + cy - cpy) - --- convert a quadratic bezier to a cubic one -bezierQ2C :: Point -> Point -> Point -> DrawOp -bezierQ2C (qp0x, qp0y) (qp1x, qp1y) (qp2x, qp2y) - = 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 -toAbsolute (cx,cy) SVG.OriginRelative (dx,dy) = (cx+dx, cy+dy) - -docTransform :: Int -> SVG.Document -> TransformationMatrix -docTransform dpi doc = multiply mirrorTransform (viewBoxTransform $ SVG._viewBox doc) - where - viewBoxTransform (Just (vbx,vby,vbw,vbh)) - = multiply (scaleTransform (w/vbw) (h/vbh)) (translateTransform (-vbx) (-vby)) - viewBoxTransform Nothing - = identityTransform - - mirrorTransform = mirrorYTransform w h - - (w, h) = (documentSize dpi doc) - -renderDoc :: Bool -> Int -> Double -> SVG.Document -> [GCodeOp] -renderDoc generateBezier dpi resolution doc - = stage2 $ renderTrees (docTransform 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) - where - convert [] _ = [] - 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) - where - 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] - renderPathCommands _ currentp _ (SVG.MoveTo origin (p:ps):ds) - = DMoveTo ap : renderPathCommands ap ap Nothing (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - - cont [] = ds - cont ps' = SVG.LineTo origin ps' : ds - - renderPathCommands firstp currentp _ (SVG.LineTo origin (p:ps):ds) - = DLineTo ap : renderPathCommands firstp ap Nothing (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - - cont [] = ds - cont ps' = SVG.LineTo origin ps' : ds - - renderPathCommands firstp (_, cy) _ (SVG.HorizontalTo SVG.OriginAbsolute (px:pxs):ds) - = DLineTo ap : renderPathCommands firstp ap Nothing (cont pxs) - where - ap = (px,cy) - - cont [] = ds - cont pxs' = SVG.HorizontalTo SVG.OriginAbsolute pxs' : ds - - renderPathCommands firstp (cx, cy) _ (SVG.HorizontalTo SVG.OriginRelative (dx:dxs):ds) - = DLineTo ap : renderPathCommands firstp ap Nothing (cont dxs) - where - ap = (cx+dx,cy) - - cont [] = ds - cont dxs' = SVG.HorizontalTo SVG.OriginRelative dxs' : ds - - renderPathCommands firstp (cx, _) _ (SVG.VerticalTo SVG.OriginAbsolute (py:pys):ds) - = DLineTo ap : renderPathCommands firstp ap Nothing (cont pys) - where - ap = (cx,py) - - cont [] = ds - cont pys' = SVG.VerticalTo SVG.OriginAbsolute pys' : ds - - renderPathCommands firstp (cx, cy) _ (SVG.VerticalTo SVG.OriginRelative (dy:dys):ds) - = DLineTo ap : renderPathCommands firstp ap Nothing (cont dys) - where - ap = (cx,cy+dy) - - cont [] = ds - cont dys' = SVG.VerticalTo SVG.OriginRelative dys' : ds - - renderPathCommands firstp currentp _ (SVG.CurveTo origin ((c1,c2,p):ps):ds) - = DBezierTo ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - ac1 = toAbsolute currentp origin (fromRPoint c1) - ac2 = toAbsolute currentp origin (fromRPoint c2) - - cont [] = ds - cont ps' = SVG.CurveTo origin ps' : ds - - renderPathCommands firstp currentp mbControlp (SVG.SmoothCurveTo origin ((c2,p):ps):ds) - = DBezierTo ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - ac1 = maybe ac2 (mirrorControlPoint currentp) mbControlp - ac2 = toAbsolute currentp origin (fromRPoint c2) - - cont [] = ds - cont ps' = SVG.SmoothCurveTo origin ps' : ds - - renderPathCommands firstp currentp _ (SVG.QuadraticBezier origin ((c1,p):ps):ds) - = cbezier : renderPathCommands firstp ap (Just ac1) (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - ac1 = toAbsolute currentp origin (fromRPoint c1) - - cbezier = bezierQ2C currentp ac1 ap - - cont [] = ds - cont ps' = SVG.QuadraticBezier origin ps' : ds - - renderPathCommands firstp currentp mbControlp (SVG.SmoothQuadraticBezierCurveTo origin (p:ps):ds) - = cbezier : renderPathCommands firstp ap (Just ac1) (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - ac1 = maybe currentp (mirrorControlPoint currentp) mbControlp - - cbezier = bezierQ2C currentp ac1 ap - - cont [] = ds - cont ps' = SVG.SmoothQuadraticBezierCurveTo origin ps' : ds - - renderPathCommands firstp currentp _ (SVG.EllipticalArc origin ((rx,ry,rot,largeArcFlag,sweepFlag,p):ps):ds) - = convertSvgArc currentp rx ry rot largeArcFlag sweepFlag ap ++ renderPathCommands firstp ap Nothing (cont ps) - where - ap = toAbsolute currentp origin (fromRPoint p) - - cont [] = ds - cont ps' = SVG.EllipticalArc origin ps' : ds - - renderPathCommands firstp@(fx,fy) (cx,cy) mbControlp (SVG.EndPath:ds) - | fx /= cx || fy /= cy - = DLineTo firstp : renderPathCommands firstp firstp mbControlp ds - | otherwise - = renderPathCommands firstp firstp mbControlp ds - - renderPathCommands _ _ _ _ = [] - - renderTree :: TransformationMatrix -> SVG.Tree -> [DrawOp] - renderTree m (SVG.GroupTree g) = renderTrees (applyTransformations m (SVG._transform (SVG._groupDrawAttributes g))) (SVG._groupChildren g) - renderTree m (SVG.PathTree p) = map (transformDrawOp tr) $ renderPathCommands (0,0) (0,0) Nothing (SVG._pathDefinition p) - where - tr = applyTransformations m (SVG._transform (SVG._pathDrawAttributes p)) - - renderTree m (SVG.RectangleTree r) - | rx == 0.0 && ry == 0.0 - = map (transformDrawOp tr) [DMoveTo (x,y), DLineTo (x+w,y), DLineTo (x+w,y+h), DLineTo (x,y+h), DLineTo (x,y)] - | otherwise - = map (transformDrawOp tr) - ([DMoveTo (x,y+ry)] ++ convertSvgArc (x,y+ry) rx ry 0 False True (x+rx, y) ++ - [DLineTo (x+w-rx,y)] ++ convertSvgArc (x+w-rx,y) rx ry 0 False True (x+w, y+ry) ++ - [DLineTo (x+w,y+h-ry)] ++ convertSvgArc (x+w,y+h-ry) rx ry 0 False True (x+w-rx, y+h) ++ - [DLineTo (x+rx,y+h)] ++ convertSvgArc (x+rx, y+h) rx ry 0 False True (x, y+h-ry) ++ - [DLineTo (x,y+ry)]) - where - (x,y) = fromSvgPoint dpi (SVG._rectUpperLeftCorner r) - w = fromSvgNumber dpi (SVG._rectWidth r) - h = fromSvgNumber dpi (SVG._rectHeight r) - (rx, ry) = mapTuple (fromSvgNumber dpi) (SVG._rectCornerRadius r) - tr = applyTransformations m (SVG._transform (SVG._rectDrawAttributes r)) - - renderTree m (SVG.LineTree l) = [DMoveTo p1, DLineTo p2] - where - p1 = 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) - where - (p0:ps) = map (\(Linear.V2 x y) -> (x,y)) (SVG._polyLinePoints l) - tr = applyTransformations m (SVG._transform (SVG._polyLineDrawAttributes l)) - - renderTree m (SVG.PolygonTree l) = map (transformDrawOp tr) (DMoveTo p0:map DLineTo (ps ++ [p0])) - where - (p0:ps) = map (\(Linear.V2 x y) -> (x,y)) (SVG._polygonPoints l) - tr = applyTransformations m (SVG._transform (SVG._polygonDrawAttributes l)) - - renderTree m (SVG.EllipseTree e) = map (transformDrawOp tr) (DMoveTo (cx-rx,cy) : bs1++bs2++bs3++bs4) - where - bs1 = convertSvgArc (cx-rx, cy) rx ry 0 False True (cx, cy-ry) - bs2 = convertSvgArc (cx, cy-ry) rx ry 0 False True (cx+rx, cy) - bs3 = convertSvgArc (cx+rx, cy) rx ry 0 False True (cx, cy+ry) - bs4 = convertSvgArc (cx, cy+ry) rx ry 0 False True (cx-rx, cy) - - (cx,cy) = fromSvgPoint dpi (SVG._ellipseCenter e) - rx = fromSvgNumber dpi (SVG._ellipseXRadius e) - ry = fromSvgNumber dpi (SVG._ellipseYRadius e) - tr = applyTransformations m (SVG._transform (SVG._ellipseDrawAttributes e)) - - renderTree m (SVG.CircleTree c) = map (transformDrawOp tr) (DMoveTo (cx-r,cy) : bs1++bs2++bs3++bs4) - where - bs1 = convertSvgArc (cx-r, cy) r r 0 False True (cx, cy-r) - bs2 = convertSvgArc (cx, cy-r) r r 0 False True (cx+r, cy) - bs3 = convertSvgArc (cx+r, cy) r r 0 False True (cx, cy+r) - bs4 = convertSvgArc (cx, cy+r) r r 0 False True (cx-r, cy) - - (cx,cy) = fromSvgPoint dpi (SVG._circleCenter c) - r = fromSvgNumber dpi (SVG._circleRadius c) - tr = applyTransformations m (SVG._transform (SVG._circleDrawAttributes c)) - - {- The rest: None, UseTree, SymbolTree, TextTree, ImageTree -} - renderTree _ _ = [] - - renderTrees :: TransformationMatrix -> [SVG.Tree] -> [DrawOp] - renderTrees m es = concat $ map (renderTree m) es +module Render ( renderDoc+ ) where++import qualified Graphics.Svg as SVG+import qualified Graphics.Svg.CssTypes as CSS+import qualified Linear++import Types+import Transformation+import SvgArcSegment+import Approx+import SVGExt++import qualified CircularArc as CA+import qualified BiArc as BA+import qualified CubicBezier as B++mapTuple :: (a -> b) -> (a, a) -> (b, b)+mapTuple f (a1, a2) = (f a1, f a2)++fromSvgPoint :: Int -> SVG.Point -> Point+fromSvgPoint dpi (x,y) = (fromSvgNumber dpi x, fromSvgNumber dpi y)++fromRPoint :: SVG.RPoint -> Point+fromRPoint (Linear.V2 x y) = (x, y)++toPoint :: Linear.V2 Double -> Point+toPoint (Linear.V2 x y) = (x, y)++fromPoint :: Point -> Linear.V2 Double+fromPoint (x, y) = (Linear.V2 x y)++-- TODO: em, percentage+fromSvgNumber :: Int -> SVG.Number -> Double+fromSvgNumber dpi num = fromNumber' (CSS.toUserUnit dpi num)+ where+ fromNumber' (SVG.Num n) = n+ fromNumber' _ = error "TODO: unhandled em or percentage"++-- current point + control point -> mirrored control point+mirrorControlPoint :: Point -> Point -> Point+mirrorControlPoint (cx, cy) (cpx, cpy) = (cx + cx - cpx, cy + cy - cpy)++-- convert a quadratic bezier to a cubic one+bezierQ2C :: Point -> Point -> Point -> DrawOp+bezierQ2C (qp0x, qp0y) (qp1x, qp1y) (qp2x, qp2y)+ = 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+toAbsolute (cx,cy) SVG.OriginRelative (dx,dy) = (cx+dx, cy+dy)++docTransform :: Int -> SVG.Document -> TransformationMatrix+docTransform dpi doc = multiply mirrorTransform (viewBoxTransform $ SVG._viewBox doc)+ where+ viewBoxTransform (Just (vbx,vby,vbw,vbh))+ = multiply (scaleTransform (w/vbw) (h/vbh)) (translateTransform (-vbx) (-vby))+ viewBoxTransform Nothing+ = identityTransform++ mirrorTransform = mirrorYTransform w h++ (w, h) = (documentSize dpi doc)++renderDoc :: Bool -> Int -> Double -> SVG.Document -> [GCodeOp]+renderDoc generateBezier dpi resolution doc+ = stage2 $ renderTrees (docTransform 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)+ where+ convert [] _ = []+ 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)+ where+ 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]+ renderPathCommands _ currentp _ (SVG.MoveTo origin (p:ps):ds)+ = DMoveTo ap : renderPathCommands ap ap Nothing (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)++ cont [] = ds+ cont ps' = SVG.LineTo origin ps' : ds++ renderPathCommands firstp currentp _ (SVG.LineTo origin (p:ps):ds)+ = DLineTo ap : renderPathCommands firstp ap Nothing (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)++ cont [] = ds+ cont ps' = SVG.LineTo origin ps' : ds++ renderPathCommands firstp (_, cy) _ (SVG.HorizontalTo SVG.OriginAbsolute (px:pxs):ds)+ = DLineTo ap : renderPathCommands firstp ap Nothing (cont pxs)+ where+ ap = (px,cy)++ cont [] = ds+ cont pxs' = SVG.HorizontalTo SVG.OriginAbsolute pxs' : ds++ renderPathCommands firstp (cx, cy) _ (SVG.HorizontalTo SVG.OriginRelative (dx:dxs):ds)+ = DLineTo ap : renderPathCommands firstp ap Nothing (cont dxs)+ where+ ap = (cx+dx,cy)++ cont [] = ds+ cont dxs' = SVG.HorizontalTo SVG.OriginRelative dxs' : ds++ renderPathCommands firstp (cx, _) _ (SVG.VerticalTo SVG.OriginAbsolute (py:pys):ds)+ = DLineTo ap : renderPathCommands firstp ap Nothing (cont pys)+ where+ ap = (cx,py)++ cont [] = ds+ cont pys' = SVG.VerticalTo SVG.OriginAbsolute pys' : ds++ renderPathCommands firstp (cx, cy) _ (SVG.VerticalTo SVG.OriginRelative (dy:dys):ds)+ = DLineTo ap : renderPathCommands firstp ap Nothing (cont dys)+ where+ ap = (cx,cy+dy)++ cont [] = ds+ cont dys' = SVG.VerticalTo SVG.OriginRelative dys' : ds++ renderPathCommands firstp currentp _ (SVG.CurveTo origin ((c1,c2,p):ps):ds)+ = DBezierTo ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)+ ac1 = toAbsolute currentp origin (fromRPoint c1)+ ac2 = toAbsolute currentp origin (fromRPoint c2)++ cont [] = ds+ cont ps' = SVG.CurveTo origin ps' : ds++ renderPathCommands firstp currentp mbControlp (SVG.SmoothCurveTo origin ((c2,p):ps):ds)+ = DBezierTo ac1 ac2 ap : renderPathCommands firstp ap (Just ac2) (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)+ ac1 = maybe ac2 (mirrorControlPoint currentp) mbControlp+ ac2 = toAbsolute currentp origin (fromRPoint c2)++ cont [] = ds+ cont ps' = SVG.SmoothCurveTo origin ps' : ds++ renderPathCommands firstp currentp _ (SVG.QuadraticBezier origin ((c1,p):ps):ds)+ = cbezier : renderPathCommands firstp ap (Just ac1) (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)+ ac1 = toAbsolute currentp origin (fromRPoint c1)++ cbezier = bezierQ2C currentp ac1 ap++ cont [] = ds+ cont ps' = SVG.QuadraticBezier origin ps' : ds++ renderPathCommands firstp currentp mbControlp (SVG.SmoothQuadraticBezierCurveTo origin (p:ps):ds)+ = cbezier : renderPathCommands firstp ap (Just ac1) (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)+ ac1 = maybe currentp (mirrorControlPoint currentp) mbControlp++ cbezier = bezierQ2C currentp ac1 ap++ cont [] = ds+ cont ps' = SVG.SmoothQuadraticBezierCurveTo origin ps' : ds++ renderPathCommands firstp currentp _ (SVG.EllipticalArc origin ((rx,ry,rot,largeArcFlag,sweepFlag,p):ps):ds)+ = convertSvgArc currentp rx ry rot largeArcFlag sweepFlag ap ++ renderPathCommands firstp ap Nothing (cont ps)+ where+ ap = toAbsolute currentp origin (fromRPoint p)++ cont [] = ds+ cont ps' = SVG.EllipticalArc origin ps' : ds++ renderPathCommands firstp@(fx,fy) (cx,cy) mbControlp (SVG.EndPath:ds)+ | fx /= cx || fy /= cy+ = DLineTo firstp : renderPathCommands firstp firstp mbControlp ds+ | otherwise+ = renderPathCommands firstp firstp mbControlp ds++ renderPathCommands _ _ _ _ = []++ renderTree :: TransformationMatrix -> SVG.Tree -> [DrawOp]+ renderTree m (SVG.GroupTree g) = renderTrees (applyTransformations m (SVG._transform (SVG._groupDrawAttributes g))) (SVG._groupChildren g)+ renderTree m (SVG.PathTree p) = map (transformDrawOp tr) $ renderPathCommands (0,0) (0,0) Nothing (SVG._pathDefinition p)+ where+ tr = applyTransformations m (SVG._transform (SVG._pathDrawAttributes p))++ renderTree m (SVG.RectangleTree r)+ | rx == 0.0 && ry == 0.0+ = map (transformDrawOp tr) [DMoveTo (x,y), DLineTo (x+w,y), DLineTo (x+w,y+h), DLineTo (x,y+h), DLineTo (x,y)]+ | otherwise+ = map (transformDrawOp tr)+ ([DMoveTo (x,y+ry)] ++ convertSvgArc (x,y+ry) rx ry 0 False True (x+rx, y) +++ [DLineTo (x+w-rx,y)] ++ convertSvgArc (x+w-rx,y) rx ry 0 False True (x+w, y+ry) +++ [DLineTo (x+w,y+h-ry)] ++ convertSvgArc (x+w,y+h-ry) rx ry 0 False True (x+w-rx, y+h) +++ [DLineTo (x+rx,y+h)] ++ convertSvgArc (x+rx, y+h) rx ry 0 False True (x, y+h-ry) +++ [DLineTo (x,y+ry)])+ where+ (x,y) = fromSvgPoint dpi (SVG._rectUpperLeftCorner r)+ w = fromSvgNumber dpi (SVG._rectWidth r)+ h = fromSvgNumber dpi (SVG._rectHeight r)+ (rx, ry) = mapTuple (fromSvgNumber dpi) (SVG._rectCornerRadius r)+ tr = applyTransformations m (SVG._transform (SVG._rectDrawAttributes r))++ renderTree m (SVG.LineTree l) = [DMoveTo p1, DLineTo p2]+ where+ p1 = 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)+ where+ (p0:ps) = map (\(Linear.V2 x y) -> (x,y)) (SVG._polyLinePoints l)+ tr = applyTransformations m (SVG._transform (SVG._polyLineDrawAttributes l))++ renderTree m (SVG.PolygonTree l) = map (transformDrawOp tr) (DMoveTo p0:map DLineTo (ps ++ [p0]))+ where+ (p0:ps) = map (\(Linear.V2 x y) -> (x,y)) (SVG._polygonPoints l)+ tr = applyTransformations m (SVG._transform (SVG._polygonDrawAttributes l))++ renderTree m (SVG.EllipseTree e) = map (transformDrawOp tr) (DMoveTo (cx-rx,cy) : bs1++bs2++bs3++bs4)+ where+ bs1 = convertSvgArc (cx-rx, cy) rx ry 0 False True (cx, cy-ry)+ bs2 = convertSvgArc (cx, cy-ry) rx ry 0 False True (cx+rx, cy)+ bs3 = convertSvgArc (cx+rx, cy) rx ry 0 False True (cx, cy+ry)+ bs4 = convertSvgArc (cx, cy+ry) rx ry 0 False True (cx-rx, cy)++ (cx,cy) = fromSvgPoint dpi (SVG._ellipseCenter e)+ rx = fromSvgNumber dpi (SVG._ellipseXRadius e)+ ry = fromSvgNumber dpi (SVG._ellipseYRadius e)+ tr = applyTransformations m (SVG._transform (SVG._ellipseDrawAttributes e))++ renderTree m (SVG.CircleTree c) = map (transformDrawOp tr) (DMoveTo (cx-r,cy) : bs1++bs2++bs3++bs4)+ where+ bs1 = convertSvgArc (cx-r, cy) r r 0 False True (cx, cy-r)+ bs2 = convertSvgArc (cx, cy-r) r r 0 False True (cx+r, cy)+ bs3 = convertSvgArc (cx+r, cy) r r 0 False True (cx, cy+r)+ bs4 = convertSvgArc (cx, cy+r) r r 0 False True (cx-r, cy)++ (cx,cy) = fromSvgPoint dpi (SVG._circleCenter c)+ r = fromSvgNumber dpi (SVG._circleRadius c)+ tr = applyTransformations m (SVG._transform (SVG._circleDrawAttributes c))++ {- The rest: None, UseTree, SymbolTree, TextTree, ImageTree -}+ renderTree _ _ = []++ renderTrees :: TransformationMatrix -> [SVG.Tree] -> [DrawOp]+ renderTrees m es = concat $ map (renderTree m) es
src/SVGExt.hs view
@@ -1,30 +1,30 @@-module SVGExt ( documentSize - ) where - -import qualified Graphics.Svg as SVG - --- it is a replacement of SVG.documentSize as that returns (Int,Int) causing a serious --- precision loss in the final gcode -documentSize :: Int -> SVG.Document -> (Double, Double) -documentSize _ SVG.Document { SVG._viewBox = Just (x1, y1, x2, y2) - , SVG._width = Just (SVG.Percent pw) - , SVG._height = Just (SVG.Percent ph) - } = - (dx * pw, dy * ph) - where - dx = abs $ x2 - x1 - dy = abs $ y2 - y1 - -documentSize _ SVG.Document { SVG._width = Just (SVG.Num w) - , SVG._height = Just (SVG.Num h) } = (w, h) - -documentSize dpi doc@(SVG.Document { SVG._width = Just w - , SVG._height = Just h }) = - documentSize dpi $ doc - { SVG._width = Just $ SVG.toUserUnit dpi w - , SVG._height = Just $ SVG.toUserUnit dpi h } - -documentSize _ SVG.Document { SVG._viewBox = Just (x1, y1, x2, y2) } = - (abs $ x2 - x1, abs $ y2 - y1) - -documentSize _ _ = (1, 1) +module SVGExt ( documentSize+ ) where++import qualified Graphics.Svg as SVG++-- it is a replacement of SVG.documentSize as that returns (Int,Int) causing a serious+-- precision loss in the final gcode+documentSize :: Int -> SVG.Document -> (Double, Double)+documentSize _ SVG.Document { SVG._viewBox = Just (x1, y1, x2, y2)+ , SVG._width = Just (SVG.Percent pw)+ , SVG._height = Just (SVG.Percent ph)+ } =+ (dx * pw, dy * ph)+ where+ dx = abs $ x2 - x1+ dy = abs $ y2 - y1++documentSize _ SVG.Document { SVG._width = Just (SVG.Num w)+ , SVG._height = Just (SVG.Num h) } = (w, h)++documentSize dpi doc@(SVG.Document { SVG._width = Just w+ , SVG._height = Just h }) =+ documentSize dpi $ doc+ { SVG._width = Just $ SVG.toUserUnit dpi w+ , SVG._height = Just $ SVG.toUserUnit dpi h }++documentSize _ SVG.Document { SVG._viewBox = Just (x1, y1, x2, y2) } =+ (abs $ x2 - x1, abs $ y2 - y1)++documentSize _ _ = (1, 1)
src/SvgArcSegment.hs view
@@ -1,83 +1,83 @@-module SvgArcSegment ( - convertSvgArc - ) where - -import Types - -radiansPerDegree :: Double -radiansPerDegree = pi / 180.0 - -calculateVectorAngle :: Double -> Double -> Double -> Double -> Double -calculateVectorAngle ux uy vx vy - | tb >= ta - = tb - ta - | otherwise - = pi * 2 - (ta - tb) - where - ta = atan2 uy ux - tb = atan2 vy vx - --- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs -convertSvgArc :: Point -> Double -> Double -> Double -> Bool -> Bool -> Point -> [DrawOp] -convertSvgArc (x0,y0) radiusX radiusY angle largeArcFlag sweepFlag (x,y) - | x0 == x && y0 == y - = [] - | radiusX == 0.0 && radiusY == 0.0 - = [DLineTo (x,y)] - | otherwise - = calcSegments x0 y0 theta1' segments' - where - sinPhi = sin (angle * radiansPerDegree) - cosPhi = cos (angle * radiansPerDegree) - - x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0 - y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0 - - numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash - - s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY)) - rx = if' (numerator < 0.0) (radiusX * s) radiusX - ry = if' (numerator < 0.0) (radiusY * s) radiusY - root = if' (numerator < 0.0) - (0.0) - ((if' ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) (-1.0) 1.0) * - sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash))) - - cxdash = root * rx * y1dash / ry - cydash = -root * ry * x1dash / rx - - cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0 - cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0 - - theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) - dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry) - dtheta = if' (not sweepFlag && dtheta' > 0) - (dtheta' - 2 * pi) - (if' (sweepFlag && dtheta' < 0) (dtheta' + 2 * pi) dtheta') - - segments' = ceiling (abs (dtheta / (pi / 2.0))) - delta = dtheta / fromInteger segments' - t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0) - - calcSegments startX startY theta1 segments - | segments == 0 - = [] - | otherwise - = (DBezierTo (startX + dx1, startY + dy1) (endpointX + dxe, endpointY + dye) (endpointX, endpointY) : calcSegments endpointX endpointY theta2 (segments - 1)) - where - cosTheta1 = cos theta1 - sinTheta1 = sin theta1 - theta2 = theta1 + delta - cosTheta2 = cos theta2 - sinTheta2 = sin theta2 - - endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx - endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy - - dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1) - dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1) - - dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2) - dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2) - +module SvgArcSegment ( + convertSvgArc+ ) where++import Types + +radiansPerDegree :: Double +radiansPerDegree = pi / 180.0++calculateVectorAngle :: Double -> Double -> Double -> Double -> Double+calculateVectorAngle ux uy vx vy+ | tb >= ta+ = tb - ta+ | otherwise+ = pi * 2 - (ta - tb)+ where+ ta = atan2 uy ux+ tb = atan2 vy vx+ +-- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs+convertSvgArc :: Point -> Double -> Double -> Double -> Bool -> Bool -> Point -> [DrawOp]+convertSvgArc (x0,y0) radiusX radiusY angle largeArcFlag sweepFlag (x,y)+ | x0 == x && y0 == y+ = []+ | radiusX == 0.0 && radiusY == 0.0+ = [DLineTo (x,y)]+ | otherwise + = calcSegments x0 y0 theta1' segments'+ where+ sinPhi = sin (angle * radiansPerDegree)+ cosPhi = cos (angle * radiansPerDegree)++ x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0+ y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0++ numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash++ s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))+ rx = if' (numerator < 0.0) (radiusX * s) radiusX+ ry = if' (numerator < 0.0) (radiusY * s) radiusY+ root = if' (numerator < 0.0) + (0.0) + ((if' ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) (-1.0) 1.0) * + sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))+ + cxdash = root * rx * y1dash / ry+ cydash = -root * ry * x1dash / rx++ cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0+ cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0+ + theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)+ dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)+ dtheta = if' (not sweepFlag && dtheta' > 0) + (dtheta' - 2 * pi)+ (if' (sweepFlag && dtheta' < 0) (dtheta' + 2 * pi) dtheta')+ + segments' = ceiling (abs (dtheta / (pi / 2.0)))+ delta = dtheta / fromInteger segments'+ t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)+ + calcSegments startX startY theta1 segments + | segments == 0+ = []+ | otherwise+ = (DBezierTo (startX + dx1, startY + dy1) (endpointX + dxe, endpointY + dye) (endpointX, endpointY) : calcSegments endpointX endpointY theta2 (segments - 1))+ where+ cosTheta1 = cos theta1+ sinTheta1 = sin theta1+ theta2 = theta1 + delta+ cosTheta2 = cos theta2+ sinTheta2 = sin theta2++ endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx+ endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy++ dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)+ dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)++ dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)+ dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)+
src/Transformation.hs view
@@ -1,66 +1,66 @@-module Transformation ( TransformationMatrix - , identityTransform - , mirrorYTransform - , translateTransform - , scaleTransform - , transformPoint - , transformDrawOp - , applyTransformations - , multiply - ) where - -import qualified Graphics.Svg as SVG -import Data.Matrix as M -import Types - -type TransformationMatrix = Matrix Double - -identityTransform :: TransformationMatrix -identityTransform = identity 3 - -mirrorYTransform :: Double -> Double -> TransformationMatrix -mirrorYTransform _ h = fromElements [1, 0, 0, -1, 0, h] - -translateTransform :: Double -> Double -> TransformationMatrix -translateTransform x y = fromElements [1, 0, 0, 1, x, y] - -scaleTransform :: Double -> Double -> TransformationMatrix -scaleTransform sx sy = fromElements [sx, 0, 0, sy, 0, 0] - -multiply :: TransformationMatrix -> TransformationMatrix -> TransformationMatrix -multiply a b = multStd a b - -fromElements :: [Double] -> TransformationMatrix -fromElements [a,b,c,d,e,f] = fromList 3 3 [a,c,e,b,d,f,0,0,1] -fromElements _ = error "Malformed transformation matrix" - -transformPoint :: TransformationMatrix -> Point -> Point -transformPoint m (x,y) = (a * x + c * y + e, b * x + d * y + f) - where - (a:c:e:b:d:f:_) = M.toList m - -transformDrawOp :: TransformationMatrix -> DrawOp -> DrawOp -transformDrawOp m (DMoveTo p) = DMoveTo (transformPoint m p) -transformDrawOp m (DLineTo p) = DLineTo (transformPoint m p) -transformDrawOp m (DBezierTo c1 c2 p2) = DBezierTo (transformPoint m c1) (transformPoint m c2) (transformPoint m p2) - -applyTransformations :: TransformationMatrix -> Maybe [SVG.Transformation] -> TransformationMatrix -applyTransformations m Nothing = m -applyTransformations m (Just ts) = foldl applyTransformation m ts - -radiansPerDegree :: Double -radiansPerDegree = pi / 180.0 - --- https://developer.mozilla.org/en/docs/Web/SVG/Attribute/transform -applyTransformation :: Matrix Double -> SVG.Transformation -> Matrix Double -applyTransformation m (SVG.TransformMatrix a b c d e f) = multStd m (fromElements [a,b,c,d,e,f]) -applyTransformation m (SVG.Translate x y) = multStd m (fromElements [1,0,0,1,x,y]) -applyTransformation m (SVG.Scale sx mbSy) = multStd m (fromElements [sx,0,0,maybe sx id mbSy,0,0]) -applyTransformation m (SVG.Rotate a Nothing) - = multStd m (fromElements [cos(r),sin(r),-sin(r),cos(r),0,0]) - where - r = a * radiansPerDegree -applyTransformation m (SVG.Rotate a (Just (x, y))) = applyTransformations m (Just [SVG.Translate x y , SVG.Rotate a Nothing , SVG.Translate (-x) (-y)]) -applyTransformation m (SVG.SkewX a) = multStd m (fromElements [1,0,tan(a*radiansPerDegree),1,0,0]) -applyTransformation m (SVG.SkewY a) = multStd m (fromElements [1,tan(a*radiansPerDegree),0,1,0,0]) -applyTransformation m (SVG.TransformUnknown) = m +module Transformation ( TransformationMatrix+ , identityTransform+ , mirrorYTransform+ , translateTransform+ , scaleTransform+ , transformPoint+ , transformDrawOp+ , applyTransformations+ , multiply+ ) where++import qualified Graphics.Svg as SVG+import Data.Matrix as M+import Types++type TransformationMatrix = Matrix Double++identityTransform :: TransformationMatrix+identityTransform = identity 3++mirrorYTransform :: Double -> Double -> TransformationMatrix+mirrorYTransform _ h = fromElements [1, 0, 0, -1, 0, h]++translateTransform :: Double -> Double -> TransformationMatrix+translateTransform x y = fromElements [1, 0, 0, 1, x, y]++scaleTransform :: Double -> Double -> TransformationMatrix+scaleTransform sx sy = fromElements [sx, 0, 0, sy, 0, 0]++multiply :: TransformationMatrix -> TransformationMatrix -> TransformationMatrix+multiply a b = multStd a b++fromElements :: [Double] -> TransformationMatrix+fromElements [a,b,c,d,e,f] = fromList 3 3 [a,c,e,b,d,f,0,0,1]+fromElements _ = error "Malformed transformation matrix"++transformPoint :: TransformationMatrix -> Point -> Point+transformPoint m (x,y) = (a * x + c * y + e, b * x + d * y + f)+ where+ (a:c:e:b:d:f:_) = M.toList m++transformDrawOp :: TransformationMatrix -> DrawOp -> DrawOp+transformDrawOp m (DMoveTo p) = DMoveTo (transformPoint m p)+transformDrawOp m (DLineTo p) = DLineTo (transformPoint m p)+transformDrawOp m (DBezierTo c1 c2 p2) = DBezierTo (transformPoint m c1) (transformPoint m c2) (transformPoint m p2)++applyTransformations :: TransformationMatrix -> Maybe [SVG.Transformation] -> TransformationMatrix+applyTransformations m Nothing = m+applyTransformations m (Just ts) = foldl applyTransformation m ts++radiansPerDegree :: Double+radiansPerDegree = pi / 180.0++-- https://developer.mozilla.org/en/docs/Web/SVG/Attribute/transform+applyTransformation :: Matrix Double -> SVG.Transformation -> Matrix Double+applyTransformation m (SVG.TransformMatrix a b c d e f) = multStd m (fromElements [a,b,c,d,e,f])+applyTransformation m (SVG.Translate x y) = multStd m (fromElements [1,0,0,1,x,y])+applyTransformation m (SVG.Scale sx mbSy) = multStd m (fromElements [sx,0,0,maybe sx id mbSy,0,0])+applyTransformation m (SVG.Rotate a Nothing)+ = multStd m (fromElements [cos(r),sin(r),-sin(r),cos(r),0,0])+ where+ r = a * radiansPerDegree+applyTransformation m (SVG.Rotate a (Just (x, y))) = applyTransformations m (Just [SVG.Translate x y , SVG.Rotate a Nothing , SVG.Translate (-x) (-y)])+applyTransformation m (SVG.SkewX a) = multStd m (fromElements [1,0,tan(a*radiansPerDegree),1,0,0])+applyTransformation m (SVG.SkewY a) = multStd m (fromElements [1,tan(a*radiansPerDegree),0,1,0,0])+applyTransformation m (SVG.TransformUnknown) = m
src/Types.hs view
@@ -1,25 +1,25 @@-module Types ( Point - , DrawOp (..) - , GCodeOp (..) - , if' - ) where - -type Point = (Double, Double) -- A point in the plane, absolute coordinates - --- all of them are invariant under affine transformation -data DrawOp = DMoveTo Point - | DLineTo Point -- End point - | DBezierTo Point Point Point -- Control point1, control point2, end point - deriving Show - --- this is basically what GCode can do -data GCodeOp = GMoveTo Point - | GLineTo Point -- End point - | GArcTo Point Point Bool -- Center point, end point, clockwise - | GBezierTo Point Point Point -- First and second control points, end point - deriving Show - --- just to make it available everywhere -if' :: Bool -> t -> t -> t -if' True t _ = t -if' False _ f = f +module Types ( Point+ , DrawOp (..)+ , GCodeOp (..)+ , if'+ ) where++type Point = (Double, Double) -- A point in the plane, absolute coordinates++-- all of them are invariant under affine transformation+data DrawOp = DMoveTo Point+ | DLineTo Point -- End point+ | DBezierTo Point Point Point -- Control point1, control point2, end point+ deriving Show++-- this is basically what GCode can do+data GCodeOp = GMoveTo Point+ | GLineTo Point -- End point+ | GArcTo Point Point Bool -- Center point, end point, clockwise+ | GBezierTo Point Point Point -- First and second control points, end point+ deriving Show++-- just to make it available everywhere+if' :: Bool -> t -> t -> t+if' True t _ = t+if' False _ f = f