diff --git a/Output.hs b/Output.hs --- a/Output.hs +++ b/Output.hs @@ -23,7 +23,7 @@ ++ hFileEnd) fileHeader :: String -fileHeader = "/* This file is generated using svg2q v.0.3.1.\n\ +fileHeader = "/* This file is generated using svg2q v.0.3.2.\n\ \\tPlease feel free to report any bugs. */\n\n\n" @@ -38,8 +38,8 @@ "#include \""++file++".h\"\n\n\ \@implementation "++file++"\n\n"++ imSynths (mapMaybe varNames (catMaybes graphics)) ++"\n\n\ - \- (id)init {\ - \\n\tself = [super initWithFrame:[self frame]];\ + \- (id)initWithCoder:(NSCoder*) aDecoder {\ + \\n\tself = [super initWithCoder:aDecoder];\ \\n\t if (self) {\ \\n\t\t // init code.\n\ \\t\t self.scaleFactor = 1;\n"++ diff --git a/PathCommand.hs b/PathCommand.hs --- a/PathCommand.hs +++ b/PathCommand.hs @@ -76,9 +76,9 @@ \with no arguments\ \ in Path:"++show input) cpch ((x':_):args:xs) = createCmds x' args:cpch xs - cpch _ = error ("this shouldn't happen. cpch did\ + cpch _ = error "this shouldn't happen. cpch did\ \not pattern match.\n\ - \Please report a bug.") + \Please report a bug." pc = concat (cpch x) in optimizePath (head pc) pc diff --git a/Translate.hs b/Translate.hs --- a/Translate.hs +++ b/Translate.hs @@ -1,5 +1,9 @@ module Translate where +import Data.Generics.Aliases (orElse) +import Helpers (split) +import Data.List (find) +import Text.XML.Light.Types as XML import Language.C.Data.Ident import Language.C.Data.Node import Language.C.Data.Position @@ -22,6 +26,161 @@ noIdent = Ident "" 0 noNodeInfo +createGraphicsFromContent :: Content -> Maybe GraphicsElement +createGraphicsFromContent (Elem e) = Just $ fromXML e +createGraphicsFromContent _ = Nothing + +createGroup :: Element -> GraphicsElement +createGroup e = Group (mapMaybe createGraphicsFromContent (elContent e)) + (getId (getString "id" (elAttribs e))) + +createDescription :: Element -> GraphicsElement +createDescription _ = Description + +createDefinition :: Element -> GraphicsElement +createDefinition _ = 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) + g [] = trace "Warning, something went wront with \ + \kvpFromCSSAttr. Probably no Attributes." + KeyValuePair "" "" + 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:_) = cdData x +getText (_:xs) = getText xs +getText _ = "" + +fromXML :: XML.Element -> GraphicsElement +fromXML 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 + + -- pretty prints a list of CBlockItems printCode :: [CBlockItem] -> IO() printCode l= let mpaa "" p = (show.pretty) p @@ -29,7 +188,6 @@ string = foldl mpaa "" l in putStrLn string - -- creates code for color of name s representing Color c. colorSetup :: String -> Maybe Color -> [CBlockItem] colorSetup _ Nothing = [] @@ -360,7 +518,16 @@ createCode e = trace ("Note: createCode: Not yet implemented: "++show e) Nothing cid :: Id -> String -cid x = toLower (head x) : tail x +cid x = let x' = concatMap idTable x + in toLower (head x') : tail x' + +idTable :: Char -> String +idTable '@' = "At" +idTable ':' = "Colon" +idTable '-' = "Dash" +idTable '.' = "Dot" +idTable ',' = "Comma" +idTable c = [c] diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -1,10 +1,7 @@ module Types where -import Text.XML.Light.Types -import Data.List (groupBy, find) -import Debug.Trace (trace) +import Data.List (find) import Color -import Helpers (replace, clean) import TextElement import Point import PathCommand diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -1,19 +1,10 @@ module Main ( main ) where import Data.SVG.SVG -import Data.Maybe (fromJust, mapMaybe) +import Data.Maybe (fromJust) import System( getArgs ) import Text.XML.Light.Types as XML -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 Translate(createGraphicsFromContent) --my translation functions import Output (mkImplementation, mkHeader) -import TextElement main :: IO () main = do @@ -35,156 +26,5 @@ . fromJust . parseSVG -createGraphicsFromContent :: Content -> Maybe GraphicsElement -createGraphicsFromContent (Elem e) = Just $ cgfe e -createGraphicsFromContent _ = Nothing -cgfe :: XML.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 _ = Description - -createDefinition :: Element -> GraphicsElement -createDefinition _ = 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) - g [] = trace ("Warning, something went wront with \ - \kvpFromCSSAttr. Probably no Attributes.") - KeyValuePair "" "" - 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:_) = cdData x -getText (_:xs) = getText xs -getText _ = "" diff --git a/svg2q.cabal b/svg2q.cabal --- a/svg2q.cabal +++ b/svg2q.cabal @@ -1,5 +1,5 @@ Name: svg2q -Version: 0.3.1 +Version: 0.3.2 Cabal-Version: >= 1.6 License: BSD3 Author: Jan Greve