svg2q-0.3.2: Translate.hs

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
import Language.C.Syntax.AST
import Language.C.Pretty
import Types hiding (strokeWidth)
import Debug.Trace (trace)
import Color
import Data.Maybe (mapMaybe,fromJust,catMaybes)
import Data.Char (toLower)
import Prelude hiding (id)
import Point
import PathCommand
import TextElement

noNodeInfo :: NodeInfo
noNodeInfo = OnlyPos (Position "nopos" 0 0)

noIdent :: Ident
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
                 mpaa s p = s ++ "\n" ++ (show.pretty) p
                 string = foldl mpaa "" l
            in putStrLn string

-- creates code for color of name s representing Color c.
colorSetup :: String -> Maybe Color -> [CBlockItem]
colorSetup _ Nothing = []
colorSetup s (Just c) = let 
                inits = map CBlockDecl 
                      [cDecl "CGColorSpaceRef" (s++"Colorspace"), 
                       cDecl "CGColorRef" (s++"Color"), 
                       cDecl "CGFloat" (s++"ColorComponents[4]")]
                assigns = 
                        [assign (var (s++"Colorspace")) (call "CGColorSpaceCreateDeviceRGB" []),
                         assign (var (s++"ColorComponents[0]"))
                                (var (show (red c))),
                         assign (var (s++"ColorComponents[1]"))
                                (var (show (green c))),
                         assign (var (s++"ColorComponents[2]"))
                                (var (show (blue c))),
                         assign (var (s++"ColorComponents[3]"))
                                (var "1"), 
                         assign (var (s++"Color"))
                                (call "CGColorCreate" [s++"Colorspace", s++"ColorComponents"])]
              in
                  inits++assigns
transparentSetup :: String -> [CBlockItem]
transparentSetup s= let 
                inits = map CBlockDecl 
                      [cDecl "CGColorSpaceRef" (s++"Colorspace"), 
                       cDecl "CGColorRef" (s++"Color"), 
                       cDecl "CGFloat" (s++"ColorComponents[4]")]
                assigns = 
                        [assign (var (s++"Colorspace")) (call "CGColorSpaceCreateDeviceRGB" []),
                         assign (var (s++"ColorComponents[0]"))
                                (var "0"),
                         assign (var (s++"ColorComponents[1]"))
                                (var "0"),
                         assign (var (s++"ColorComponents[2]"))
                                (var "0"),
                         assign (var (s++"ColorComponents[3]"))
                                (var "0"), 
                         assign (var (s++"Color"))
                                (call "CGColorCreate" [s++"Colorspace", s++"ColorComponents"])]
              in
                  inits++assigns

release :: [String] -> [CBlockItem]
release = 
     foldr
        (\ s ->
           (++)
             [CBlockStmt
                (createStat (call "CGColorSpaceRelease" [s ++ "Colorspace"])),
              CBlockStmt (createStat (call "CGColorRelease" [s ++ "Color"]))])
        []


draw :: [CBlockItem]
draw = [CBlockStmt (createStat (call "CGContextDrawPath" ["context", "kCGPathFillStroke"]))]

drawEmpty :: [CBlockItem]
drawEmpty = [CBlockStmt (createStat (call "CGContextStrokePath"
                                          ["context"]))]

drawRoundedRect :: [String] -> [CBlockItem]
drawRoundedRect s
                | length s == 9 = [CBlockStmt (createStat (call "drawRoundedRect" s))]
                | length s == 10 = [CBlockStmt (createStat (call "drawRoundedRectFill" s))]

createStat :: CExpr -> CStat
createStat e = CExpr (Just e) noNodeInfo

createBlStmt :: CExpr -> CBlockItem
createBlStmt e = CBlockStmt (createStat e)
                
setStrokeColor :: String -> CExpr
setStrokeColor s = call "CGContextSetStrokeColorWithColor"
                        ["context", s++"Color"]

setFillColor :: String -> CExpr
setFillColor s = call "CGContextSetFillColorWithColor"
                      ["context", s++"Color"]

fillPath :: CExpr
fillPath = call "CGContextFillPath" ["context"]

strokePath :: CExpr
strokePath = call "CGContextStrokePath" ["context"]

fillRect :: CExpr
fillRect = call "CGContextFillRect" ["context", "rect"]

fillEllipse :: CExpr
fillEllipse = call "CGContextFillEllipseInRect" ["context", "rect"]

setFont :: Maybe String -> Float -> CExpr
setFont _ f = call "CGContextSelectFont"
                   ["context"
                   ,show "Helvetica"
                   ,show f
                   ,"kCGEncodingMacRoman"]

setFont' :: Maybe String -> String -> CExpr
setFont' _ s = call "CGContextSelectFont"
                    ["context"
                    ,show "Helvetica"
                    ,s
                    , "kCGEncodingMacRoman"]


textAtPoint :: Point -> String -> CExpr
textAtPoint (Point x y) s =
            call "CGContextShowTextAtPoint"
                 ["context"
                 ,show x
                 ,show y
                 ,show s
                 , show (length s)]

varTextAtPoint :: Point -> String -> CExpr
varTextAtPoint (Point x y) s =
               let len = '[':s++" length]"
                   cstr = '[':s++" UTF8String]"
               in
                call "CGContextShowTextAtPoint"
                     ["context"
                     , show x
                     , show y
                     , cstr
                     , len]

setLineWidth :: Float -> CExpr
setLineWidth f = call "CGContextSetLineWidth"
                      ["context", show f]

setLineWidth' :: String -> CExpr
setLineWidth' s = call "CGContextSetLineWidth"
                       ["context", s]

cMove :: Point -> CExpr
cMove (Point x y) = call "CGContextMoveToPoint"
                         ["context", show x, show y]

cLine :: Point -> CExpr
cLine (Point x y) = call "CGContextAddLineToPoint"
                                  ["context",show x, show y]

rrectcall :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> CBlockItem
rrectcall x y rx ry w h sw =
          CBlockStmt (CExpr (Just (var ("[QRect drawWithContext:context andX:"
                                       ++show x++" andY:"
                                       ++show y++" andRadiusX:"
                                       ++show rx++" andRadiusY:"
                                       ++show ry++" andWidth:"
                                       ++show w++" andHeight:"
                                       ++show h++" andStrokeWidth:"
                                       ++show sw++" andStrokeColor: strokeColor]")))
                            noNodeInfo)
frrectcall :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> CBlockItem
frrectcall x y rx ry w h sw = 
           CBlockStmt (CExpr (Just (var ("[QRect drawWithContext:context andX:"
                                       ++show x++" andY:"
                                       ++show y++" andRadiusX:"
                                       ++show rx++" andRadiusY:"
                                       ++show ry++" andWidth:"
                                       ++show w++" andHeight:"
                                       ++show h++" andStrokeWidth:"
                                       ++show sw++" andStrokeColor: strokeColor"
                                       ++" andFillColor: fillColor]")))
                            noNodeInfo)


codeString :: GraphicsElement -> Maybe String
codeString (Group xs _) = Nothing -- future works.
codeString Description = Nothing
codeString Definition = Nothing

codeString x = if id x == Nothing
               then Just $ prettyCode (catMaybes [createCode x])
               else genVarCode x 


createCode :: GraphicsElement -> Maybe CBlockItem
createCode (Rect (Point x y) 
                 width
                 height 
                 rx
                 ry
                 fillColor
                 strokeWidth
                 strokeColor
                 Nothing) = 
     let color = colorSetup "stroke" strokeColor 
               ++ colorSetup "fill" fillColor
     in
       if fillColor == Nothing
       then Just $ createComp (color
                              ++ [rrectcall x y rx ry width height strokeWidth])
       else Just $ createComp (color
                              ++ [frrectcall x y rx ry width height strokeWidth])



createCode (Circle (Point cx cy) 
                  r      
                  fillColor
                  strokeWidth
                  strokeColor
                  Nothing) = 
           let
           x = cx - r
           y = cy - r
           color = colorSetup "stroke" strokeColor ++colorSetup "fill" fillColor
           crel = release ["stroke", "fill"]
           cbl = [CBlockDecl (cDecl "CGRect" "rect"),
                          assign (var "rect")
                                 (call "CGRectMake"
                                       (map show [x, y, r*2, r*2]))]
           str = map createBlStmt
                        [setFillColor "fill",
                         setStrokeColor "stroke",
                         call "CGContextAddEllipseInRect" 
                              ["context", "rect"],
                         setLineWidth strokeWidth]
           in
           if fillColor == Nothing
              then Just $ createComp (color
                                     ++ cbl ++ tail str
                                     ++ drawEmpty
                                     ++ release ["stroke"])
              else Just $createComp (color 
                                    ++ cbl ++ str 
                                    ++ draw 
                                    ++ crel)

createCode (Ellipse (Point cx cy)
                    rx
                    ry
                    fillColor
                    strokeWidth
                    strokeColor
                    Nothing) =
           let
           x = cx - rx
           y = cy - ry
           color = colorSetup "stroke" strokeColor ++ colorSetup "fill" fillColor
           crel = release ["stroke", "fill"]
           cbl = [CBlockDecl (cDecl "CGRect" "rect"),
                          assign (var "rect")
                                 (call "CGRectMake"
                                       (map show [x, y, rx*2, ry*2]))]
           str = map createBlStmt
                        [setFillColor "fill",
                         setStrokeColor "stroke",
                         call "CGContextAddEllipseInRect" ["context", "rect"],
                         setLineWidth strokeWidth]
           in
           if fillColor == Nothing
              then Just $ createComp (color
                                     ++ cbl ++ tail str
                                     ++ drawEmpty
                                     ++ release ["stroke"])
              else Just $ createComp (color 
                                     ++ cbl ++ str 
                                     ++ draw 
                                     ++ crel)
createCode (Line p1 
                 p2 
                 width 
                 strokeColor 
                 Nothing) = 
           let color = (colorSetup "stroke" strokeColor)
               crel = release ["stroke"]
               stroke = map createBlStmt
                            [setStrokeColor "stroke",
                             cMove p1,
                             cLine p2,
                             setLineWidth width]
             in
                Just $ createComp (color++stroke++draw++crel)

createCode (Path pc
                 Nothing
                 fillColor
                 strokeWidth
                 strokeColor) =
           let color = colorSetup "stroke" strokeColor++colorSetup "fill" fillColor
               crel = release ["stroke", "fill"]
               stroke = map createBlStmt
                        ([setFillColor "fill",
                          setLineWidth strokeWidth,
                          setStrokeColor "stroke"]++
                         pathCommands pc)
           in
           if fillColor == Nothing
              then Just $ createComp (color
                                     ++ tail stroke
                                     ++ drawEmpty
                                     ++ release ["stroke"])
              else Just $ createComp (color 
                                     ++ stroke 
                                     ++ draw 
                                     ++ crel)

createCode (TextElement (TextElem text
                                  fontSize
                                  _
                                  start
                                  strokeColor
                                  strokeWidth
                                  fillColor)
                        Nothing) =
           let color = colorSetup "stroke" strokeColor++colorSetup "fill" fillColor
               a = map createBlStmt [setFillColor "fill"
                                     ,setLineWidth strokeWidth
                                     ,setStrokeColor "stroke"
                                     ,call "CGContextSetTextMatrix"
                                           ["context"
                                           ,"CGAffineTransformMakeScale(1,-1)"]
                                     ,call "CGContextSetTextDrawingMode"
                                           ["context"
                                           ,"kCGTextFillStroke"]
                                     ,setFont (Just "Helvetica") fontSize
                                     ,textAtPoint start text]
            in
                Just $ createComp (color
                                  ++ a)

createCode (Group xs id) = Just (createComp (mapMaybe createCode xs))
createCode Description = Nothing
createCode e = trace ("Note: createCode: Not yet implemented: "++show e) Nothing

cid :: Id -> String
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]



genVarCode :: GraphicsElement -> Maybe String
genVarCode (Group xs _) = Nothing -- future works.
genVarCode Description = Nothing
genVarCode Definition = Nothing

genVarCode (Path pc
                 (Just id)
                 _
                 _
                 _) =
           let id' = cid id
               stroke = map createBlStmt
                        ([setFillColor (id'++"Element.fill"),
                          setLineWidth' (id'++"Element.strokeWidth"),
                          setStrokeColor (id'++"Element.stroke")]++
                         pathCommands pc)
           in Just (prettyCode [createComp (stroke 
                                     ++ draw)])


genVarCode x =
           if id x /= Nothing
           then
                let id' = cid (fromJust (id x))
                in 
                   Just $ "\t["++id'++"Element drawWithContext:context];\n"
           else
                Nothing

createComp :: [CBlockItem] -> CBlockItem
createComp bil = CBlockStmt $ CCompound [] bil noNodeInfo

var :: String -> CExpr
var s = CVar (Ident s 0 noNodeInfo) noNodeInfo

call :: String -> [String] -> CExpr
call s0 s1 = CCall (var s0) (map var s1) noNodeInfo

assign :: CExpr -> CExpr -> CBlockItem
assign e1 e2 = CBlockStmt (CExpr (Just (CAssign CAssignOp e1 e2 noNodeInfo)) noNodeInfo)

-- produces delaration of type s1, name s2
cDecl :: String -> String -> CDecl
cDecl s1 s2 = CDecl [typeDef s1] [(Just (nameDeclr s2),Nothing, Nothing)] noNodeInfo

-- produces declarator of input string
nameDeclr :: String -> CDeclr
nameDeclr s = CDeclr (Just (Ident s 0 noNodeInfo)) [] Nothing [] noNodeInfo

-- produces type of input string
typeDef :: String -> CDeclSpec
typeDef s = CTypeSpec (CTypeDef (Ident s 0 noNodeInfo) noNodeInfo)

pathCommands :: [PathCommand] -> [CExpr]
pathCommands [] = []
pathCommands pc = map helper pc
             where
             helper (PathMoveTo x) = cMove x
             helper (PathLineTo x) = cLine x
             helper (PathCurveTo (Point cp1x cp1y)
                                 (Point cp2x cp2y)
                                 (Point p1x p1y)) = 
                     call "CGContextAddCurveToPoint"
                          ("context":map show [cp1x, cp1y, cp2x, cp2y, p1x, p1y])
             helper (PathQuadraticCurveTo (Point cx cy)
                                          (Point x y)) =
                    call "CGContextAddQuadCurveToPoint"
                         ("context":map show [cx, cy,x,y])
             helper PathClosePath = call "CGContextClosePath" ["context"]
             helper x = error ("pathCommands: not yet implemented: "++show x)

prettyCode :: [CBlockItem] -> String
prettyCode cbi = let 
                 f "" p = (show.pretty) p
                 f s p = s ++ "\n" ++ (show.pretty) p
                 in
                 foldl f "" cbi ++ "\n"

convertId :: Maybe Id -> String
convertId (Just id) = toLower (head id) : tail id
convertId Nothing = []

mkInitVals :: GraphicsElement -> Maybe CBlockItem
mkInitVals (Rect (Point x y)
                 width
                 height
                 rx
                 ry
                 fill
                 strokeWidth
                 stroke
                 id)
     | id == Nothing = Nothing
     | fill == Nothing =
       let color = colorSetup "stroke" stroke
                 ++ transparentSetup "fill"
           f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
       in
        Just $ createComp (color ++ [ f "x" (show x)
                 , f "y" (show y)
                 , f "width" (show width)
                 , f "height" (show height)
                 , f "radiusX" (show rx)
                 , f "radiusY" (show ry)
                 , f "strokeWidth" (show strokeWidth)
                 , f "fillColor" "fillColor"
                 , f "strokeColor" "strokeColor"])
     | otherwise =
       let color = colorSetup "stroke" stroke ++ colorSetup "fill" fill
           f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
       in
        Just $ createComp (color ++ [ f "x" (show x)
                 , f "y" (show y)
                 , f "width" (show width)
                 , f "height" (show height)
                 , f "radiusX" (show rx)
                 , f "radiusY" (show ry)
                 , f "strokeWidth" (show strokeWidth)
                 , f "strokeColor" "strokeColor"
                 , f "fillColor" "fillColor"])

mkInitVals (Ellipse (Point x y)
                    rx
                    ry
                    fill
                    strokeWidth
                    stroke
                    id)
     | id == Nothing = Nothing
     | otherwise =
       let color = colorSetup "stroke" stroke 
                 ++ colorSetup "fill" fill
                 ++ transparentSetup "trans"
           f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
           l = color ++ [f "x" (show x)
                  , f "y" (show y)
                  , f "radiusX" (show rx)
                  , f "radiusY" (show ry)
                  , f "strokeWidth" (show strokeWidth)
                  , f "strokeColor" "strokeColor"]
       in
        if fill == Nothing
           then Just $ createComp (l++[f "fillColor" "transColor"])
           else Just $ createComp (l++[f "fillColor" "fillColor"])

mkInitVals (Path _
                 id
                 fill
                 strokeWidth
                 stroke)
     | id == Nothing = Nothing
     | otherwise =
       let color = colorSetup "stroke" stroke 
                 ++ colorSetup "fill" fill
                 ++ transparentSetup "trans"
           f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
           l = color ++ [f "strokeColor" "strokeColor"
                        ,f "strokeWidth" (show strokeWidth)]
       in
        if fill == Nothing
           then Just $ createComp (l++[f "fillColor" "transColor"])
           else Just $ createComp (l++[f "fillColor" "fillColor"])

mkInitVals (Circle (Point x y)
                   radius
                   fill
                   strokeWidth
                   stroke
                   id)
      | id == Nothing = Nothing
      | otherwise =
        let color = colorSetup "stroke" stroke 
                 ++ colorSetup "fill" fill
                 ++ transparentSetup "trans"
            f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
            l = color ++ [f "x" (show x)
                         ,f "y" (show y)
                         ,f "radiusX" (show radius)
                         ,f "radiusY" (show radius)
                         ,f "strokeWidth" (show strokeWidth)
                         ,f "strokeColor" "strokeColor"]
         in
                if fill == Nothing
                   then Just $ createComp (l
                                          ++[f "fillColor"
                                               "transColor"])
                   else Just $ createComp (l
                                          ++[f "fillColor" "fillColor"])

mkInitVals (Line (Point x1 y1)
                 (Point x2 y2)
                 strokeWidth
                 stroke
                 id)
      | id == Nothing = Nothing
      | otherwise =
        let color = colorSetup "stroke" stroke
            f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
            l = color ++ [f "x1" (show x1)
                         ,f "x2" (show x2)
                         ,f "y1" (show y1)
                         ,f "y2" (show y2)
                         ,f "strokeWidth" (show strokeWidth)
                         ,f "strokeColor" "strokeColor"]
         in Just $ createComp l

mkInitVals (TextElement elem id)
           | id == Nothing = Nothing
           | otherwise =
             let color = colorSetup "stroke" (strokeColor elem)
                       ++ colorSetup "fill" (fillColor elem)
                 f s1 s2 = assign (var (cid (fromJust id)++"Element."++s1)) (var s2)
                 l = color ++ [f "text" ('@':show (content elem))
                              ,f "fillColor" "fillColor"
                              ,f "strokeColor" "strokeColor"
                              ,f "strokeWidth" (show (strokeWidth elem))
                              ,f "fontSize" (show (fontSize elem))
                              , f "x" (show (xCood (start elem)))
                              ,f "y" (show (yCood (start elem)))]
             in
                Just $ createComp l
                 
mkInitVals e
           | e == Description = Nothing
           | e == Definition = Nothing
           | id e == Nothing = Nothing
           | otherwise = trace ("Note: mkInitVals: not yet: "++show e) Nothing


mkAllocs :: GraphicsElement -> Maybe String
mkAllocs (Rect _ _ _ _ _ _ _ _ (Just id)) =
         Just $ "\t\t"++cid id++"Element = [[QRect alloc] init];\n"
mkAllocs (Circle _ _ _ _ _ (Just id)) =
         Just $ "\t\t"++cid id++"Element = [[QEllipse alloc] init];\n"
mkAllocs (Ellipse _ _ _ _ _ _ (Just id)) =
         Just $ "\t\t"++cid id++"Element = [[QEllipse alloc] init];\n"
mkAllocs (Line _ _ _ _ (Just id)) =
         Just $ "\t\t"++cid id++"Element = [[QLine alloc] init];\n"
mkAllocs (Path _ (Just id) _ _ _) =
         Just $ "\t\t"++cid id++"Element = [[QPath alloc] init];\n"
mkAllocs (TextElement _ (Just id)) =
         Just $ "\t\t"++cid id++"Element = [[QText alloc] init];\n"
mkAllocs _ = Nothing

varNames :: GraphicsElement -> Maybe String
varNames Description = Nothing
varNames Definition = Nothing
varNames x
         | id x /= Nothing =
           Just $ cid (fromJust (id x))++"Element"
         | otherwise = Nothing

mkMember :: GraphicsElement -> Maybe String
mkMember (Rect _ _ _ _ _ _ _ _ (Just id)) =
         Just $ "\tQRect* "++cid id++"Element;\n"
mkMember (Circle _ _ _ _ _ (Just id)) =
         Just $ "\tQEllipse* "++cid id++"Element;\n"
mkMember (Ellipse _ _ _ _ _ _ (Just id)) =
         Just $ "\tQEllipse* "++cid id++"Element;\n"
mkMember (Line _ _ _ _ (Just id)) =
         Just $ "\tQLine* "++cid id++"Element;\n"
mkMember (Path _ (Just id) _ _ _) =
         Just $ "\tQPath* "++cid id++"Element;\n"
mkMember (TextElement _ (Just id)) =
         Just $ "\tQText* "++cid id++"Element;\n"
mkMember _ = Nothing