module Main ( main ) where import Data.SVG.SVG import Data.Maybe (catMaybes, fromJust, mapMaybe) import System( getArgs ) import Text.XML.Light.Types import Types --my own types import Translate --my translation functions import Debug.Trace (trace) import Data.Generics.Aliases (orElse) import Helpers (split) import Data.List (find) import Color import Point import PathCommand (createPathCommands) import Output (mkImplementation, mkHeader) import TextElement main = do args <- getArgs if or [null args, null (tail args)] then putStrLn "usage: svg2q " else do contents <- readFile $ head args let graphics = map createGraphicsFromContent (extractSVGContent contents) -- let code = mapMaybe createCode (catMaybes graphics) mkImplementation graphics (args !! 1) mkHeader graphics (args!!1) -- printCode code extractSVGContent :: String -> [Content] extractSVGContent = elContent . getSVGElement . fromJust . parseSVG createGraphicsFromContent :: Content -> Maybe GraphicsElement createGraphicsFromContent (Elem e) = Just $ cgfe e createGraphicsFromContent _ = Nothing cgfe :: Element -> GraphicsElement cgfe e = let name = qName (elName e) a = elAttribs e in case name of "rect" -> Rect (Point (getFloat "x" a) (getFloat "y" a)) (getFloat "width" a) (getFloat "height" a) (getFloat "rx" a) (getFloat "ry" a) (getColor (getString "fill" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) (getId (getString "id" a)) "circle" -> Circle (Point (getFloat "cx" a) (getFloat "cy" a)) (getFloat "r" a) (getColor (getString "fill" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) (getId (getString "id" a)) "ellipse" -> Ellipse (Point (getFloat "cx" a) (getFloat "cy" a)) (getFloat "rx" a) (getFloat "ry" a) (getColor (getString "fill" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) (getId (getString "id" a)) "line" -> Line (Point (getFloat "x1" a) (getFloat "y1" a)) (Point (getFloat "x2" a) (getFloat "y2" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) (getId (getString "id" a)) "polyline" -> mkPolyline (getPoints (getString "points" a)) (getColor (getString "fill" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) (getId (getString "id" a)) "polygon" -> let p = getPoints (getString "points" a) in mkPolyline (p++[head p]) (getColor (getString "fill" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) (getId (getString "id" a)) "g" -> createGroup e "desc" -> createDescription e "defs" -> createDefinition e "path" -> createPath a "text" -> TextElement (TextElem (getText (elContent e)) (getFloat "font-size" a) (getString "font-family" a) (Point (getFloat "x" a) (getFloat "y" a)) (getColor (getString "stroke" a)) (getFloat "stroke-width" a) (getColor (getString "fill" a))) (getId (getString "id" a)) -- die on unknown tags, but promt them _ -> error $ "unknown tag: "++ name createGroup :: Element -> GraphicsElement createGroup e = Group (mapMaybe createGraphicsFromContent (elContent e)) (getId (getString "id" (elAttribs e))) createDescription :: Element -> GraphicsElement createDescription e = Description createDefinition :: Element -> GraphicsElement createDefinition e = Definition createPath :: [Attr] -> GraphicsElement createPath a = Path (createPathCommands (getString "d" a)) (getId (getString "id" a)) (getColor (getString "fill" a)) (getFloat "stroke-width" a) (getColor (getString "stroke" a)) kvpFromCSSAttr :: Maybe Attr -> [KeyValuePair] kvpFromCSSAttr Nothing = [] kvpFromCSSAttr (Just a) = let f = map (g . split ":") g (x:y:[]) = KeyValuePair x y g (x:y:_) = trace ("Warning: too many values for \ \Key "++x++", using "++y) (KeyValuePair x y) g (x:_) = error ("Error: No value for key "++x) sl = split ";" (attrVal a) in f sl getStyleString :: String -> [Attr] -> Maybe String getStyleString s a = getStringFromKVP s (kvpFromCSSAttr (find (\x -> qName (attrKey x) == "style") a)) getXMLString :: String -> [Attr] -> Maybe String getXMLString s l = let sr = (find (\x -> qName (attrKey x) == s) l) in if sr == Nothing then Nothing else Just (attrVal (fromJust sr)) getStyleFloat :: String -> [Attr] -> Maybe Float getStyleFloat s a = let sr = (getStyleString s a) in if sr == Nothing then Nothing else Just (read (fromJust sr)) getXMLFloat :: String -> [Attr] -> Maybe Float getXMLFloat s a = let sr = (getXMLString s a) in if sr == Nothing then Nothing else Just (read (fromJust sr)) getString :: String -> [Attr] -> Maybe String getString s a = let xml = getXMLString s a style = getStyleString s a in orElse style xml getFloat :: String -> [Attr] -> Float getFloat s a = let xml = getXMLFloat s a style = getStyleFloat s a r = orElse style xml in if r == Nothing then if s `elem` ["rx", "ry"] then 0 else error ("Error: expected value for key \""++s++"\"\ \, but none found.") else fromJust r getText :: [Content] -> String getText (Text x:xs) = cdData x getText (_:xs) = getText xs getText _ = ""