packages feed

yjsvg 0.1.8 → 0.1.9

raw patch · 2 files changed

+43/−22 lines, 2 files

Files

src/Text/XML/YJSVG.hs view
@@ -3,6 +3,7 @@ , SVG(..) , Transform(..) , Color(..)+, Position(..) , yjsvgVersion ) where @@ -14,16 +15,24 @@ import Data.Word(Word8)  yjsvgVersion :: (Int, String)-yjsvgVersion = (3, "0.1.8")+yjsvgVersion = (4, "0.1.9")  type Font = String+data Position+	= TopLeft{posX :: Double, posY :: Double}+	| Center{posX :: Double, posY :: Double}+	deriving Show -data SVG   = Line Double Double Double Double Color Double |-             Polyline [ ( Double, Double ) ] Color Color Double |-             Rect Double Double Double Double Double Color Color |-	     Circle Double Double Double Color |-             Text Double Double Double Color Font String |-	     Image Double Double Double Double FilePath |+getPos :: Double -> Double -> Position -> (Double, Double)+getPos _ _ TopLeft{posX = x, posY = y} = (x, y)+getPos w h Center{posX = x, posY = y} = (x + w / 2, - y + h / 2)++data SVG   = Line Position Position Color Double |+             Polyline [Position] Color Color Double |+             Rect Position Double Double Double Color Color |+	     Circle Position Double Color |+             Text Position Double Color Font String |+	     Image Position Double Double FilePath | 	     Group [ Transform ] [ SVG ] 	deriving Show data Color@@ -61,8 +70,8 @@ showSVG :: Double -> Double -> [ SVG ] -> String showSVG w h = show . document . svgToXml w h -svgToElem :: SVG -> Element ()-svgToElem (Line x1 y1 x2 y2 color lineWidth)+svgToElem :: Double -> Double -> SVG -> Element ()+svgToElem pw ph (Line p1 p2 color lineWidth)   = Elem (N "line") [        ( N "x1", AttValue [ Left $ show x1 ] )      , ( N "y1", AttValue [ Left $ show y1 ] )@@ -71,8 +80,11 @@      , ( N "stroke", AttValue [ Left $ mkColorStr color ] )      , ( N "stroke-width", AttValue [ Left $ show lineWidth ] )      ] []+	where+	(x1, y1) = getPos pw ph p1+	(x2, y2) = getPos pw ph p2 -svgToElem (Polyline points fillColor lineColor lineWidth)+svgToElem pw ph (Polyline points fillColor lineColor lineWidth)   = Elem (N "polyline") [        ( N "points", AttValue [ Left $ pointsToAttVal points ] )      , ( N "fill"  , AttValue [ Left $ mkColorStr fillColor ] )@@ -80,12 +92,13 @@      , ( N "stroke-width", AttValue [ Left $ show lineWidth ] )      ] []   where-  pointsToAttVal :: [ ( Double, Double ) ] -> String+  pointsToAttVal :: [Position] -> String   pointsToAttVal [] = ""-  pointsToAttVal ( (x, y):ps )-    = show x ++ "," ++ show y ++ " " ++ pointsToAttVal ps+  pointsToAttVal (p : ps)+    = let (x, y) = getPos pw ph p in+	show x ++ "," ++ show y ++ " " ++ pointsToAttVal ps -svgToElem (Rect x y w h sw cf cs)+svgToElem pw ph (Rect p w h sw cf cs)   = Elem (N "rect") [    ( N "x", AttValue [ Left $ show x ] )  , ( N "y", AttValue [ Left $ show y ] )@@ -95,8 +108,10 @@  , ( N "fill", AttValue [ Left $ mkColorStr cf ] )  , ( N "stroke", AttValue [ Left $ mkColorStr cs ] )  ] []+	where+	(x, y) = getPos pw ph p -svgToElem (Text x y s c f t)+svgToElem pw ph (Text p s c f t)   = Elem (N "text") [    ( N "x", AttValue [ Left $ show x ] )  , ( N "y", AttValue [ Left $ show y ] )@@ -104,35 +119,41 @@  , ( N "font-size", AttValue [ Left $ show s ] )  , ( N "fill", AttValue [ Left $ mkColorStr c ] )  ] [ CString False t () ]+	where+	(x, y) = getPos pw ph p -svgToElem (Circle x y r c)+svgToElem pw ph (Circle p r c)   = Elem (N "circle") [        ( N "cx", AttValue [ Left $ show x ] )      , ( N "cy", AttValue [ Left $ show y ] )      , ( N "r", AttValue [ Left $ show r ] )      , ( N "fill", AttValue [ Left $ mkColorStr c ] )      ] []+	where+	(x, y) = getPos pw ph p -svgToElem (Image x y w h p)+svgToElem pw ph (Image p w h path)   = Elem (N "image") [        ( 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 p ] )+     , ( N "xlink:href", AttValue [ Left path ] )      ] []+	where+	(x, y) = getPos pw ph p -svgToElem (Group trs svgs)+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) svgs+     ) $ map (flip CElem () . svgToElem pw ph) svgs   svgToXml :: Double -> Double -> [ SVG ] -> Document () svgToXml w h svgs   = Document prlg ent-      (Elem (N "svg") (emAtt w h) $ map (flip CElem () . svgToElem) svgs) els+      (Elem (N "svg") (emAtt w h) $ map (flip CElem () . svgToElem w h) svgs) els  pmsc :: [Misc] pmsc    = [ Comment " MADE BY SVG.HS " ]
yjsvg.cabal view
@@ -2,7 +2,7 @@ Cabal-Version:	>= 1.6  Name:		yjsvg-Version:	0.1.8+Version:	0.1.9 stability:	experimental author:		YoshikuniJujo <PAF01143@nifty.ne.jp> maintainer:	YoshikuniJujo <PAF01143@nifty.ne.jp>