From 0d406ebf18a0fefdbc7df031d3df106b8d204d64 Mon Sep 17 00:00:00 2001
From: lecoanet
Date: Mon, 24 Mar 2003 12:24:56 +0000
Subject: Portage depuis perl

---
 demos/pathTags.tcl | 268 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 268 insertions(+)
 create mode 100644 demos/pathTags.tcl

(limited to 'demos/pathTags.tcl')

diff --git a/demos/pathTags.tcl b/demos/pathTags.tcl
new file mode 100644
index 0000000..cce6b86
--- /dev/null
+++ b/demos/pathTags.tcl
@@ -0,0 +1,268 @@
+#!/usr/bin/wish8.3
+# 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
+
+
+set w .path_tags
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Path tags Demonstration"
+wm iconname $w "Path tags"
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+
+## this demo demonstrates the use of path tags to address one or more items
+## belonging to a hierarchy of groups.
+## This hierarchy is described just below gr_xxx designates a group
+## (with a tag xxx and i_yyy designates an non-group item (with a tag yyy .
+
+#  gr_top --- gr_a --- gr_aa --- gr_aaa --- gr_aaaa --- i_aaaaa
+#          |       |         |          |-- i_aaab  |-- i_aaaab
+#          |       |         -- i_aab
+#          |       |-- i_ab
+#          |       |
+#          |       ---gr_ac --- i_aca
+#          |                |
+#          |-- i_b          --- i_acb
+#          |
+#          --- gr_c --- gr_ca --- i_caa
+#                   |         |
+#                   |         --- i_cab
+#                   |-- i_cb
+#                   |
+#                   ---gr_cc --- i_cca
+#                            |
+#                            --- i_ccb
+#the same objects are cloned and put in an other hierarchy where
+#gr_top is replaced by gr_other_top
+
+set defaultForecolor sienna
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 5 -font 10x20 
+pack $w.text -expand yes -fill both
+
+$w.text insert 0.0 {
+    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
+    or experiment your own tags in the input field}
+
+###########################################
+# Zinc creation
+###########################################
+zinc $w.zinc -width 850 -height 360 -font 10x20 -borderwidth 0 -backcolor white
+pack $w.zinc
+
+###########################################
+# Creation of a bunch of radiobutton and a text input
+###########################################
+
+pack [frame $w.tagsfm]
+
+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
+pack [frame $w.rtop] -side left -expand 1 -padx .5c -pady .2c
+pack [frame $w.rbottom ] -side left -expand 1 -padx .5c -pady .2c
+pack [frame $w.rbot_left] -side left -expand 1 -padx .5c -pady .2c
+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
+    pack $w.left.r$i -side top -pady 2 -anchor w
+}
+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
+    pack $w.middle.r$i -side top -pady 2 -anchor w
+}
+
+
+label $w.rtop.label -font 10x20 -relief flat -text your own tag :
+pack $w.rtop.label -side left
+entry $w.rtop.entry -font 10x20 -width 15 ->pack -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
+    pack $w.rbot_left.r$i -side top -pady 2 -anchor w
+}
+
+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
+    pack $w.rbot_right.r$i -side top -pady 2 -anchor w
+}
+
+# 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} {
+    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 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 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 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 ac -tags aca -text aca -position {90 260}
+    $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 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}
+}
+
+
+# converts a list of items ids in a list of sorted tags the first tag of each item 
+sub items2tags {items} {
+
+    foreach my item $items {
+	set tags [$w.zinc itemcget $item -tags ]
+	if {[lindex $tags 0]=="frame" || [lindex $tags 0]=="title"} {continue}
+	lappend selected_tags [lindex $tags 0]
+    }
+    return [lsort selected_tags]
+}
+
+### drawing :
+#### a rectangle item for showing the bounding box of each group 
+### a text item for the group name i.e. its first tag 
+
+## backgrounds used to fill rectangles representing groups
+set backgrounds {grey90 grey82 grey75 grey68 grey60 grey52 grey45}
+
+proc drawHierarchy {group level} {
+    global w
+    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" 
+
+    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" 
+	
+    } else {
+	puts "undefined bbox for $group : $tags\n"
+    }
+}
+
+### this sub extracts out of groups both text and frame representing
+### each group. This is necessary to avoid unexpected selection of
+### rectangles and titles inside groups
+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"
+	set grandFather [lindex $ancestors 1]
+	$w.zinc chggroup $group_title $grandFather 1 
+    }
+}
+
+## 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]
+    set tags [items2tags $selected]
+    puts "selected: $tags\n"
+    # print "selected= "
+    # foreach @selected { print $_ " " $w.zinc type $_ " " 
+    #			 join " " $w.zinc gettags $_ " / "}
+    # print "\n"
+    ## unselecting all items 
+    foreach item [$w.zinc find withtype text] {
+	$w.zinc itemconfigure $item -color $defaultForecolor 
+    }
+    foreach item [$w.zinc find withtype rectangle] {
+	$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
+	    }
+	}
+    }
+}
+
+drawHierarchy top 0 
+drawHierarchy other_top 0 
+$w.zinc translate other_top 4000
+extractTextAndFrames
+
+
+
+
-- 
cgit v1.1