{-# LANGUAGE OverloadedStrings #-}
module Graphics.Implicit.Export.PolylineFormats (svg, hacklabLaserGCode, dxf2) where
import Prelude((.), ($), (-), (+), (/), minimum, maximum, unzip, show, unwords, fmap, snd, compare, min, max, length, foldl, mempty, (<>))
import Graphics.Implicit.Definitions (Polyline(Polyline), ℝ, ℝ2)
import Graphics.Implicit.Export.TextBuilderUtils (Text, Builder, toLazyText, bf, buildInt, buildTruncFloat)
import Text.Blaze.Svg.Renderer.Text (renderSvg)
import Text.Blaze.Svg11 ((!),docTypeSvg,g,polyline,toValue,Svg)
import Text.Blaze.Internal (stringValue)
import qualified Text.Blaze.Svg11.Attributes as A (version, width, height, viewbox, points, stroke, strokeWidth, fill)
import Data.List (sortBy)
import Data.Foldable (fold, foldMap, traverse_)
default (ℝ)
svg :: [Polyline] -> Text
svg plines = renderSvg . svg11 . svg' $ plines
where
strokeWidth :: ℝ
strokeWidth = 1
(xmin, xmax, ymin, ymax) = (xmin' - margin, xmax' + margin, ymin' - margin, ymax' + margin)
where margin = strokeWidth / 2
((xmin', xmax'), (ymin', ymax')) = (maxMinList xs,maxMinList ys)
(xs,ys) = unzip $ foldMap pair plines
pair (Polyline a) = a
maxMinList :: [ℝ] -> (ℝ,ℝ)
maxMinList (x:others) = foldl (\(l,h) y -> (min l y, max h y)) (x,x) others
maxMinList [] = (0,0)
svg11 = docTypeSvg ! A.version "1.1"
! A.width (stringValue $ show (xmax-xmin) <> "mm")
! A.height (stringValue $ show (ymax-ymin) <> "mm")
! A.viewbox (stringValue $ unwords . fmap show $ [0,0,xmax-xmin,ymax-ymin])
svg' :: [Polyline] -> Svg
svg' [] = mempty
svg' polylines = thinBlueGroup $ traverse_ poly polylines
poly (Polyline line) = polyline ! A.points pointList
where pointList = toValue $ toLazyText $ fold [bf (x-xmin) <> "," <> bf (ymax - y) <> " " | (x,y) <- line]
thinBlueGroup = g ! A.stroke "rgb(0,0,255)" ! A.strokeWidth (stringValue $ show strokeWidth) ! A.fill "none"
dxf2 :: [Polyline] -> Text
dxf2 plines = toLazyText $ dxf2Header <> dxf2Tables <> dxf2Blocks <> dxf2Entities
where
dxf2Header :: Builder
dxf2Header =
" 0\n" <> "SECTION\n" <>
" 2\n" <> "HEADER\n" <>
" 9\n" <> "$ACADVER\n" <>
" 1\n" <> "AC1009\n" <>
" 9\n" <> "$LIMMIN\n" <>
" 10\n" <> buildTruncFloat dxfxmin <> "\n" <>
" 20\n" <> buildTruncFloat dxfymin <> "\n" <>
" 9\n" <> "$LIMMAX\n" <>
" 10\n" <> buildTruncFloat dxfxmax <> "\n" <>
" 20\n" <> buildTruncFloat dxfymax <> "\n" <>
" 9\n" <> "$LUPREC\n" <>
" 70\n" <> "4\n" <>
" 0\n" <> "ENDSEC\n"
dxf2Tables :: Builder
dxf2Tables =
" 0\n" <> "SECTION\n" <>
" 2\n" <> "TABLES\n" <>
" 0\n" <> "ENDSEC\n"
dxf2Blocks :: Builder
dxf2Blocks =
" 0\n" <> "SECTION\n" <>
" 2\n" <> "BLOCKS\n" <>
" 0\n" <> "ENDSEC\n"
dxf2Entities :: Builder
dxf2Entities =
" 0\n" <> "SECTION\n" <>
" 2\n" <> "ENTITIES\n" <>
foldMap buildPolyline (orderPolylines plines) <>
" 0\n" <> "ENDSEC\n"
buildPolyline :: Polyline -> Builder
buildPolyline (Polyline singlePolyline) =
" 0\n" <> "POLYLINE\n" <>
" 8\n" <> "0\n" <>
" 6\n" <> "CONTINUOUS\n" <>
" 66\n" <> "1\n" <>
" 62\n" <> buildInt (length singlePolyline) <> "\n" <>
" 10\n" <> "0.0\n" <>
" 20\n" <> "0.0\n" <>
" 30\n" <> "0.0000\n" <>
foldMap buildVertex singlePolyline <>
" 0\n" <> "SEQEND\n"
buildVertex :: ℝ2 -> Builder
buildVertex (x1,y1) =
" 0\n" <>"VERTEX\n" <>
" 8\n" <>"0\n" <>
" 10\n" <> buildTruncFloat x1 <> "\n" <>
" 20\n" <> buildTruncFloat y1 <> "\n"
(dxfxmin, dxfxmax, dxfymin, dxfymax) = (minimum xs, maximum xs, minimum ys, maximum ys)
(xs, ys) = unzip $ foldMap pair plines
pair :: Polyline -> [ℝ2]
pair (Polyline x) = x
orderPolylines :: [Polyline] -> [Polyline]
orderPolylines =
fmap snd . sortBy (\(a,_) (b, _) -> compare a b) . fmap (\x -> (polylineRadius x, x))
where
polylineRadius :: Polyline -> ℝ
polylineRadius polyline' = max (xmax' - xmin') (ymax' - ymin')
where
((xmin', xmax'), (ymin', ymax')) = polylineRadius' [polyline']
polylineRadius' :: [Polyline] -> (ℝ2, ℝ2)
polylineRadius' lines = (maxMinList xs,maxMinList ys)
where
(xs,ys) = unzip $ foldMap pair lines
pair (Polyline a) = a
maxMinList :: [ℝ] -> (ℝ,ℝ)
maxMinList (x:others) = foldl (\(l,h) y -> (min l y, max h y)) (x,x) others
maxMinList [] = (0,0)
hacklabLaserGCode :: [Polyline] -> Text
hacklabLaserGCode polylines = toLazyText $ gcodeHeader <> foldMap interpretPolyline (orderPolylines polylines) <> gcodeFooter
where
gcodeHeader :: Builder
gcodeHeader = "(generated by ImplicitCAD, based of hacklab wiki example)\n"
<> "M63 P0 (laser off)\n"
<> "G0 Z0.002 (laser off)\n"
<> "G21 (units=mm)\n"
<> "F400 (set feedrate)\n"
<> "M3 S1 (enable laser)\n\n"
gcodeFooter :: Builder
gcodeFooter = "M5 (disable laser)\n"
<> "G00 X0.0 Y0.0 (move to 0)\n"
<> "M2 (end)"
gcodeXY :: ℝ2 -> Builder
gcodeXY (x,y) = "X" <> buildTruncFloat x <> " Y" <> buildTruncFloat y
interpretPolyline :: Polyline -> Builder
interpretPolyline (Polyline (start:others)) =
"G00 " <> gcodeXY start
<> "\nM62 P0 (laser on)\n"
<> fold [ "G01 " <> gcodeXY point <> "\n" | point <- others]
<> "M63 P0 (laser off)\n\n"
interpretPolyline (Polyline []) = mempty