yjsvg 0.1.18 → 0.2.0.0
raw patch · 2 files changed
+70/−31 lines, 2 filesdep ~HaXmldep ~base
Dependency ranges changed: HaXml, base
Files
- src/Text/XML/YJSVG.hs +60/−26
- yjsvg.cabal +10/−5
src/Text/XML/YJSVG.hs view
@@ -45,6 +45,8 @@ getPos _ _ TopLeft{posX = x, posY = y} = (x, y) getPos w h Center{posX = x, posY = y} = (x + w / 2, - y + h / 2) +type Id = String+ data SVG = Line Position Position Color Double | Polyline [Position] Color Color Double | Rect Position Double Double Double Color Color |@@ -52,7 +54,11 @@ Circle Position Double Color | Text Position Double Color Font String | Image Position Double Double FilePath |- Group [ Transform ] [ SVG ]+ Use Position Double Double String |+ Group [ Transform ] [ (Id,SVG) ] | + Defs [ (Id,SVG) ]+ --Symbol [ (Id,SVG) ]+ deriving (Show, Read) data Color = ColorName{@@ -79,17 +85,23 @@ deriving (Show, Read) showTrans :: Transform -> String-showTrans (Translate tx ty) = "translate(" ++ show tx ++ "," ++ show ty ++ ")"-showTrans (Scale sx sy) = "scale(" ++ show sx ++ "," ++ show sy ++ ")"-showTrans _ = error "not implemented yet"+showTrans (Translate tx ty) = "translate(" ++ show tx ++ "," ++ show ty ++ ") "+showTrans (Scale sx sy) = "scale(" ++ show sx ++ "," ++ show sy ++ ") "+showTrans (SkewX s) = "skewX(" ++ show s ++ ") "+showTrans (SkewY s) = "skewY(" ++ show s ++ ") "+showTrans (Rotate s _) = "rotate(" ++ show s ++ ") "+showTrans (Matrix a b c d e f) = "matrix(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "," ++ show d ++ "," ++ show e ++ "," ++ show f ++ ") " -showSVG :: Double -> Double -> [ SVG ] -> String+-- showTrans _ = error "not implemented yet"++showSVG :: Double -> Double -> [ (Id, SVG) ] -> String showSVG w h = show . document . svgToXml w h -svgToElem :: Double -> Double -> SVG -> Element ()-svgToElem pw ph (Line p1 p2 color lineWidth)+svgToElem :: Double -> Double -> (Id, SVG) -> Element ()+svgToElem pw ph (idn, (Line p1 p2 color lineWidth)) = Elem (N "line") [- ( N "x1", AttValue [ Left $ show x1 ] )+ ( N "id", AttValue [ Left $ idn ] )+ , ( N "x1", AttValue [ Left $ show x1 ] ) , ( N "y1", AttValue [ Left $ show y1 ] ) , ( N "x2", AttValue [ Left $ show x2 ] ) , ( N "y2", AttValue [ Left $ show y2 ] )@@ -101,9 +113,10 @@ (x1, y1) = getPos pw ph p1 (x2, y2) = getPos pw ph p2 -svgToElem pw ph (Polyline points fillColor lineColor lineWidth)+svgToElem pw ph (idn, (Polyline points fillColor lineColor lineWidth)) = Elem (N "polyline") [- ( N "points", AttValue [ Left $ pointsToAttVal points ] )+ ( N "id", AttValue [ Left $ idn ] )+ , ( N "points", AttValue [ Left $ pointsToAttVal points ] ) , ( N "fill" , AttValue [ Left $ mkColorStr fillColor ] ) , ( N "stroke", AttValue [ Left $ mkColorStr lineColor ] ) , ( N "stroke-width", AttValue [ Left $ show lineWidth ] )@@ -115,9 +128,10 @@ = let (x, y) = getPos pw ph p in show x ++ "," ++ show y ++ " " ++ pointsToAttVal ps -svgToElem pw ph (Rect p w h sw cf cs)+svgToElem pw ph (idn, (Rect p w h sw cf cs)) = Elem (N "rect") [- ( N "x", AttValue [ Left $ show x ] )+ ( N "id", AttValue [ Left $ idn ] )+ , ( N "x", AttValue [ Left $ show x ] ) , ( N "y", AttValue [ Left $ show y ] ) , ( N "width", AttValue [ Left $ show w ] ) , ( N "height", AttValue [ Left $ show h ] )@@ -128,12 +142,13 @@ where (x, y) = getPos pw ph p -svgToElem pw ph (Fill c)- = svgToElem pw ph $ Rect (TopLeft 0 0) pw ph 0 c c+svgToElem pw ph (idn, (Fill c))+ = svgToElem pw ph $ (idn, Rect (TopLeft 0 0) pw ph 0 c c) -svgToElem pw ph (Text p s c f t)+svgToElem pw ph (idn, (Text p s c f t)) = Elem (N "text") [- ( N "x", AttValue [ Left $ show x ] )+ ( N "id", AttValue [ Left $ idn ] )+ , ( N "x", AttValue [ Left $ show x ] ) , ( N "y", AttValue [ Left $ show y ] ) , ( N "font-family", AttValue [ Left $ fontName f ] ) , ( N "font-weight", AttValue [ Left $ weightValue $ fontWeight f ] )@@ -143,9 +158,10 @@ where (x, y) = getPos pw ph p -svgToElem pw ph (Circle p r c)+svgToElem pw ph (idn, (Circle p r c)) = Elem (N "circle") [- ( N "cx", AttValue [ Left $ show x ] )+ ( N "id", AttValue [ Left $ idn ] )+ , ( N "cx", AttValue [ Left $ show x ] ) , ( N "cy", AttValue [ Left $ show y ] ) , ( N "r", AttValue [ Left $ show r ] ) , ( N "fill", AttValue [ Left $ mkColorStr c ] )@@ -153,9 +169,10 @@ where (x, y) = getPos pw ph p -svgToElem pw ph (Image p w h path)+svgToElem pw ph (idn, (Image p w h path)) = Elem (N "image") [- ( N "x", AttValue [ Left $ show x ] )+ ( N "id", AttValue [ Left $ idn ] )+ , ( N "x", AttValue [ Left $ show x ] ) , ( N "y", AttValue [ Left $ show y ] ) , ( N "width", AttValue [ Left $ show w ] ) , ( N "height", AttValue [ Left $ show h ] )@@ -164,14 +181,31 @@ where (x, y) = getPos pw ph p -svgToElem pw ph (Group trs svgs)- = Elem (N "g") (- map (\ tr -> let a = showTrans tr- in ( N "transform", AttValue [ Left a ] ) ) trs- ) $ map (flip CElem () . svgToElem pw ph) svgs+svgToElem pw ph (_idn, (Use p w h path))+ = Elem (N "use") [+ ( N "x", AttValue [ Left $ show x ] )+ , ( N "y", AttValue [ Left $ show y ] )+ , ( N "width", AttValue [ Left $ show w ] )+ , ( N "height", AttValue [ Left $ show h ] )+ , ( N "xlink:href", AttValue [ Left ("url(#"++path++")") ] )+ ] []+ where+ (x, y) = getPos pw ph p +svgToElem pw ph (_idn, (Group trs svgs))+ = Elem (N "g") + [ ( N "transform", AttValue (map Left (map showTrans trs))) ]+ $ map (flip CElem () . svgToElem pw ph) svgs -svgToXml :: Double -> Double -> [ SVG ] -> Document ()+svgToElem pw ph (_idn, (Defs svgs))+ = Elem (N "defs") + [] (map (flip CElem () . svgToElem pw ph) svgs)++--svgToElem pw ph (id, (Symbol svgs))+-- = Elem (N "symbol") +-- [] (map (flip CElem () . svgToElem pw ph) svgs)++svgToXml :: Double -> Double -> [ (Id,SVG) ] -> Document () svgToXml w h svgs = Document prlg ent (Elem (N "svg") (emAtt w h) $ map (flip CElem () . svgToElem w h) svgs) els
yjsvg.cabal view
@@ -1,8 +1,8 @@ Build-Type: Simple-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Name: yjsvg-Version: 0.1.18+Version: 0.2.0.0 stability: experimental author: YoshikuniJujo <PAF01143@nifty.ne.jp> maintainer: YoshikuniJujo <PAF01143@nifty.ne.jp>@@ -14,7 +14,7 @@ synopsis: make SVG string from Haskell data description: > import Text.XML.YJSVG- > main = putStrLn $ showSVG 500 750 [ Line 30 40 100 200 "yellow" 10 ]+ > main = putStrLn $ showSVG 500 750 [ ("", Line 30 40 100 200 "yellow" 10) ] . etc @@ -22,8 +22,13 @@ type: git location: git://github.com/YoshikuniJujo/yjsvg.git +source-repository this+ type: git+ location: git://github.com/YoshikuniJujo/yjsvg.git+ tag: yjsvg-0.2.0.0+ Library Hs-source-dirs: src Exposed-Modules: Text.XML.YJSVG- Build-Depends: base > 3 && < 5, HaXml >= 1.22.3- Ghc-Options: -Wall+ Build-Depends: base == 4.*, HaXml == 1.24.*+ Ghc-Options: -Wall -fno-warn-tabs