packages feed

pictikz 1.0.0.1 → 1.1.0.0

raw patch · 5 files changed

+94/−74 lines, 5 files

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for pictikz +## 1.1.0.0  -- 2017-04-09++* Added style for nodes.+ ## 1.0.0.1  -- 2017-04-02  * Fixed small problem with the .cabal file.
pictikz.1 view
@@ -1,6 +1,6 @@ .\" Manpage for pictikz. .\" Contact marcelogmillani@gmail.com to correct errors or typos.-.TH man 1 "26 Mar 2017" "1.0.0.0" "pictikz man page"+.TH man 1 "09 Apr 2017" "1.1.0.0" "pictikz man page" .SH NAME pictikz \- a tool for converting SVG images into tikz code. .SH SYNOPSIS@@ -8,7 +8,7 @@ .SH DESCRIPTION Tikz is often used to draw graphs (i.e., networks) in LaTeX. Even though the resulting image can be very clean, manually writing tikz code can be time consuming, especially when the picture needs to be modified afterwards. -On the other side of the spectrum, drawing with graphical tools like inkscape is easy, but getting a clean looking result can be complicated.+On the other side of the spectrum, drawing with graphical tools like inkscape is easy, but getting a clean-looking result can be complicated.  With pictikz you get the best of both worlds: You draw using a graphical tool and pictikz converts the resulting SVG file to tikz code, making some automatic style adjustments if you desire. .SH OPTIONS@@ -51,7 +51,7 @@  The pictikz-thick property in tikz is set if the stroke-width attribute of the path is at least 50% larger than the minimum stroke-width and larger than the average between the minimum and maximum stroke-width. -An edge becomes pictikz-dashed if the stroke-dasharray property is set and the length of the first dash is at least twice the stroke-width of the edge. If it is set but smaller than that, the edge becomes pictikz-dotted instead.+An object becomes pictikz-dashed if the stroke-dasharray property is set and the length of the first dash is at least twice the stroke-width of the object. If it is set but smaller than that, the object becomes pictikz-dotted instead.  Finally, text objects in SVG can become labels for nodes. For each text, the nearest node is taken. .SH BUGS
pictikz.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                pictikz-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Converts a svg image to tikz code. description:         Tikz is often used to draw graphs (i.e., networks) in LaTeX. Even though the resulting image can be very clean, manually writing tikz code can be time consuming, especially when the picture needs to be modified afterwards.
src/Pictikz/Graph.hs view
@@ -26,14 +26,15 @@ joinArrow ArrowFrom ArrowTo = ArrowBoth joinArrow a b = b -data NodeStyle = Rectangle                         deriving (Show, Read, Eq, Ord)-data EdgeStyle =+data Style =     Dashed   | Dotted   | Thick+  | Rectangle+  | Circle   | Arrow ArrowType                               deriving (Show, Read, Eq, Ord)-data Node a = Node a a String String [NodeStyle]  deriving (Show, Read, Eq, Ord)-data Edge = Edge String String [EdgeStyle]        deriving (Show, Read, Eq, Ord)+data Node a  = Node a a String String [Style]     deriving (Show, Read, Eq, Ord)+data Edge    = Edge String String [Style]         deriving (Show, Read, Eq, Ord) data Graph a = Graph [Node a] [Edge]              deriving (Show, Read, Eq, Ord)  instance Show ArrowType where@@ -46,22 +47,22 @@   getPos (Node x y _ _ _)     = (x,y)   fPos f (Node x y id name style) = let (x1,y1) = f (x,y) in Node x1 y1 id name style -instance Drawable NodeStyle where+instance Drawable Style where+  draw Dotted    = ", pictikz-dotted"+  draw Dashed    = ", pictikz-dashed"+  draw Thick     = ", pictikz-thick"   draw Rectangle = ", pictikz-rectangle"--instance Drawable EdgeStyle where-  draw Dotted = ", pictikz-dotted"-  draw Dashed = ", pictikz-dashed"-  draw Thick  = ", pictikz-thick"+  draw Circle    = ", pictikz-node"+  draw (Arrow ArrowNone) = ""   draw (Arrow t) = ", " ++ show t  instance (Num a, Show a) => Drawable (Node a) where   draw (Node x y id name style) = concat-    [ "\\node[pictikz-node"-    , concatMap draw style+    [ "\\node["+    , drop 2 $ concatMap draw style     , "] ("-    , id,-    ") at ("+    , id+    , ") at ("     , show x     , ", "     , show y@@ -73,7 +74,7 @@ instance Drawable Edge where   draw (Edge n1 n2 style) = concat     [ "\\draw["-    , concatMap draw style+    , drop 2 $ concatMap draw style     , "] ("     , n1     , ") edge ("
src/Pictikz/Loader.hs view
@@ -28,38 +28,42 @@  import qualified Text.XML.Light as X -data Element a b = Object (Shape a) String String | Line a a a a [b] | Text a a String deriving (Show, Eq)+data Element a b = Object (Shape a) String String [b] | Line a a a a [b] | Text a a String deriving (Show, Eq) -isObject (Object _ _ _) = True+isObject (Object _ _ _ _) = True isObject _ = False isLine (Line _ _ _ _ _) = True isLine _ = False isText (Text _ _ _) = True isText _ = False -lineStyle (Line _ _ _ _ style) = style+getStyle (Line _ _ _ _ style) = style+getStyle (Object _ _ _ style) = style +fStyle f (Line x0 y0 x1 y1 style) = Line x0 y0 x1 y1 (f style)+fStyle f (Object s iD name style) = Object s iD name (f style)+ defaultText = Text 0 0 "ERROR"-defaultRectangle = (Rectangle 0 0 0 0, "", "", identity 3)-defaultEllipsis  = (Ellipsis  0 0 0 0, "", "", identity 3)+defaultRectangle = (Rectangle 0 0 0 0, "", "", [(G.Rectangle, 0)], identity 3)+defaultEllipsis  = (Ellipsis  0 0 0 0, "", "", [(G.Circle, 0)], identity 3) defaultGNode = G.Node 0 0 "" ""  loadGraph svg =   let contents = X.parseXML svg       elements = concatMap (parseElements (identity 3)) contents       gnames = filter isText elements-      gnodes = assignNames (filter isObject elements) gnames-      gedges = map (closest gnodes) $ fixEdgeStyle $ filter isLine elements+      gnodes = assignNames (fixGraphStyle (filter isObject elements)) gnames+      gedges = map (closest gnodes) $ fixGraphStyle $ filter isLine elements   in G.Graph (map (fPos (\(x,y) -> (x,-y))) (map toNode gnodes)) gedges   where     parseElements matrix (X.Elem element)       -- Objects       | (X.qName $ X.elName element) `elem` ["rect"] =-        let (shape, id, name, m2) = foldl parseRectangle defaultRectangle $ X.elAttribs element-        in [transform (matrix * m2) (Object shape id name)]+        let (shape, id, name, style, m2) = foldl parseRectangle defaultRectangle $ X.elAttribs element+        in [transform (matrix * m2) (Object shape id name style)]       | (X.qName $ X.elName element) `elem` ["ellipse", "circle"] =-        let (shape, id, name, m2) = foldl parseEllipsis defaultEllipsis $ X.elAttribs element-        in [transform (matrix * m2) (Object shape id name)]+        let (shape, id, name, style, m2) = foldl parseEllipsis defaultEllipsis $ X.elAttribs element+        in [transform (matrix * m2) (Object shape id name style)]       -- Transformations       | (X.qName $ X.elName element) `elem` ["defs"] = []       | (X.qName $ X.elName element) `elem` ["g"] =@@ -71,18 +75,18 @@       | (X.qName $ X.elName element) == "text" =  [transform matrix $ parseName $ X.elContent element]       | otherwise = concatMap (parseElements matrix ) $ X.elContent element     parseElements matrix _ = []-    transform matrix ( Object (Rectangle x y w h) id name) =+    transform matrix ( Object (Rectangle x y w h) id name style) =       let [x', y',_] = toList $ matrix * (fromList 3 1 [x,y,1])           [w1,h1,w2,h2,_,_] = toList $ matrix * (fromList 3 2 [w,0,0,h,0,0])           w' = maximum [w1,h1,0] - minimum [w1,h1,0]           h' = maximum [w2,h2,0] - minimum [w2,h2,0]-      in (Object (Rectangle x' y' w' h') id name)-    transform matrix (Object (Ellipsis x y rx ry) id name) =+      in (Object (Rectangle x' y' w' h') id name style)+    transform matrix (Object (Ellipsis x y rx ry) id name style) =       let [x', y',_] = toList $ matrix * (fromList 3 1 [x,y,1])           [rx1,ry1,rx2,ry2,_,_] = toList $ matrix * (fromList 3 2 [rx,0,0,ry,0,0])           rx' = maximum [rx1,ry1,0] - minimum [rx1,ry1,0]           ry' = maximum [rx2,ry2,0] - minimum [rx2,ry2,0]-      in (Object (Ellipsis x' y' rx' ry') id name)+      in (Object (Ellipsis x' y' rx' ry') id name style)     transform matrix (Line x0 y0 x1 y1 a) =       let [x0', y0',_, x1', y1', _] = toList $ matrix * (fromList 3 2 [x0,y0,1, x1,y1,1])       in Line x0' y0' x1' y1' a@@ -92,25 +96,33 @@     parseG matrix attr       | "transform" == (X.qName $ X.attrKey attr) = matrix * (parseTransform $ X.attrVal attr)       | otherwise = matrix-    parseRectangle (Rectangle x y w h, id, name, matrix) attr-      | "id" == (X.qName $ X.attrKey attr) = (Rectangle x y w h, (X.attrVal attr), name, matrix)-      | "x"  == (X.qName $ X.attrKey attr) = (Rectangle (read $ X.attrVal attr :: Float) y w h, id, name, matrix)-      | "y"  == (X.qName $ X.attrKey attr) = (Rectangle x (read $ X.attrVal attr :: Float) w h, id, name, matrix)-      | "height" == (X.qName $ X.attrKey attr) = (Rectangle x y w (read $ X.attrVal attr :: Float), id, name, matrix)-      | "width"  == (X.qName $ X.attrKey attr) = (Rectangle x y (read $ X.attrVal attr :: Float) h, id, name, matrix)-      | "transform"  == (X.qName $ X.attrKey attr) = (Rectangle x y (read $ X.attrVal attr :: Float) h, id, name, matrix * (parseTransform $ X.attrVal attr))-      | otherwise = (Rectangle x y w h, id, name, matrix)-    parseEllipsis (Ellipsis x y rx ry, id, name, matrix) attr-      | "id" == (X.qName $ X.attrKey attr) = (Ellipsis x y rx ry, (X.attrVal attr), name, matrix)-      | "cx" == (X.qName $ X.attrKey attr) = (Ellipsis (read $ X.attrVal attr :: Float) y rx ry, id, name, matrix)-      | "cy" == (X.qName $ X.attrKey attr) = (Ellipsis x (read $ X.attrVal attr :: Float) rx ry, id, name, matrix)-      | "rx" == (X.qName $ X.attrKey attr) = (Ellipsis x y (read $ X.attrVal attr :: Float)  ry, id, name, matrix)-      | "ry" == (X.qName $ X.attrKey attr) = (Ellipsis x y rx (read $ X.attrVal attr :: Float) , id, name, matrix)-      | "r"  == (X.qName $ X.attrKey attr) = (Ellipsis x y (read $ X.attrVal attr :: Float) (read $ X.attrVal attr :: Float), id, name, matrix)-      | "transform"  == (X.qName $ X.attrKey attr) = (Ellipsis x y rx ry, id, name, matrix * (parseTransform $ X.attrVal attr))-      | otherwise = (Ellipsis x y rx ry, id, name, matrix)-    toNode (Object (Rectangle x y w h) id name) = G.Node (x + w/2) (y + h/2) id name [G.Rectangle]-    toNode (Object (Ellipsis x y _ _)  id name) = G.Node x y id name []+    parseRectangle (Rectangle x y w h, id, name, style, matrix) attr+      | "id" == (X.qName $ X.attrKey attr) = (Rectangle x y w h, (X.attrVal attr), name, style,  matrix)+      | "x"  == (X.qName $ X.attrKey attr) = (Rectangle (read $ X.attrVal attr :: Float) y w h, id, name, style, matrix)+      | "y"  == (X.qName $ X.attrKey attr) = (Rectangle x (read $ X.attrVal attr :: Float) w h, id, name, style, matrix)+      | "height" == (X.qName $ X.attrKey attr) = (Rectangle x y w (read $ X.attrVal attr :: Float), id, name, style, matrix)+      | "width"  == (X.qName $ X.attrKey attr) = (Rectangle x y (read $ X.attrVal attr :: Float) h, id, name, style, matrix)+      | "transform"  == (X.qName $ X.attrKey attr) = (Rectangle x y (read $ X.attrVal attr :: Float) h, id, name, style, matrix * (parseTransform $ X.attrVal attr))+      | "style"      == (X.qName $ X.attrKey attr) =+        let fields = parseStyle $ X.attrVal attr+            style' = graphStyle fields+        in (Rectangle x y w h, id, name, style ++ style', matrix)+      | otherwise = (Rectangle x y w h, id, name, style, matrix)+    parseEllipsis (Ellipsis x y rx ry, id, name, style, matrix) attr+      | "id" == (X.qName $ X.attrKey attr) = (Ellipsis x y rx ry, (X.attrVal attr), name, style, matrix)+      | "cx" == (X.qName $ X.attrKey attr) = (Ellipsis (read $ X.attrVal attr :: Float) y rx ry, id, name, style, matrix)+      | "cy" == (X.qName $ X.attrKey attr) = (Ellipsis x (read $ X.attrVal attr :: Float) rx ry, id, name, style, matrix)+      | "rx" == (X.qName $ X.attrKey attr) = (Ellipsis x y (read $ X.attrVal attr :: Float)  ry, id, name, style, matrix)+      | "ry" == (X.qName $ X.attrKey attr) = (Ellipsis x y rx (read $ X.attrVal attr :: Float) , id, name, style, matrix)+      | "r"  == (X.qName $ X.attrKey attr) = (Ellipsis x y (read $ X.attrVal attr :: Float) (read $ X.attrVal attr :: Float), id, name, style, matrix)+      | "transform"  == (X.qName $ X.attrKey attr) = (Ellipsis x y rx ry, id, name, style, matrix * (parseTransform $ X.attrVal attr))+      | "style"      == (X.qName $ X.attrKey attr) =+        let fields = parseStyle $ X.attrVal attr+            style' = graphStyle fields+        in (Ellipsis x y rx ry, id, name, style ++ style', matrix)+      | otherwise = (Ellipsis x y rx ry, id, name, style, matrix)+    toNode (Object (Rectangle x y w h) id name style) = G.Node (x + w/2) (y + h/2) id name style+    toNode (Object (Ellipsis x y _ _)  id name style) = G.Node x y id name style     parseName [] = defaultText     parseName ((X.Elem element):xs)       | (X.qName $ X.elName element) == "tspan" =@@ -129,22 +141,23 @@         in Line x0 y0 x1 y1 a       | "style"        == (X.qName $ X.attrKey attr) =         let fields = parseStyle $ X.attrVal attr-            style = edgeStyle fields+            style = graphStyle fields         in Line xa ya xb yb style       | otherwise = Line xa ya xb yb a-    edgeStyle :: [(String, String)] -> [(G.EdgeStyle, Float)]-    edgeStyle [] = []-    edgeStyle (x:xs) = case x of-      ("marker-end", "none")        -> (G.Arrow G.ArrowNone, undefined) : edgeStyle xs-      ("marker-end", _)             -> (G.Arrow G.ArrowTo,   undefined) : edgeStyle xs-      ("marker-start", "none")      -> (G.Arrow G.ArrowNone, undefined) : edgeStyle xs-      ("marker-start", _)           -> (G.Arrow G.ArrowFrom, undefined) : edgeStyle xs-      ("stroke-width", len)         -> (G.Thick, (readLength len)) : edgeStyle xs-      ("stroke-dasharray", "none")  -> edgeStyle xs-      ("stroke-dasharray", dashes)  -> let dash = takeWhile (/=',') dashes in (G.Dashed, (read dash :: Float)) : edgeStyle xs-      _ -> edgeStyle xs-    fixEdgeStyle ls =-      let strokeWs = map snd $ filter (\(s,v) -> s == G.Thick) $ concatMap lineStyle ls+    graphStyle :: [(String, String)] -> [(G.Style, Float)]+    graphStyle [] = []+    graphStyle (x:xs) = case x of+      ("marker-end", "none")        -> (G.Arrow G.ArrowNone, undefined) : graphStyle xs+      ("marker-end", _)             -> (G.Arrow G.ArrowTo,   undefined) : graphStyle xs+      ("marker-start", "none")      -> (G.Arrow G.ArrowNone, undefined) : graphStyle xs+      ("marker-start", _)           -> (G.Arrow G.ArrowFrom, undefined) : graphStyle xs+      ("stroke-width", len)         -> (G.Thick, (readLength len)) : graphStyle xs+      ("stroke-dasharray", "none")  -> graphStyle xs+      ("stroke-dasharray", dashes)  -> let dash = takeWhile (/=',') dashes in (G.Dashed, (read dash :: Float)) : graphStyle xs+      _ -> graphStyle xs+    fixGraphStyle :: [Element Float (G.Style, Float)] -> [Element Float G.Style]+    fixGraphStyle ls =+      let strokeWs = map snd $ filter (\(s,v) -> s == G.Thick) $ concatMap getStyle ls           minStroke = minimum strokeWs           maxStroke = maximum strokeWs           midStroke = minStroke + (maxStroke - minStroke) / 2@@ -153,7 +166,9 @@             (G.Thick, v)   -> if v > midStroke && v > minStroke * 1.4 then G.Thick : fixLine arrow ss else (fixLine arrow ss)             (G.Dashed, v)  -> (if v > 2*minStroke then G.Dashed else G.Dotted) : (fixLine arrow ss)             (G.Arrow a, _) -> fixLine (G.joinArrow a arrow) ss-      in map (\(Line x0 y0 x1 y1 s) -> Line x0 y0 x1 y1 (fixLine G.ArrowNone s)) ls+            (s, _) -> s : (fixLine arrow ss)+      in map (fStyle (fixLine G.ArrowNone)) ls+      --in map (\(Line x0 y0 x1 y1 s) -> Line x0 y0 x1 y1 (fixLine G.ArrowNone s)) ls     parseCoordinates (x,y, matrix) attr       | "x" == (X.qName $ X.attrKey attr) = ((read $ X.attrVal attr :: Float), y, matrix)       | "y" == (X.qName $ X.attrKey attr) = (x,(read $ X.attrVal attr :: Float), matrix)@@ -162,15 +177,15 @@     assignNames [] _ = []     assignNames gnodes [] = gnodes     assignNames gnodes (t:ts) =-      let (Object s iD n) = assignName gnodes t-      in (Object s iD n) : assignNames (filter (\(Object _ iD1 _) -> iD1 /= iD) gnodes) ts+      let (Object s iD n style) = assignName gnodes t+      in (Object s iD n style) : assignNames (filter (\(Object _ iD1 _ _) -> iD1 /= iD) gnodes) ts     assignName gnodes (Text x0 y0 n) =       let dist s = squareDistance (x0,y0) s-          (Object s iD _ ) = minimumBy (\(Object s0 _ _) (Object s1 _ _) -> compare (dist s0) (dist s1) ) gnodes-      in (Object s iD n )+          (Object s iD _ style) = minimumBy (\(Object s0 _ _ _) (Object s1 _ _ _) -> compare (dist s0) (dist s1) ) gnodes+      in (Object s iD n style)     closest vertices (Line x0 y0 x1 y1 a) =       let p0 = (x0, y0)           p1 = (x1, y1)-          (n0,_) = minimumBy (\p q -> compare (snd p) (snd q)) $ map (\(Object shape id _) -> (id, squareDistance p0 shape)) vertices-          (n1,_) = minimumBy (\p q -> compare (snd p) (snd q)) $ map (\(Object shape id _) -> (id, squareDistance p1 shape)) vertices+          (n0,_) = minimumBy (\p q -> compare (snd p) (snd q)) $ map (\(Object shape id _ _) -> (id, squareDistance p0 shape)) vertices+          (n1,_) = minimumBy (\p q -> compare (snd p) (snd q)) $ map (\(Object shape id _ _) -> (id, squareDistance p1 shape)) vertices       in G.Edge n0 n1 a