Richard Suchenwirth 2002-11-05 - SVG (Scalable Vector Graphics) is an application of XML to describe images in terms of elements, which often resemble Tk's canvas items. The following code attempts to dump canvas contents into a well-formed SVG string. Having neither the complete SVG spec nor a viewer at hand, it is just a first shot - no warranty, feel free to improve and edit this page! }
proc canvas2svg c {
set res "<svg[att width [$c cget -width]][att height [$c cget -height]]>\n"
foreach item [$c find all] {
set type [$c type $item]
set atts ""
foreach {x0 y0 x1 y1} \
[string map {".0 " " "} "[$c coords $item] "] break
set fill [rgb2xcolor [$c itemcget $item -fill]]
catch {set stroke [rgb2xcolor [$c itemcget $item -outline]]}
catch {set width [expr round([$c itemcget $item -width])]}
set pts {}
foreach {x y} [$c coords $item] {
lappend pts [list [expr {round($x)}] [expr {round($y)}]]
}
switch -- $type {
line {
set type polyline
append atts [att points [join $pts ", "]]
append atts [att stroke $fill #000000]
append atts [att stroke-width $width 1]
}
oval {
set type ellipse
append atts [att cx [expr {($x0+$x1)/2}]]
append atts [att cy [expr {($y0+$y1)/2}]]
append atts [att rx [expr {($x1-$x0)/2}]]
append atts [att ry [expr {($y1-$y0)/2}]]
append atts [att fill $fill #000000][att stroke $stroke none]
append atts [att stroke-width $width 1]
}
polygon {
append atts [att points [join $pts ", "]]
append atts [att fill $fill #000000][att stroke $stroke none]
append atts [att stroke-width $width 1]
}
rectangle {
set type rect
append atts [att x $x0][att y $y0]
append atts [att width [expr {$x1-$x0}]]
append atts [att height [expr {$y1-$y0}]]
append atts [att fill $fill #000000][att stroke $stroke none]
append atts [att stroke-width $width 1]
}
text {
append atts [att x $x0][att y $y0][att fill $fill #000000]
set text [$c itemcget $item -text]
}
default {error "type $type not(yet) dumpable to SVG"}
}
append res " <$type$atts"
if {$type=="text"} {
append res ">$text</$type>\n"
} else {
append res " />\n"
}
}
append res "</svg>"
}
proc att {name value {default -}} {
if {$value != $default} {return " $name=\"$value\""}
}
proc rgb2xcolor rgb {
if {$rgb == ""} {return none}
foreach {r g b} [winfo rgb . $rgb] break
format #%02x%02x%02x [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]
}# Test code:
if {[file tail [info script]] == [file tail $argv0]} {
catch {console show} ;# for Win and Mac
pack [canvas .c]
.c create rect 10 10 90 90 -fill red -outline yellow -width 2
.c create oval 110 10 190 90 -fill blue
.c create poly 175 37 190 80 235 80 190 107 212 150 175 125 \
138 150 152 107 115 80 160 80 -fill yellow
.c create line 50 50 150 50
.c create text 100 100 -text Hello -font {Helvetica 18}
foreach item [.c find all] {
puts $item:[.c type $item],[.c itemconfig $item]\n
}
puts [canvas2svg .c]
bind . <Escape> {exec wish $argv0 &; exit}
}if 0 {This is what comes out of the test:
<svg width="377" height="264"> <rect x="10" y="10" width="80" height="80" fill="#ff0000" stroke="#ffff00" stroke-width="2" /> <ellipse cx="150" cy="50" rx="40" ry="40" fill="#0000ff" stroke="#000000" stroke-width="1" /> <polygon points="175 37, 190 80, 235 80, 190 107, 212 150, 175 125, 138 150, 152 107, 115 80, 160 80" fill="#ffff00" stroke="none" stroke-width="1" /> <polyline points="50 50, 150 50" stroke="#000000" stroke-width="1" /> <text x="100" y="100" fill="#000000">Hello</text> </svg>
For a more elaborate dumper see http://hem.fyristorg.com/matben/download/can2svg.tcl
2007-09-11 VI Just using that in an svg file causes Firefox to display say - No style information. And it displays the xml source rather than the graphic. The minimum I required to add was an xmlns parameter to the svg tag, like this (only first line is below).
<svg xmlns="http://www.w3.org/2000/svg" width="377" height="264">
Arts and crafts of Tcl-Tk programming