| What | simplify_SVG.tcl |
| Description | Provides translation from XML/SVG format to canvas commands. |
| Where | http://sourceforge.net/projects/rattlecad |
| Requires | tdom, Tk |
| Updated | 17.02.2011 |
For my project on sourceforge http://sourceforge.net/projects/rattlecad/ i need to read svg-files. To keep complexity from my software I do not support all object types. Especially not the path-tags. Therefore I create this script to read the path-tags and convert them into polylines and polygons.
I refer to allready existing scripts:
the script is not complete at all.
try following files to test this script:
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
##+##########################################################################
#
#
#
# http://wiki.tcl.tk/3884 - Richard Suchenwirth - 2002-08-13
# http://wiki.tcl.tk/10530 - Greg Blair - 2003-09-29
#
# add a converter to read SVG-Path and convert path-Elements into polygon & polyline
#
# http://www.w3.org/TR/SVG/expanded-toc.html
#
# http://www.selfsvg.info/?section=3.5
#
#
package require Tk
package require tdom
proc absolutPath {pathDefinition {position {0 0}} } {
set transform(x) [lindex $position 0]
set transform(y) [lindex $position 1]
set preformatSplit [string map { M {_M_} Z {_Z_} L {_L_} H {_H_} V {_V_} C {_C_} S {_S_} Q {_Q_} T {_T_} A {_A_} \
m {_m_} z {_Z_} l {_l_} h {_h_} v {_v_} c {_c_} s {_s_} q {_q_} t {_t_} a {_a_} \
{-} {_-} {,} {_} } \
[string trim $pathDefinition] ]
set valueList_tmp [split $preformatSplit {_ }]
set pathValueList {}
foreach value $valueList_tmp {
if {$value == {} } {continue}
set value [string trim $value]
set pathValueList [lappend pathValueList $value ]
}
# puts "$pathDefList\n ______pathDefList_____"
# -- internal procedure: return 1 if $value is a control-character in SVG-path element
#
proc checkControl {value} {
set controlChar [string map { M {__} Z {__} L {__} H {__} V {__} C {__} S {__} Q {__} T {__} A {__} \
m {__} z {__} l {__} h {__} v {__} c {__} s {__} q {__} t {__} a {__} } \
$value ]
if {$controlChar == {__}} {
return 1
} else {
return 0
}
}
# -- convert all relative values to absolute values
#
array \
set penPosition { {x 0}
{y 0} }
# -- loop throug pathValueList
#
set pathValueList_abs {}
set listIndex 0
while {$listIndex < [llength $pathValueList]} {
# -- get value at Position
#
set value [lindex $pathValueList $listIndex]
# -- get next Index
#
incr listIndex
# -- check value on
#
if {[checkControl $value]} {
# puts " ... $value"
switch -exact $value {
M { # puts " $value ... implemented yet"
set penPosition(x) [expr [lindex $pathValueList $listIndex] + $transform(x)] ; incr listIndex
set penPosition(y) [expr [lindex $pathValueList $listIndex] + $transform(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $value $penPosition(x) $penPosition(y)]
}
m { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs M]
# puts " $listIndex - [lindex $pathValueList $listIndex] "
foreach {x y} [lrange $pathValueList $listIndex end] {
# puts " ... control: [checkControl $x] ... $x $y ";
if {[checkControl $x]} {break}
set penPosition(x) [expr $x + $penPosition(x)] ; incr listIndex
set penPosition(y) [expr $y + $penPosition(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
}
}
l { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs L]
# puts " $listIndex - [lindex $pathValueList $listIndex] "
foreach {x y} [lrange $pathValueList $listIndex end] {
# puts " ... control: [checkControl $x] ... $x $y ";
if {[checkControl $x]} {break}
set penPosition(x) [expr $x + $penPosition(x)] ; incr listIndex
set penPosition(y) [expr $y + $penPosition(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
}
}
c { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs C]
set bezierIndex 0
foreach {x y} [lrange $pathValueList $listIndex end] {
# puts " ... control: [checkControl $x] ... $x $y ";
if {[checkControl $x]} {break}
set ctrlPosition(x) [expr $x + $penPosition(x)] ; incr listIndex
set ctrlPosition(y) [expr $y + $penPosition(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $ctrlPosition(x) $ctrlPosition(y)]
incr bezierIndex
if {$bezierIndex > 2} {
set penPosition(x) $ctrlPosition(x)
set penPosition(y) $ctrlPosition(y)
set bezierIndex 0
}
}
}
h { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs L]
set x [lindex $pathValueList $listIndex]
if {[checkControl $x]} {continue}
set penPosition(x) [expr $x + $penPosition(x)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
}
v { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs L]
set y [lindex $pathValueList $listIndex]
if {[checkControl $y]} {continue}
set penPosition(y) [expr $y + $penPosition(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
}
L { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs L]
# puts " $listIndex - [lindex $pathValueList $listIndex] "
foreach {x y} [lrange $pathValueList $listIndex end] {
# puts " ... control: [checkControl $x] ... $x $y ";
if {[checkControl $x]} {break}
set penPosition(x) [expr $x + $transform(x)] ; incr listIndex
set penPosition(y) [expr $y + $transform(y)] ; incr listIndex
# set penPosition(x) [expr $x + $penPosition(x)] ; incr listIndex
# set penPosition(y) [expr $y + $penPosition(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
# puts " [checkControl $x]
}
}
H { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs L]
set x [lindex $pathValueList $listIndex]
if {[checkControl $x]} {continue}
set penPosition(x) [expr $x + $transform(x)] ; incr listIndex
# set ctrlPosition(x) [expr $x + $penPosition(x)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
}
V { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs L]
set y [lindex $pathValueList $listIndex]
if {[checkControl $y]} {continue}
set penPosition(y) [expr $y + $transform(y)] ; incr listIndex
# set penPosition(y) [expr $y + $penPosition(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
}
C { # puts " $value ... implemented yet"
set pathValueList_abs [lappend pathValueList_abs C]
# puts " $listIndex - [lindex $pathValueList $listIndex] "
foreach {x y} [lrange $pathValueList $listIndex end] {
# puts " ... control: [checkControl $x] ... $x $y ";
if {[checkControl $x]} {break}
set penPosition(x) [expr $x + $transform(x)] ; incr listIndex
set penPosition(y) [expr $y + $transform(y)] ; incr listIndex
set pathValueList_abs [lappend pathValueList_abs $penPosition(x) $penPosition(y)]
# puts " [checkControl $x]
}
}
S -
Q -
T -
A -
s -
q -
t -
a {
# incr listIndex
puts " $value ... not implemented yet - $listIndex"
}
Z -
z {
# puts " $value ... implemented yet - $listIndex"
set pathValueList_abs [lappend pathValueList_abs Z]
}
default {
# incr listIndex
puts " $value ... not registered yet - $listIndex"
}
}
}
}
return $pathValueList_abs
}
# puts "\n$pathDefinition\n ______pathDefinition_____\n"
# set pathValueList [ absolutPath $pathDefinition [list 0 0]]
# puts "\n$pathValueList\n ______pathValueList_____\n"
# set pathValueList [ absolutPath $pathDefinition [list 30 20]]
# puts "\n$pathValueList\n ______pathValueList_____\n"
# exit
proc Bezier {xy {PRECISION 10}} {
# puts " -> $xy"
set PRECISION 8
set np [expr {[llength $xy] / 2}]
if {$np < 4} return
proc BezierSpline {a b c d mu} {
# --------------------------------------------------------
# http://www.cubic.org/~submissive/sourcerer/bezier.htm
# evaluate a point on a bezier-curve. mu goes from 0 to 1.0
# --------------------------------------------------------
set ab [Lerp $a $b $mu]
set bc [Lerp $b $c $mu]
set cd [Lerp $c $d $mu]
set abbc [Lerp $ab $bc $mu]
set bccd [Lerp $bc $cd $mu]
return [Lerp $abbc $bccd $mu]
}
proc Lerp {a b mu} {
# -------------------------------------------------
# http://www.cubic.org/~submissive/sourcerer/bezier.htm
# simple linear interpolation between two points
# -------------------------------------------------
set ax [lindex $a 0]
set ay [lindex $a 1]
set bx [lindex $b 0]
set by [lindex $b 1]
return [list [expr {$ax + ($bx-$ax)*$mu}] [expr {$ay + ($by-$ay)*$mu}] ]
}
set idx 0
foreach {x y} $xy {
set X($idx) $x
set Y($idx) $y
incr idx
}
set xy {}
set idx 0
while {[expr {$idx+4}] <= $np} {
set a [list $X($idx) $Y($idx)]; incr idx
set b [list $X($idx) $Y($idx)]; incr idx
set c [list $X($idx) $Y($idx)]; incr idx
set d [list $X($idx) $Y($idx)];# incr idx ;# use last pt as 1st pt of next segment
for {set j 0} {$j <= $PRECISION} {incr j} {
set mu [expr {double($j) / double($PRECISION)}]
set pt [BezierSpline $a $b $c $d $mu]
lappend xy [lindex $pt 0] [lindex $pt 1]
}
}
# puts " -> $xy"
return $xy
}
proc simplifySVG {domSVG {parentTransform {0 0}}} {
puts "\n"
puts " =============================================="
puts " -- simplifySVG"
puts " =============================================="
puts "\n"
variable flatSVG
# puts " ... [ $flatSVG asXML]\n"
set root [ $flatSVG documentElement ]
# puts " ... [ $root asXML]\n"
set transform(parent) $parentTransform
foreach {transform(parent_x) transform(parent_y)} $transform(parent) break;
# puts " ... parent: $transform(parent_x) / $transform(parent_y)\n"
# puts " --- simplifySVG --"
foreach node [$domSVG childNodes] {
# puts " ... $node"
if {[$node nodeType] != {ELEMENT_NODE}} continue
# -- set defaults
set objectPoints {}
# -- get transform attribute
if {[catch {set transform(this) [ $node getAttribute transform ]} errmsg] } {
set transform(this_x) 0
set transform(this_y) 0
} else {
set transform(this) [ lrange [ split [ $node getAttribute transform ] (,) ] 1 2]
foreach {transform(this_x) transform(this_y)} $transform(this) break
}
# puts " ... this: $transform(this_x) / $transform(this_y)"
set transform(this_x) [expr $transform(this_x) + $transform(parent_x)]
set transform(this_y) [expr $transform(this_y) + $transform(parent_y)]
# puts " ... this: $transform(this_x) / $transform(this_y)\n"
# -- get nodeName
set nodeName [$node nodeName]
# puts " ... $nodeName :"
# puts " ... $transform(this_x) / $transform(this_y)"
switch -exact $nodeName {
g {
# puts "\n\n ... looping"
# puts " [$node asXML]"
simplifySVG $node [list $transform(this_x) $transform(this_y)]
}
rect {
set myNode [ $flatSVG createElement $nodeName]
$myNode setAttribute x [ $node getAttribute x ]
$myNode setAttribute y [ $node getAttribute y ]
$myNode setAttribute width [ $node getAttribute width ]
$myNode setAttribute height [ $node getAttribute height ]
$myNode setAttribute fill none
$myNode setAttribute stroke black
$myNode setAttribute stroke-width 0.1
$root appendChild $myNode
}
polygon {
set valueList [ $node getAttribute points ]
set myNode [ $flatSVG createElement $nodeName]
$myNode setAttribute points $valueList
$myNode setAttribute fill none
$myNode setAttribute stroke black
$myNode setAttribute stroke-width 0.1
$root appendChild $myNode
}
polyline { # polyline class="fil0 str0" points="44.9197,137.492 47.3404,135.703 48.7804,133.101 ...
set valueList [ $node getAttribute points ]
set myNode [ $flatSVG createElement $nodeName]
$myNode setAttribute points $valueList
$myNode setAttribute fill none
$myNode setAttribute stroke black
$myNode setAttribute stroke-width 0.1
$root appendChild $myNode
}
line { # line class="fil0 str0" x1="89.7519" y1="133.41" x2="86.9997" y2= "119.789"
set myNode [ $flatSVG createElement $nodeName]
$myNode setAttribute x1 [ $node getAttribute x1 ]
$myNode setAttribute y1 [ $node getAttribute y1 ]
$myNode setAttribute x2 [ $node getAttribute x2 ]
$myNode setAttribute y2 [ $node getAttribute y2 ]
$myNode setAttribute fill none
$myNode setAttribute stroke black
$myNode setAttribute stroke-width 0.1
$root appendChild $myNode
}
circle { # circle class="fil0 str2" cx="58.4116" cy="120.791" r="5.04665"
# --- dont display the center_object with id="center_00"
set myNode [ $flatSVG createElement $nodeName]
$myNode setAttribute cx [ $node getAttribute cx ]
$myNode setAttribute cy [ $node getAttribute cy ]
$myNode setAttribute r [ $node getAttribute r ]
$myNode setAttribute fill none
$myNode setAttribute stroke black
$myNode setAttribute stroke-width 0.1
$root appendChild $myNode
}
path { # path d="M ......."
# absolutPath
set svgPath [ absolutPath [ $node getAttribute d ] [ list $transform(this_x) $transform(this_y)] ]
set splitIndex [lsearch -exact -all $svgPath {M}]
set splitIndex [lappend splitIndex end]
set i 0
while {$i < [llength $splitIndex]-1} {
set indexStart [lindex $splitIndex $i]
set indexEnd [lindex $splitIndex $i+1]
incr i
if {$indexEnd != {end}} {set indexEnd [expr $indexEnd -1 ]}
set pathSegment [lrange $svgPath $indexStart $indexEnd ]
# puts " ... $indexStart / $indexEnd"
# puts " ... $i [lindex $splitIndex $i]"
# puts " ... $pathSegment"
if { [lindex $pathSegment end] == {Z} } {
set pathSegment [string trim [string map {Z { }} $pathSegment] ]
set elementType polygon
} else {
set elementType polyline
}
# puts "\n$pathSegment\n_________pathSegment________"
set objectPoints [ convertPath2Line $pathSegment ]
# puts "\n$objectPoints\n_________objectPoints________"
set myNode [ $flatSVG createElement $elementType]
$myNode setAttribute points $objectPoints
$myNode setAttribute fill none
$myNode setAttribute stroke black
$myNode setAttribute stroke-width 0.1
$root appendChild $myNode
}
# puts " ... search for: [lsearch -exact -all $svgPath {M}]\n"
}
default { }
}
# puts " $nodeName: $objectPoints"
}
# puts [$root asXML]
return $root
}
proc convertPath2Line {pathDefinition} {
# -------------------------------------------------
# http://www.selfsvg.info/?section=3.5
#
# -------------------------------------------------
# puts "\n\n === new pathString =====================\n"
# puts "\npathString:\n $pathString\n"
# puts " - > pathDefinition:\n$pathDefinition\n"
set canvasElementType line
set controlString {}
set isClosed {no}
# puts " ... convertPath2Line :\n$pathString"
set pathString [string map { M {_M} L {_L} H {_H} V {_V} C {_C} S {_S} Q {_Q} T {_T} A {_A} } [string trim $pathDefinition] ]
set lineString {}
set segmentList [split $pathString {_}]
# puts "$segmentList\n-------------------------convertPath2Line---"
set cleanList {}
foreach value $segmentList {
if {$value == {}} {continue}
set cleanList [lappend cleanList $value]
}
set segmentList $cleanList
# puts "$segmentList\n-------------------------convertPath2Line---"
set prevCoord_x 55
set prevCoord_y 55
set ref_x 0
set ref_y 0
set loopControl 0
foreach segment $segmentList {
# puts "\n\n_____loop_______________________________________________"
# puts "\n\n $ref_x $ref_y\n_____ref_x___ref_y________"
# puts "\n\n <$segment>\n_____segment________"
# puts " ... $segment"
set segmentDef [split [string trim $segment]]
set segmentType [lindex $segmentDef 0]
set segmentCoords [lrange $segmentDef 1 end]
# puts "\n$segmentType - [llength $segmentCoords] - $segmentCoords\n____type__segmentCoords__"
switch -exact $segmentType {
M { #MoveTo
set lineString [ concat $lineString $segmentCoords ]
set ref_x [ lindex $segmentCoords 0 ]
set ref_y [ lindex $segmentCoords 1 ]
}
L { #LineTo - absolute
set lineString [ concat $lineString $segmentCoords ]
set ref_x [ lindex $segmentCoords end-1]
set ref_y [ lindex $segmentCoords end ]
}
C { # Bezier - absolute
# puts "\n\n [llength $segmentCoords] - $segmentCoords\n______segmentCoords____"
# puts "\n( $ref_x / $ref_y )\n ____start_position__"
# puts "\n$segmentType - [llength $segmentCoords] - ( $ref_x / $ref_y ) - $segmentCoords\n ______type__segmentCoords__"
set segmentValues {}
foreach {value} $segmentCoords {
set segmentValues [ lappend segmentValues $value ]
}
# exception on to less values
# - just a line to last coordinate
#
if {[llength $segmentValues] < 6 } {\
set ref_x [ lindex $segmentValues end-1]
set ref_y [ lindex $segmentValues end ]
set lineString [ concat $lineString $ref_x $ref_y ]
puts "\n\n <[llength $segmentValues]> - $segmentValues\n_____Exception________"
continue
}
# continue Bezier definition
# - just a line to last coordinate
#
set segmentValues [ linsert $segmentValues 0 $ref_x $ref_y ]
# puts "\n [llength $segmentValues_abs] - $segmentValues_abs\n______segmentValues_abs____"
set bezierValues [ Bezier $segmentValues]
set ref_x [ lindex $bezierValues end-1]
set ref_y [ lindex $bezierValues end ]
# puts " ===================="
# puts " $prevCoord -> $prevCoord"
# puts " $bezierString"
# puts " ===================="
set lineString [ concat $lineString [lrange $bezierValues 2 end] ]
}
default {
puts "\n\n ... whats on there? -> $segmentType \n\n"
}
}
# incr loopControl
# puts " ... $loopControl"
# puts "\n( $ref_x / $ref_y )\n ____end_position__"
# puts "\n\n $ref_x $ref_y\n_____ref_x___ref_y________"
}
foreach {x y} [split $lineString { }] {
set pointList [lappend pointList "$x,$y"]
}
# puts "-> pointList:\n$pointList\n"
return $pointList
}
proc drawSVG {domSVG canvas {transform {0 0}}} {
puts "\n"
puts " =============================================="
puts " -- drawSVG"
puts " =============================================="
puts "\n"
set nodeList [$domSVG childNodes]
foreach {transform_x transform_y} $transform break;
# return
foreach node $nodeList {
# puts [$node asXML]
# -- set defaults
set objectPoints {}
set nodeName [$node nodeName]
switch -exact $nodeName {
rect {
set x [expr [$node getAttribute x] + $transform_x ]
set y [expr [$node getAttribute y] + $transform_y ]
set width [$node getAttribute width ]
set height [$node getAttribute height]
set x2 [expr $x + $width ]
set y2 [expr $y - $height]
set objectPoints [list $x $y $x $y2 $x2 $y2 $x2 $y]
# -- create rectangle
# puts "$canvas create polygon $objectPoints -outline black -fill white"
$canvas create polygon $objectPoints -outline black -fill white
}
polygon {
set valueList [ $node getAttribute points ]
foreach {coords} $valueList {
foreach {x y} [split $coords ,] break
set x [expr $x + $transform_x ]
set y [expr $y + $transform_y ]
set objectPoints [lappend objectPoints $x $y ]
}
# -- create polygon
# puts "\n$canvas create polygon $objectPoints -outline black -fill white"
$canvas create polygon $objectPoints -outline black -fill {}
}
polyline { # polyline class="fil0 str0" points="44.9197,137.492 47.3404,135.703 48.7804,133.101 ...
set valueList [ $node getAttribute points ]
foreach {coords} $valueList {
foreach {x y} [split $coords ,] break
set x [expr $x + $transform_x ]
set y [expr $y + $transform_y ]
set objectPoints [lappend objectPoints $x $y ]
}
# -- create polyline
# puts "$canvas create line $objectPoints -fill black"
$canvas create line $objectPoints -fill black
}
line { # line class="fil0 str0" x1="89.7519" y1="133.41" x2="86.9997" y2= "119.789"
set objectPoints [list [expr [$node getAttribute x1] + $transform_x ] [expr -([$node getAttribute y1] + $transform_y )] \
[expr [$node getAttribute x2] + $transform_x ] [expr -([$node getAttribute y2] + $transform_y )] ]
# -- create line
# puts "$canvas create line $objectPoints -fill black"
$canvas create line $objectPoints -fill black
}
circle { # circle class="fil0 str2" cx="58.4116" cy="120.791" r="5.04665"
# --- dont display the center_object with id="center_00"
set cx [expr [$node getAttribute cx] + $transform_x ]
set cy [expr [$node getAttribute cy] + $transform_y ]
set r [$node getAttribute r]
set x1 [expr $cx - $r]
set y1 [expr $cy - $r]
set x2 [expr $cx + $r]
set y2 [expr $cy + $r]
set objectPoints [list $x1 $y1 $x2 $y2]
# -- create circle
# puts "$canvas create oval $objectPoints -fill black"
$canvas create oval $objectPoints -fill black
}
default {}
}
}
}
proc recurseInsert {w node parent} {
set nodeName [$node nodeName]
set done 0
if {$nodeName eq "#text" || $nodeName eq "#cdata"} {
set text [string map {\n " "} [$node nodeValue]]
} else {
set text {}
foreach att [getAttributes $node] {
catch {append text " $att=\"[$node getAttribute $att]\""}
}
set children [$node childNodes]
if {[llength $children]==1 && [$children nodeName] eq "#text"} {
append text [$children nodeValue]
set done 1
}
}
$w insert $parent end -id $node -text $nodeName -values [list "$text"]
if {$parent eq {}} {$w item $node -open 1}
if !$done {
foreach child [$node childNodes] {
recurseInsert $w $child $node
}
}
}
proc cleanupTree {w} {
foreach childNode [$w children {} ] {
$w detach $childNode
$w delete $childNode
}
}
proc getAttributes node {
if {![catch {$node attributes} res]} {set res}
}
proc openSVG {{argv {}}} {
variable resultCanvas
variable originalTree
variable resultTree
variable resultText
variable flatSVG
puts "\n"
puts " =============================================="
puts " -- openSVG: $argv"
puts " =============================================="
puts "\n"
# --- result SVG -----------
set flatSVG [dom createDocument svg]
set root [$flatSVG documentElement]
$root setAttribute version 1.0
$root setAttribute xmlns "http://www.w3.org/2000/svg"
# --- open File ------------
if {[llength $argv] == 0} {
set fileName [tk_getOpenFile]
if {$fileName == {}} {exit}
set fp [open $fileName]
} else {
set fp [open [file join [lindex $argv 0]]]
}
fconfigure $fp -encoding utf-8
set xml [read $fp]
close $fp
# --- compute results ------
dom parse $xml doc
$doc documentElement root
set flatSVG [simplifySVG $root {0 0}]
# set flatSVG [simplifySVG $root {50 50} ]
# --- cleanup outputs ------
$resultCanvas delete all
cleanupTree $originalTree
cleanupTree $resultTree
$resultText delete 1.0 end
# --- fill outputs ---------
drawSVG $flatSVG $resultCanvas {15 15}
recurseInsert $originalTree $root {}
recurseInsert $resultTree $flatSVG {}
$resultText insert end [$flatSVG asXML]
}
# --- window ----------
#
pack [ frame .f -bg yellow]
set buttonBar [ frame .f.bb ]
pack $buttonBar -expand yes -fill both
button $buttonBar.openSVG -text "Open SVG" -command openSVG
# button $buttonBar.reset -text "reset Project" -command resetProject
pack $buttonBar.openSVG -side left
set nb_result [ ttk::notebook .f.nb ]
pack $nb_result -expand yes -fill both
$nb_result add [frame $nb_result.nb_canvas] -text "... Canvas"
$nb_result add [frame $nb_result.nb_original] -text "... original SVG"
$nb_result add [frame $nb_result.nb_tree] -text "... simplified SVG"
$nb_result add [frame $nb_result.nb_text] -text "... XML as Text"
set canvasFrame [ frame $nb_result.nb_canvas.f -relief sunken ]
pack $canvasFrame -expand yes -fill both -padx 15 -pady 15
set origFrame [ frame $nb_result.nb_original.f -relief sunken ]
pack $origFrame -expand yes -fill both
set treeFrame [ frame $nb_result.nb_tree.f -relief sunken ]
pack $treeFrame -expand yes -fill both
set textFrame [ frame $nb_result.nb_text.f -relief sunken ]
pack $textFrame -expand yes -fill both
# --- result canvas ---
#
set resultCanvas [ canvas $canvasFrame.cv -width 900 -height 800 -relief sunken -bg white]
pack $resultCanvas -fill both -expand yes -padx 0 -pady 0
# --- result canvas ---
#
set originalTree [ ttk::treeview $origFrame.t -columns "id value" \
-yscrollcommand "$origFrame.y set" \
-xscrollcommand "$origFrame.x set" -height 40 ]
scrollbar $origFrame.x -ori hori -command "$origFrame.t xview"
scrollbar $origFrame.y -ori vert -command "$origFrame.t yview"
grid $origFrame.t $origFrame.y -sticky news
grid $origFrame.x -sticky news
grid rowconfig $origFrame 0 -weight 1
grid columnconfig $origFrame 0 -weight 1
# --- result treeview ---
#
set resultTree [ ttk::treeview $treeFrame.t -columns "id value" \
-xscrollcommand "$treeFrame.x set" \
-yscrollcommand "$treeFrame.y set" -height 40 ]
scrollbar $treeFrame.x -ori hori -command "$treeFrame.t xview"
scrollbar $treeFrame.y -ori vert -command "$treeFrame.t yview"
grid $treeFrame.t $treeFrame.y -sticky news
grid $treeFrame.x -sticky news
grid rowconfig $treeFrame 0 -weight 1
grid columnconfig $treeFrame 0 -weight 1
# --- result textview ---
set resultText [ text $textFrame.txt -wrap none -xscroll "$textFrame.h set" \
-yscroll "$textFrame.v set" -height 50 -width 160 ]
scrollbar $textFrame.v -orient vertical -command "$textFrame.txt yview"
scrollbar $textFrame.h -orient horizontal -command "$textFrame.txt xview"
# Lay them out
grid $textFrame.txt $textFrame.v -sticky nsew
grid $textFrame.h -sticky nsew
# Tell the text widget to take all the extra room
grid rowconfigure $textFrame.txt 0 -weight 1
grid columnconfigure $textFrame.txt 0 -weight 1
# --- compute ----------
#
puts " ... $argv"
openSVG $argv
# exit
#-------------------------------------------------------------------------------