======
#  svg2can.tcl ---
#  
#      This file provides translation from canvas commands to XML/SVG format.
#      
#  Copyright (c) 2004-2007  Mats Bengtsson
#  
#  This file is distributed under BSD style license.
#
# $Id: svg2can.tcl,v 1.42 2008-02-06 13:57:24 matben Exp $
# 
# ########################### USAGE ############################################
#
#   NAME
#      svg2can - translate XML/SVG to canvas command.
#      
#   SYNOPSIS
#      svg2can::parsesvgdocument xmllist
#      svg2can::parseelement xmllist
#      
#
# ########################### CHANGES ##########################################
#
#   0.1      first release
#   0.2      starting support for tkpath package
#
# ########################### TODO #############################################
#
#       A lot...
#
# ########################### INTERNALS ########################################
# 
# The whole parse tree is stored as a hierarchy of lists as:
# 
#       xmllist = {tag attrlist isempty cdata {child1 child2 ...}}

# We need URN decoding for the file path in images. From my whiteboard code.

package require uriencode

package provide svg2can 1.0

namespace eval svg2can {

    variable confopts
    array set confopts {
        -foreignobjecthandler ""
        -httphandler          ""
        -imagehandler         ""
        -imagehandlerex       ""
    }

    variable textAnchorMap
    array set textAnchorMap {
        start   w
        middle  c
        end     e
    }
    
    variable fontWeightMap 
    array set fontWeightMap {
        normal    normal
        bold      bold
        bolder    bold
        lighter   normal
        100       normal
        200       normal
        300       normal
        400       normal
        500       normal
        600       bold
        700       bold
        800       bold
        900       bold
    }
    
    # We need to have a temporary tag for doing transformations.
    variable tmptag _tmp_transform
    variable pi 3.14159265359
    variable degrees2Radians [expr {2*$pi/360.0}]
    variable systemFont

    switch -- $::tcl_platform(platform) {
        unix {
            set systemFont {Helvetica 10}
            if {[package vcompare [info tclversion] 8.3] == 1} {        
                if {[string equal [tk windowingsystem] "aqua"]} {
                    set systemFont system
                }
            }
        }
        windows {
            set systemFont system
        }
    }
    
    variable priv
    set priv(havetkpath) 0
    if {![catch {package require tkpath 0.2.8}]} {
        set priv(havetkpath) 1
    }

    # We don't want it now.
    set priv(havetkpath) 0

    variable chache
    variable cache_key ""
}

# svg2can::config --
# 
#       Processes the configuration options.

proc svg2can::config {args} {
    variable confopts
    
    set options [lsort [array names confopts -*]]
    set usage [join $options ", "]
    if {[llength $args] == 0} {
        set result {}
        foreach name $options {
            lappend result $name $confopts($name)
        }
        return $result
    }
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    if {[llength $args] == 1} {
        set flag [lindex $args 0]
        if {[regexp -- $pat $flag]} {
            return $confopts($flag)
        } else {
            return -code error "Unknown option $flag, must be: $usage"
        }
    } else {
        foreach {flag value} $args {
            if {[regexp -- $pat $flag]} {
                set confopts($flag) $value
            } else {
                return -code error "Unknown option $flag, must be: $usage"
            }
        }
    }
}

# svg2can::cache_* --
# 
#       A few routines to handle the caching of images and gradients.
#       Useful for garbage collection. Cache stuff per key which is typically
#       a widget path, and then do:
#       svg2can::cache_set_key $w
#       bind $w <Destroy> +[list svg2can::cache_free $w]
#       This works only if parsing svg docs in one shot.

proc svg2can::cache_set_key {key} {
    variable cache_key
    set cache_key $key
}

proc svg2can::cache_get_key {} {
    variable cache_key
    return $cache_key
}

proc svg2can::cache_get {$key} {
    variable cache
    if {[info exists cache($key)]} {
        return $cache($key)
    } else {
        return [list]
    }
}

proc svg2can::cache_add {type token} {
    variable cache
    variable cache_key
    lappend cache($cache_key) [list $type $token]
}

proc svg2can::cache_free {key} {
    variable cache
    
    if {![info exists cache($key)]} {
        return
    }
    foreach spec $cache($key) {
        set type [lindex $spec 0]
        set token [lindex $spec 1]
        switch -- $type {
            image {
                image delete $token
            }
            gradient {
                ::tkpath::gradient delete $token
            }
        }
    }
    set cache($key) [list]
}

proc svg2can::cache_reset {key} {
    variable cache
    set cache($key) [list]
}

# svg2can::parsesvgdocument --
# 
# 
# Arguments:
#       xmllist     the parsed document as a xml list
#       args        configuration options
#          -httphandler
#               -imagehandler            
#       
# Results:
#       a list of canvas commands without the widgetPath

proc svg2can::parsesvgdocument {xmllist args} {
    variable confopts
    variable priv

    array set argsA [array get confopts]
    array set argsA $args
    set paropts [array get argsA]
        
    set ans {}
    foreach c [getchildren $xmllist] {
        if {$priv(havetkpath)} {
            set ans [concat $ans [ParseElemRecursiveEx $c $paropts {}]]
        } else {
            set ans [concat $ans [ParseElemRecursive $c $paropts {}]]
        }
    }
    return $ans
}

# svg2can::parseelement --
# 
#       External interface for parsing a single element.
# 
# Arguments:
#       xmllist     the elements xml list
#       args        configuration options
#          -httphandler
#               -imagehandler            
#               -imagehandlerex            
#       
# Results:
#       a list of canvas commands without the widgetPath

proc svg2can::parseelement {xmllist args} {
    variable confopts
    variable priv

    array set argsA [array get confopts]
    array set argsA $args
    set paropts [array get argsA]
    if {$priv(havetkpath)} {    
        return [ParseElemRecursiveEx $xmllist $paropts {}]
    } else {
        return [ParseElemRecursive $xmllist $paropts {}]
    }
}

# svg2can::ParseElemRecursive --
# 
#       Parses element for internal usage.
#       
# Arguments:
#       xmllist     the elements xml list
#       paropts     parse options
#       transformL
#       args        list of attributes from any enclosing element (g).
#       
# Results:
#       a list of canvas commands without the widgetPath

proc svg2can::ParseElemRecursive {xmllist paropts transformL args} {

    set cmdList [list]
    set tag [gettag $xmllist]
    
    # Handle any tranform attribute; may be recursive, so keep a list.
    set transformL [concat $transformL [ParseTransformAttr [getattr $xmllist]]]

    switch -- $tag {
        circle - ellipse - image - line - polyline - polygon - rect - path - text {
            set func [string totitle $tag]
            set cmdL [eval {Parse${func} $xmllist $paropts $transformL} $args]
            set cmdList [concat $cmdList $cmdL]
        }
        a - g {
            
            # Need to collect the attributes for the g element since
            # the child elements inherit them. g elements may be nested!
            # Must parse any style to the actual attribute names.
            array set attrA $args
            array set attrA [getattr $xmllist]
            unset -nocomplain attrA(id)
            if {[info exists attrA(style)]} {
                array set attrA [StyleAttrToList $attrA(style)]
            }
            foreach c [getchildren $xmllist] {
                set cmdList [concat $cmdList [eval {
                    ParseElemRecursive $c $paropts $transformL
                } [array get attrA]]]
            }            
        }
        foreignObject {
            array set parseArr $paropts
            if {[string length $parseArr(-foreignobjecthandler)]} {
                set elem [uplevel #0 $parseArr(-foreignobjecthandler) \
                  [list $xmllist $paropts $transformL] $args]
                if {$elem != ""} {
                    set cmdList [concat $cmdList $elem]
                }
            }
        }
        use - defs - marker - symbol {
            # todo
        }
    }
    return $cmdList
}

# svg2can::ParseElemRecursiveEx --
# 
#       Same for tkpath...
#       
# Arguments:
#       transAttr   this is a list of transform attributes

proc svg2can::ParseElemRecursiveEx {xmllist paropts transAttr args} {

    set cmdList [list]
    set tag [gettag $xmllist]
    
    switch -- $tag {
        circle - ellipse - image - line - polyline - polygon - rect - path - text {
            set func [string totitle $tag]
            set cmd [eval {Parse${func}Ex $xmllist $paropts $transAttr} $args]
            if {[llength $cmd]} {
                lappend cmdList $cmd
            }
        }
        a - g {
            
            # Need to collect the attributes for the g element since
            # the child elements inherit them. g elements may be nested!
            # Must parse any style to the actual attribute names.
            array set attrA $args
            array set attrA [getattr $xmllist]
            unset -nocomplain attrA(id)
            if {[info exists attrA(style)]} {
                array set attrA [StyleAttrToList $attrA(style)]
            }
            if {[info exists attrA(transform)]} {
                eval {lappend transAttr} [TransformAttrToList $attrA(transform)]
                unset attrA(transform)
            }
            foreach c [getchildren $xmllist] {
                set cmdList [concat $cmdList [eval {
                    ParseElemRecursiveEx $c $paropts $transAttr
                } [array get attrA]]]
            }            
        }
        linearGradient {
            CreateLinearGradient $xmllist
        }
        radialGradient {
            CreateRadialGradient $xmllist
        }
        foreignObject {
            array set parseArr $paropts
            if {[string length $parseArr(-foreignobjecthandler)]} {
                set elem [uplevel #0 $parseArr(-foreignobjecthandler) \
                  [list $xmllist $paropts $transformL] $args]
                if {$elem != ""} {
                    set cmdList [concat $cmdList $elem]
                }
            }
        }
        defs {
            eval {ParseDefs $xmllist $paropts $transAttr} $args
        }
        use - marker - symbol {
            # todo
        }
    }
    return $cmdList
}

proc svg2can::ParseDefs {xmllist paropts transAttr args} {
    
    # @@@ Only gradients so far.
    
    foreach c [getchildren $xmllist] {
        set tag [gettag $c]
    
        switch -- $tag {
            linearGradient {
                CreateLinearGradient $c
            }
            radialGradient {
                CreateRadialGradient $c
            }
        }
    }    
}

# svg2can::ParseCircle, ParseEllipse, ParseLine, ParseRect, ParsePath, 
#   ParsePolyline, ParsePolygon, ParseImage --
# 
#       Makes the necessary canvas commands needed to reproduce the
#       svg element.
#       
# Arguments:
#       xmllist
#       paropts     parse options
#       transformL
#       args        list of attributes from any enclosing element (g).
#       
# Results:
#       list of canvas create command without the widgetPath.

proc svg2can::ParseCircle {xmllist paropts transformL args} {
    variable tmptag
    
    set opts {}
    set presAttr {}
    set cx 0
    set cy 0
    set r 0
    array set attrA $args
    array set attrA [getattr $xmllist]
    
    # We need to have a temporary tag for doing transformations.
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }
    
    foreach {key value} [array get attrA] {        
        switch -- $key {
            cx - cy - r {
                set $key [parseLength $value]
            }
            id {
                set tags [concat $tags $value]
            }
            style {
                set opts [StyleToOpts oval [StyleAttrToList $value]]
            }
            default {
                # Valid itemoptions will be sorted out below.
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -tags $tags
    set coords [list [expr {$cx - $r}] [expr {$cy - $r}] \
      [expr {$cx + $r}] [expr {$cy + $r}]]        
    set opts [MergePresentationAttr oval $opts $presAttr]
    set cmdList [list [concat create oval $coords $opts]]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParseCircleEx {xmllist paropts transAttr args} {

    set opts {}
    set cx 0
    set cy 0
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]

    foreach {key value} [array get attrA] {        
        switch -- $key {
            cx - cy {
                set $key [parseLength $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr]]
    return [concat create circle $cx $cy $opts]
}

proc svg2can::ParseEllipse {xmllist paropts transformL args} {
    variable tmptag
    
    set opts {}
    set presAttr {}
    set cx 0
    set cy 0
    set rx 0
    set ry 0
    array set attrA $args
    array set attrA [getattr $xmllist]
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }
    
    foreach {key value} [array get attrA] {
        
        switch -- $key {
            cx - cy - rx - ry {
                set $key [parseLength $value]
            }
            id {
                set tags [concat $tags $value]
            }
            style {
                set opts [StyleToOpts oval [StyleAttrToList $value]]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -tags $tags
    set coords [list [expr $cx - $rx] [expr $cy - $ry] \
      [expr $cx + $rx] [expr $cy + $ry]]
    set opts [MergePresentationAttr oval $opts $presAttr]
    set cmdList [list [concat create oval $coords $opts]]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParseEllipseEx {xmllist paropts transAttr args} {

    set opts {}
    set cx 0
    set cy 0
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]

    foreach {key value} [array get attrA] {        
        switch -- $key {
            cx - cy {
                set $key [parseLength $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr]]
    return [concat create ellipse $cx $cy $opts]    
}

proc svg2can::ParseImage {xmllist paropts transformL args} {
    variable tmptag
    
    set x 0
    set y 0    
    set presAttr {}
    set photo {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    array set paroptsA $paropts
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }

    foreach {key value} [array get attrA] {        
        switch -- $key {
            x - y - height - width {
                # The canvas image item does not have width and height.
                # These are REQUIRED in SVG.
                set $key [parseLength $value]
            }
            id {
                set tags [concat $tags $value]
            }
            style {
                set opts [StyleToOpts image [StyleAttrToList $value]]
            }
            xlink:href {
                set xlinkhref $value
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -tags $tags -anchor nw
    set opts [MergePresentationAttr image $opts $presAttr]

    if {[string length $paroptsA(-imagehandlerex)]} {                    
        uplevel #0 $paroptsA(-imagehandlerex) [list $xmllist $opts]
        return
    }
    
    # Handle the xlink:href attribute.
    if {[info exists xlinkhref]} {
        
        switch -glob -- $xlinkhref {
            file:/* {                        
                set path [::uri::urn::unquote $xlinkhref]
                set path [string map {file:/// /} $path]
                if {[string length $paroptsA(-imagehandler)]} {                    
                    set cmd [concat create image $x $y $opts]
                    lappend cmd -file $path -height $height -width $width
                    set photo [uplevel #0 $paroptsA(-imagehandler) [list $cmd]]
                    lappend opts -image $photo
                } else {                        
                    if {[string tolower [file extension $path]] eq ".gif"} {
                        set photo [image create photo -file $path -format gif]
                        cache_add image $photo
                    } else {
                        set photo [image create photo -file $path]
                        cache_add image $photo
                    }
                    lappend opts -image $photo
                }
            }
            http:/* {
                if {[string length $paroptsA(-httphandler)]} {
                    set cmd [concat create image $x $y $opts]
                    lappend cmd -url $xlinkhref  -height $height -width $width
                    uplevel #0 $paroptsA(-httphandler) [list $cmd]
                }
                return
            }
            default {
                return
            }
        }        
    }
    set cmd [concat create image $x $y $opts]
    set cmdList [list $cmd]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParseImageEx {xmllist paropts transAttr args} {

    set x 0
    set y 0    
    set width  0
    set height 0
    set opts {}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    array set paroptsA $paropts

    foreach {key value} [array get attrA] {        
        switch -- $key {
            x - y {
                set $key [parseLength $value]
            }
            height - width {
                # A value of 0 disables rendering in SVG.
                # tkpath uses 0 for using natural sizes.
                if {$value == 0.0} {
                    return
                }
                set $key [parseLength $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            xlink:href {
                set xlinkhref $value
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -width $width -height $height
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    if {[string length $paroptsA(-imagehandlerex)]} {                    
        uplevel #0 $paroptsA(-imagehandlerex) [list $xmllist $opts]
        return
    }

    # Handle the xlink:href attribute.
    if {[info exists xlinkhref]} {

        switch -glob -- $xlinkhref {
            file:/* {                        
                set path [::uri::urn::unquote $xlinkhref]
                set path [string map {file:/// /} $path]
                if {[string length $paroptsA(-imagehandler)]} {                    
                    set cmd [concat create image $x $y $opts]
                    lappend cmd -file $path -height $height -width $width
                    set photo [uplevel #0 $paroptsA(-imagehandler) [list $cmd]]
                    lappend opts -image $photo
                } else {                        
                    if {[string tolower [file extension $path]] eq ".gif"} {
                        set photo [image create photo -file $path -format gif]
                        cache_add image $photo
                    } else {
                        set photo [image create photo -file $path]
                        cache_add image $photo
                    }
                    lappend opts -image $photo
                }
            }
            http:/* {
                if {[string length $paroptsA(-httphandler)]} {
                    set cmd [concat create image $x $y $opts]
                    lappend cmd -url $xlinkhref -height $height -width $width
                    uplevel #0 $paroptsA(-httphandler) [list $cmd]
                }
                return
            }
            default {
                return
            }
        }        
    }
    
    set opts [MergePresentationAttrEx $opts $presAttr]
    return [concat create pimage $x $y $opts]    
}

proc svg2can::ParseLine {xmllist paropts transformL args} {
    variable tmptag
    
    set opts {}
    set coords {0 0 0 0}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }
    
    foreach {key value} [array get attrA] {
        
        switch -- $key {
            id {
                set tags [concat $tags $value]
            }
            style {
                set opts [StyleToOpts line [StyleAttrToList $value]]
            }
            x1 {
                lset coords 0 [parseLength $value]
            }
            y1 {
                lset coords 1 [parseLength $value]
            }
            x2 {
                lset coords 2 [parseLength $value]
            }
            y2 {
                lset coords 3 [parseLength $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -tags $tags
    set opts [MergePresentationAttr line $opts $presAttr]  
    set cmdList [list [concat create line $coords $opts]]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParseLineEx {xmllist paropts transAttr args} {

    set x1 0
    set y1 0
    set x2 0
    set y2 0
    set opts {}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]

    foreach {key value} [array get attrA] {        
        switch -- $key {
            x1 - y1 - x2 - y2 {
                set $key [parseLength $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr] 1]
    return [concat create pline $x1 $y1 $x2 $y2 $opts]    
}

proc svg2can::ParsePath {xmllist paropts transformL args} {
    variable tmptag
    
    set cmdList {}
    set opts {}
    set presAttr {}
    set path {}
    set styleList {}
    set lineopts {}
    set polygonopts {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }
    
    foreach {key value} [array get attrA] {
        
        switch -- $key {
            d {
                set path $value
            }
            id {
                set tags [concat $tags $value]
            }
            style {
                # Need to parse separately for each canvas item since different
                # default values.
                set lineopts    [StyleToOpts line    [StyleAttrToList $value]]
                set polygonopts [StyleToOpts polygon [StyleAttrToList $value]]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }

    # The resulting canvas items are typically lines and polygons.
    # Since the style parsing is different keep separate copies.
    lappend lineopts    -tags $tags
    lappend polygonopts -tags $tags
    set lineopts    [MergePresentationAttr line    $lineopts    $presAttr]
    set polygonopts [MergePresentationAttr polygon $polygonopts $presAttr]
    
    # Parse the actual path data. 
    set co {}
    set cantype line
    set itemopts {}
    
    regsub -all -- {([a-zA-Z])([0-9])} $path {\1 \2} path
    regsub -all -- {([0-9])([a-zA-Z])} $path {\1 \2} path
    set path [string map {- " -"} $path]
    set path [string map {, " "} $path]
    
    set i 0
    set len  [llength $path]
    set len1 [expr $len - 1]
    set len2 [expr $len - 2]
    set len4 [expr $len - 4]
    set len6 [expr $len - 6]
    
    # 'i' is the index into the path list; points to the command (character).
    
    while {$i < $len} {
        set elem [lindex $path $i]
        set isabsolute 1
        if {[string is lower $elem]} {
            set isabsolute 0
        }
        
        switch -glob -- $elem {
            A - a {
                # Not part of Tiny SVG.
                incr i
                foreach {rx ry phi fa fs x y} [lrange $path $i [expr $i + 6]] break
                if {!$isabsolute} {
                    set x [expr $cpx + $x] 
                    set y [expr $cpy + $y]
                    
                }
                set arcpars \
                  [EllipticArcParameters $cpx $cpy $rx $ry $phi $fa $fs $x $y]
                
                # Handle special cases.
                switch -- $arcpars {
                    skip {
                        # Empty
                    }
                    lineto {
                        lappend co [lindex $path [expr $i + 5]] \
                          [lindex $path [expr $i + 6]]
                    }
                    default {
                        
                        # Need to end any previous path.
                        if {[llength $co] > 2} {
                            set opts [concat [set ${cantype}opts] $itemopts]
                            lappend cmdList [concat create $cantype $co $opts]
                        }

                        # Cannot handle rotations.
                        foreach {cx cy rx ry theta delta phi} $arcpars break
                        set box [list [expr $cx-$rx] [expr $cy-$ry] \
                          [expr $cx+$rx] [expr $cy+$ry]]
                        set itemopts [list -start $theta -extent $delta]
                        
                        # Try to interpret any subsequent data as a
                        # -style chord | pieslice.
                        # Z: chord; float float Z: pieslice.
                        set ia [expr $i + 7]
                        set ib [expr $i + 10]
                        
                        if {[regexp -nocase {z} [lrange $path $ia $ia]]} {
                            lappend itemopts -style chord
                            incr i 1
                        } elseif {[regexp -nocase {l +([-0-9\.]+) +([-0-9\.]+) +z} \
                          [lrange $path $ia $ib] m mx my] &&  \
                          [expr hypot($mx-$cx, $my-$cy)] < 4.0} {
                            lappend itemopts -style pieslice
                            incr i 4
                        } else {
                            lappend itemopts -style arc
                        }
                        set opts [concat $polygonopts $itemopts]
                        lappend cmdList [concat create arc $box $opts]
                        set co {}
                        set itemopts {}
                    }
                }
                incr i 6
            }
            C - c {
                # We could have a sequence of pairs of points here...
                # Approximate by quadratic bezier.
                # There are three options here: 
                # C (p1 p2 p3) (p4 p5 p6)...           finalize item
                # C (p1 p2 p3) S (p4 p5)...            let S trigger below
                # C p1 p2 p3 anything else             finalize here
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len6)} {
                    set co [list $cpx $cpy] 
                    if {$isabsolute} {
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        set cpx [lindex $co end-1]
                        set cpy [lindex $co end]
                    } else {
                        PathAddRelative $path co i cpx cpy
                        PathAddRelative $path co i cpx cpy
                        PathAddRelative $path co i cpx cpy
                    }
                    
                    # Do not finalize item if S instruction.
                    if {![string equal -nocase [lindex $path [expr $i+1]] "S"]} {
                        lappend itemopts -smooth 1
                        set opts [concat $lineopts $itemopts]
                        lappend cmdList [concat create line $co $opts]
                        set co {}
                        set itemopts {}
                    }
                }
                incr i
            }
            H {
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len1)} {
                    lappend co [lindex $path [incr i]] $cpy
                }
                incr i
            }
            h {
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len1)} {
                    lappend co [expr $cpx + [lindex $path [incr i]]] $cpy
                }
                incr i
            }
            L - {[0-9]+} - {-[0-9]+} {
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len2)} {
                    lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                }
                incr i
            }
            l {
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len2)} {
                    lappend co [expr $cpx + [lindex $path [incr i]]] \
                      [expr $cpy + [lindex $path [incr i]]]
                }
                incr i
            }
            M - m {
                # Make a fresh canvas item and finalize any previous command.
                if {[llength $co]} {
                    set opts [concat [set ${cantype}opts] $itemopts]
                    lappend cmdList [concat create $cantype $co $opts]
                }
                if {!$isabsolute && [info exists cpx]} {
                    set co [list  \
                      [expr $cpx + [lindex $path [incr i]]]
                      [expr $cpy + [lindex $path [incr i]]]]
                } else {
                    set co [list [lindex $path [incr i]] [lindex $path [incr i]]]
                }
                set itemopts {}
                incr i
            }
            Q - q {
                # There are three options here: 
                # Q p1 p2 p3 p4...           finalize item
                # Q p1 p2 T p3...            let T trigger below
                # Q p1 p2 anything else      finalize here
                
                # We may have a sequence of pairs of points following the Q.
                # Make a fresh item for each.
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len4)} {
                    set co [list $cpx $cpy] 
                    if {$isabsolute} {
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        set cpx [lindex $co end-1]
                        set cpy [lindex $co end]
                    } else {
                        PathAddRelative $path co i cpx cpy
                        PathAddRelative $path co i cpx cpy
                    }
                    
                    # Do not finalize item if T instruction.
                    if {![string equal -nocase [lindex $path [expr $i+1]] "T"]} {
                        lappend itemopts -smooth 1
                        set opts [concat $lineopts $itemopts]
                        lappend cmdList [concat create line $co $opts]
                        set co {}
                        set itemopts {}
                    }
                }
                incr i
            }
            S - s {
                # Must annihilate last point added and use its mirror instead.
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len4)} {
                    
                    # Control point from mirroring.
                    set ctrlpx [expr 2 * $cpx - [lindex $co end-3]]
                    set ctrlpy [expr 2 * $cpy - [lindex $co end-2]]
                    lset co end-1 $ctrlpx
                    lset co end $ctrlpy
                    if {$isabsolute} {
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        set cpx [lindex $co end-1]
                        set cpy [lindex $co end]
                    } else {
                        PathAddRelative $path co i cpx cpy
                        PathAddRelative $path co i cpx cpy
                    }
                }
                
                # Finalize item.
                lappend itemopts -smooth 1
                set dx [expr [lindex $co 0] - [lindex $co end-1]]
                set dy [expr [lindex $co 1] - [lindex $co end]]
                
                # Check endpoints to see if closed polygon.
                # Remove first AND end points if closed!
                if {[expr hypot($dx, $dy)] < 0.5} {
                    set opts [concat $polygonopts $itemopts]
                    set co [lrange $co 2 end-2]
                    lappend cmdList [concat create polygon $co $opts]
                } else {
                    set opts [concat $lineopts $itemopts]
                    lappend cmdList [concat create line $co $opts]
                }
                set co {}
                set itemopts {}
                incr i
            }
            T - t {
                # Must annihilate last point added and use its mirror instead.
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len2)} {
                    
                    # Control point from mirroring.
                    set ctrlpx [expr 2 * $cpx - [lindex $co end-3]]
                    set ctrlpy [expr 2 * $cpy - [lindex $co end-2]]
                    lset co end-1 $ctrlpx
                    lset co end $ctrlpy
                    if {$isabsolute} {
                        lappend co [lindex $path [incr i]] [lindex $path [incr i]]
                        set cpx [lindex $co end-1]
                        set cpy [lindex $co end]
                    } else {
                        PathAddRelative $path co i cpx cpy
                    }
                }                
                
                # Finalize item.
                lappend itemopts -smooth 1
                set dx [expr [lindex $co 0] - [lindex $co end-1]]
                set dy [expr [lindex $co 1] - [lindex $co end]]
                
                # Check endpoints to see if closed polygon.
                # Remove first AND end points if closed!
                if {[expr hypot($dx, $dy)] < 0.5} {
                    set opts [concat $polygonopts $itemopts]
                    set co [lrange $co 2 end-2]
                    lappend cmdList [concat create polygon $co $opts]
                } else {
                    set opts [concat $lineopts $itemopts]
                    lappend cmdList [concat create line $co $opts]                    
                }
                set co {}
                set itemopts {}
                incr i
            }
            V {
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len1)} {
                    lappend co $cpx [lindex $path [incr i]]
                }
                incr i
            }
            v {
                while {![regexp {[a-zA-Z]} [lindex $path [expr $i+1]]] && \
                  ($i < $len1)} {
                    lappend co $cpx [expr $cpy + [lindex $path [incr i]]]
                }
                incr i
            }
            Z - z {
                if {[llength $co]} {
                    set opts [concat $polygonopts $itemopts]
                    lappend cmdList [concat create polygon $co $opts]
                }
                set cantype line
                set itemopts {}
                incr i
                set co {}
            }
            default {
                # ?
                incr i
            }
        }   ;# End switch.
        
        # Keep track of the pens current point.
        if {[llength $co]} {
            set cpx [lindex $co end-1]
            set cpy [lindex $co end]
        }
    }   ;# End while loop.
    
    # Finalize the last element if any.
    if {[llength $co]} {
        set opts [concat [set ${cantype}opts] $itemopts]
        lappend cmdList [concat create $cantype $co $opts]
    }
    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParsePathEx {xmllist paropts transAttr args} {
    
    set opts {}
    set presAttr {}
    set path {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    
    foreach {key value} [array get attrA] {
        switch -- $key {
            d { 
                set path [parsePathAttr $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value 
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr]]
    return [concat create path [list $path] $opts]
}

# Handle different defaults for fill and stroke.

proc svg2can::StrokeFillDefaults {opts {noFill 0}} {

    array set optsA $opts
    if {!$noFill && ![info exists optsA(-fill)]} {
        set optsA(-fill) black
    }
    if {[info exists optsA(-fillgradient)]} {
        unset -nocomplain optsA(-fill)
    }
    if {![info exists optsA(-stroke)]} {
        set optsA(-stroke) {}
    }
    return [array get optsA]
}

proc svg2can::ParsePolyline {xmllist paropts transformL args} {
    variable tmptag
    
    set coords {}
    set opts {}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }

    foreach {key value} [array get attrA] {
        
        switch -- $key {
            points {
                set coords [PointsToList $value]
            }
            id {
                set tags [concat $tags $value]
            }
            style {
                set opts [StyleToOpts line [StyleAttrToList $value]]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -tags $tags
    set opts [MergePresentationAttr line $opts $presAttr]
    set cmdList [list [concat create line $coords $opts]]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParsePolylineEx {xmllist paropts transAttr args} {

    set opts {}
    set points {0 0}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]

    foreach {key value} [array get attrA] {        
        switch -- $key {
            points {
                set points [PointsToList $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr]]
    return [concat create polyline $points $opts]    
}

proc svg2can::ParsePolygon {xmllist paropts transformL args} {
    variable tmptag
    
    set coords {}
    set opts {}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }

    foreach {key value} [array get attrA] {
        
        switch -- $key {
            points {
                set coords [PointsToList $value]
            }
            id {
                set tags [concat $tags $value]
            }
            style {
                set opts [StyleToOpts polygon [StyleAttrToList $value]]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    lappend opts -tags $tags
    set opts [MergePresentationAttr polygon $opts $presAttr]
    set cmdList [list [concat create polygon $coords $opts]]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParsePolygonEx {xmllist paropts transAttr args} {

    set opts {}
    set points {0 0}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]

    foreach {key value} [array get attrA] {        
        switch -- $key {
            points {
                set points [PointsToList $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr]]
    return [concat create ppolygon $points $opts]    
}

proc svg2can::ParseRect {xmllist paropts transformL args} {
    variable tmptag
    
    set opts {}
    set coords {0 0 0 0}
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    set tags {}
    if {[llength $transformL]} {
        lappend tags $tmptag
    }
    
    foreach {key value} [array get attrA] {
        
        switch -- $key {
            id {
                set tags [concat $tags $value]
            }
            rx - ry {
                # unsupported :-(
            }
            style {
                set opts [StyleToOpts rectangle [StyleAttrToList $value]]
            }
            x - y - width - height {
                set $key [parseLength $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[info exists x]} {
        lset coords 0 $x
    }
    if {[info exists y]} {
        lset coords 1 $y
    }
    if {[info exists width]} {
        lset coords 2 [expr [lindex $coords 0] + $width]
    }
    if {[info exists height]} {
        lset coords 3 [expr [lindex $coords 1] + $height]
    }
    lappend opts -tags $tags
    set opts [MergePresentationAttr rectangle $opts $presAttr]
    set cmdList [list [concat create rectangle $coords $opts]]

    return [AddAnyTransformCmds $cmdList $transformL]
}

proc svg2can::ParseRectEx {xmllist paropts transAttr args} {

    set opts {}
    set x 0
    set y 0
    set width  0
    set height 0
    set presAttr {}
    array set attrA $args
    array set attrA [getattr $xmllist]
    
    foreach {key value} [array get attrA] {        
        switch -- $key {
            x - y - width - height {
                set $key [parseLength $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                eval {lappend opts} [StyleToOptsEx [StyleAttrToList $value]]
            }
            transform {
                eval {lappend transAttr} [TransformAttrToList $value]
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    if {[llength $transAttr]} {
        lappend opts -matrix [TransformAttrListToMatrix $transAttr]
    }
    set x2 [expr {$x + $width}]
    set y2 [expr {$y + $height}]
    set opts [StrokeFillDefaults [MergePresentationAttrEx $opts $presAttr]]
    return [concat create prect $x $y $x2 $y2 $opts]    
}

# svg2can::ParseText --
# 
#       Takes a text element and returns a list of canvas create text commands.
#       Assuming that chdata is not mixed with elements, we should now have
#       either chdata OR more elements (tspan).

proc svg2can::ParseText {xmllist paropts transformL args} {
    set x 0
    set y 0
    set xAttr 0
    set yAttr 0
    set cmdList [ParseTspan $xmllist $transformL x y xAttr yAttr {}]
    return $cmdList
}

proc svg2can::ParseTextEx {xmllist paropts transAttr args} {
    return [eval {ParseText $xmllist $paropts {}} $args]
}

# svg2can::ParseTspan --
# 
#       Takes a tspan or text element and returns a list of canvas
#       create text commands.

proc svg2can::ParseTspan {xmllist transformL xVar yVar xAttrVar yAttrVar opts} { 
    variable tmptag
    variable systemFont
    upvar $xVar x
    upvar $yVar y
    upvar $xAttrVar xAttr
    upvar $yAttrVar yAttr

    # Nested tspan elements do not inherit x, y, dx, or dy attributes set.
    # Sibling tspan elements do inherit x, y attributes.
    # Keep two separate sets of x and y; (x,y) and (xAttr,yAttr):
    # (x,y) 
    
    # Inherit opts.
    array set optsA $opts
    array set optsA [ParseTextAttr $xmllist xAttr yAttr baselineShift]

    set tag [gettag $xmllist]
    set childList [getchildren $xmllist]
    set cmdList {}
    if {[string equal $tag "text"]} {
        set x $xAttr
        set y $yAttr
    }
    
    if {[llength $childList]} {
        
        # Nested tspan elements do not inherit x, y set via attributes.
        if {[string equal $tag "tspan"]} {
            set xAttr $x
            set yAttr $y
        }
        set opts [array get optsA]
        foreach c $childList {
            
            switch -- [gettag $c] {
                tspan {
                    set cmdList [concat $cmdList \
                      [ParseTspan $c $transformL x y xAttr yAttr $opts]]
                }
                default {
                    # empty
                }
            }
        }
    } else {
        set str [getcdata $xmllist]
        set optsA(-text) $str
        if {[llength $transformL]} {
            lappend optsA(-tags) $tmptag
        }
        set opts [array get optsA]
        set theFont $systemFont
        if {[info exists optsA(-font)]} {
            set theFont $optsA(-font)
        }
        
        # Need to adjust the text position so that the baseline matches y.
        # nw to baseline
        set ascent [font metrics $theFont -ascent]
        set cmdList [list [concat create text  \
          $xAttr [expr $yAttr - $ascent + $baselineShift] $opts]]        
        set cmdList [AddAnyTransformCmds $cmdList $transformL]
        
        # Each text insert moves both the running coordinate sets.
        # newlines???
        set deltax [font measure $theFont $str]
        set x     [expr $x + $deltax]
        set xAttr [expr $xAttr + $deltax]
    }
    return $cmdList
}

# svg2can::ParseTextAttr --
# 
#       Parses the attributes in xmllist and returns the translated canvas
#       option list.

proc svg2can::ParseTextAttr {xmllist xVar yVar baselineShiftVar} {    
    variable systemFont
    upvar $xVar x
    upvar $yVar y
    upvar $baselineShiftVar baselineShift

    # svg defaults to start with y being the baseline while tk default is c.
    #set opts {-anchor sw}
    # Anchor nw is simplest when newlines.
    set opts {-anchor nw}
    set presAttr {}
    set baselineShift 0
    
    foreach {key value} [getattr $xmllist] {
        
        switch -- $key {
            baseline-shift {
                set baselineShiftSet $value
            }
            dx {
                set x [expr $x + $value]
            }
            dy {
                set y [expr $y + $value]
            }
            id {
                lappend opts -tags $value
            }
            style {
                set opts [concat $opts \
                  [StyleToOpts text [StyleAttrToList $value]]]
            }
            x - y {
                set $key $value
            }
            default {
                lappend presAttr $key $value
            }
        }
    }
    array set optsA $opts
    set theFont $systemFont
    if {[info exists optsA(-font)]} {
        set theFont $optsA(-font)
    }
    if {[info exists baselineShiftSet]} {
        set baselineShift [BaselineShiftToDy $baselineShiftSet $theFont]
    }
    return [MergePresentationAttr text $opts $presAttr]
}

# svg2can::AttrToCoords --
# 
#       Returns coords from SVG attributes.
#       
# Arguments:
#       type        SVG type
#       attr        list of geometry attributes
#       
# Results:
#       list of coordinates

proc svg2can::AttrToCoords {type attrlist} {
    
    # Defaults.
    array set attr {
        cx      0
        cy      0
        height  0
        r       0
        rx      0
        ry      0
        width   0
        x       0
        x1      0
        x2      0
        y       0
        y1      0
        y2      0
    }
    array set attr $attrlist
    
    switch -- $type {
        circle {
            set coords [list  \
              [expr $attr(cx) - $attr(r)] [expr $attr(cy) - $attr(r)] \
              [expr $attr(cx) + $attr(r)] [expr $attr(cy) + $attr(r)]]        
        }
        ellipse {
            set coords [list  \
              [expr $attr(cx) - $attr(rx)] [expr $attr(cy) - $attr(ry)] \
              [expr $attr(cx) + $attr(rx)] [expr $attr(cy) + $attr(ry)]]
        }
        image {
            set coords [list $attr(x) $attr(y)]
        }
        line {
            set coords [list $attr(x1) $attr(y1) $attr(x2) $attr(y2)]
        }
        path {
            # empty
        }
        polygon {
            set coords [PointsToList $attr(points)] 
        }
        polyline {
            set coords [PointsToList $attr(points)] 
        }
        rect {
            set coords [list $attr(x) $attr(y) \
              [expr $attr(x) + $attr(width)] [expr $attr(y) + $attr(height)]]
        }
        text {
            set coords [list $attr(x) $attr(y)]
        }
    }
    return $coords
}

# @@@ There is a lot TODO here!

proc svg2can::CreateLinearGradient {xmllist} {
    variable gradientIDToToken
    
    set x1 0
    set y1 0
    set x2 1
    set y2 0
    set method pad
    set units bbox
    set stops {}

    # We first need to find out if any xlink:href attribute since:
    # Any 'linearGradient' attributes which are defined on the
    # referenced element which are not defined on this element are 
    # inherited by this element.
    set attr [getattr $xmllist]
    set idx [lsearch -exact $attr xlink:href]
    if {$idx >= 0 && [expr {$idx % 2 == 0}]} {
        set value [lindex $attr [incr idx]]
        if {![string match {\#*} $value]} {
            return -code error "unrecognized gradient uri \"$value\""
        }
        set uri [string range $value 1 end]
        if {![info exists gradientIDToToken($uri)]} {
            return -code error "unrecognized gradient uri \"$value\""
        }
        set hreftoken $gradientIDToToken($uri)
        set units  [::tkpath::gradient cget $hreftoken -units]
        set method [::tkpath::gradient cget $hreftoken -method]
        set hrefstops [::tkpath::gradient cget $hreftoken -stops]
        foreach {x1 y1 x2 y2} \
          [::tkpath::gradient cget $hreftoken -lineartransition] { break }        
    }    
    
    foreach {key value} $attr {        
        switch -- $key {
            x1 - y1 - x2 - y2 {
                set $key [parseUnaryOrPercentage $value]
            }
            id {
                set id $value
            }
            gradientUnits {
                set units [string map \
                  {objectBoundingBox bbox userSpaceOnUse userspace} $value]
            }
            spreadMethod {
                set method $value
            }
        }
    }
    if {![info exists id]} {
        return
    }
    
    # If this element has no defined gradient stops, and the referenced element 
    # does, then this element inherits the gradient stop from the referenced 
    # element.
    set stops [ParseGradientStops $xmllist]    
    if {$stops eq {}} {
        if {[info exists hrefstops]} {
            set stops $hrefstops
        }
    }
    set token [::tkpath::gradient create linear -method $method -units $units \
      -lineartransition [list $x1 $y1 $x2 $y2] -stops $stops]
    set gradientIDToToken($id) $token
    cache_add gradient $token
}

proc svg2can::CreateRadialGradient {xmllist} {
    variable gradientIDToToken

    set cx 0.5
    set cy 0.5
    set r  0.5
    set fx 0.5
    set fy 0.5
    set method pad
    set units bbox
    set stops {}
    
    # We first need to find out if any xlink:href attribute since:
    # Any 'linearGradient' attributes which are defined on the
    # referenced element which are not defined on this element are 
    # inherited by this element.
    set attr [getattr $xmllist]
    set idx [lsearch -exact $attr xlink:href]
    if {$idx >= 0 && [expr {$idx % 2 == 0}]} {
        set value [lindex $attr [incr idx]]
        if {![string match {\#*} $value]} {
            return -code error "unrecognized gradient uri \"$value\""
        }
        set uri [string range $value 1 end]
        if {![info exists gradientIDToToken($uri)]} {
            return -code error "unrecognized gradient uri \"$value\""
        }
        set hreftoken $gradientIDToToken($uri)
        set units  [::tkpath::gradient cget $hreftoken -units]
        set method [::tkpath::gradient cget $hreftoken -method]
        set hrefstops [::tkpath::gradient cget $hreftoken -stops]
        set transL [::tkpath::gradient cget $hreftoken -radialtransition]
        set cx [lindex $transL 0]
        set cy [lindex $transL 1]
        if {[llength $transL] > 2} {
            set r [lindex $transL 2]
            if {[llength $transL] == 5} {
                set fx [lindex $transL 3]
                set fy [lindex $transL 4]
            }
        }
    }    

    foreach {key value} [getattr $xmllist] {        
        switch -- $key {
            cx - cy - r - fx - fy {
                set $key [parseUnaryOrPercentage $value]
            }
            id {
                set id $value
            }
            gradientUnits {
                set units [string map \
                  {objectBoundingBox bbox userSpaceOnUse userspace} $value]
            }
            spreadMethod {
                set method $value
            }
        }
    }
    if {![info exists id]} {
        return
    }
    # If this element has no defined gradient stops, and the referenced element 
    # does, then this element inherits the gradient stop from the referenced 
    # element.
    set stops [ParseGradientStops $xmllist]    
    if {$stops eq {}} {
        if {[info exists hrefstops]} {
            set stops $hrefstops
        }
    }
    set token [::tkpath::gradient create radial -method $method -units $units \
      -radialtransition [list $cx $cy $r $fx $fy] -stops $stops]
    set gradientIDToToken($id) $token
    cache_add gradient $token
}

proc svg2can::ParseGradientStops {xmllist} {
    
    set stops {}
    
    foreach stopE [getchildren $xmllist] {
        if {[gettag $stopE] eq "stop"} {
            set opts {}
            set offset 0
            set color black
            set opacity 1
            
            foreach {key value} [getattr $stopE] {
                switch -- $key {
                    offset {
                        set offset [parseUnaryOrPercentage $value]
                    }
                    stop-color {
                        set color [parseColor $value]
                    }
                    stop-opacity {
                        set opacity $value
                    }
                    style {
                        set opts [StopsStyleToStopSpec [StyleAttrToList $value]]
                    }
                }
            }

            # Style takes precedence.
            array set stopA [list color $color opacity $opacity]
            array set stopA $opts
            lappend stops [list $offset $stopA(color) $stopA(opacity)]
        }
    }
    return $stops
}

proc svg2can::parseUnaryOrPercentage {offset} {
    if {[string is double -strict $offset]} {
        return $offset
    } elseif {[regexp {(.+)%} $offset - percent]} {
        return [expr {$percent/100.0}]
    }
}

# svg2can::parseColor --
# 
#       Takes a SVG color definition and turns it into a Tk color.
#       
# Arguments:
#       color       SVG color
#       
# Results:
#       tk color

proc svg2can::parseColor {color} {
    
    if {[regexp {rgb\(([0-9]{1,3})%, *([0-9]{1,3})%, *([0-9]{1,3})%\)}  \
      $color - r g b]} {
        set col "#"
        foreach c [list $r $g $b] {
            append col [format %02x [expr round(2.55 * $c)]]
        }
    } elseif {[regexp {rgb\(([0-9]{1,3}), *([0-9]{1,3}), *([0-9]{1,3})\)}  \
      $color - r g b]} {
        set col "#"
        foreach c [list $r $g $b] {
            append col [format %02x $c]
        }
    } else {
        set col [MapNoneToEmpty $color]
    }
    return $col
}

proc svg2can::parseFillToList {value} {
    variable gradientIDToToken

    if {[regexp {url\(#(.+)\)} $value - id]} {
        #puts "\t id=$id"
        if {[info exists gradientIDToToken($id)]} {
            #puts "\t gradientIDToToken=$gradientIDToToken($id)"
            return [list -fill $gradientIDToToken($id)]
        } else {
            puts "--------> missing gradientIDToToken id=$id"
            return [list -fill black]
        }
    } else {
        return [list -fill [parseColor $value]]
    }
}

proc svg2can::parseLength {length} {    
    if {[string is double -strict $length]} {
        return $length
    }    
    # SVG is using: px, pt, mm, cm, em, ex, in, %.
    # @@@ Incomplete!
    set length [string map {px ""  pt p  mm m  cm c  in i} $length]
    return [winfo fpixels . $length]
}

proc svg2can::parsePathAttr {path} {
    regsub -all -- {([a-zA-Z])([0-9])} $path {\1 \2} path
    regsub -all -- {([0-9])([a-zA-Z])} $path {\1 \2} path
    regsub -all -- {([a-zA-Z])([a-zA-Z])} $path {\1 \2} path
    return [string map {- " -"  , " "} $path]
}

# svg2can::StyleToOpts --
# 
#       Takes the style attribute as a list and parses it into
#       resonable canvas drawing options.
#       Discards all attributes that don't map to an item option.
#       
# Arguments:
#       type        tk canvas item type
#       styleList
#       
# Results:
#       list of canvas options

proc svg2can::StyleToOpts {type styleList args} {
    
    variable textAnchorMap
    
    array set argsA {
        -setdefaults 1 
        -origfont    {Helvetica 12}
    }
    array set argsA $args

    # SVG and canvas have different defaults.
    if {$argsA(-setdefaults)} {
        switch -- $type {
            oval - polygon - rectangle {
                array set optsA {-fill black -outline ""}
            }
            line {
                array set optsA {-fill black}
            }
        }
    }
    
    set fontSpec $argsA(-origfont)
    set haveFont 0
    
    foreach {key value} $styleList {
        
        switch -- $key {
            fill {
                switch -- $type {
                    arc - oval - polygon - rectangle - text {
                        set optsA(-fill) [parseColor $value]
                    }
                }
            }
            font-family {
                lset fontSpec 0 $value
                set haveFont 1
            }
            font-size {
                
                # Use pixels instead of points.
                if {[regexp {([0-9\.]+)pt} $value match pts]} {
                    set pix [expr int($pts * [tk scaling] + 0.01)]
                    lset fontSpec 1 "-$pix"
                } elseif {[regexp {([0-9\.]+)px} $value match pix]} {
                    lset fontSpec 1 [expr int(-$pix)]
                } else {
                    lset fontSpec 1 [expr int(-$value)]
                }
                set haveFont 1
            }
            font-style {
                switch -- $value {
                    italic {
                        lappend fontSpec italic
                    }
                }
                set haveFont 1
            }
            font-weight {
                switch -- $value {
                    bold {
                        lappend fontSpec bold
                    }
                }
                set haveFont 1
            }
            marker-end {
                set optsA(-arrow) last
            }
            marker-start {
                set optsA(-arrow) first                
            }
            stroke {
                switch -- $type {
                    arc - oval - polygon - rectangle {
                        set optsA(-outline) [parseColor $value]
                    }
                    line {
                        set optsA(-fill) [parseColor $value]
                    }
                }
            }
            stroke-dasharray {
                set dash [split $value ,]
                if {[expr [llength $dash]%2 == 1]} {
                    set dash [concat $dash $dash]
                }
            }
            stroke-linecap {        
                # canvas: butt (D), projecting , round 
                # svg:    butt (D), square, round
                if {[string equal $value "square"]} {
                    set optsA(-capstyle) "projecting"
                }
                if {![string equal $value "butt"]} {
                    set optsA(-capstyle) $value
                }
            }
            stroke-linejoin {
                set optsA(-joinstyle) $value
            }
            stroke-miterlimit {
                # empty
            }
            stroke-opacity {
                if {[expr {$value == 0}]} {
                    
                }
            }
            stroke-width {
                if {![string equal $type "text"]} {
                    set optsA(-width) $value
                }
            }
            text-anchor {
                set optsA(-anchor) $textAnchorMap($value)
            }
            text-decoration {
                switch -- $value {
                    line-through {
                        lappend fontSpec overstrike
                    }
                    underline {
                        lappend fontSpec underline
                    }
                }
                set haveFont 1
            }
        }
    }
    if {$haveFont} {
        set optsA(-font) $fontSpec
    }
    return [array get optsA]
}

proc svg2can::StyleToOptsEx {styleList args} {
    
    foreach {key value} $styleList {    
        switch -- $key {
            fill {
                foreach {name val} [parseFillToList $value] { break }
                set optsA($name) $val
            } 
            opacity {
                # @@@ This is much more complicated than this for groups!
                set optsA(-fillopacity) $value
                set optsA(-strokeopacity) $value
            }
            stroke {
                set optsA(-$key) [parseColor $value]                
            }
            stroke-dasharray {
                if {$value eq "none"} {
                    set optsA(-strokedasharray) {}
                } else {
                    set dash [split $value ,]
                    set optsA(-strokedasharray) $dash
                }
            }
            fill-opacity - stroke-linejoin - stroke-miterlimit - stroke-opacity {                
                set name [string map {"-" ""} $key]
                set optsA(-$name) $value
            }
            stroke-linecap {
                # svg:    butt (D), square, round
                # canvas: butt (D), projecting , round 
                if {$value eq "square"} {
                    set value "projecting"
                }
                set name [string map {"-" ""} $key]
                set optsA(-$name) $value
            }
            stroke-width {                
                set name [string map {"-" ""} $key]
                set optsA(-$name) [parseLength $value]
            }
            r - rx - ry - width - height {
                set optsA(-$key) [parseLength $value]
            }
        }
    }
    return [array get optsA]
}

# svg2can::StopsStyleToStopSpec --
# 
#       Takes the stop style attribute as a list and parses it into
#       a flat array for the gradient stopSpec: {offset color ?opacity?}

proc svg2can::StopsStyleToStopSpec {styleList} {
    
    foreach {key value} $styleList {    
        switch -- $key {
            stop-color {
                set optsA(color) [parseColor $value]                
            }
            stop-opacity {
                set optsA(opacity) $value
            }
        }
    }
    return [array get optsA]
}

# svg2can::EllipticArcParameters --
# 
#       Conversion from endpoint to center parameterization.
#       From: http://www.w3.org/TR/2003/REC-SVG11-20030114

proc svg2can::EllipticArcParameters {x1 y1 rx ry phi fa fs x2 y2} {
    variable pi

    # NOTE: direction of angles are opposite for Tk and SVG!
    
    # F.6.2 Out-of-range parameters 
    if {($x1 == $x2) && ($y1 == $y2)} {
        return skip
    }
    if {[expr $rx == 0] || [expr $ry == 0]} {
        return lineto
    }
    set rx [expr abs($rx)]
    set ry [expr abs($ry)]
    set phi [expr fmod($phi, 360) * $pi/180.0]
    if {$fa != 0} {
        set fa 1
    }
    if {$fs != 0} {
        set fs 1
    }
    
    # F.6.5 Conversion from endpoint to center parameterization 
    set dx [expr ($x1-$x2)/2.0]
    set dy [expr ($y1-$y2)/2.0]
    set x1prime [expr cos($phi) * $dx + sin($phi) * $dy]
    set y1prime [expr -sin($phi) * $dx + cos($phi) * $dy]
    
    # F.6.6 Correction of out-of-range radii
    set rx [expr abs($rx)]
    set ry [expr abs($ry)]
    set x1prime2 [expr $x1prime * $x1prime]
    set y1prime2 [expr $y1prime * $y1prime]
    set rx2 [expr $rx * $rx]
    set ry2 [expr $ry * $ry]
    set lambda [expr $x1prime2/$rx2 + $y1prime2/$ry2]
    if {$lambda > 1.0} {
        set rx [expr sqrt($lambda) * $rx]
        set ry [expr sqrt($lambda) * $ry]
        set rx2 [expr $rx * $rx]
        set ry2 [expr $ry * $ry]
    }    
    
    # Compute cx' and cy'
    set sign [expr {$fa == $fs} ? -1 : 1]
    set square [expr ($rx2 * $ry2 - $rx2 * $y1prime2 - $ry2 * $x1prime2) /  \
      ($rx2 * $y1prime2 + $ry2 * $x1prime2)]
    set root [expr sqrt(abs($square))]
    set cxprime [expr  $sign * $root * $rx * $y1prime/$ry]
    set cyprime [expr -$sign * $root * $ry * $x1prime/$rx]
    
    # Compute cx and cy from cx' and cy'
    set cx [expr $cxprime * cos($phi) - $cyprime * sin($phi) + ($x1 + $x2)/2.0]
    set cy [expr $cxprime * sin($phi) + $cyprime * cos($phi) + ($y1 + $y2)/2.0]

    # Compute start angle and extent
    set ux [expr ($x1prime - $cxprime)/double($rx)]
    set uy [expr ($y1prime - $cyprime)/double($ry)]
    set vx [expr (-$x1prime - $cxprime)/double($rx)]
    set vy [expr (-$y1prime - $cyprime)/double($ry)]

    set sign [expr {$uy > 0} ? 1 : -1]
    set theta [expr $sign * acos( $ux/hypot($ux, $uy) )]

    set sign [expr {$ux * $vy - $uy * $vx > 0} ? 1 : -1]
    set delta [expr $sign * acos( ($ux * $vx + $uy * $vy) /  \
      (hypot($ux, $uy) * hypot($vx, $vy)) )]
    
    # To degrees
    set theta [expr $theta * 180.0/$pi]
    set delta [expr $delta * 180.0/$pi]
    #set delta [expr fmod($delta, 360)]
    set phi   [expr fmod($phi, 360)]
    
    if {($fs == 0) && ($delta > 0)} {
        set delta [expr $delta - 360]
    } elseif {($fs ==1) && ($delta < 0)} {
        set delta [expr $delta + 360]
    }

    # NOTE: direction of angles are opposite for Tk and SVG!
    set theta [expr -1*$theta]
    set delta [expr -1*$delta]
    
    return [list $cx $cy $rx $ry $theta $delta $phi]
}

# svg2can::MergePresentationAttr --
# 
#       Let the style attribute override the presentation attributes.

proc svg2can::MergePresentationAttr {type opts presAttr} {
    
    if {[llength $presAttr]} {
        array set optsA [StyleToOpts $type $presAttr]
        array set optsA $opts
        set opts [array get optsA]
    }
    return $opts
}

proc svg2can::MergePresentationAttrEx {opts presAttr} {
    
    if {[llength $presAttr]} {
        array set optsA [StyleToOptsEx $presAttr]
        array set optsA $opts
        set opts [array get optsA]
    }
    return $opts
}

proc svg2can::StyleAttrToList {style} {    
    return [split [string trim [string map {" " ""} $style] \;] :\;]
}

proc svg2can::BaselineShiftToDy {baselineshift fontSpec} {
    
    set linespace [font metrics $fontSpec -linespace]
    
    switch -regexp -- $baselineshift {
        sub {
            set dy [expr 0.8 * $linespace]
        }
        super {
            set dy [expr -0.8 * $linespace]
        }
        {-?[0-9]+%} {
            set dy [expr 0.01 * $linespace * [string trimright $baselineshift %]]
        }
        default {
            # 0.5em ?
            set dy $baselineshift
        }
    }
    return $dy
}

# svg2can::PathAddRelative --
# 
#       Utility function to add a relative point from the path to the 
#       coordinate list. Updates iVar, and the current point.

proc svg2can::PathAddRelative {path coVar iVar cpxVar cpyVar} {
    upvar $coVar  co
    upvar $iVar   i
    upvar $cpxVar cpx
    upvar $cpyVar cpy

    set newx [expr $cpx + [lindex $path [incr i]]]
    set newy [expr $cpy + [lindex $path [incr i]]]
    lappend co $newx $newy
    set cpx $newx
    set cpy $newy
}

proc svg2can::PointsToList {points} {
    return [string map {, " "} $points]
}

# svg2can::ParseTransformAttr --
# 
#       Parse the svg syntax for the transform attribute to a simple tcl
#       list.

proc svg2can::ParseTransformAttr {attrlist} {  
    set cmd ""
    set idx [lsearch -exact $attrlist "transform"]
    if {$idx >= 0} {
        set cmd [TransformAttrToList [lindex $attrlist [incr idx]]]
    }
    return $cmd
}

proc svg2can::TransformAttrToList {cmd} {    
    regsub -all -- {\( *([-0-9.]+) *\)} $cmd { \1} cmd
    regsub -all -- {\( *([-0-9.]+)[ ,]+([-0-9.]+) *\)} $cmd { {\1 \2}} cmd
    regsub -all -- {\( *([-0-9.]+)[ ,]+([-0-9.]+)[ ,]+([-0-9.]+) *\)} \
      $cmd { {\1 \2 \3}} cmd
    regsub -all -- {,} $cmd {} cmd
    return $cmd
}

# svg2can::TransformAttrListToMatrix --
# 
#       Processes a SVG transform attribute to a transformation matrix.
#       Used by tkpath only.
#       
#       | a c tx |
#       | b d ty |
#       | 0 0 1  |
#       
#       linear form : {a b c d tx ty}

proc svg2can::TransformAttrListToMatrix {transform} {
    variable degrees2Radians
    
    # @@@ I don't have 100% control of multiplication order!
    set i 0

    foreach {op value} $transform {
        
        switch -- $op {
            matrix {
                set m([incr i]) $value
            }
            rotate {
                set phi [lindex $value 0]
                set cosPhi  [expr cos($degrees2Radians*$phi)]
                set sinPhi  [expr sin($degrees2Radians*$phi)]
                set msinPhi [expr {-1.0*$sinPhi}]
                if {[llength $value] == 1} {
                    set m([incr i])  \
                      [list $cosPhi $sinPhi $msinPhi $cosPhi 0 0]
                } else {
                    set cx [lindex $value 1]
                    set cy [lindex $value 2]
                    set m([incr i]) [list $cosPhi $sinPhi $msinPhi $cosPhi \
                      [expr {-$cx*$cosPhi + $cy*$sinPhi + $cx}] \
                      [expr {-$cx*$sinPhi - $cy*$cosPhi + $cy}]]
                }
            }
            scale {
                set sx [lindex $value 0]
                if {[llength $value] > 1} {
                    set sy [lindex $value 1]
                } else {
                    set sy $sx
                }
                set m([incr i]) [list $sx 0 0 $sy 0 0]
            }
            skewx {
                set tana [expr {tan($degrees2Radians*[lindex $value 0])}]
                set m([incr i]) [list 1 0 $tana 1 0 0]
            }
            skewy {
                set tana [expr {tan($degrees2Radians*[lindex $value 0])}]
                set m([incr i]) [list 1 $tana 0 1 0 0]
            }
            translate {
                set tx [lindex $value 0]
                if {[llength $value] > 1} {
                    set ty [lindex $value 1]
                } else {
                    set ty 0
                }
                set m([incr i]) [list 1 0 0 1 $tx $ty]
            }
        }
    }
    if {$i == 1} {
        # This is the most common case.
        set mat $m($i)
    } else {
        set mat {1 0 0 1 0 0}
        foreach i [lsort -integer [array names m]] {
            set mat [MMult $mat $m($i)]
        }
    }
    foreach {a b c d tx ty} $mat { break }
    return [list [list $a $c] [list $b $d] [list $tx $ty]]
}

proc svg2can::MMult {m1 m2} {
    foreach {a1 b1 c1 d1 tx1 ty1} $m1 { break }
    foreach {a2 b2 c2 d2 tx2 ty2} $m2 { break }
    return [list \
      [expr {$a1*$a2  + $c1*$b2}]        \
      [expr {$b1*$a2  + $d1*$b2}]        \
      [expr {$a1*$c2  + $c1*$d2}]        \
      [expr {$b1*$c2  + $d1*$d2}]        \
      [expr {$a1*$tx2 + $c1*$ty2 + $tx1}] \
      [expr {$b1*$tx2 + $d1*$ty2 + $ty1}]]
}

# svg2can::CreateTransformCanvasCmdList --
# 
#       Takes a parsed list of transform attributes and turns them
#       into a sequence of canvas commands.
#       Standard items only which miss a matrix option.

proc svg2can::CreateTransformCanvasCmdList {tag transformL} {
    
    set cmdList {}
    foreach {key argument} $transformL {
        
        switch -- $key {
            translate {
                lappend cmdList [concat [list move $tag] $argument]
            }
            scale {
                
                switch -- [llength $argument] {
                    1 {
                        set xScale $argument
                        set yScale $argument
                    }
                    2 {
                        foreach {xScale yScale} $argument break
                    }
                    default {
                        set xScale 1.0
                        set yScale 1.0
                    }
                }
                lappend cmdList [list scale $tag 0 0 $xScale $yScale]
            }
        }
    }
    return $cmdList
}

proc svg2can::AddAnyTransformCmds {cmdList transformL} {
    variable tmptag
    
    if {[llength $transformL]} {
        set cmdList [concat $cmdList \
          [CreateTransformCanvasCmdList $tmptag $transformL]]
        lappend cmdList [list dtag $tmptag]
    }
    return $cmdList
}

proc svg2can::MapNoneToEmpty {val} {

    if {[string equal $val "none"]} {
        return
    } else {
        return $val
    }
}

proc svg2can::FlattenList {hilist} {
    
    set flatlist {}
    FlatListRecursive $hilist flatlist
    return $flatlist
}

proc svg2can::FlatListRecursive {hilist flatlistVar} {
    upvar $flatlistVar flatlist
    
    if {[string equal [lindex $hilist 0] "create"]} {
        set flatlist [list $hilist]
    } else {
        foreach c $hilist {
            if {[string equal [lindex $c 0] "create"]} {
                lappend flatlist $c
            } else {
                FlatListRecursive $c flatlist
            }
        }
    }
}

# svg2can::gettag, getattr, getcdata, getchildren --
# 
#       Accesor functions to the specific things in a xmllist.

proc svg2can::gettag {xmllist} { 
    return [lindex $xmllist 0]
}

proc svg2can::getattr {xmllist} { 
    return [lindex $xmllist 1]
}

proc svg2can::getcdata {xmllist} { 
    return [lindex $xmllist 3]
}

proc svg2can::getchildren {xmllist} { 
    return [lindex $xmllist 4]
}

proc svg2can::_DrawSVG {fileName w} {
    set fd [open $fileName r]
    set xml [read $fd]
    close $fd
    set xmllist [tinydom::documentElement [tinydom::parse $xml]]
    set cmdList [svg2can::parsesvgdocument $xmllist]
    foreach c $cmdList {
        puts $c
        eval $w $c
    }
}

# Tests...
if {0} {
    # load /Users/matben/C/cvs/tkpath/macosx/build/tkpath0.2.1.dylib
    package require svg2can
    toplevel .t
    pack [canvas .t.c -width 600 -height 500]    
    set i 0
        
    set xml([incr i]) {<polyline points='400 10 10 10 10 400' \
      style='stroke: #000000; stroke-width: 1.0; fill: none;'/>}
                    
    # Text
    set xml([incr i]) {<text x='10.0' y='20.0' \
      style='stroke-width: 0; font-family: Helvetica; font-size: 12; \
      fill: #000000;' id='std text t001'>\
      <tspan>Start</tspan><tspan>Mid</tspan><tspan>End</tspan></text>}
    set xml([incr i]) {<text x='10.0' y='40.0' \
      style='stroke-width: 0; font-family: Helvetica; font-size: 12; \
      fill: #000000;' id='std text t002'>One\
      straight text data</text>}
    set xml([incr i]) {<text x='10.0' y='60.0' \
      style='stroke-width: 0; font-family: Helvetica; font-size: 12; \
      fill: #000000;' id='std text t003'>\
      <tspan>Online</tspan><tspan dy='6'>dy=6</tspan><tspan dy='-6'>End</tspan></text>}
    set xml([incr i]) {<text x='10.0' y='90.0' \
      style='stroke-width: 0; font-family: Helvetica; font-size: 16; \
      fill: #000000;' id='std text t004'>\
      <tspan>First</tspan>\
      <tspan dy='10'>Online (dy=10)</tspan>\
      <tspan><tspan>Nested</tspan></tspan><tspan>End</tspan></text>}
    
    # Paths
    set xml([incr i]) {<path d='M 200 100 L 300 100 300 200 200 200 Z' \
      style='fill-rule: evenodd; fill: none; stroke: black; stroke-width: 1.0;\
      stroke-linejoin: round;' id='std poly t005'/>}
    set xml([incr i]) {<path d='M 30 100 Q 80 30 100 100 130 65 200 80' \
      style='fill-rule: evenodd; fill: none; stroke: #af5da8; stroke-width: 4.0;\
      stroke-linejoin: round;' id='std poly t006'/>}
    set xml([incr i]) {<polyline points='30 100,80 30,100 100,130 65,200 80' \
      style='fill: none; stroke: red;'/>}
    set xml([incr i])  {<path d='M 10 200 H 100 200 v20h 10'\
    style='fill-rule: evenodd; fill: none; stroke: black; stroke-width: 2.0;\
      stroke-linejoin: round;' id='std t008'/>}
    set xml([incr i])  {<path d='M 20 200 V 300 310 h 10 v 10'\
      style='fill-rule: evenodd; fill: none; stroke: blue; stroke-width: 2.0;\
      stroke-linejoin: round;' id='std t008'/>}
    set xml([incr i]) {<path d='M 30 100 Q 80 30 100 100 T 200 80' \
      style='fill: none; stroke: green; stroke-width: 2.0;' id='t006'/>}
    set xml([incr i]) {<path d='M 30 200 Q 80 130 100 200 T 150 180 200 180 250 180 300 180' \
      style='fill: none; stroke: gray50; stroke-width: 2.0;' id='t006'/>}
    set xml([incr i]) {<path d='M 30 300 Q 80 230 100 300 t 50 0 50 0 50 0 50 0' \
      style='fill: none; stroke: gray50; stroke-width: 1.0;' id='std poly t006'/>}
    set xml([incr i]) {<path d="M100,200 C100,100 250,100 250,200 \
      S400,300 400,200" style='fill: none; stroke: black'/>}

    set xml([incr i]) {<path d="M 125 75 A 100 50 0 0 0 225 125" \
      style='fill: none; stroke: blue; stroke-width: 2.0;'/>}
    set xml([incr i]) {<path d="M 125 75 A 100 50 0 0 1 225 125" \
      style='fill: none; stroke: red; stroke-width: 2.0;'/>}
    set xml([incr i]) {<path d="M 125 75 A 100 50 0 1 0 225 125" \
      style='fill: none; stroke: green; stroke-width: 2.0;'/>}
    set xml([incr i]) {<path d="M 125 75 A 100 50 0 1 1 225 125" \
      style='fill: none; stroke: gray50; stroke-width: 2.0;'/>}

    # g
    set xml([incr i]) {<g fill="none" stroke="red" stroke-width="3" > \
      <line x1="300" y1="10" x2="350" y2="10" /> \
      <line x1="300" y1="10" x2="300" y2="50" /> \
      </g>}
    
    # translate
    set xml([incr i]) {<rect id="t0012" x="10" y="10" width="20" height="20" \
      style="stroke: yellow; fill: none; stroke-width: 2.0;" \
      transform="translate(200,200)"/>}
    set xml([incr i]) {<rect id="t0013" x="10" y="10" width="20" height="20" \
      style="stroke: yellow; fill: none; stroke-width: 2.0;" transform="scale(4)"/>}
    set xml([incr i]) {<circle id="t0013" cx="10" cy="10" r="20" \
      style="stroke: yellow; fill: none; stroke-width: 2.0;"\
      transform="translate(200,300)"/>}
    set xml([incr i]) {<text x='10.0' y='40.0' transform="translate(200,300)" \
      style='font-family: Helvetica; font-size: 24; \
      fill: #000000;'>Translated Text</text>}
    
    # tkpath tests...
    set xml([incr i]) {<rect x='10' y='10' height='15' width='20' \
      transform='translate(30, 20) scale(2)' style='fill: gray;'/>}
    set xml([incr i]) {<rect x='10' y='10' height='15' width='20' \
      transform='scale(2) translate(30, 20)' style='fill: black;'/>}
    
    set xml([incr i]) {<g transform='translate(30, 20)'> \
      <g transform='scale(2)'> \
      <rect x='10' y='10' height='15' width='20' style='stroke: blue; fill: none;'/> \
      </g> \
      </g>}
    
    .t.c create path "M 30 20 h 100 M 30 20 v 100"
    .t.c create prect 10 10 30 25 -stroke {} -fill gray
    
    foreach i [lsort -integer [array names xml]] {
        set xmllist [tinydom::documentElement [tinydom::parse $xml($i)]]
        set cmdList [svg2can::parseelement $xmllist]
        foreach c $cmdList {
            puts $c
            eval .t.c $c
        }
    }

}
    
#-------------------------------------------------------------------------------
======



[[
[Category Package] | [Category Graphics]
]]
----
'''[kpv] - 2010-02-23 20:13:33'''

KPV - has anyone gotten this to work? It calls for ''package require uriencode'', 
''tinydom::parse'', and ''<canvas widget> create prect 10 10 30 25 -stroke {} -fill gray''.