svg2q 0.3.1 → 0.3.2
raw patch · 6 files changed
+178/−174 lines, 6 files
Files
- Output.hs +3/−3
- PathCommand.hs +2/−2
- Translate.hs +169/−2
- Types.hs +1/−4
- main.hs +2/−162
- svg2q.cabal +1/−1
Output.hs view
@@ -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"++
PathCommand.hs view
@@ -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
Translate.hs view
@@ -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]
Types.hs view
@@ -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
main.hs view
@@ -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 _ = ""
svg2q.cabal view
@@ -1,5 +1,5 @@ Name: svg2q-Version: 0.3.1+Version: 0.3.2 Cabal-Version: >= 1.6 License: BSD3 Author: Jan Greve