diff options
Diffstat (limited to 'demos/pathTags.tcl')
-rw-r--r-- | demos/pathTags.tcl | 183 |
1 files changed, 97 insertions, 86 deletions
diff --git a/demos/pathTags.tcl b/demos/pathTags.tcl index cce6b86..de2779b 100644 --- a/demos/pathTags.tcl +++ b/demos/pathTags.tcl @@ -2,10 +2,11 @@ # these simple samples have been developped by C. Mertz mertz@cena.fr in perl # tcl version by Jean-Paul Imbert imbert@cena.fr -load /usr/lib/tkzinc3.2.so - +if {![info exists zincDemo]} { + error "This script should be run from the zinc-widget demo." +} -set w .path_tags +set w .pathTags catch {destroy $w} toplevel $w wm title $w "Zinc Path tags Demonstration" @@ -43,19 +44,18 @@ pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 # | # --- i_ccb #the same objects are cloned and put in an other hierarchy where -#gr_top is replaced by gr_other_top +#grTop is replaced by grOtherTop -set defaultForecolor sienna +set defaultForeColor sienna ########################################### # Text zone ########################################### -text $w.text -relief sunken -borderwidth 2 -height 5 -font 10x20 +text $w.text -relief sunken -borderwidth 2 -height 5 pack $w.text -expand yes -fill both -$w.text insert 0.0 { - This represents a group hierarchy: +$w.text insert end {This represents a group hierarchy: - groups are represented by a rectangle and a Title. - non-group items are represented by a text. Select a pathTag or a tag with one of the radio-button @@ -73,7 +73,7 @@ pack $w.zinc pack [frame $w.tagsfm] -set pathtag +set pathtag {} pack [frame $w.left] -side left -expand 1 -padx .5c -pady .2c pack [frame $w.middle] -side left -expand 1 -padx .5c -pady .2c pack [frame $w.right] -side left -expand 1 -padx .5c -pady .2c @@ -84,85 +84,86 @@ pack [frame $w.rbot_right] -side left -expand 1 -padx .5c -pady .2c set i 0 foreach p {top .top .top. .top* .top*cca .5.} { - radiobutton $w.left.r$i -text "$p" -font 10x20 -command displayPathtag -variable pathtag -relief flat -value $p - incr i + radiobutton $w.left.r$i -text $p -command displayPathtag \ + -variable pathtag -relief flat -value $p pack $w.left.r$i -side top -pady 2 -anchor w + incr i } set i 0 foreach p {.top*aa .top*aa. .top*aa* .top*aaa .top*aaa. .5*} { - radiobutton $w.middle.r$i-text "$p" -font 10x20 -command displayPathtag -variable pathtag -relief flat -value $p - incr i + radiobutton $w.middle.r$i -text $p -command displayPathtag \ + -variable pathtag -relief flat -value $p pack $w.middle.r$i -side top -pady 2 -anchor w + incr i } -label $w.rtop.label -font 10x20 -relief flat -text your own tag : +label $w.rtop.label -relief flat -text {your own tag:} pack $w.rtop.label -side left -entry $w.rtop.entry -font 10x20 -width 15 ->pack -side left +entry $w.rtop.entry -width 15 +pack $w.rtop.entry -side left bind $w.rtop.entry <Key-Return> " " #sub {$pathtag $_"0"->get &displayPathtag} set i 0 -foreach p {.top*aa*aaa .top*aa*aaa. .top*aa*aaa* .other_top*aa* .5*ca*} { - radiobutton $w.rbot_left.r$i -text "$p" -font {10x20} -command displayPathtag -variable pathtag -relief flat -value $p - incr i +foreach p {.top*aa*aaa .top*aa*aaa. .top*aa*aaa* .otherTop*aa* .5*ca*} { + radiobutton $w.rbot_left.r$i -text $p -command displayPathtag \ + -variable pathtag -relief flat -value $p pack $w.rbot_left.r$i -side top -pady 2 -anchor w + incr i } +set i 0 foreach p "{*aa*aaaa *aaa} {aa || ca} none all" { - radiobutton $w.rbot_right.r$i -text "$p" -font 10x20 -command displayPathtag -variable pathtag -relief flat -value p - incr i + radiobutton $w.rbot_right.r$i -text $p -command displayPathtag \ + -variable pathtag -relief flat -value p pack $w.rbot_right.r$i -side top -pady 2 -anchor w + incr i } -# creating the item hierarchy -$w.zinc add group 1 -tags top -createSubHierarchy top - -# creating a parallel hierarchy -zinc add group 1 -tags other_top -createSubHierarchy other_top - ### Here we create the genuine hierarchy of groups and items ### Later we will create graphical objects to display groups -sub createSubHierarchy {gr} { +proc createSubHierarchy {gr} { global w $w.zinc add group $gr -tags a - $w.zinc add text $gr -tags b text -text b -position {270 150} + $w.zinc add text $gr -tags {b text} -text b -position {270 150} $w.zinc add group $gr -tags c $w.zinc add group a -tags aa - $w.zinc add text a -tags ab text -text ab -position {60 220} + $w.zinc add text a -tags {ab text} -text ab -position {60 220} $w.zinc add group a -tags ac $w.zinc add group aa -tags aaa - $w.zinc add text aa -tags aab text -text aab -position {90 190} + $w.zinc add text aa -tags {aab text} -text aab -position {90 190} $w.zinc add group aaa -tags aaaa - $w.zinc add text aaaa -tags aaaaa text -text aaaaa -position {150 110} - $w.zinc add text aaaa -tags aaaab text -text aaaab -position {150 130} - $w.zinc add text aaa -tags aaab text -text aaab -position {120 160} + $w.zinc add text aaaa -tags {aaaaa text} -text aaaaa -position {150 110} + $w.zinc add text aaaa -tags {aaaab text} -text aaaab -position {150 130} + $w.zinc add text aaa -tags {aaab text} -text aaab -position {120 160} $w.zinc add text ac -tags aca -text aca -position {90 260} - $w.zinc add text ac -tags acb text -text acb -position {90 290} + $w.zinc add text ac -tags {acb text} -text acb -position {90 290} $w.zinc add group c -tags ca - $w.zinc add text c -tags cb text -text cb -position {330 160} + $w.zinc add text c -tags {cb text} -text cb -position {330 160} $w.zinc add group c -tags cc - $w.zinc add text ca -tags caa text -text caa -position {360 110} - $w.zinc add text ca -tags cab text -text cab -position {360 130} - - $w.zinc add text cc -tags cca text -text cca -position {360 200} - $w.zinc add text cc -tags ccb text -text ccb -position {360 220} + $w.zinc add text ca -tags {caa text} -text caa -position {360 110} + $w.zinc add text ca -tags {cab text} -text cab -position {360 130} + + $w.zinc add text cc -tags {cca text} -text cca -position {360 200} + $w.zinc add text cc -tags {ccb text} -text ccb -position {360 220} } # converts a list of items ids in a list of sorted tags the first tag of each item -sub items2tags {items} { +proc items2tags {items} { + global w - foreach my item $items { + foreach item $items { set tags [$w.zinc itemcget $item -tags ] - if {[lindex $tags 0]=="frame" || [lindex $tags 0]=="title"} {continue} + if {[lindex $tags 0]=="frame" || [lindex $tags 0]=="title"} { + continue + } lappend selected_tags [lindex $tags 0] } return [lsort selected_tags] @@ -176,23 +177,24 @@ sub items2tags {items} { set backgrounds {grey90 grey82 grey75 grey68 grey60 grey52 grey45} proc drawHierarchy {group level} { - global w + global w backgrounds + set tags [$w.zinc gettags $group] foreach g [$w.zinc find withtype group ".$group."] { drawHierarchy $g [expr $level+1] } set coords [$w.zinc bbox $group] - set x [lindex $coords 0] - set y [lindex $coords 1] - set x2 [lindex $coords 2] - set y2 [lindex $coords 3] - $w.zinc add text $group -position my $x $y $x2 $y2 - "[expr $x-5] [expr$y-4]" -text "[lindex $tags 0]" -anchor w -alignment left -underlined 1 -priority 20 -tags "title_.[lindex $tags 0]group_title" + foreach {x y x2 y2} $coords break + $w.zinc add text $group -position [list [expr $x-5] [expr $y-4]] \ + -text [lindex $tags 0] -anchor w -alignment left \ + -underlined 1 -priority 20 -tags [list "title_.[lindex $tags 0]" group_title] if {$x} { set background [lindex $backgrounds $level] - $w.zinc add rectangle $group "[expr $x+0] [expr $y+5] [expr $x2+5] [expr $y2+2]" -filled 1 -fillcolor $background -priority $level -tags "frame_.[lindex $tags 0]group_frame" + $w.zinc add rectangle $group [list [expr $x+0] [expr $y+5] [expr $x2+5] [expr $y2+2]]\ + -filled 1 -fillcolor $background -priority $level \ + -tags [list frame_.[lindex $tags 0]group_frame] } else { puts "undefined bbox for $group : $tags\n" @@ -206,7 +208,7 @@ proc extractTextAndFrames {} { global w foreach group_title [$w.zinc find withtag {group_title || group_frame}] { set ancestors [$w.zinc find ancestor $group_title] - # print "$group_title @ancestors\n" + # puts "$group_title @ancestors\n" set grandFather [lindex $ancestors 1] $w.zinc chggroup $group_title $grandFather 1 } @@ -215,54 +217,63 @@ proc extractTextAndFrames {} { ## this sub modifies the color/line color of texts and rectangles ## representing selected items. proc displayPathtag {} { - global w - global pathtag - set selected [zinc find withtag $pathtag] + global w pathtag defaultForeColor + + set selected [$w.zinc find withtag $pathtag] set tags [items2tags $selected] puts "selected: $tags\n" - # print "selected= " - # foreach @selected { print $_ " " $w.zinc type $_ " " - # join " " $w.zinc gettags $_ " / "} - # print "\n" + # puts "selected= " + # foreach sel $selected { + # puts "$sel [$w.zinc type $sel] [join [$w.zinc gettags $sel] ,] /\n" + # } + # ## unselecting all items foreach item [$w.zinc find withtype text] { - $w.zinc itemconfigure $item -color $defaultForecolor + $w.zinc itemconfigure $item -color $defaultForeColor } foreach item [$w.zinc find withtype rectangle] { - $w.zinc itemconfigure $item -linecolor $defaultForecolor + $w.zinc itemconfigure $item -linecolor $defaultForeColor } ## highlighting selected items foreach item $selected { set type [$w.zinc type $item ] # print $item " " $w.zinc type $item " " join " " $w.zinc gettags $item "\n" - if {$type == text} { - $w.zinc itemconfigure $item -color black - } else if { $type == "rectangle"} { - $w.zinc itemconfigure $item -linecolor black - } else if {$type == "group"} { - set tag [$w.zinc gettags $item 0] - set grandFather [$w.zinc find ancestors $item 1] - if {$grandFather} { - ## as there is 2 // hierachy we must refine the tag used - ## to restrict to the proper hierarchy - $w.zinc itemconfigure "*$grandFather*frame_$tag" -linecolor black - $w.zinc itemconfigure "*$grandFather*title_$tag" -color black - } else { - ## when a group as no grandfather it can only be top or other_top - ## as their tags are non-ambiguous no need to refine! - $w.zinc itemconfigure "frame_$tag" -linecolor black - $w.zinc itemconfigure "title_$tag" -color black + switch -- $type { + text { + $w.zinc itemconfigure $item -color black + } + rectangle { + $w.zinc itemconfigure $item -linecolor black + } + group { + set tag [lindex [$w.zinc gettags $item] 0] + set grandFather [$w.zinc find ancestors $item top] + if {$grandFather == 1} { + ## as there is 2 // hierachy we must refine the tag used + ## to restrict to the proper hierarchy + $w.zinc itemconfigure "*$grandFather*frame_$tag" -linecolor black + $w.zinc itemconfigure "*$grandFather*title_$tag" -color black + } else { + ## when a group as no grandfather it can only be top or otherTop + ## as their tags are non-ambiguous no need to refine! + $w.zinc itemconfigure "frame_$tag" -linecolor black + $w.zinc itemconfigure "title_$tag" -color black + } } } } } -drawHierarchy top 0 -drawHierarchy other_top 0 -$w.zinc translate other_top 4000 -extractTextAndFrames - - +# creating the item hierarchy +$w.zinc add group 1 -tags top +createSubHierarchy top +# creating a parallel hierarchy +$w.zinc add group 1 -tags otherTop +createSubHierarchy otherTop +drawHierarchy top 0 +drawHierarchy otherTop 0 +$w.zinc translate otherTop 400 0 +extractTextAndFrames |