Ajout de plusieurs demos et remaniement

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