Browse files

Rewrite the SVG output code to use blaze-svg.

Presumably, this has tremendous positive performance implications,
but I haven't benchmarked it.

(Commit 2/n of my quest to add efficient GHCLive support for ImplicitCAD.)
  • Loading branch information...
1 parent d6164e9 commit f906115babcb077e71a520fa1963541b7645f22a @matthewSorensen committed Aug 23, 2012
Showing with 47 additions and 30 deletions.
  1. +9 −9 Graphics/Implicit/Export.hs
  2. +34 −19 Graphics/Implicit/Export/PolylineFormats.hs
  3. +4 −2 implicit.cabal
View
18 Graphics/Implicit/Export.hs
@@ -26,19 +26,19 @@ import qualified Graphics.Implicit.Export.SymbolicFormats as SymbolicFormats
-- Write an object in a given formet...
writeObject :: (DiscreteAproxable obj aprox) =>
- ℝ -- ^ Resolution
- -> (aprox -> Text) -- ^ File Format (Function that formats)
- -> FilePath -- ^ File Name
- -> obj -- ^ Object to render
- -> IO () -- ^ Writing Action!
+ ℝ -- ^ Resolution
+ -> (aprox -> Text) -- ^ File Format (Function that formats)
+ -> FilePath -- ^ File Name
+ -> obj -- ^ Object to render
+ -> IO () -- ^ Writing Action!
writeObject res format filename obj = writeFile filename $ formatObject res format obj
formatObject :: (DiscreteAproxable obj aprox) =>
- ℝ -- ^ Resolution
- -> (aprox -> Text) -- ^ File Format (Function that formats)
- -> obj -- ^ Object to render
- -> Text -- ^ Resulting lazy ByteString
+ ℝ -- ^ Resolution
+ -> (aprox -> Text) -- ^ File Format (Function that formats)
+ -> obj -- ^ Object to render
+ -> Text -- ^ Resulting lazy ByteString
formatObject res format = format . discreteAprox res
View
53 Graphics/Implicit/Export/PolylineFormats.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
@@ -8,29 +9,43 @@ import Graphics.Implicit.Definitions
import Text.Printf (printf)
-import Data.Text.Lazy (Text,pack)
+import Data.Text.Lazy (Text,unwords,pack)
+
+import Text.Blaze.Svg.Renderer.Text (renderSvg)
+import Text.Blaze.Svg
+import Text.Blaze.Svg11 ((!),docTypeSvg,g,polyline,toValue)
+import qualified Text.Blaze.Svg11.Attributes as A
+
+import Data.List (foldl')
+
+import Data.Monoid (mempty)
+
+import Prelude hiding (unwords)
svg :: [Polyline] -> Text
-svg polylines = pack text
- where
- -- SVG is stupidly laid out... (0,0) is the top left corner
- (xs, ys) = unzip (concat polylines)
- (minx, maxy) = (minimum xs, maximum ys)
- transform (x,y) = (x-minx, maxy - y)
- polylines2 = map (map transform) polylines
- svglines = concat $ map (\line ->
- " <polyline points=\""
- ++ concat (map (\(x,y) -> " " ++ show x ++ "," ++ show y) line)
- ++ "\" style=\"stroke:rgb(0,0,255);stroke-width:1;fill:none;\"/> \n" )
- polylines2
- text = "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\"> \n"
- ++ svglines
- ++ "</svg> "
+svg = renderSvg . svg11 . svg'
+ where
+ svg11 content = docTypeSvg ! A.version "1.1" $ content
+ -- The reason this isn't totally straightforwards is that svg has different coordinate system
+ -- and we need to compute the requisite translation.
+ svg' [] = mempty
+ -- When we have a known point, we can compute said transformation:
+ svg' polylines@((start:_):_) = let mm = foldl' (foldl' minmax) start polylines
+ in thinBlueGroup $ mapM_ (poly mm) polylines
+ -- Otherwise, if we don't have a point to start out with, skip this polyline:
+ svg' ([]:rest) = svg' rest
+
+ minmax (xa,ya) (xb,yb) = (min xa xb, max ya yb)
+
+ poly (minx,maxy) line = polyline ! A.points pointList
+ where pointList = toValue $ unwords [pack $ show (x-minx) ++ "," ++ show (maxy - y) | (x,y) <- line]
+ -- Instead of setting styles on every polyline, we wrap the lines in a group element and set the styles on it:
+ thinBlueGroup = g ! A.stroke "rgb(0,0,255)" ! A.strokeWidth "1" ! A.fill "none" -- $ obj
hacklabLaserGCode :: [Polyline] -> Text
hacklabLaserGCode polylines = pack text
- where
- gcodeHeader =
+ where
+ gcodeHeader =
"(generated by ImplicitCAD, based of hacklab wiki example)\n"
++"M63 P0 (laser off)\n"
++"G0 Z0.002 (laser off)\n"
@@ -43,7 +58,7 @@ hacklabLaserGCode polylines = pack text
++"G00 X0.0 Y0.0 (move to 0)\n"
++"M2 (end)"
showF n = printf "%.4f" n
- gcodeXY :: ℝ2 -> [Char]
+ gcodeXY :: ℝ2 -> String
gcodeXY (x,y) = "X"++ showF x ++" Y"++ showF y
interpretPolyline (start:others) =
"G00 "++ gcodeXY start ++ "\n"
View
6 implicit.cabal
@@ -24,7 +24,8 @@ Library
containers,
plugins,
deepseq,
- text
+ text,
+ blaze-svg
ghc-options:
-O2 -optc-O3
@@ -48,7 +49,8 @@ Library
ScopedTypeVariables,
TypeSynonymInstances,
UndecidableInstances,
- ViewPatterns
+ ViewPatterns,
+ OverloadedStrings
Exposed-Modules:
Graphics.Implicit

0 comments on commit f906115

Please sign in to comment.