aboutsummaryrefslogtreecommitdiff
path: root/demos
diff options
context:
space:
mode:
authorlecoanet2003-03-24 12:24:56 +0000
committerlecoanet2003-03-24 12:24:56 +0000
commit0d406ebf18a0fefdbc7df031d3df106b8d204d64 (patch)
tree9d7a2c1dd70b64c2958ab937db4fa978be1571b3 /demos
parent31867b10c11defb596f15ed6567e2e4e1f2bbb93 (diff)
downloadtkzinc-0d406ebf18a0fefdbc7df031d3df106b8d204d64.zip
tkzinc-0d406ebf18a0fefdbc7df031d3df106b8d204d64.tar.gz
tkzinc-0d406ebf18a0fefdbc7df031d3df106b8d204d64.tar.bz2
tkzinc-0d406ebf18a0fefdbc7df031d3df106b8d204d64.tar.xz
Portage depuis perl
Diffstat (limited to 'demos')
-rw-r--r--demos/allOptions.tcl116
-rw-r--r--demos/atomicGroups.tcl187
-rw-r--r--demos/clipping.tcl118
-rw-r--r--demos/colorCircular.tcl47
-rw-r--r--demos/colorX.tcl41
-rw-r--r--demos/colorY.tcl42
-rw-r--r--demos/contours.tcl191
-rw-r--r--demos/curveBezier.tcl199
-rw-r--r--demos/fillRule.tcl97
-rw-r--r--demos/groupsPriority.tcl233
-rw-r--r--demos/items.tcl97
-rw-r--r--demos/labelformat.tcl83
-rw-r--r--demos/lines.tcl51
-rw-r--r--demos/mapinfo.tcl124
-rw-r--r--demos/olditems.tcl285
-rw-r--r--demos/pathTags.tcl268
-rw-r--r--demos/rotation.tcl93
-rw-r--r--demos/simpleInteractionTrack.tcl216
-rw-r--r--demos/textInput.tcl71
-rw-r--r--demos/tkZincLogo.tcl155
-rw-r--r--demos/translation.tcl88
-rw-r--r--demos/triangles.tcl46
-rw-r--r--demos/windowContours.tcl89
-rw-r--r--demos/zoom.tcl108
24 files changed, 3045 insertions, 0 deletions
diff --git a/demos/allOptions.tcl b/demos/allOptions.tcl
new file mode 100644
index 0000000..bc3e4d2
--- /dev/null
+++ b/demos/allOptions.tcl
@@ -0,0 +1,116 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .all_options
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc All Option Demonstration"
+wm iconname $w "All options"
+
+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
+
+# The explanation displayed when running this demo
+label $w.label -text "Click on one of the following\nbuttons to get a list of Item\nattributes (or zinc options)\nwith their types.\n" -justify "left"
+
+pack $w.label -padx 10 -pady 10
+
+
+# Creating the zinc widget
+zinc $w.zinc -width 1 -height 1 -font "10x20" -borderwidth 0 -relief "sunken"
+pack $w.zinc
+
+# Creating an instance of every item type
+#my %itemtypes;
+
+# These Items have fields! So the number of fields must be given at creation time
+foreach type {tabular track waypoint} {
+ set itemtypes($type) [$w.zinc add $type 1 0]
+}
+
+# These items needs no specific initial values
+foreach type {group icon map reticle text window} {
+ set itemtypes($type) [$w.zinc add $type 1]
+}
+
+# These items needs some coordinates at creation time
+# However curves usually needs more than 2 points.
+foreach type {arc curve rectangle} {
+ set itemtypes($type) [$w.zinc add $type 1 "0 0 1 1"]
+}
+
+# Triangles item needs at least 3 points for the coordinates
+foreach type {triangles} {
+ set itemtypes($type) [$w.zinc add $type 1 "0 0 1 1 2 2"]
+}
+
+
+proc showAllOptions { w type} {
+ global itemtypes
+ if [winfo exists .tl] {destroy .tl}
+ toplevel .tl
+ set title "All options of an item $type"
+ #my @option return
+ if {[string compare $type "zinc"]==0} {
+ set options [$w.zinc configure]
+ set typeopt "optionClass"
+ set readopt "defaultValue"
+ set title "All options of zinc widget"
+ } else {
+ set options [$w.zinc itemconfigure $itemtypes($type)];
+ set title "All attributes of an item $type"
+ set typeopt "Type"
+ set readopt "ReadOnly"
+ }
+
+ #.tl configure -title $title
+
+ frame .tl.f1
+ set bgcolor "ivory"
+
+ label .tl.f1.opt -text "Option" -background $bgcolor -relief "ridge" -width 20
+ label .tl.f1.typ -text $typeopt -background $bgcolor -relief "ridge" -width 20
+ label .tl.f1.rd -text $readopt -background $bgcolor -relief "ridge" -width 21
+
+ pack .tl.f1.opt .tl.f1.typ .tl.f1.rd -side left
+ set nbelem [llength $options]
+ frame .tl.f2
+ listbox .tl.f2.l1 -width 20 -height $nbelem
+ listbox .tl.f2.l2 -width 20 -height $nbelem
+ listbox .tl.f2.l3 -width 20 -height $nbelem
+ pack .tl.f2.l1 .tl.f2.l2 .tl.f2.l3 -side left
+ pack .tl.f1 .tl.f2 -side top -anchor "nw"
+
+ # Remplissage des list box
+ foreach elem $options {
+ .tl.f2.l1 insert end [lindex $elem 0]
+ .tl.f2.l2 insert end [lindex $elem 1]
+ .tl.f2.l3 insert end [lindex $elem 3]
+ }
+}
+
+pack [frame $w.col]
+
+set width 0;
+foreach type [lsort [array names itemtypes]] {
+ if {[string length $type] > $width} {
+ set width [string length $type]
+ }
+}
+
+foreach type [lsort [array names itemtypes]] {
+ button $w.col.$type -text "$type" -width $width -command {showAllOptions $w $type}
+ pack $w.col.$type -pady 4
+
+}
+
+button $w.col.b -text "zinc widget options" -command {showAllOptions $w "zinc"}
+pack $w.col.b -pady 4
+
diff --git a/demos/atomicGroups.tcl b/demos/atomicGroups.tcl
new file mode 100644
index 0000000..bc57da0
--- /dev/null
+++ b/demos/atomicGroups.tcl
@@ -0,0 +1,187 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+
+set w .atomic-groups
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Atomicity Demonstration"
+wm iconname $w "Atomic"
+
+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
+
+zinc $w.zinc -width 500 -height 350 -font "10x20" -borderwidth 0
+pack $w.zinc
+
+set groups_group_atomicity 0
+set red_group_atomicity 0
+set green_group_atomicity 0
+
+set display_clipping_item_background 0
+set clip 1
+
+$w.zinc add "text" 1 -font $defaultfont -text "- There are 3 groups: a red group containing 2 redish objects\na green group containing 2 greenish objects,\nand groups_group containing both previous groups.\n- You can make some groups atomic or not by depressing \nthe toggle buttons at the bottom of the window\n- Try and then click on some items to observe that callbacks\n are then different: they modify either the item, or 2 items of\n a group or all items" -anchor "nw" -position "10 10"
+
+
+############### creating the top group with its bindings ###############################
+set groups_group [$w.zinc add group 1 -visible 1 -atomic $groups_group_atomicity -tags groups_group]
+
+# the following callbacks will be called only if "groups_group" IS atomic
+$w.zinc bind $groups_group <1> modify_bitmap_bg
+$w.zinc bind $groups_group <ButtonRelease-1> modify_bitmap_bg
+
+############### creating the red_group, with its binding and its content ################
+# the red_group may be atomic, that is is makes all children as a single object
+# and sensitive to red_group callbacks
+set red_group [$w.zinc add group $groups_group -visible 1 -atomic $red_group_atomicity -sensitive 1 -tags red_group]
+
+# the following callbacks will be called only if "groups_group" IS NOT-atomic
+# and if "red_group" IS atomic
+$w.zinc bind $red_group <1> "modify_item_lines $red_group"
+$w.zinc bind $red_group <ButtonRelease-1> "modify_item_lines $red_group"
+
+
+set rc [$w.zinc add arc $red_group {100 200 140 240} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags red_circle]
+set rr [$w.zinc add rectangle $red_group {300 200 400 250} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags red_rectangle]
+
+# the following callbacks will be called only if "groups_group" IS NOT atomic
+# and if "red_group" IS NOT atomic
+$w.zinc bind $rc <1> toggle_color
+$w.zinc bind $rc <ButtonRelease-1> toggle_color
+$w.zinc bind $rr <1> toggle_color
+$w.zinc bind $rr <ButtonRelease-1> toggle_color
+
+############### creating the green_group, with its binding and its content ################
+# the green_group may be atomic, that is is makes all children as a single object
+# and sensitive to green_group callbacks
+set green_group [$w.zinc add group $groups_group -visible 1 -atomic $green_group_atomicity -sensitive 1 -tags green_group]
+
+# the following callbacks will be called only if "groups_group" IS NOT atomic
+# and if "green_group" IS atomic
+$w.zinc bind $green_group <1> "modify_item_lines $green_group"
+$w.zinc bind $green_group <ButtonRelease-1> "modify_item_lines $green_group"
+
+set gc [$w.zinc add arc $green_group {100 270 140 310} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags green_circle]
+
+set gr [$w.zinc add rectangle $green_group {300 270 400 320} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags green_rectangle]
+# the following callbacks will be called only if "groups_group" IS NOT atomic
+# and if "green_group" IS NOT atomic
+$w.zinc bind $gc <1> toggle_color
+$w.zinc bind $gc <ButtonRelease-1> toggle_color
+$w.zinc bind $gr <1> toggle_color
+$w.zinc bind $gr <ButtonRelease-1> toggle_color
+
+
+
+set current_bg ""
+###################### groups_group callback ##############
+
+proc modify_bitmap_bg {} {
+ global current_bg
+ global rc rr gc gr
+ global w
+ if {$current_bg=="AlphaStipple2"} {
+ set current_bg {}
+ } else {
+ set current_bg AlphaStipple2
+ }
+ foreach item "$rc $rr $gc $gr" {
+ $w.zinc itemconfigure $item -fillpattern $current_bg
+ }
+}
+
+#################### red/green_group callback ##############
+proc modify_item_lines {gr} {
+ global w
+
+ set children [$w.zinc find withtag ".$gr*"]
+ # we are using a pathtag (still undocumented feature of 3.2.6) to get items of an atomic group!
+ # we could also temporary modify the groups (make it un-atomic) to get its child
+
+ set current_linewidth [$w.zinc itemcget [lindex $children 0] -linewidth]
+
+ if {$current_linewidth == 3} {
+ set current_linewidth 0
+ } else {
+ set current_linewidth 3
+ }
+ foreach item $children {
+ $w.zinc itemconfigure $item -linewidth $current_linewidth
+ }
+
+}
+
+
+##################### items callback ######################
+proc toggle_color {} {
+ global w
+ set item [$w.zinc find withtag current]
+ set fillcolor [$w.zinc itemcget $item -fillcolor]
+ regexp {([a-z]+)(\d)} $fillcolor "" color num
+
+ #my ($color $num) = $fillcolor =~ /("a-z"+)(\d)/
+ if {$num == 2} {
+ set val 1
+ set num 4
+ } else {
+ set num 2
+ }
+ $w.zinc itemconfigure $item -fillcolor "$color$num"
+}
+
+proc atomic_or_not {gr} {
+ global w
+ set val [lindex [$w.zinc itemconfigure $gr -atomic] 4]
+ if {$val==1} {
+ $w.zinc itemconfigure $gr -atomic 0
+ } else {
+ $w.zinc itemconfigure $gr -atomic 1
+ }
+ update_found_items
+}
+
+
+###################### toggle buttons at the bottom ####
+frame $w.row
+pack $w.row
+
+checkbutton $w.row.cb -text "groups_group is atomic" -variable groups_group_atomicity -command "atomic_or_not $groups_group"
+pack $w.row.cb -anchor "w"
+
+checkbutton $w.row.cb2 -text "red group is atomic" -foreground red4 -variable red_group_atomicity -command "atomic_or_not $red_group"
+pack $w.row.cb2 -anchor w
+
+checkbutton $w.row.cb3 -text "green group is atomic" -foreground green4 -variable green_group_atomicity -command "atomic_or_not $green_group"
+pack $w.row.cb3 -anchor w
+
+label $w.row.lb
+pack $w.row.lb -anchor w
+
+label $w.row.lb2 -text "Following command $w.zinc find overlapping 0 200 500 400 returns:"
+pack $w.row.lb2 -anchor w
+set label [pack [label $w.row.label -background gray95] -anchor w]
+
+##### to update the list of enclosed items
+proc update_found_items {} {
+ global w
+ set found [$w.zinc find overlapping 0 200 500 400]
+ set str ""
+ foreach item $found {
+ set tags [$w.zinc itemcget $item -tags]
+ set str "$str $tags"
+ }
+ $w.row.label configure -text $str
+}
+
+# to init the list of enclosed items
+update_found_items
diff --git a/demos/clipping.tcl b/demos/clipping.tcl
new file mode 100644
index 0000000..53a357e
--- /dev/null
+++ b/demos/clipping.tcl
@@ -0,0 +1,118 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .clipping
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Clipping Demonstration"
+wm iconname $w "Clipping"
+
+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
+
+
+zinc $w.zinc -width 700 -height 600 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+set display_clipping_item_background 0
+set clip 1
+
+$w.zinc add text 1 -font $defaultfont -text "You can drag and drop the objects.\nThere are two groups of objects a tan group and a blue group\nTry to move them and discover the clipping area which is a curve.\nwith two contours" -anchor nw -position {10 10}
+
+
+set clipped_group [$w.zinc add group 1 -visible 1]
+
+set clipping_item [$w.zinc add curve $clipped_group {10 100 690 100 690 590 520 350 350 590 180 350 10 590} -closed 1 -priority 1 -fillcolor tan2 -linewidth 0 -filled $display_clipping_item_background]
+$w.zinc contour $clipping_item add +1 {200 200 500 200 500 250 200 250}
+
+############### creating the tan_group objects ################
+# the tan_group is atomic that is is makes all children as a single object
+# and sensitive to tan_group callbacks
+set tan_group [$w.zinc add group $clipped_group -visible 1 -atomic 1 -sensitive 1]
+
+
+$w.zinc add arc $tan_group {200 220 280 300} -filled 1 -linewidth 1 -startangle 45 -extent 270 -pieslice 1 -closed 1 -fillcolor tan
+
+
+$w.zinc add curve $tan_group {400 400 440 450 400 500 500 500 460 450 500 400} -filled 1 -fillcolor tan -linecolor tan
+
+
+############### creating the blue_group objects ################
+# the blue_group is atomic too that is is makes all children as a single object
+# and sensitive to blue_group callbacks
+set blue_group [$w.zinc add group $clipped_group -visible 1 -atomic 1 -sensitive 1]
+
+$w.zinc add rectangle $blue_group {570 180 470 280} -filled 1 -linewidth 1 -fillcolor blue2
+
+$w.zinc add curve $blue_group {200 400 200 500 300 500 300 400 300 300} -filled 1 -fillcolor blue -linewidth 0
+
+
+$w.zinc itemconfigure $clipped_group -clip $clipping_item
+
+
+###################### drag and drop callbacks ############
+# for both tan_group and blue_group
+
+$w.zinc bind $tan_group <1> "itemStartDrag $tan_group %x %y"
+$w.zinc bind $tan_group <B1-Motion> "itemDrag $tan_group %x %y"
+$w.zinc bind $blue_group <1> "itemStartDrag $blue_group %x %y"
+$w.zinc bind $blue_group <B1-Motion> "itemDrag $blue_group %x %y"
+
+
+
+# callback for starting a drag
+set x_orig ""
+set y_orig ""
+
+proc itemStartDrag {item x y} {
+ global x_orig y_orig
+ set x_orig $x
+ set y_orig $y
+}
+
+# Callback for moving an item
+proc itemDrag {item x y} {
+ global x_orig y_orig
+ global w
+ $w.zinc translate $item [expr $x-$x_orig] [expr $y-$y_orig];
+ set x_orig $x;
+ set y_orig $y;
+}
+
+
+
+###################### toggle buttons at the bottom #######
+frame $w.row
+pack $w.row
+checkbutton $w.row.show -text "Show clipping item" -variable display_clipping_item_background -command "display_clipping_area"
+checkbutton $w.row.clip -text Clip -variable clip -command "clipcommand "
+pack $w.row.show $w.row.clip
+
+proc display_clipping_area {} {
+ global clipping_item
+ global w
+ global display_clipping_item_background
+ $w.zinc itemconfigure $clipping_item -filled $display_clipping_item_background
+}
+
+proc clipcommand {} {
+ global clip
+ global clipped_group
+ global clipping_item
+ global w
+
+ if {$clip} {
+ $w.zinc itemconfigure $clipped_group -clip $clipping_item
+ } else {
+ $w.zinc itemconfigure $clipped_group -clip ""
+ }
+}
diff --git a/demos/colorCircular.tcl b/demos/colorCircular.tcl
new file mode 100644
index 0000000..bb9b75b
--- /dev/null
+++ b/demos/colorCircular.tcl
@@ -0,0 +1,47 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .color-circular
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Color Circular Demonstration"
+wm iconname $w "Color Circular"
+
+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
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
+zinc $w.zinc -width 700 -height 600 -borderwidth 3 -relief sunken -render 1
+pack $w.zinc
+
+$w.zinc add rectangle 1 {10 10 80 80} -fillcolor {red|blue 50 50} -filled 1
+$w.zinc add text 1 -font $defaultfont -text "Radial variation from non-transparent red to non-transparent blue\nin a squarre. The gradient starts from the lower right corner.\n" -anchor nw -position {120 20}
+$w.zinc add arc 1 {10 110 90 190} -fillcolor {red;40|blue;40 0 25} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "Radial variation from 40%transparent red to 40% transparent blue\nin a disc. The gradient starts in the middle between\nthe center on the bottom point" -anchor nw -position {120 120}
+
+$w.zinc add arc 1 {10 210 90 290} -fillcolor {red;40|green;40 50|blue;40 0 0} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from 40%transparent red to 40% transparent blue.\nthrough a 40%green on the middle of the disc. The gradient is centered." -anchor nw -position {120 220}
+
+$w.zinc add text 1 -font $defaultfont -text "Two overlaping radialy transparently colored items on a white background" -anchor nw -position {20 320}
+
+$w.zinc add rectangle 1 {10 340 690 590} -fillcolor white -filled 1
+
+$w.zinc add rectangle 1 {20 365 220 565} -fillcolor {red;40|green;40 50|blue;40 0 0} -filled 1
+
+$w.zinc add arc 1 {150 365 350 565} -fillcolor {yellow;40|black;40 50|cyan;40 0 0} -filled 1
+
+$w.zinc add arc 1 {280 365 480 565} -fillcolor {black;100|black;100 20|white;40 0 0} -filled 1 -linewidth 0
+
+$w.zinc add arc 1 {480 365 580 500} -fillcolor {black;100|white;40 -10 16} -filled 1
+
+$w.zinc add arc 1 {580 410 680 580} -fillcolor {black;70|white;20 -40 -40} -filled 1
+$w.zinc add arc 1 {580 410 680 580} -fillcolor {black;70|white;20 40 40} -filled 1 \ No newline at end of file
diff --git a/demos/colorX.tcl b/demos/colorX.tcl
new file mode 100644
index 0000000..9fef483
--- /dev/null
+++ b/demos/colorX.tcl
@@ -0,0 +1,41 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .color-x
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Color-x Demonstration"
+wm iconname $w "Color X"
+
+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
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
+zinc $w.zinc -width 700 -height 600 -borderwidth 3 -relief sunken -render 1
+pack $w.zinc
+
+$w.zinc add rectangle 1 {10 10 690 100} -fillcolor {red|blue} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from non transparent red to non transparent blue.\n" -anchor nw -position {20 20}
+
+$w.zinc add rectangle 1 {10 110 690 200} -fillcolor {red;40|blue;40} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from 40%transparent red to 40% transparent blue." -anchor nw -position {20 120}
+
+$w.zinc add rectangle 1 {10 210 690 300} -fillcolor {red;40|green;40 50|blue;40} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from 40%transparent red to 40% transparent blue.\nthrough a 40%green on the middle" -anchor nw -position {20 220}
+
+$w.zinc add text 1 -font $defaultfont -text "Two overlaping transparently colored rectangles on a white background" -anchor nw -position {20 320}
+
+$w.zinc add rectangle 1 {10 340 690 590} -fillcolor white -filled 1
+$w.zinc add rectangle 1 {200 350 500 580} -fillcolor {red;40|green;40 50|blue;40} -filled 1
+
+$w.zinc add rectangle 1 {10 400 690 500} -fillcolor {yellow;40|black;40 50|cyan;40} -filled 1
diff --git a/demos/colorY.tcl b/demos/colorY.tcl
new file mode 100644
index 0000000..016dde1
--- /dev/null
+++ b/demos/colorY.tcl
@@ -0,0 +1,42 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .color-y
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Color-y Demonstration"
+wm iconname $w "Color y"
+
+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
+
+
+set defaultfont -adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*
+zinc $w.zinc -width 700 -height 600 -borderwidth 3 -relief sunken -render 1
+pack $w.zinc
+
+$w.zinc add rectangle 1 {10 10 690 100} -fillcolor {@axial 90|red|blue} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from non transparent red to non transparent blue.\n" -anchor nw -position {20 20}
+
+$w.zinc add rectangle 1 {10 110 690 200} -fillcolor {@axial 90|red;40|blue;40} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from 40%transparent red to 40% transparent blue." -anchor nw -position {20 120}
+
+$w.zinc add rectangle 1 {10 210 690 300} -fillcolor {@axial 90|red;40|green;40 50|blue;40} -filled 1
+
+$w.zinc add text 1 -font $defaultfont -text "A variation from 40%transparent red to 40% transparent blue.\nthrough a 40%green on the middle" -anchor nw -position {20 220}
+
+$w.zinc add text 1 -font $defaultfont -text "Two overlaping transparently colored rectangles on a white background" -anchor nw -position {20 320}
+
+$w.zinc add rectangle 1 {10 340 690 590} -fillcolor white -filled 1
+$w.zinc add rectangle 1 {200 350 500 580} -fillcolor {@axial 90|red;40|green;40 50|blue;40} -filled 1
+
+$w.zinc add rectangle 1 {10 400 690 500} -fillcolor {@axial 90|yellow;40|black;40 50|cyan;40} -filled 1
diff --git a/demos/contours.tcl b/demos/contours.tcl
new file mode 100644
index 0000000..07fa3c3
--- /dev/null
+++ b/demos/contours.tcl
@@ -0,0 +1,191 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .contours
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Curve contours Demonstration"
+wm iconname $w Curve
+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
+
+# The explanation displayed when running this demo
+text $w.text -relief sunken -borderwidth 2 -setgrid true -height 9
+pack $w.text -expand yes -fill both
+
+$w.text insert end "All visibles items are made by combining 2 items using contours:
+ - the firebrick curve1 has been holed using a addhole with a circle,
+ - the lightblue curve2 has been mickey-moused by adding two circles,
+ - the yellow curve3 is the union with a disjoint circle,
+ - the grey curve4 is combined with 7 circles, with positive -fillrule.
+The following operations are possible:
+ - Mouse Button 1 for dragging objects.
+ - Mouse Button 1 for dragging the black handle and
+ modifying the grey curve contour."
+
+# Creating the zinc widget
+zinc $w.zinc -width 600 -height 500 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+
+# Creation of 2 items NOT visible, but used for creating visible
+# curves[1-5] with more than one contours.
+# The center of these 2 items is 200,100
+
+set curve0 [$w.zinc add curve 1 { {300 0} {400 100 c} {300 200} {200 300 c} {100 200} {0 100 c} {100 0} } -closed 1 -visible 0 -filled 1]
+set cercle100 [$w.zinc add arc 1 {130 30 280 180} -visible 0]
+
+
+# cloning curve0 as curve1 and moving it
+set curve1 [$w.zinc clone $curve0 -visible 1 -fillcolor firebrick1]
+# adding a ifference' contour to the curve1
+$w.zinc contour $curve1 add +1 $cercle100
+
+
+# cloning curve0 as curve2 and moving it
+# creating a curve without contour to control contour clockwise/counterclockwise
+set curve2 [$w.zinc add curve 1 {} -closed 1 -filled 1 -visible 1 -fillcolor lightblue2 -fillrule positive]
+$w.zinc contour $curve2 add -1 $curve0
+## why must the flag be -1 and not -1 !?
+
+# adding the left ear of mickey mouse!
+$w.zinc translate $curve2 100 90
+
+# adding the right ear of mickey mouse!
+$w.zinc contour $curve2 add +1 $cercle100
+$w.zinc translate $curve2 -200 0
+
+# adding an 'intersection' contour to the curve2
+$w.zinc contour $curve2 add +1 $cercle100
+# ... translate to make it more visible
+$w.zinc translate $curve2 320 20
+
+# cloning curve0 as curve3 and moving it
+set curve3 [$w.zinc clone $curve0 -visible 1 -fillcolor yellow3]
+$w.zinc translate $curve3 0 290
+
+# adding an nion' contour to the curve3
+$w.zinc contour $curve3 add +1 $cercle100
+# ... translate to make it more visible
+$w.zinc translate $curve3 -130 0
+
+
+
+
+# cloning curve0 as curve4 and moving it slightly
+set curve4 [$w.zinc clone $curve0 -visible 1 -fillcolor grey50 -tags grouped -fillrule positive]
+ # the tag "grouped" is used for both curve4 and
+ # a handle (see just below)
+ # It is used for translating both easily
+
+
+set index 2; ## index of the vertex associated to the handle
+set coord [$w.zinc coords $curve4 0 $index]
+set x [lindex $coord 0]
+set y [lindex $coord 1]
+set handle [$w.zinc add rectangle 1 "[expr $x-5] [expr $y-5] [expr $x+5] [expr $y+5]" -fillcolor black -filled 1 -tags {grouped}]
+
+
+# adding a 'difference' contour to the curve4
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped 110 0
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped -220 0
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped 10 80
+$w.zinc contour $curve4 add -1 $cercle100
+$w.zinc translate grouped 0 -10
+$w.zinc contour $curve4 add +1 $cercle100
+
+$w.zinc translate grouped 200 80
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped -350 0
+$w.zinc contour $curve4 add +1 $cercle100
+
+$w.zinc translate grouped 350 250
+#$zinc->lower(grouped);
+
+# Deleting no more usefull items: curve0 and cercle10:
+$w.zinc remove $curve0 $cercle100
+
+$w.zinc raise $curve1
+
+# adding drag and drop callback to each visible curve!
+foreach item "$curve1 $curve2 $curve3 $curve4" {
+ # Some bindings for dragging the items
+ $w.zinc bind $item <1> "itemStartDrag $item %x %y"
+ $w.zinc bind $item <B1-Motion> "itemDrag $item %x %y"
+ # <ButtonRelease-1> release
+}
+
+# adding drag and drop on curve4 which also moves handle
+$w.zinc bind $curve4 <ButtonPress-1> {press $curve4 motionWithHandle}
+$w.zinc bind $curve4, <ButtonRelease-1> release
+
+# adding drag and drop on handle which also modify curve4
+$w.zinc bind handle <ButtonPress-1> {press $handle moveHandle}
+$w.zinc bind handle <ButtonRelease-1> release
+
+# callback for starting a drag
+set x_orig ""
+set y_orig ""
+
+proc itemStartDrag {item x y} {
+ global x_orig y_orig
+ set x_orig $x
+ set y_orig $y
+}
+
+# Callback for moving an item
+proc itemDrag {item x y} {
+ global x_orig y_orig
+ global w
+ $w.zinc translate $item [expr $x-$x_orig] [expr $y-$y_orig];
+ set x_orig $x;
+ set y_orig $y;
+}
+
+# Callback for moving an item and its handle
+proc motionWithHandle {item} {
+ global x_orig
+ global y_orig
+ set ev [$w.zinc XEvent]
+ set x_orig $ev->x;
+ set y_orig $ev->y;
+
+ set tag [$w.zinc itemcget $item -tags]
+ $w.zinc translate $tag [epxr $x-$x_orig] [expr $y-$y_orig]
+ set x_orig $x;
+ set y_orig $y;
+}
+
+# Callback for moving the handle and modifying curve4
+# this code is far from being generic. Only for demonstrating how we can
+# modify a contour with a unique handle!
+proc moveHandle {handle} {
+ global x_orig
+ global y_orig
+ set ev [$w.zinc XEvent]
+ set x_orig $ev->x;
+ set y_orig $ev->y;
+
+ $w.zinc translate $handle [expr $x-$x_orig] [expr $y-$y_orig];
+
+ set ($vertxX,$vertxY) [$w.zinc coords $curve4 0 $index]
+ $w.zinc coords $curve4 0 $index "[expr $vertxX+($x-$x_orig)] [expr $vertxY+($y-$y_orig)]"
+ set x_orig $x
+ set y_orig $y
+}
+
+
+proc release {} {
+ $w.zinc Tk::bind('<Motion>', '');
+}
diff --git a/demos/curveBezier.tcl b/demos/curveBezier.tcl
new file mode 100644
index 0000000..e8f6671
--- /dev/null
+++ b/demos/curveBezier.tcl
@@ -0,0 +1,199 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+
+set w .curve_bezier
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Curve Bezier Demonstration"
+wm iconname $w Curve
+
+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
+
+
+text $w.text -relief sunken -borderwidth 2 -setgrid true -height 3
+pack $w.text -expand yes -fill both
+
+$w.text insert 0.0 {
+6 examples of curves containing control points are displayed
+ with the list of control points written just below.
+You can move the handles to modify the bezier curves
+}
+
+zinc $w.zinc -width 700 -height 650 -font 9x15 -borderwidth 0 -backcolor white
+pack $w.zinc
+
+
+set group [$w.zinc add group 1]
+
+$w.zinc add text $group -position {50 20} -anchor w -text "Examples of curve items using cubic bezier control points" -color grey20
+
+## Please note: much of the following items below could be computed
+$w.zinc add curve $group {100 200 100 100} -tags {line1 l1-2} -linecolor \#888888 -filled 0 -linewidth 2
+$w.zinc add curve $group {400 100 400 200} -tags {line1 l3-4} -linecolor \#888888 -filled 0 -linewidth 2
+$w.zinc add curve $group {{100 200} {100 100 c} {400 100 c} {400 200}} -tags {bezier1} -closed 0 -linecolor red -linewidth 5
+$w.zinc add arc $group {90 190 110 210} -tags {handle1 p1} -filled 1 -fillcolor \#BBBBBB
+$w.zinc add arc $group {90 90 110 110} -tags {handle1 p2} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
+$w.zinc add arc $group {390 90 410 110} -tags {handle1 p3} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
+$w.zinc add arc $group {390 190 410 210} -tags {handle1 p4} -filled 1 -fillcolor \#BBBBBB
+
+$w.zinc add curve $group {600 200 675 100} -tags {line2 l1-2} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {975 100 900 200} -tags {line2 l3-4} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {{600 200} {675 100 c} {975 100 c} {900 200}} -tags {bezier2} -closed 0 -linecolor red -linewidth 5
+$w.zinc add arc $group {590 190 610 210} -tags {handle2 p1} -filled 1 -linecolor grey80 -linewidth 2
+$w.zinc add arc $group {665 90 685 110} -tags {handle2 p2} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {965 90 985 110} -tags {handle2 p3} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {890 190 910 210} -tags {handle2 p4} -filled 1 -linecolor grey80 -linewidth 2
+
+$w.zinc add curve $group {100 500 25 400} -tags {line3 l1-2} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {475 400 400 500} -tags {line3 l3-4} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {{100 500} {25 400 c} {475 400 c} {400 500}} -tags {bezier3} -closed 0 -linecolor red -linewidth 5
+$w.zinc add arc $group {90 490 110 510} -tags {handle3 p1} -filled 1 -linecolor grey80 -linewidth 2
+$w.zinc add arc $group {15 390 35 410} -tags {handle3 p2} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {465 390 485 410} -tags {handle3 p3} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {390 490 410 510} -tags {handle3 p4} -filled 1 -linecolor grey80 -linewidth 2
+
+#$w.zinc add "text" $group -position {570 570} -anchor w -tags {"bezier4"} -color "grey20"
+$w.zinc add curve $group {600 500 600 350} -tags {line4 l1-2} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {900 650 900 500} -tags {line4 l3-4} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {{600 500} {600 350 c} {900 650 c} {900 500}} -tags {bezier4} -closed 0 -linecolor red -linewidth 5
+$w.zinc add arc $group {590 490 610 510} -tags {handle4 p1} -filled 1 -linecolor grey80 -linewidth 2
+$w.zinc add arc $group {590 340 610 360} -tags {handle4 p2} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {890 640 910 660} -tags {handle4 p3} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {890 490 910 510} -tags {handle4 p4} -filled 1 -linecolor grey80 -linewidth 2
+
+$w.zinc add curve $group {100 800 175 700} -tags {line5 l1-2} -linecolor \#888888 -filled 0 -linewidth 2
+$w.zinc add curve $group {325 700 400 800} -tags {line5 l3-4} -linecolor \#888888 -filled 0 -linewidth 2
+$w.zinc add curve $group {{100 800} {175 700 c} {325 700 c} {400 800}} -tags {bezier5} -closed 0 -linecolor red -linewidth 5
+$w.zinc add arc $group {90 790 110 810} -tags {handle5 p1} -filled 1 -linecolor grey80 -linewidth 2
+$w.zinc add arc $group {165 690 185 710} -tags {handle5 p2} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
+$w.zinc add arc $group {315 690 335 710} -tags {handle5 p3} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
+$w.zinc add arc $group {390 790 410 810} -tags {handle5 p4} -filled 1 -linecolor grey80 -linewidth 2
+
+$w.zinc add curve $group {600 800 625 700} -tags {line6 l1-2} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {725 700 750 800} -tags {line6 l3-4} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {750 800 775 900} -tags {line6 l4-5} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {875 900 900 800} -tags {line6 l6-7} -linecolor \#888888 -linewidth 2
+$w.zinc add curve $group {{600 800} {625 700 c} {725 700 c} {750 800} {775 900 c} {875 900 c} {900 800}} -tags {bezier6} -filled 0 -closed 0 -linecolor red -linewidth 5
+$w.zinc add arc $group {590 790 610 810} -tags {handle6 p1} -filled 1 -linecolor grey80 -linewidth 2
+$w.zinc add arc $group {615 690 635 710} -tags {handle6 p2} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {715 690 735 710} -tags {handle6 p3} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {740 790 760 810} -tags {handle6 p4} -filled 1 -linecolor blue -fillcolor blue -linewidth 2
+$w.zinc add arc $group {766 891 784 909} -tags {handle6 p5} -filled 1 -linecolor grey80 -linewidth 4
+$w.zinc add arc $group {865 890 885 910} -tags {handle6 p6} -filled 1 -linewidth 0 -fillcolor grey80
+$w.zinc add arc $group {890 790 910 810} -tags {handle6 p7} -filled 1 -linecolor grey80 -linewidth 2
+
+$w.zinc add text $group -position {25 980} -anchor w -tags coords -color grey20
+
+
+$w.zinc scale $group 0.6 0.6
+
+## Set the text of the text item with a tag "tag"
+## to a human-readable form of the coords of the
+## corresponding curve with the same tag "tag"
+proc setText {tag} {
+ global w
+ set textItem [$w.zinc find withtype text coords]
+ set curveItem [$w.zinc find withtype curve $tag]
+ set coords [$w.zinc coords $curveItem]
+ set count 0
+ $w.zinc itemconfigure $textItem -text $coords
+}
+
+foreach bezierCount {1 2 3 4 5 6} {
+ set setText "bezier$bezierCount"
+ set curveItem [$w.zinc find withtype curve "bezier$bezierCount"]
+ set coords [$w.zinc coords $curveItem]
+ #puts "$bezierCount : $curveItem : $coords"
+ $w.zinc bind "handle$bezierCount" <1> {itemStartDrag %x %y}
+ $w.zinc bind "handle$bezierCount" <B1-Motion> {itemDrag %x %y}
+ #$w.zinc bind "handle$bezierCount" "<ButtonPress-1>" {\&press \&motion}
+ #$w.zinc bind "handle$bezierCount" "<ButtonRelease-1>" {\&release}
+}
+
+
+
+
+##### bindings for moving the handles
+set item ""
+set bezierNum ""
+set ptNum ""
+
+set x_orig ""
+set y_orig ""
+
+proc itemStartDrag {x y} {
+ global w
+ global x_orig y_orig
+ global bezierNum ptNum
+ global item
+ set x_orig $x
+ set y_orig $y
+ set item [$w.zinc find withtag current]
+
+ foreach val [$w.zinc gettags $item] {
+ regexp {([a-z]+)(\d)} $val "" name num
+ if {$name=="handle"} {set bezierNum $num}
+ if {$name=="p"} {set ptNum $num}
+ }
+ #puts "bezierNum=$bezierNum ptNum=$ptNum"
+}
+
+# Callback for moving an item
+proc itemDrag {x y} {
+ global x_orig y_orig
+ global w
+ global item
+ $w.zinc transform $item "[expr $x-$x_orig] [expr $y-$y_orig]"
+ moveHandle [expr $x-$x_orig] [expr $y-$y_orig]
+ set x_orig $x;
+ set y_orig $y;
+}
+
+
+proc moveHandle {dx dy} {
+ global w
+ global bezierNum
+ global ptNum
+ global item
+ set pt1 [lindex [$w.zinc coords $item] 0]
+ set pt2 [lindex [$w.zinc coords $item] 1]
+
+ ## modifying the handle coords
+ $w.zinc coords $item "[expr [lindex $pt1 0]+$dx] [expr [lindex $pt1 1]+$dy] [expr [lindex $pt2 0]+$dx] [expr [lindex $pt2 1]+$dy]"
+ set prevPtNum [expr $ptNum-1]
+
+ # there should only be one such item!
+ set lineA [$w.zinc find withtag "line$bezierNum && l$prevPtNum-$ptNum"]
+ if {$lineA!=""} {
+ set x [lindex [$w.zinc coords $lineA 0 1] 0]
+ set y [lindex [$w.zinc coords $lineA 0 1] 1]
+ $w.zinc coords $lineA 0 1 "[expr $x+$dx] [expr $y+$dy]"
+ }
+
+ set nextPtNum [expr $ptNum+1]
+ # there should only be one such item:
+ set lineB [$w.zinc find withtag "line$bezierNum && l$ptNum-$nextPtNum"]
+ if {$lineB!=""} {
+ set x [lindex [$w.zinc coords $lineB 0 0] 0]
+ set y [lindex [$w.zinc coords $lineB 0 0] 1]
+ $w.zinc coords $lineB 0 0 "[expr $x+$dx] [expr $y+$dy]"
+ }
+ set tab [$w.zinc coords "bezier$bezierNum" 0 [expr $ptNum-1]]
+ set x [lindex $tab 0]
+ set y [lindex $tab 1]
+ set control [lindex $tab 2]
+ $w.zinc coords "bezier$bezierNum" 0 [expr $ptNum-1] "[expr $x+$dx] [expr $y+$dy] $control"
+ setText "bezier$bezierNum"
+}
+
diff --git a/demos/fillRule.tcl b/demos/fillRule.tcl
new file mode 100644
index 0000000..83c3b94
--- /dev/null
+++ b/demos/fillRule.tcl
@@ -0,0 +1,97 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .fillrule
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Fillrule Demonstration"
+wm iconname $w "Fillrule"
+
+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 file has been largely inspired from figure 11-3
+####### of "The OpenGL Programming Guide 3rd Edition The
+####### Official Guide to Learning OpenGL Version 1.2" ISBN 0201604582
+
+####### it illustrates the use of :
+####### -fillrule attribute of curves
+####### contour coords and clone method
+
+zinc $w.zinc -width 550 -height 630 -font 10x20 -borderwidth 0 -backcolor white
+pack $w.zinc
+
+
+$w.zinc add text 1 -position {20 8} -text {This still static example reproduces figure 11-3
+ of "The OpenGL Programming Guide 3rd Edition" V 1.2}
+
+set group [$w.zinc add group 1]
+
+set g1 [$w.zinc add group $group]
+set curve1 [$w.zinc add curve $g1 {}]
+$w.zinc contour $curve1 add +1 { 0 0 0 120 120 120 120 0 0 0}
+$w.zinc contour $curve1 add +1 { 20 20 20 100 100 100 100 20 20 20}
+$w.zinc contour $curve1 add +1 { 40 40 40 80 80 80 80 40 40 40}
+$w.zinc translate $g1 40 40
+
+
+set g2 [$w.zinc add group $group]
+set curve2 [$w.zinc add curve $g2 {}]
+$w.zinc contour $curve2 add +1 { 0 0 0 120 120 120 120 0 0 0}
+$w.zinc contour $curve2 add -1 { 20 20 20 100 100 100 100 20 20 20}
+$w.zinc contour $curve2 add -1 { 40 40 40 80 80 80 80 40 40 40}
+$w.zinc translate $g2 200 40
+
+
+set g3 [$w.zinc add group $group]
+set curve3 [$w.zinc add curve $g3 {}]
+$w.zinc contour $curve3 add +1 { 20 0 20 120 100 120 100 0 20 0}
+$w.zinc contour $curve3 add +1 { 40 20 60 120 80 20 40 20}
+$w.zinc contour $curve3 add +1 { 0 60 0 80 120 80 120 60 0 60}
+$w.zinc translate $g3 360 40
+
+set g4 [$w.zinc add group $group]
+set curve4 [$w.zinc add curve $g4 {}]
+$w.zinc contour $curve4 add +1 { 0 0 0 140 140 140 140 60 60 60 60 80 80 80 80 40 40 40 40 100 100 100 100 20 20 20 20 120 120 120 120 0 0 0}
+$w.zinc translate $g4 520 40
+
+$w.zinc scale $group 0.6 0.6
+$w.zinc translate $group 80 20
+
+$w.zinc add text $group -position {-110 40} -text "contours\nand\nwinding\nnumbers"
+$w.zinc add text $group -position {-110 170} -text "winding\nrules"
+set dy 0
+foreach fillrule {odd nonzero positive negative abs_geq_2} {
+ set dy [expr $dy + 160]
+ $w.zinc add text $group -position "-110 [expr 100+$dy]" -text $fillrule
+ foreach item "$curve1 $curve2 $curve3 $curve4" {
+ set clone [$w.zinc clone $item -fillrule $fillrule -filled 1]
+ $w.zinc translate $clone 0 $dy
+ }
+}
+
+# creating simple lines with arrows under each curves
+foreach item "$curve1 $curve2 $curve3 $curve4" {
+ set contour_number [$w.zinc contour $item]
+ #puts "$item contour_number=$contour_number\n"
+ for {set n 0} {$n <=[expr $contour_number-1]} {incr n} {
+ set points [$w.zinc coords $item $n]
+ set nbpoints [llength $points]
+ for {set i 0} {$i <=[expr $nbpoints-2]} {incr i} {
+ set firstpoint [lindex $points $i]
+ set lastpoint [lindex $points [expr $i+1]]
+ set middlepoint "[expr [lindex $firstpoint 0]+([lindex $lastpoint 0]- [lindex $firstpoint 0])/1.5] [expr [lindex $firstpoint 1]+([lindex $lastpoint 1]-[lindex $firstpoint 1])/1.5]"
+ $w.zinc add curve [$w.zinc group $item] "$firstpoint $middlepoint" -lastend "7 10 4"
+ }
+ }
+}
diff --git a/demos/groupsPriority.tcl b/demos/groupsPriority.tcl
new file mode 100644
index 0000000..eaef4c8
--- /dev/null
+++ b/demos/groupsPriority.tcl
@@ -0,0 +1,233 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+
+set w .groups_priority
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Groups priority Demonstration"
+wm iconname $w Groups
+
+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
+
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 12
+pack $w.text -expand yes -fill both
+
+$w.text insert end "There are two groups (a red one and a green one) each containing\n4 rectangles. Those rectangles display their current priority.\nThe following operations are possible:\n Mouse Button 1 for dragging objects.\n Mouse Button 2 for dragging a colored group.\n Key + on a rectangle to raise it inside its group.\n Key - on a rectangle to lower it inside its group.\n Key l on a rectangle to lower its colored group.\n Key r on a rectangle to raise its colored group.\n Key t on a rectangle to change its group (but not its color!).\n Key 0-9 on a rectangle to set the priority to 0-9\nRaising or lowering an item inside a group modify its priority if necessary"
+
+###########################################
+# Zinc
+###########################################
+set zinc_width 600
+set zinc_height 500
+zinc $w.zinc -width $zinc_width -height $zinc_height -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+#########################################################################"
+# Creating the redish group
+set group1 [$w.zinc add group 1 -visible 1]
+
+set counter 0
+# Adding 4 rectangles with text to redish group
+foreach data { {200 100 red} {210 210 red1} {390 110 red2} {395 215 red3} } {
+ set counter [expr $counter+ 2]
+ set centerx [lindex $data 0]
+ set centery [lindex $data 1]
+ set color [lindex $data 2]
+
+ # this small group is for merging together :
+ # the rectangle and the text showing its name
+ set g [$w.zinc add group $group1 -visible 1 -atomic 1 -sensitive 1 -priority $counter]
+ set rec [$w.zinc add rectangle $g "[expr $centerx-100] [expr $centery-60] [expr $centerx+100] [expr $centery+60]" -fillcolor $color -filled 1]
+
+ set txt [$w.zinc add "text" $g -position "$centerx $centery" -text "pri=$counter" -anchor center]
+
+ # Some bindings for dragging the rectangle or the full group
+ $w.zinc bind $g <1> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B1-Motion> "itemDrag $g %x %y"
+ $w.zinc bind $g <2> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B2-Motion> "groupDrag $g %x %y"
+}
+
+#########################################################################"
+# Creating the greenish group
+set group2 [$w.zinc add group 1 -visible 1]
+set counter 0
+
+# Adding 4 rectangles with text to greenish group
+foreach data {{200 300 green1} {210 410 green2} {390 310 green3} {395 415 green4}} {
+ incr counter
+ set centerx [lindex $data 0]
+ set centery [lindex $data 1]
+ set color [lindex $data 2]
+
+ # this small group is for merging together a rectangle
+ # and the text showing its priority
+ set g [$w.zinc add group $group2 -atomic 1 -sensitive 1 -priority $counter]
+
+ set rec [$w.zinc add rectangle $g "[expr $centerx-100] [expr $centery-60] [expr $centerx+100] [expr $centery+60]" -fillcolor $color -filled 1]
+
+ set txt [$w.zinc add text $g -position "$centerx $centery" -text "pri=$counter" -anchor center]
+
+ # Some bindings for dragging the rectangle or the full group
+ $w.zinc bind $g <1> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B1-Motion> "itemDrag $g %x %y"
+ $w.zinc bind $g <2> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B2-Motion> "groupDrag $g %x %y"
+}
+
+
+#########################################################################"
+# adding the key bindings
+
+# the focus on the widget is ABSOLUTELY necessary for key bindings!
+focus $w.zinc
+
+bind $w.zinc <KeyPress-r> raiseGroup
+bind $w.zinc <KeyPress-l> lowerGroup
+bind $w.zinc <KeyPress-plus> raise
+
+bind $w.zinc <KP_Add> raise
+bind $w.zinc <KeyPress-minus> lower
+bind $w.zinc <KP_Subtract> lower
+bind $w.zinc <KeyPress-t> toggleItemGroup
+
+for {set i 0} {$i<=9} {incr i} {
+ bind $w.zinc <KeyPress-$i> "setPriorrity $i"
+ bind $w.zinc <KeyPress-KP_$i> "setPriorrity $i"
+}
+
+# The following binding is currently not possible only text items
+# with focus can get a KeyPress or KeyRelease event
+# $zinc->bind($g '<KeyPress>' [\&raise $g]
+
+####################################withtype#####################################"
+# Definition of all callbacks
+
+
+proc updateLabel {group} {
+ global w
+ set priority [$w.zinc itemcget $group -priority]
+ # we get the text item from this group:
+ set textitem [$w.zinc find withtype text ".$group."]
+ $w.zinc itemconfigure $textitem -text "pri=$priority"
+}
+
+proc setPriorrity {priority} {
+ global w
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ $w.zinc itemconfigure $item -priority $priority
+ updateLabel $item
+}
+
+
+# Callback to lower a small group of a rectangle and a text
+proc lower {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ $w.zinc lower $item
+ updateLabel $item
+}
+
+
+# Callback to raise a small group of a rectangle and a text
+proc raise {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ $w.zinc raise $item
+ updateLabel $item
+}
+
+# Callback to raise the group of groups of a rectangle and a text
+proc lowerGroup {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ set coloredGroup [$w.zinc group $item]
+ $w.zinc lower $coloredGroup
+}
+
+# Callback to raise the group of groups of a rectangle and a text
+proc raiseGroup {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ set coloredGroup [$w.zinc group $item]
+ $w.zinc raise $coloredGroup
+ updateLabel $item
+}
+
+# Callback to change puts raise
+#the group of groups of a rectangle and a text
+proc toggleItemGroup {} {
+ global group1
+ global group2
+ global w
+
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+
+ # return unless $item
+ set newgroup ""
+ if {$group1 == [$w.zinc group $item]} {
+ set newgroup $group2
+ } else {
+ set newgroup $group1
+ }
+ $w.zinc chggroup $item $newgroup 1
+ updateLabel $item
+}
+
+# callback for starting a drag
+set x_orig ""
+set y_orig ""
+
+proc itemStartDrag {item x y} {
+ global x_orig y_orig
+ set x_orig $x
+ set y_orig $y
+}
+
+# Callback for moving an item
+proc itemDrag {item x y} {
+ global x_orig y_orig
+ global w
+ $w.zinc translate $item [expr $x-$x_orig] [expr $y-$y_orig];
+ set x_orig $x;
+ set y_orig $y;
+}
+
+# Callback for moving an item
+proc groupDrag {item x y} {
+ global x_orig y_orig
+ global w
+ set coloredGroup [$w.zinc group $item]
+ $w.zinc translate $coloredGroup [expr $x-$x_orig] [expr $y-$y_orig];
+ set x_orig $x;
+ set y_orig $y;
+}
+
+
+
diff --git a/demos/items.tcl b/demos/items.tcl
new file mode 100644
index 0000000..0f18218
--- /dev/null
+++ b/demos/items.tcl
@@ -0,0 +1,97 @@
+# $Id$
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .items
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Item Demonstration"
+wm iconname $w Items
+
+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
+
+zinc $w.zinc -width 700 -height 600 -font 10x20 -borderwidth 3 -relief sunken
+
+pack $w.zinc
+
+$w.zinc add rectangle 1 {10 10 100 50} -fillcolor green -filled 1 -linewidth 10 -relief roundridge -linecolor darkgreen
+
+
+$w.zinc add text 1 -font $defaultfont -text "A filled rectangle with a \"roundridge\" relief border of 10 pixels." -anchor nw -position {120 20}
+
+
+set labelformat {x82x60+0+0 x60a0^0^0 x32a0^0>1 a0a0>2>1 x32a0>3>1 a0a0^0>2};
+
+set x 20;
+set y 120;
+set track [$w.zinc add track 1 6 -labelformat $labelformat -position "$x $y" -speedvector {40 -10} -speedvectormark 1 -speedvectorticks 1]
+
+# moving the track, to display past positions
+for {set i 0} {$i<=5} {incr i} {
+ set x1 [expr $x+$i*10]
+ set y1 [expr $y-$i*2]
+ $w.zinc coords "$track" "$x1 $y1"
+}
+
+$w.zinc add text 1 -font $defaultfont -text "A flight track for a radar display. (A waypoint looks similar,\nbut has no speedvector neither past positions)" -anchor nw -position {200 80}
+
+$w.zinc itemconfigure $track 0 -filled 0 -bordercolor DarkGreen -border contour
+
+$w.zinc itemconfigure $track 1 -filled 1 -backcolor gray60 -text AFR001
+$w.zinc itemconfigure $track 2 -filled 0 -backcolor gray65 -text 360
+$w.zinc itemconfigure $track 3 -filled 0 -backcolor gray65 -text /
+$w.zinc itemconfigure $track 4 -filled 0 -backcolor gray65 -text 410
+$w.zinc itemconfigure $track 5 -filled 0 -backcolor gray65 -text Beacon
+
+
+$w.zinc add arc 1 {150 140 450 240} -fillcolor gray20 -filled 0 -linewidth 1 -startangle 45 -extent 270
+$w.zinc add arc 1 {260 150 340 230} -fillcolor gray20 -filled 0 -linewidth 1 -startangle 45 -extent 270 -pieslice 1 -closed 1 -linestyle mixed -linewidth 3
+
+$w.zinc add text 1 -font $defaultfont -text "Two arcs, starting at 45° with an extent of 270°." -anchor nw -position {320 180}
+
+
+$w.zinc add curve 1 {10 324 24 300 45 432 247 356 128 401} -filled 0 -relief roundgroove
+# -linewidth 10, ## BUG with zinc 3.2.3g
+
+$w.zinc add text 1 -font $defaultfont -text "An open curve." -anchor nw -position {50 350}
+
+$w.zinc add text 1 -font $defaultfont -text "A waypoint" -anchor nw -position {10 480}
+
+set waypoint [$w.zinc add waypoint 1 6 -position {100 520} -labelformat $labelformat -symbol AtcSymbol2 -labeldistance 30]
+
+for {set fieldId 1} {$fieldId<=5} {incr fieldId} {
+ $w.zinc itemconfigure $waypoint $fieldId -filled 0 -bordercolor DarkGreen -border contour -text "field$fieldId"
+}
+
+
+$w.zinc add text 1 -font $defaultfont -text "3 tabulars of 2 fields,\nattached together." -anchor nw -position {510 380}
+
+set labelformat2 {x72x40 x72a0^0^0 x34a0^0>1}
+
+set tabular1 [$w.zinc add tabular 1 6 -position {570 250} -labelformat $labelformat2]
+set tabular2 [$w.zinc add tabular 1 6 -connecteditem $tabular1 -labelformat $labelformat2]
+set tabular3 [$w.zinc add tabular 1 6 -connecteditem $tabular2 -labelformat $labelformat2]
+
+set count 1
+
+foreach tab "$tabular1 $tabular2 $tabular3" {
+ $w.zinc itemconfigure $tab 1 -filled 0 -bordercolor DarkGreen -border "contour" -text tabular
+ $w.zinc itemconfigure $tab 2 -filled 0 -bordercolor DarkGreen -border "contour" -text "n°$count"
+ incr count
+}
+
+
+$w.zinc add reticle 1 -position {530 550} -firstradius 20 -numcircles 6 -period 2 -stepsize 20 -brightlinestyle dashed -brightlinecolor darkred
+
+$w.zinc add text 1 -font $defaultfont -text "a reticle of 6 circles." -anchor nw -position {530 540}
+
+$w.zinc add text 1 -font $defaultfont -text "maps, triangles and groups items\nare not demonstrated here." -anchor nw -position {10 550}
diff --git a/demos/labelformat.tcl b/demos/labelformat.tcl
new file mode 100644
index 0000000..9584d3c
--- /dev/null
+++ b/demos/labelformat.tcl
@@ -0,0 +1,83 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .label
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Label Format Demonstration"
+wm iconname $w Label
+
+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
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 4
+pack $w.text -expand yes -fill both
+
+$w.text insert end "This toy-appli demonstrates the use of labelformat for tabular items.\nThe fieldPos (please, refer to the labelformat type description\nin the Zinc reference manual) of each field as described in\nthe labelformat is displayed inside the field."
+
+
+###########################################
+# Zinc
+##########################################
+zinc $w.zinc -width 600 -height 500 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+### this function displays in each field, the corresponding <fieldPos>
+### part of the labelformat
+proc setLabelContent {item labelformat} {
+ global w
+ set i 0
+ puts "Label: $item: $labelformat"
+ foreach fieldSpec $labelformat {
+ set posSpec $i
+ puts ":$i:$fieldSpec:"
+ regexp {^.\d+.\d+(.*)} $fieldSpec "" posSpec
+ $w.zinc itemconfigure $item $i -text "$i: $posSpec" -border "contour"
+ incr i
+ }
+}
+
+###########################################
+# Tabulars
+###########################################
+
+### first labelformat and tabular
+set labelformat1 {x100x20+0+0 x100x20+100+0 x100x20+0+20 x100x20+100+20 x100x20+50+55}
+
+set tabular1 [$w.zinc add tabular 1 5 -position {10 10} -labelformat $labelformat1]
+
+setLabelContent $tabular1 $labelformat1
+
+$w.zinc add text 1 -position {10 100} -text "All fields positions\nare given in pixels"
+
+
+### second labelformat and tabular
+set labelformat2 {x110x20+100+30 x80x20<0<0 x80x20<0>0 x80x20>0>0 x80x20>0<0}
+
+set tabular2 [$w.zinc add tabular 1 5 -position {270 10} -labelformat $labelformat2]
+setLabelContent $tabular2 $labelformat2
+
+$w.zinc add text 1 -position {260 100} -text "All fields positions are given\nrelatively to field 0.\nThey are either on the left/right\nand up/down the field 0."
+
+
+### third labelformat and tabular
+set labelformat3 {x200x70+100+70 x80x26^0<0 x80x26^0>0 x80x29$0$0 x80x32$0^0 x90x20<1^1 x90x20<2$2 x90x20^4<4 x90x20^3>3}
+
+set tabular3 [$w.zinc add tabular 1 9 -position {150 180} -labelformat $labelformat3]
+
+setLabelContent $tabular3 $labelformat3
+
+$w.zinc add text 1 -position {40 360} -text "Fields 1-4 are positionned relatively to field 0.\nField 5 is positionned relatively to field 1\nField 6 is positionned relatively to field 2..."
diff --git a/demos/lines.tcl b/demos/lines.tcl
new file mode 100644
index 0000000..dab5f0a
--- /dev/null
+++ b/demos/lines.tcl
@@ -0,0 +1,51 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .lines
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Lines Demonstration"
+wm iconname $w Lines
+
+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
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
+zinc $w.zinc -width 700 -height 600 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+$w.zinc add text 1 -font $defaultfont -text "A set of lines with different styles of lines and termination\nNB: some attributes such as line styles are not necessarily\navailable with an openGL rendering system" -anchor nw -position {20 20}
+
+$w.zinc add curve 1 {20 100 320 100}
+$w.zinc add curve 1 {20 120 320 120} -linewidth 20
+
+$w.zinc add curve 1 {20 160 320 160} -linewidth 20 -capstyle butt
+
+$w.zinc add curve 1 {20 200 320 200} -linewidth 20 -capstyle projecting
+
+$w.zinc add curve 1 {20 240 320 240} -linewidth 20 -linepattern AlphaStipple7 -linecolor red
+
+
+# right column
+$w.zinc add curve 1 {340 100 680 100} -firstend {10 10 10} -lastend {10 25 45}
+
+$w.zinc add curve 1 {340 140 680 140} -linewidth 2 -linestyle dashed
+
+$w.zinc add curve 1 {340 180 680 180} -linewidth 4 -linestyle mixed
+
+$w.zinc add curve 1 {340 220 680 220} -linewidth 2 -linestyle dotted
+
+
+$w.zinc add curve 1 {20 300 140 360 320 300 180 260} -closed 1 -filled 1 -fillpattern "" -fillcolor grey60 -linecolor red -marker AtcSymbol7 -markercolor blue
+
+
+$w.zinc add curve 1 {340 300 440 360 620 300 480 260} -closed 1 -linewidth 10 -joinstyle miter -linecolor red
+
+$w.zinc add curve 1 {400 300 440 330 560 300 480 280} -closed 1 -linewidth 10 -joinstyle round -tile "" -fillcolor grey60 -filled 1 -linecolor red
diff --git a/demos/mapinfo.tcl b/demos/mapinfo.tcl
new file mode 100644
index 0000000..02189e1
--- /dev/null
+++ b/demos/mapinfo.tcl
@@ -0,0 +1,124 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .mapinfo
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Mapinfo Demonstration"
+wm iconname $w Mapinfo
+
+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
+
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 4
+pack $w.text -expand yes -fill both
+
+$w.text insert end "This toy-appli shows zoom actions on map item.\nThe following operations are possible:\n Click - to zoom out\n Click + to zoom in "
+
+###########################################
+# Zinc
+###########################################
+set zinc_width 600
+set zinc_height 500
+zinc $w.zinc -width $zinc_width -height $zinc_height -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+###########################################
+# Waypoints and sector
+###########################################
+
+mapinfo mapinfo create
+#creation of mapinfo
+
+#--------------------------------
+# Waypoints
+#--------------------------------
+mapinfo mapinfo add symbol 200 100 0
+mapinfo mapinfo add symbol 300 150 0
+mapinfo mapinfo add symbol 400 50 0
+mapinfo mapinfo add symbol 350 450 0
+mapinfo mapinfo add symbol 300 250 0
+mapinfo mapinfo add symbol 170 240 0
+mapinfo mapinfo add symbol 550 200 0
+
+#--------------------------------
+# Waypoints names
+#--------------------------------
+mapinfo mapinfo add text normal simple 170 100 DO
+mapinfo mapinfo add text normal simple 270 160 RE
+mapinfo mapinfo add text normal simple 410 50 MI
+mapinfo mapinfo add text normal simple 345 470 FA
+mapinfo mapinfo add text normal simple 280 265 SOL
+mapinfo mapinfo add text normal simple 150 240 LA
+mapinfo mapinfo add text normal simple 555 200 SI
+
+#--------------------------------
+# Routes
+#--------------------------------
+
+mapinfo mapinfo add line simple 1 200 100 300 150
+mapinfo mapinfo add line simple 1 300 150 400 50
+mapinfo mapinfo add line simple 1 300 150 350 450
+mapinfo mapinfo add line simple 1 300 250 170 240
+mapinfo mapinfo add line simple 1 300 250 550 200
+
+#--------------------------------
+# Sectors
+#---------------------------------
+mapinfo mapinfo add line simple 1 300 0 400 50
+mapinfo mapinfo add line simple 1 400 50 500 100
+mapinfo mapinfo add line simple 1 500 100 550 200
+mapinfo mapinfo add line simple 1 550 200 550 400
+mapinfo mapinfo add line simple 1 550 400 350 450
+mapinfo mapinfo add line simple 1 350 450 170 240
+mapinfo mapinfo add line simple 1 170 240 200 100
+mapinfo mapinfo add line simple 1 200 100 300 0
+
+#--------------------------------
+# Sectors
+#---------------------------------
+set gpe [$w.zinc add group 1]
+set map [$w.zinc add map $gpe -mapinfo mapinfo -symbols AtcSymbol15]
+
+
+###################################################
+# control panel
+###################################################
+frame $w.rc
+pack $w.rc
+
+#the reference of the scale function is top-left corner of the zinc object
+#so we first translate the group to zoom in order to put its center on top-left corner
+#change the scale of the group
+#translate the group to put it back at the center of the zinc object
+
+
+button $w.rc.minus -width 2 -height 2 -text {-} -command {
+ $w.zinc translate $gpe [expr -$zinc_width/2] [expr -$zinc_height/2]
+ $w.zinc scale $gpe 0.8 0.8
+ $w.zinc translate $gpe [expr $zinc_width/2] [expr $zinc_height/2]
+}
+pack $w.rc.minus -side left
+
+button $w.rc.plus -width 2 -height 2 -text {+} -command {
+ $w.zinc translate $gpe [expr -$zinc_width/2] [expr -$zinc_height/2]
+ $w.zinc scale $gpe 1.2 1.2
+ $w.zinc translate $gpe [expr $zinc_width/2] [expr $zinc_height/2]
+}
+pack $w.rc.plus -side right
+
+
diff --git a/demos/olditems.tcl b/demos/olditems.tcl
new file mode 100644
index 0000000..dac62ed
--- /dev/null
+++ b/demos/olditems.tcl
@@ -0,0 +1,285 @@
+# items.tcl --
+#
+# This demonstration script creates a canvas that displays the
+# canvas item types.
+#
+# RCS: @(#) $Id$
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .items
+catch {destroy $w}
+toplevel $w
+wm title $w "Canvas Item Demonstration"
+wm iconname $w Items
+positionWindow $w
+set c $w.frame.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
+pack $w.msg -side top
+
+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
+
+frame $w.frame
+pack $w.frame -side top -fill both -expand yes
+
+canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \
+ -relief sunken -borderwidth 2 \
+ -xscrollcommand "$w.frame.hscroll set" \
+ -yscrollcommand "$w.frame.vscroll set"
+scrollbar $w.frame.vscroll -command "$c yview"
+scrollbar $w.frame.hscroll -orient horiz -command "$c xview"
+
+grid $c -in $w.frame \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.vscroll \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.hscroll \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $w.frame 0 -weight 1 -minsize 0
+grid columnconfig $w.frame 0 -weight 1 -minsize 0
+
+# Display a 3x3 rectangular grid.
+
+$c create rect 0c 0c 30c 24c -width 2
+$c create line 0c 8c 30c 8c -width 2
+$c create line 0c 16c 30c 16c -width 2
+$c create line 10c 0c 10c 24c -width 2
+$c create line 20c 0c 20c 24c -width 2
+
+set font1 {Helvetica 12}
+set font2 {Helvetica 24 bold}
+if {[winfo depth $c] > 1} {
+ set blue DeepSkyBlue3
+ set red red
+ set bisque bisque3
+ set green SeaGreen3
+} else {
+ set blue black
+ set red black
+ set bisque black
+ set green black
+}
+
+# Set up demos within each of the areas of the grid.
+
+$c create text 5c .2c -text Lines -anchor n
+$c create line 1c 1c 3c 1c 1c 4c 3c 4c -width 2m -fill $blue \
+ -cap butt -join miter -tags item
+$c create line 4.67c 1c 4.67c 4c -arrow last -tags item
+$c create line 6.33c 1c 6.33c 4c -arrow both -tags item
+$c create line 5c 6c 9c 6c 9c 1c 8c 1c 8c 4.8c 8.8c 4.8c 8.8c 1.2c \
+ 8.2c 1.2c 8.2c 4.6c 8.6c 4.6c 8.6c 1.4c 8.4c 1.4c 8.4c 4.4c \
+ -width 3 -fill $red -tags item
+$c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -arrow both -arrowshape {15 15 7} -tags item
+$c create line 1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c \
+ -cap round -join round -tags item
+
+$c create text 15c .2c -text "Curves (smoothed lines)" -anchor n
+$c create line 11c 4c 11.5c 1c 13.5c 1c 14c 4c -smooth on \
+ -fill $blue -tags item
+$c create line 15.5c 1c 19.5c 1.5c 15.5c 4.5c 19.5c 4c -smooth on \
+ -arrow both -width 3 -tags item
+$c create line 12c 6c 13.5c 4.5c 16.5c 7.5c 18c 6c \
+ 16.5c 4.5c 13.5c 7.5c 12c 6c -smooth on -width 3m -cap round \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $red -tags item
+
+$c create text 25c .2c -text Polygons -anchor n
+$c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \
+ 24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green \
+ -outline black -width 4 -tags item
+$c create polygon 25c 4c 25c 4c 25c 1c 26c 1c 27c 4c 28c 1c \
+ 29c 1c 29c 4c 29c 4c -fill $red -smooth on -tags item
+$c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \
+ 28c 5.25c 24c 5.25c 24c 6.0c 26c 6c 26c 7.5c 22c 7.5c \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -outline black -tags item
+
+$c create text 5c 8.2c -text Rectangles -anchor n
+$c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item
+$c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item
+$c create rectangle 6c 10c 9c 15c -outline {} \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $blue -tags item
+
+$c create text 15c 8.2c -text Ovals -anchor n
+$c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item
+$c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item
+$c create oval 16c 10c 19c 15c -outline {} \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $blue -tags item
+
+$c create text 25c 8.2c -text Text -anchor n
+$c create rectangle 22.4c 8.9c 22.6c 9.1c
+$c create text 22.5c 9c -anchor n -font $font1 -width 4c \
+ -text "A short string of text, word-wrapped, justified left, and anchored north (at the top). The rectangles show the anchor points for each piece of text." -tags item
+$c create rectangle 25.4c 10.9c 25.6c 11.1c
+$c create text 25.5c 11c -anchor w -font $font1 -fill $blue \
+ -text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \
+ -justify center -tags item
+$c create rectangle 24.9c 13.9c 25.1c 14.1c
+$c create text 25c 14c -font $font2 -anchor c -fill $red -stipple gray50 \
+ -text "Stippled characters" -tags item
+
+$c create text 5c 16.2c -text Arcs -anchor n
+$c create arc 0.5c 17c 7c 20c -fill $green -outline black \
+ -start 45 -extent 270 -style pieslice -tags item
+$c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \
+ -outline $blue -start -135 -extent 270 -tags item \
+ -outlinestipple @[file join $tk_library demos images gray25.bmp]
+$c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \
+ -fill {} -outline $red -start 225 -extent -90 -tags item
+$c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \
+ -fill $blue -outline {} -start 45 -extent 270 -tags item
+
+$c create text 15c 16.2c -text Bitmaps -anchor n
+$c create bitmap 13c 20c -tags item \
+ -bitmap @[file join $tk_library demos images face.bmp]
+$c create bitmap 17c 18.5c -tags item \
+ -bitmap @[file join $tk_library demos images noletter.bmp]
+$c create bitmap 17c 21.5c -tags item \
+ -bitmap @[file join $tk_library demos images letters.bmp]
+
+$c create text 25c 16.2c -text Windows -anchor n
+button $c.button -text "Press Me" -command "butPress $c $red"
+$c create window 21c 18c -window $c.button -anchor nw -tags item
+entry $c.entry -width 20 -relief sunken
+$c.entry insert end "Edit this text"
+$c create window 21c 21c -window $c.entry -anchor nw -tags item
+scale $c.scale -from 0 -to 100 -length 6c -sliderlength .4c \
+ -width .5c -tickinterval 0
+$c create window 28.5c 17.5c -window $c.scale -anchor n -tags item
+$c create text 21c 17.9c -text Button: -anchor sw
+$c create text 21c 20.9c -text Entry: -anchor sw
+$c create text 28.5c 17.4c -text Scale: -anchor s
+
+# Set up event bindings for canvas:
+
+$c bind item <Any-Enter> "itemEnter $c"
+$c bind item <Any-Leave> "itemLeave $c"
+bind $c <2> "$c scan mark %x %y"
+bind $c <B2-Motion> "$c scan dragto %x %y"
+bind $c <3> "itemMark $c %x %y"
+bind $c <B3-Motion> "itemStroke $c %x %y"
+bind $c <Control-f> "itemsUnderArea $c"
+bind $c <1> "itemStartDrag $c %x %y"
+bind $c <B1-Motion> "itemDrag $c %x %y"
+
+# Utility procedures for highlighting the item under the pointer:
+
+proc itemEnter {c} {
+ global restoreCmd
+
+ if {[winfo depth $c] == 1} {
+ set restoreCmd {}
+ return
+ }
+ set type [$c type current]
+ if {$type == "window"} {
+ set restoreCmd {}
+ return
+ }
+ if {$type == "bitmap"} {
+ set bg [lindex [$c itemconf current -background] 4]
+ set restoreCmd [list $c itemconfig current -background $bg]
+ $c itemconfig current -background SteelBlue2
+ return
+ }
+ set fill [lindex [$c itemconfig current -fill] 4]
+ if {(($type == "rectangle") || ($type == "oval") || ($type == "arc"))
+ && ($fill == "")} {
+ set outline [lindex [$c itemconfig current -outline] 4]
+ set restoreCmd "$c itemconfig current -outline $outline"
+ $c itemconfig current -outline SteelBlue2
+ } else {
+ set restoreCmd "$c itemconfig current -fill $fill"
+ $c itemconfig current -fill SteelBlue2
+ }
+}
+
+proc itemLeave {c} {
+ global restoreCmd
+
+ eval $restoreCmd
+}
+
+# Utility procedures for stroking out a rectangle and printing what's
+# underneath the rectangle's area.
+
+proc itemMark {c x y} {
+ global areaX1 areaY1
+ set areaX1 [$c canvasx $x]
+ set areaY1 [$c canvasy $y]
+ $c delete area
+}
+
+proc itemStroke {c x y} {
+ global areaX1 areaY1 areaX2 areaY2
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ if {($areaX1 != $x) && ($areaY1 != $y)} {
+ $c delete area
+ $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \
+ -outline black]
+ set areaX2 $x
+ set areaY2 $y
+ }
+}
+
+proc itemsUnderArea {c} {
+ global areaX1 areaY1 areaX2 areaY2
+ set area [$c find withtag area]
+ set items ""
+ foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] {
+ if {[lsearch [$c gettags $i] item] != -1} {
+ lappend items $i
+ }
+ }
+ puts stdout "Items enclosed by area: $items"
+ set items ""
+ foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
+ if {[lsearch [$c gettags $i] item] != -1} {
+ lappend items $i
+ }
+ }
+ puts stdout "Items overlapping area: $items"
+}
+
+set areaX1 0
+set areaY1 0
+set areaX2 0
+set areaY2 0
+
+# Utility procedures to support dragging of items.
+
+proc itemStartDrag {c x y} {
+ global lastX lastY
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+}
+
+proc itemDrag {c x y} {
+ global lastX lastY
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ $c move current [expr $x-$lastX] [expr $y-$lastY]
+ set lastX $x
+ set lastY $y
+}
+
+# Procedure that's invoked when the button embedded in the canvas
+# is invoked.
+
+proc butPress {w color} {
+ set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n]
+ after 500 "$w delete $i"
+}
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
+
+
+
+
diff --git a/demos/rotation.tcl b/demos/rotation.tcl
new file mode 100644
index 0000000..488397d
--- /dev/null
+++ b/demos/rotation.tcl
@@ -0,0 +1,93 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set angle [expr 3.1416/6]
+
+set w .rotation
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Rotation Demonstration"
+wm iconname $w Rotation
+
+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
+
+
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 4
+pack $w.text -expand yes -fill both
+
+$w.text insert end "This toy-appli shows rotations on waypoint items.\nThe following operations are possible:\nClick <- for negative rotation\nClick -> for positive rotation"
+
+
+###########################################
+# Zinc
+###########################################
+set zinc_width 600
+set zinc_height 500
+zinc $w.zinc -width $zinc_width -height $zinc_height -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+###########################################
+# Waypoints
+###########################################
+
+set wp_group [$w.zinc add group 1 -visible 1]
+
+set p1 {200 200}
+set wp1 [$w.zinc add waypoint $wp_group 1 -position $p1 -connectioncolor green -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp1 0 -text DO
+
+
+set p2 {300 300}
+set wp2 [$w.zinc add waypoint $wp_group 1 -position $p2 -connecteditem $wp1 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp2 0 -text RE
+
+
+set p3 {400 150}
+set wp3 [$w.zinc add waypoint $wp_group 2 -position $p3 -connecteditem $wp2 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx 20 -labeldy +10]
+
+$w.zinc itemconfigure $wp3 0 -text MI
+
+
+###################################################
+# control panel
+###################################################
+frame $w.rc
+pack $w.rc
+
+button $w.rc.left -width 2 -height 2 -text "<-" -command {
+ global w
+ # Negative rotation
+ #--------------------------------
+ set x [lindex [lindex [$w.zinc coords $wp2] 0 ] 0]
+ set y [lindex [lindex [$w.zinc coords $wp2] 0 ] 1]
+ #the center of the rotation is $wp2
+ $w.zinc rotate $wp_group -$angle $x $y
+}
+pack $w.rc.left -side left
+
+button $w.rc.right -width 2 -height 2 -text "->" -command {
+ global w
+ # Positive rotation
+ #--------------------------------
+ set x [lindex [lindex [$w.zinc coords $wp2] 0 ] 0]
+ set y [lindex [lindex [$w.zinc coords $wp2] 0 ] 1]
+ $w.zinc rotate $wp_group $angle $x $y
+}
+pack $w.rc.right -side right
diff --git a/demos/simpleInteractionTrack.tcl b/demos/simpleInteractionTrack.tcl
new file mode 100644
index 0000000..1ac3966
--- /dev/null
+++ b/demos/simpleInteractionTrack.tcl
@@ -0,0 +1,216 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+
+set w .simple_interation_track
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Track Interaction Demonstration"
+wm iconname $w TrackInteraction
+
+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
+
+###########################################
+# Zinc
+###########################################
+zinc $w.zinc -width 600 -height 500 -font 10x20 -borderwidth 0
+pack $w.zinc
+
+
+# The explanation displayed when running this demo
+$w.zinc add text 1 -position {10 10} -text {This toy-appli shows some interactions on different parts of a flight track item.
+ The following operations are possible:
+ - Drag Button 1 on the track to move it.
+ Please Note the position history past positions
+ - Enter/Leave flight label fields
+ - Enter/Leave the speedvector symbol i.e. current position label leader} -font 9x15
+
+
+###########################################
+# Track
+###########################################
+
+#the label format 6 formats for 6 fields#
+set labelformat {x80x60+0+0 x60a0^0^0 x30a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2}
+
+#the track#
+set x 250
+set y 200
+set track [$w.zinc add track 1 6 -labelformat $labelformat -position "$x $y" -speedvector {30 -15} -markersize 10]
+
+# moving the track to display past positions
+for {set i 0} {$i<=5} {incr i} {
+ $w.zinc coords "$track" "[expr $x+$i*10] [expr $y-$i*5]"
+}
+
+#fields of the label#
+$w.zinc itemconfigure $track 0 -filled 0 -bordercolor DarkGreen -border contour
+$w.zinc itemconfigure $track 1 -filled 1 -backcolor gray60 -text AFR6128
+
+$w.zinc itemconfigure $track 2 -filled 0 -backcolor gray65 -text 390
+
+$w.zinc itemconfigure $track 3 -filled 0 -backcolor gray65 -text /
+
+$w.zinc itemconfigure $track 4 -filled 0 -backcolor gray65 -text 350
+
+$w.zinc itemconfigure $track 5 -filled 0 -backcolor gray65 -text TUR
+
+
+
+###########################################
+# Events on the track
+###########################################
+#---------------------------------------------
+# Enter/Leave a field of the label of the track
+#---------------------------------------------
+
+for {set field 0} {$field<=5} {incr field} {
+ #Entering the field $field higlights it#
+ $w.zinc bind "$track:$field" "<Enter>" "highlight_enter $field"
+ #Leaving the field cancels the highlight of $field#
+ $w.zinc bind "$track:$field" "<Leave>" "highlight_leave $field"
+}
+
+proc highlight_enter {field} {
+ if {$field ==0} {
+ higlight_label_on
+ } else {
+ highlight_fields_on $field
+ }
+
+}
+proc highlight_leave {field} {
+ if {$field==0} {
+ higlight_label_off
+ } else {
+ if {$field==1} {
+ highlight_field1_off
+ } else {
+ highlight_other_fields_off $field
+ }
+ }
+}
+
+#fonction#
+proc higlight_label_on {} {
+ global w
+ $w.zinc itemconfigure current 0 -filled 0 -bordercolor red -border contour
+}
+
+proc higlight_label_off {} {
+ global w
+ $w.zinc itemconfigure current 0 -filled 0 -bordercolor DarkGreen -border contour
+}
+
+proc highlight_fields_on {field} {
+ global w
+ $w.zinc itemconfigure current $field -border contour -filled 1 -color white
+}
+
+proc highlight_field1_off {} {
+ global w
+ $w.zinc itemconfigure current 1 -border "" -filled 1 -color black -backcolor gray60
+}
+
+proc highlight_other_fields_off {field} {
+ global w
+ $w.zinc itemconfigure current $field -border "" -filled 0 -color black -backcolor gray65
+}
+
+#---------------------------------------------
+# Enter/Leave other parts of the track
+#---------------------------------------------
+$w.zinc bind "$track:position" <Enter> {$w.zinc itemconfigure "$track" -symbolcolor red}
+$w.zinc bind "$track:position" <Leave> {$w.zinc itemconfigure "$track" -symbolcolor black }
+$w.zinc bind "$track:speedvector" <Enter> {$w.zinc itemconfigure "$track" -speedvectorcolor red }
+$w.zinc bind "$track:speedvector" <Leave> {$w.zinc itemconfigure "$track" -speedvectorcolor black }
+$w.zinc bind "$track:leader" <Enter> {$w.zinc itemconfigure "$track" -leadercolor red }
+$w.zinc bind "$track:leader" <Leave> {$w.zinc itemconfigure "$track" -leadercolor black }
+
+#---------------------------------------------
+# Drag and drop the track
+#---------------------------------------------
+#Binding to ButtonPress event -> "move_on" state#
+$w.zinc bind "$track" <1> {
+ select_color_on
+ move_on %x %y
+}
+
+
+
+#"move_on" state#
+proc move_on {x y} {
+ global track w
+ global xi yi
+
+ set xi $x
+ set yi $y
+
+ #ButtonPress event not allowed on track
+ $w.zinc bind "$track" <ButtonPress-1> ""
+ #Binding to Motion event -> move the track#
+ $w.zinc bind "$track" <Motion> "bind_motion %x %y"
+
+ #Binding to ButtonRelease event -> "move_off" state#
+ $w.zinc bind "$track" <ButtonRelease-1> {
+ select_color_off
+ move_off
+ }
+}
+
+proc bind_motion { x y} {
+ global xi yi
+
+ move $xi $yi $x $y
+
+ set xi $x
+ set yi $y
+}
+
+#"move_off" state#
+proc move_off {} {
+ global track w
+ #Binding to ButtonPress event -> "move_on" state#
+ $w.zinc bind "$track" <ButtonPress-1> {
+ select_color_on
+ move_on %x %y
+ }
+
+
+ #Motion event not allowed on track
+ $w.zinc bind "$track" <Motion> ""
+ #ButtonRelease event not allowed on track
+ $w.zinc bind "$track" <ButtonRelease-1> ""
+}
+
+#move the track#
+proc move {xi yi x y} {
+ global w
+ global track
+ select_color_on
+ set coords [$w.zinc coords "$track"]
+ set X1 [lindex [lindex $coords 0] 0]
+ set Y1 [lindex [lindex $coords 0] 1]
+ $w.zinc coords "$track" "[expr $X1+$x-$xi] [expr $Y1+$y-$yi]"
+}
+
+
+proc select_color_on {} {
+ global track w
+ $w.zinc itemconfigure "$track" -speedvectorcolor white -markercolor white -leadercolor white
+}
+
+proc select_color_off {} {
+ global track w
+ $w.zinc itemconfigure "$track" -speedvectorcolor black -markercolor black -leadercolor black
+}
diff --git a/demos/textInput.tcl b/demos/textInput.tcl
new file mode 100644
index 0000000..32f8a7a
--- /dev/null
+++ b/demos/textInput.tcl
@@ -0,0 +1,71 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .textInput
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc textInput Demonstration"
+wm iconname $w textInput
+
+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
+
+
+
+###########################################
+# Text zone
+#######################
+####################
+
+text $w.text -relief sunken -borderwidth 2 -height 5
+pack $w.text -expand yes -fill both
+
+$w.text insert end {This toy-appli demonstrates the use of the Tk::ZincText module. This module is designed for facilitating text input a la emacs on text items or on fields of items such as tracks, waypoints or tabulars.}
+
+
+###########################################
+# Zinc
+##########################################
+zinc $w.zinc -width 500 -height 300 -font 10x20 -borderwidth 0
+pack $w.zinc
+
+#ZincText $w.zinc
+# for mapping text input bindings on item with a 'text' tag.
+
+
+### creating a tabular with 3 fields 2 of them being editable
+set labelformat1 {130x100 x130x20+0+0 x130x20+0+20 x130x20+0+40}
+
+set x 120
+set y 6
+set track [$w.zinc add track 1 3 -position "$x $y" -speedvector {40 10} -labeldistance 30 -labelformat $labelformat1 -tags text]
+
+# moving the track to display past positions
+for {set i 0} {$i<=5} {incr i} {
+ $w.zinc coords "$track" "[expr $x+$i*10] [expr $y+$i*2]"
+}
+
+$w.zinc itemconfigure $track 0 -border contour -text {not editable} -sensitive 0
+
+$w.zinc itemconfigure $track 1 -border contour -text editable -sensitive 1
+
+$w.zinc itemconfigure $track 2 -border contour -text {editable too} -alignment center -sensitive 1
+
+
+# creating a text item tagged with "text" but not editable because
+# it is not sensitive
+$w.zinc add text 1 -position {220 160} -text "this text is not editable \nbecause it is not sensitive" -sensitive 0 -tags text
+
+
+# creating an editable text item
+$w.zinc add text 1 -position {50 230} -text {this text IS editable} -sensitive 1 -tags text
diff --git a/demos/tkZincLogo.tcl b/demos/tkZincLogo.tcl
new file mode 100644
index 0000000..9806212
--- /dev/null
+++ b/demos/tkZincLogo.tcl
@@ -0,0 +1,155 @@
+# this simple demo has been adapted by C. Mertz <mertz@cena.fr> from the original
+# work of JL. Vinot <vinot@cena.fr>
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .tkZincLogo
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Logo Demonstration"
+wm iconname $w Logo
+
+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
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-140-*-*-*-*-*-*"
+text $w.text -relief sunken -borderwidth 2 -height 7
+pack $w.text -expand yes -fill both
+
+$w.text insert 0.0 {This tkZinc logo should used openGL for a correct rendering!
+ You can transform this logo with your mouse:
+ Drag-Button 1 for moving the logo
+ Drag-Button 2 for zooming the logo
+ Drag-Button 3 for rotating the logo
+ Shift-Drag-Button 1 for modifying the logo transparency
+ Shift-Drag-Button 2 for modifying the logo gradient.}
+
+
+zinc $w.zinc -width 350 -height 250 -render 1 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+set group [$w.zinc add group 1 ]
+
+
+set logo = $w.zinc LogoZinc -parent $group -position {40 70} -priority 800 -scale {.6 .6}
+
+
+
+$w.zinc Tk::bind <ButtonPress-1> "press $w.zinc motion"
+$w.zinc Tk::bind <ButtonRelease-1> "release $w.zinc"
+
+$w.zinc Tk::bind <ButtonPress-2> "press $w.zinc zoom"
+$w.zinc Tk::bind <ButtonRelease-2> "release $w.zinc"
+
+$w.zinc Tk::bind <ButtonPress-3> "press $w.zinc rotate"
+$w.zinc Tk::bind <ButtonRelease-3> "release $w.zinc"
+
+
+$w.zinc Tk::bind <Shift-ButtonPress-1> "press $w.zinc modifyAlpha"
+$w.zinc Tk::bind <Shift-ButtonRelease-1> "release $w.zinc"
+
+$w.zinc Tk::bind <Shift-ButtonPress-2> "press $w.zinc modifyGradient"
+$w.zinc Tk::bind <Shift-ButtonRelease-2> "release $w.zinc"
+
+
+#
+# Controls for the window transform.
+#
+my $cur_x $cur_y $cur_angle
+proc press {zinc action} {
+ my $w.zinc $action = @_
+ set ev = $w.zinc XEvent
+ $cur_x = $ev x
+ $cur_y = $ev y
+ $cur_angle = atan2 $cur_y $cur_x
+ $w.zinc Tk::bind <Motion> $action
+}
+
+proc modifyAlpha {zinc} {
+ my $w.zinc = @_
+ set ev = $w.zinc XEvent
+ set lx = $ev x
+ set xrate = $lx / $w.zinc cget -width
+
+ $xrate = 0 if $xrate < 0
+ $xrate = 1 if $xrate > 1
+
+ set alpha = $xrate * 100
+ print "Alpha=$alpha\n"
+ $w.zinc itemconfigure $group -alpha $alpha
+}
+
+proc modifyGradient {zinc} {
+ my $w.zinc = @_
+ set ev = $w.zinc XEvent
+ set ly = $ev y
+ set yrate = $ly / $w.zinc cget -height
+
+ $yrate = 0 if $yrate < 0
+ $yrate = 1 if $yrate > 1
+ set gradientpercent = sprintf "%d" $yrate * 100
+
+ $w.zinc itemconfigure "letters" -fillcolor "#ffffff:100 0 28|#66848c:100 $gradientpercent|#7192aa:100 100/270"
+}
+
+
+proc motion {zinc} {
+ my $w.zinc = @_
+ set ev = $w.zinc XEvent
+ set lx = $ev x
+ set ly = $ev y
+ my @res
+
+ @res = $w.zinc transform $group "$lx $ly $cur_x $cur_y"
+ $w.zinc translate $group $res[0] - $res[2] $res[1] - $res[3]
+ $cur_x = $lx
+ $cur_y = $ly
+}
+
+proc zoom {zinc} {
+ my $w.zinc $self = @_
+ set ev = $w.zinc XEvent
+ set lx = $ev x
+ set ly = $ev y
+ set maxx
+ set maxy
+ set sx
+ set sy
+
+ if $lx > $cur_x {
+ $maxx = $lx
+ } else {
+ $maxx = $cur_x
+ }
+ if $ly > $cur_y {
+ $maxy = $ly
+ } else {
+ $maxy = $cur_y
+ }
+ return if $maxx == 0 || $maxy == 0
+ $sx = 1.0 + $lx - $cur_x/$maxx
+ $sy = 1.0 + $ly - $cur_y/$maxy
+ $cur_x = $lx
+ $cur_y = $ly
+ $w.zinc scale $group $sx $sy
+}
+
+proc rotate {zinc x y} {
+ set ev = $zinc XEvent
+ set lx = $ev x
+ set ly = $ev y
+
+ $langle = atan2 $ly $lx
+ $w.zinc rotate $group - $langle - $cur_angle
+ $cur_angle = $langle
+}
+
+proc release {zinc} {
+ $zinc bind <Motion> ""
+}
diff --git a/demos/translation.tcl b/demos/translation.tcl
new file mode 100644
index 0000000..16aa256
--- /dev/null
+++ b/demos/translation.tcl
@@ -0,0 +1,88 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .translation
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Translation Demonstration"
+wm iconname $w Translation
+
+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
+
+###########################################
+# Text zone
+###########################################
+text $w.text -relief sunken -borderwidth 2 -setgrid true -height 6
+
+pack $w.text -expand yes -fill both
+
+$w.text insert end "This toy-appli shows translations on waypoint items.\nThe following operations are possible:\n Click Up for up translation\n Click Left for left translation\n Click Right for right translation\n Click Down for down translation"
+
+###########################################
+# Zinc
+###########################################
+set zinc_width 600
+set zinc_height 500;
+zinc $w.zinc -width $zinc_width -height $zinc_height -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+###########################################
+# Waypoints
+###########################################
+
+set wp_group [$w.zinc add group 1 -visible 1]
+
+set p1 {200 200}
+set wp1 [$w.zinc add waypoint $wp_group 1 -position $p1 -connectioncolor green -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp1 0 -text DO
+
+
+set p2 {300 300}
+set wp2 [$w.zinc add waypoint $wp_group 1 -position $p2 -connecteditem $wp1 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp2 0 -text RE
+
+
+set p3 {400 150}
+set wp3 [$w.zinc add waypoint $wp_group 2 -position $p3 -connecteditem $wp2 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx 20 -labeldy +10]
+
+$w.zinc itemconfigure $wp3 0 -text MI
+
+
+###################################################
+# control panel
+###################################################
+frame $w.rc
+pack $w.rc
+
+button $w.rc.up -width 2 -height 2 -text Up -command {
+ $w.zinc translate "$wp_group" 0 -10
+}
+grid $w.rc.up -row 0 -column 1
+
+button $w.rc.left -width 2 -height 2 -text Left -command {
+ $w.zinc translate "$wp_group" -10 0
+}
+grid $w.rc.left -row 1 -column 0
+
+
+button $w.rc.right -width 2 -height 2 -text Right -command {
+ $w.zinc translate "$wp_group" 10 0
+}
+grid $w.rc.right -row 1 -column 2
+
+button $w.rc.down -width 2 -height 2 -text Down -command {
+ $w.zinc translate "$wp_group" 0 10
+}
+grid $w.rc.down -row 2 -column 1
diff --git a/demos/triangles.tcl b/demos/triangles.tcl
new file mode 100644
index 0000000..bde074c
--- /dev/null
+++ b/demos/triangles.tcl
@@ -0,0 +1,46 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr and N. Banoun banoun@cena.fr
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .triangles
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Triangles Demonstration"
+wm iconname $w Triangles
+
+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
+
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
+
+zinc $w.zinc -width 700 -height 300 -font 10x20 -render 1 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+# 6 equilateral triangles around a point
+$w.zinc add text 1 -position {5 10} -text "Triangles item without transparency"
+
+set x0 200
+set y0 150
+set coords [list "$x0 $y0"]
+for {set i 0} {$i<=6} {incr i} {
+ set angle [expr $i * 6.28/6]
+ lappend coords "[expr $x0 + 100 * cos($angle)] [expr $y0 - 100 * sin ($angle)]"
+}
+
+set tr1 [$w.zinc add triangles 1 $coords -fan 1 -colors {white yellow magenta blue cyan green red yellow} -visible 1]
+
+
+$w.zinc add text 1 -position {370 10} -text "Triangles item with transparency"
+
+
+# using the clone method to make a copy and then modify the clone"colors
+set tr2 [$w.zinc clone $tr1]
+$w.zinc translate $tr2 300 0
+$w.zinc itemconfigure $tr2 -colors {white;50 yellow;50 magenta;50 blue;50 cyan;50 green;50 red;50 yellow;50}
diff --git a/demos/windowContours.tcl b/demos/windowContours.tcl
new file mode 100644
index 0000000..0d4ff75
--- /dev/null
+++ b/demos/windowContours.tcl
@@ -0,0 +1,89 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .window-contours
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Contours Demonstration"
+wm iconname $w Contours
+
+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
+
+# Creating the zinc widget
+zinc $w.zinc -width 600 -height 500 -font 9x15 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+# The explanation displayed when running this demo
+$w.zinc add text 1 -position {10 10} -text "These windows are simply rectangles holed by 4 smaller\nrectangles. The text appears behind the window glasses.\nYou can drag text or windows" -font 10x20
+
+
+# Text in background
+set backtext [$w.zinc add text 1 -position {50 200} -text "This text appears\nthrough holes of curves" -font "-adobe-helvetica-bold-o-normal--34-240-100-100-p-182-iso8859-1"]
+
+set window [$w.zinc add curve 1 {100 100 300 100 300 400 100 400} -closed 1 -visible 1 -filled 1 -fillcolor grey66]
+
+
+set aGlass [$w.zinc add rectangle 1 {120 120 190 240}]
+$w.zinc contour $window add +1 $aGlass
+
+$w.zinc translate $aGlass 90 0
+$w.zinc contour $window add +1 $aGlass
+
+$w.zinc translate $aGlass 0 140
+$w.zinc contour $window add +1 $aGlass
+
+$w.zinc translate $aGlass -90 0
+$w.zinc contour $window add +1 $aGlass
+
+
+# deleting $aGlass which is no more usefull
+$w.zinc remove $aGlass
+
+# cloning $window
+set window2 [$w.zinc clone $window]
+
+# changing its background moving it and scaling it!
+$w.zinc itemconfigure $window2 -fillcolor grey50
+$w.zinc translate $window2 30 50
+$w.zinc scale $window 0.8 0.8
+
+
+
+
+# adding drag and drop callback to the two windows and backtext
+foreach item "$window $window2 $backtext" {
+ # Some bindings for dragging the items
+ $w.zinc bind $item <1> "itemStartDrag $item %x %y"
+ $w.zinc bind $item <B1-Motion> "itemDrag $item %x %y"
+}
+
+# callback for starting a drag
+set x_orig ""
+set y_orig ""
+
+proc itemStartDrag {item x y} {
+ global x_orig y_orig
+ set x_orig $x
+ set y_orig $y
+}
+
+# Callback for moving an item
+proc itemDrag {item x y} {
+ global x_orig y_orig
+ global w
+ $w.zinc translate $item [expr $x-$x_orig] [expr $y-$y_orig];
+ set x_orig $x;
+ set y_orig $y;
+}
+
+
diff --git a/demos/zoom.tcl b/demos/zoom.tcl
new file mode 100644
index 0000000..038848e
--- /dev/null
+++ b/demos/zoom.tcl
@@ -0,0 +1,108 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+set w .zoom
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Zoom Demonstration"
+wm iconname $w Zoom
+
+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
+
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 4
+pack $w.text -expand yes -fill both
+
+$w.text insert end "This toy-appli shows zoom actions on waypoint and curve items.\nThe following operations are possible:\n Click - to zoom out\n Click + to zoom in"
+
+###########################################
+# Zinc
+###########################################
+set zinc_width 600
+set zinc_height 500
+zinc $w.zinc -width $zinc_width -height $zinc_height -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+###########################################
+# Waypoints and sector
+###########################################
+set wp_group [$w.zinc add group 1 -visible 1]
+
+set p1 {200 100}
+set wp1 [$w.zinc add waypoint $wp_group 1 -position $p1 -connectioncolor green -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp1 0 -text DO
+
+set p2 {300 150}
+set wp2 [$w.zinc add waypoint $wp_group 1 -position $p2 -connecteditem $wp1 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp2 0 -text RE
+
+set p3 {400 50}
+set wp3 [$w.zinc add waypoint $wp_group 2 -position $p3 -connecteditem $wp2 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx 20 -labeldy +10]
+
+$w.zinc itemconfigure $wp3 0 -text MI
+
+set p4 {350 450}
+set wp4 [$w.zinc add waypoint $wp_group 2 -position $p4 -connecteditem $wp2 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -15]
+
+$w.zinc itemconfigure $wp4 0 -text FA
+
+set p5 {300 250}
+set wp5 [$w.zinc add waypoint $wp_group 2 -position $p5 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -15]
+
+$w.zinc itemconfigure $wp5 0 -text SOL
+
+set p6 {170 240}
+set wp6 [$w.zinc add waypoint $wp_group 2 -position $p6 -connecteditem $wp5 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx -20]
+
+$w.zinc itemconfigure $wp6 0 -text LA
+
+set p7 {550 200}
+set wp7 [$w.zinc add waypoint $wp_group 2 -position $p7 -connecteditem $wp5 -connectioncolor blue -symbolcolor blue -labelformat {x20x18+0+0} -leaderwidth 0 -labeldx 20]
+
+$w.zinc itemconfigure $wp7 0 -text SI
+
+set sector [$w.zinc add curve $wp_group {300 0 400 50 500 100 550 200 550 400 350 450 170 240 200 100 300 0}]
+
+###################################################
+# control panel
+###################################################
+frame $w.rc
+pack $w.rc
+
+#the reference of the scale function is top-left corner of the zinc object
+#so we first translate the group to zoom in order to put its center on top-left corner
+#change the scale of the group
+#translate the group to put it back at the center of the zinc object
+
+
+button $w.rc.minus -width 2 -height 2 -text - -command {
+ $w.zinc translate $wp_group [expr -$zinc_width/2] [expr -$zinc_height/2]
+ $w.zinc scale $wp_group 0.8 0.8
+ $w.zinc translate $wp_group [expr $zinc_width/2] [expr $zinc_height/2]
+}
+pack $w.rc.minus -side left
+
+button $w.rc.plus -width 2 -height 2 -text + -command {
+ $w.zinc translate $wp_group [expr -$zinc_width/2] [expr -$zinc_height/2]
+ $w.zinc scale $wp_group 1.2 1.2
+ $w.zinc translate $wp_group [expr $zinc_width/2] [expr $zinc_height/2]
+}
+pack $w.rc.plus -side right
+