aboutsummaryrefslogtreecommitdiff
path: root/demos
diff options
context:
space:
mode:
authorlecoanet2003-03-28 17:36:34 +0000
committerlecoanet2003-03-28 17:36:34 +0000
commit11d300cf2d4d7c0da508ff27534c14261d5043a0 (patch)
tree35ff0c0185d755c6d52dcacf958bd587c55739b4 /demos
parent7a103bee4cda4532e237522e72f6a7d7e81e6839 (diff)
downloadtkzinc-11d300cf2d4d7c0da508ff27534c14261d5043a0.zip
tkzinc-11d300cf2d4d7c0da508ff27534c14261d5043a0.tar.gz
tkzinc-11d300cf2d4d7c0da508ff27534c14261d5043a0.tar.bz2
tkzinc-11d300cf2d4d7c0da508ff27534c14261d5043a0.tar.xz
Ajout de plusieurs demos et remaniement
Diffstat (limited to 'demos')
-rw-r--r--demos/allOptions.tcl2
-rw-r--r--demos/atomicGroups.tcl2
-rw-r--r--demos/colorCircular.tcl2
-rw-r--r--demos/colorX.tcl2
-rw-r--r--demos/colorY.tcl4
-rw-r--r--demos/curveBezier.tcl2
-rw-r--r--demos/fillRule.tcl2
-rw-r--r--demos/groupsInAtcStrips.tcl911
-rw-r--r--demos/groupsPriority.tcl2
-rw-r--r--demos/labelformat.tcl2
-rw-r--r--demos/pathTags.tcl183
-rw-r--r--demos/simpleInteractionTrack.tcl2
-rw-r--r--demos/textInput.tcl9
-rw-r--r--demos/tiger.tcl3
-rw-r--r--demos/tkZincLogo.tcl219
-rw-r--r--demos/transforms.tcl2
-rw-r--r--demos/windowContours.tcl2
-rw-r--r--demos/zinc-widget64
18 files changed, 1175 insertions, 240 deletions
diff --git a/demos/allOptions.tcl b/demos/allOptions.tcl
index bc3e4d2..e4454fe 100644
--- a/demos/allOptions.tcl
+++ b/demos/allOptions.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .all_options
+set w .allOptions
catch {destroy $w}
toplevel $w
wm title $w "Zinc All Option Demonstration"
diff --git a/demos/atomicGroups.tcl b/demos/atomicGroups.tcl
index bc57da0..97cd362 100644
--- a/demos/atomicGroups.tcl
+++ b/demos/atomicGroups.tcl
@@ -6,7 +6,7 @@ if {![info exists zincDemo]} {
}
-set w .atomic-groups
+set w .atomicGroups
catch {destroy $w}
toplevel $w
wm title $w "Zinc Atomicity Demonstration"
diff --git a/demos/colorCircular.tcl b/demos/colorCircular.tcl
index dbd9367..016e02d 100644
--- a/demos/colorCircular.tcl
+++ b/demos/colorCircular.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .color-circular
+set w .colorCircular
catch {destroy $w}
toplevel $w
wm title $w "Zinc Color Circular Demonstration"
diff --git a/demos/colorX.tcl b/demos/colorX.tcl
index 9fef483..87a78b8 100644
--- a/demos/colorX.tcl
+++ b/demos/colorX.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .color-x
+set w .colorX
catch {destroy $w}
toplevel $w
wm title $w "Zinc Color-x Demonstration"
diff --git a/demos/colorY.tcl b/demos/colorY.tcl
index 013cedc..08f4788 100644
--- a/demos/colorY.tcl
+++ b/demos/colorY.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .color-y
+set w .colorY
catch {destroy $w}
toplevel $w
wm title $w "Zinc Color-y Demonstration"
@@ -37,6 +37,6 @@ $w.zinc add text 1 -font $defaultfont -text "A variation from 40%transparent red
$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 0 0|red;40|green;40 50|blue;40} -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/curveBezier.tcl b/demos/curveBezier.tcl
index e8f6671..9546a41 100644
--- a/demos/curveBezier.tcl
+++ b/demos/curveBezier.tcl
@@ -6,7 +6,7 @@ if {![info exists zincDemo]} {
}
-set w .curve_bezier
+set w .curveBezier
catch {destroy $w}
toplevel $w
wm title $w "Zinc Curve Bezier Demonstration"
diff --git a/demos/fillRule.tcl b/demos/fillRule.tcl
index 83c3b94..b4e7162 100644
--- a/demos/fillRule.tcl
+++ b/demos/fillRule.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .fillrule
+set w .fillRule
catch {destroy $w}
toplevel $w
wm title $w "Zinc Fillrule Demonstration"
diff --git a/demos/groupsInAtcStrips.tcl b/demos/groupsInAtcStrips.tcl
new file mode 100644
index 0000000..fb6bdd0
--- /dev/null
+++ b/demos/groupsInAtcStrips.tcl
@@ -0,0 +1,911 @@
+#!/usr/bin/perl -w
+#-----------------------------------------------------------------------------------
+#
+# Copyright (C) 2002
+# Centre d'Études de la Navigation Aérienne
+#
+# Authors: Jean-Luc Vinot <vinot@cena.fr> for whole graphic design and coding
+# Christophe Mertz <mertz@cena.fr> for adding simple animations
+# and integration in zinc-demos
+# This integration is still not perfect and requires an extension in zinc
+# We must know if a named gradient already exists, when launching
+# many time the same demo in the same process!
+#
+# $Id:
+#-----------------------------------------------------------------------------------
+# This small application illustrates both the use of groups in combination
+# of -composescale attributes and an implementation of kind of air traffic
+# control electronic strips.
+# However it is only a simplified example given as is, without any immediate usage!
+#
+# 3 strips formats are accessible through "+" / "-" buttons on the right side
+#
+# 1. small-format: with 2 lines of info, and reduced length
+#
+# 2. normal-format: with 3 lines of info, full length
+#
+# 3. extended-format: with 3 lines of infos, full length
+# the 3 lines are zoomed
+# an additionnel 4th lone is displayed
+#
+# An additionnal 4th format (micro-format) is available when double-clicking somewhere...
+#
+# Strips can be moved around by drag&drop from the callsign
+#
+# When changing size, strips are animated. The animation is a very simple one,
+# which should be enhanced.... You can change the animation parameters, by modifyng
+# $delay and $steps.
+#
+#-----------------------------------------------------------------------------------
+#
+# Ported to Tcl by P.Lecoanet
+
+
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
+
+
+set w .groupsInAtcStrips
+catch {destroy $w}
+toplevel $w
+wm title $w "Atc electronic strips using groups"
+wm iconname $w groupsInAtcStrips
+
+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 {'These fake air Traffic Control electronic strips illustrates
+ the use of groups for an advanced graphic design.
+The following interactions are possible:
+ "drag&drop button1" on the callsign.
+ "button 1" triangle buttons on the right side of the strips
+ to modify strips size
+ "double click 1" on the blueish zone to fully reduce size}
+
+
+###########################################
+# Zinc
+##########################################
+image create photo texture -file \
+ [file join $zinc_library demos images background_texture.gif]
+
+zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 -lightangle 130 -tile texture
+pack $w.zinc -fill both -expand 1
+
+
+
+my @stripGradiants;
+my %stripFontset;
+my %textures;
+
+my $oldfkey;
+my ($dx, $dy);
+
+my $delay = 50; # ms between each animation steps
+my $steps = 6; # number of steps for the animation
+my %scales; # this hash just memorizes the current x and y scaling ratio
+ # In a real appli, this should be memorized in strip objects
+
+#----------------------
+# configuration data
+#----------------------
+my $fnb10 = 'cenapii-digistrips-b10';
+my $fnb10c = 'cenapii-digistrips-b10c';
+my $fnb11 = 'cenapii-digistrips-b11';
+my $fnb12 = 'cenapii-digistrips-b12';
+my $fnb15 = 'cenapii-radar-b15';
+my $fnm20 = 'cenapii-radar-m20';
+my $fne18 = 'cenapii-radar-m18';
+
+my @ratio2fontset = ([1.2, 'normal'],
+ [10, 'large']);
+
+my %stripstyle = (-gradset => {'idnt' => '#ffffff 0|#ffeedd 30|#e9d1ca 90|#e9a89a/90',
+ 'back' => '#c1daff|#8aaaff/0',
+ 'shad' => '#000000:50 0|#000000:50 92|#000000:0 100[200 -100',
+ 'btn_outside' => '#ffeedd|#8a9acc/0',
+ 'btn_inside' => '#ffeedd|#8a9acc/180',
+ 'ch1' => '#8aaaff|#5B76ED/0',
+ },
+
+ -fontset => {'normal' => {'callsign' => $fnb15,
+ 'type1' => $fnb12,
+ 'type2' => $fnb10,
+ 'type3' => $fnb10c,
+ },
+
+ 'large' => {'callsign' => $fnm20,
+ 'type1' => $fne18,
+ 'type2' => $fnb15,
+ 'type3' => $fnb12,
+ },
+ },
+
+ -width => 340,
+ -height => 86,
+ -shadowcoords => [8, 8, 374, 94],
+ -shadowcolor => 'shad',
+
+ -strip => {-linewidth => 3,
+ -linecolor => '#aaccff',
+ -fillcolor => 'back',
+ -relief => 'roundraised',
+ },
+
+ -buttons => {-coords => [340, 0],
+ -clipcoords => [0, 0, 90, 83],
+ -zone => {-coords => [0, 0, 26, 85],
+ -fillcolor => 'btn_outside',
+ -linewidth => 0,
+ },
+
+ -btns => {'btnup' => {-coords => [0, 0, 26, 43],
+ -arrow => [14, 2, 24, 40,
+ 1, 40, 14, 2],
+ -linewidth => 1,
+ -linecolor => '#aabadd',
+ -fillcolor => 'btn_inside',
+ -label => {-coords => [13, 27],
+ -text => "+",
+ -font => $fnm20,
+ -color => '#ffffff',
+ -anchor => 'center',
+ },
+ },
+
+ 'btndn' => {-coords => [0, 43, 26, 86],
+ -arrow => [14, 83, 24, 43,
+ 1, 43, 14, 83],
+ -linewidth => 1,
+ -linecolor => '#aabadd',
+ -fillcolor => 'btn_inside',
+ -label => {-coords => [13, 56],
+ -text => "-",
+ -font => $fnm20,
+ -color => '#ffffff',
+ -anchor => 'center',
+ },
+ },
+ },
+ },
+
+ -clipcoords => [3, 3, 332, 80],
+ -zones => {'ident' => {-coords => [3, 3, 90, 50],
+ -atomic => 1,
+ -priority => 200,
+ -sensitive => 1,
+ -tags => "move",
+ -linewidth => 1,
+ -filled => 1,
+ -relief => 'sunken',
+ -linecolor => '#ffeedd',
+ -fillcolor => 'idnt',
+ -fields => {-callsign => {-coords => [10, 18],
+ -font => 'callsign',
+ -text => 'EWG361',
+ -anchor => 'w',
+ -color => '#000000',
+ },
+ -company => {-coords => [10, 34],
+ -font => 'type2',
+ -text => 'Eurowing',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ },
+ },
+ 'input' => {-coords => [3, 3, 334, 82],
+ -atomic => 1,
+ -priority => 100,
+ -sensitive => 1,
+ -tags => "scale",
+ -linewidth => 0,
+ -filled => 1,
+ -relief => 'flat',
+ -linecolor => 'white',
+ -fillcolor => 'back', #'#afb2cc',
+ -fields => {-type => {-coords => [100, 18],
+ -font => 'type1',
+ -text => 'TYPA',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ -cfmu => {-coords => [200, 18],
+ -font => 'type1',
+ -text => '08:26',
+ -anchor => 'e',
+ -color => '#444444',
+ },
+ -ptsid => {-coords => [100, 40],
+ -font => 'type2',
+ -text => 'NIPOR',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ -confsid => {-coords => [158, 40],
+ -font => 'type2',
+ -text => '8G',
+ -anchor => 'center',
+ -color => '#444444',
+ },
+ -park => {-coords => [200, 40],
+ -font => 'type2',
+ -text => 'G23',
+ -anchor => 'e',
+ -color => '#444444',
+ },
+
+ -dest => {-coords => [10, 66],
+ -font => 'type2',
+ -text => 'DEST',
+ -anchor => 'w',
+ -color => '#555555',
+ },
+ -champ1 => {-type => 'rect',
+ -coords => [45, 56,
+ 135, 76],
+ -filled => 1,
+ -fillcolor => 'ch1',
+ -linecolor => 'white',
+ -linewidth => 0,
+ },
+ -bret => {-coords => [200, 66],
+ -font => 'type2',
+ -text => 'Bret.',
+ -anchor => 'e',
+ -color => '#444444',
+ },
+ },
+ },
+
+ 'zreco' => {-coords => [210, 3, 346, 82],
+ -atomic => 1,
+ -priority => 200,
+ -texture => "stripped_texture.gif",
+ -sensitive => 1,
+ -tags => "edit",
+ -linewidth => 2,
+ -filled => 1,
+ -relief => 'sunken',
+ -linecolor => '#deecff',
+ -fillcolor => '#d3e5ff',
+ },
+
+
+ },
+
+ -zinfo => {-coords => [0, 86],
+ -rectcoords => [0, 0, 340, 20],
+ -shadowcoords => [8, 8, 348, 28],
+ -shadowcolor => 'shad',
+ -atomic => 1,
+ -priority => 200,
+ -sensitive => 1,
+ -tags => "edit2",
+ -linewidth => 2,
+ -linecolor => '#aaccff',
+ -fillcolor => 'back',
+ -relief => 'roundraised',
+ -fields => {-ssr => {-coords => [4, 10],
+ -font => 'type3',
+ -text => '7656',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ -pdep => {-coords => [47, 10],
+ -font => 'type3',
+ -text => 'G23',
+ -anchor => 'center',
+ -color => '#444444',
+ },
+ -qfu => {-coords => [73, 10],
+ -font => 'type3',
+ -text => '09R',
+ -anchor => 'center',
+ -color => '#444444',
+ },
+ -slabel => {-coords => [105, 10],
+ -font => 'type3',
+ -text => 'vit:',
+ -anchor => 'e',
+ -color => '#444444',
+ },
+ -speed => {-coords => [106, 10],
+ -font => 'type3',
+ -text => '260',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ -pper => {-coords => [142, 10],
+ -font => 'type3',
+ -text => 'EPL',
+ -anchor => 'center',
+ -color => '#444444',
+ },
+ -rfl => {-coords => [166, 10],
+ -font => 'type3',
+ -text => '210',
+ -anchor => 'center',
+ -color => '#444444',
+ },
+ -cautra => {-coords => [183, 10],
+ -font => 'type3',
+ -text => '8350',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ -nsect => {-coords => [219, 10],
+ -font => 'type3',
+ -text => 'MOD',
+ -anchor => 'w',
+ -color => '#444444',
+ },
+ -day => {-coords => [297, 10],
+ -font => 'type3',
+ -text => '21/05/02',
+ -anchor => 'e',
+ -color => '#444444',
+ },
+ -hour => {-coords => [332, 10],
+ -font => 'type3',
+ -text => '13:50',
+ -anchor => 'e',
+ -color => '#444444',
+ },
+ },
+
+ },
+ );
+
+
+
+#------------------------
+# creation du widget Zinc
+
+
+my ($xn, $yn) = (10, 30);
+
+# test Strips
+for (my $index = 0; $index < 4 ; $index++) {
+
+ &createStrip($index, $xn, $yn, \%stripstyle);
+
+ $xn += 50;
+ $yn += 120;
+
+}
+
+
+&initBindings('move', 'scale');
+
+
+
+
+Tk::MainLoop;
+
+#----------------------------------------------------------------------- fin de MAIN
+
+
+# Création du Strip
+sub createStrip {
+ my ($index, $x, $y, $style) = @_;
+
+ # initialise les gradiants
+ unless (@stripGradiants) {
+ my %gradiants = %{$style->{'-gradset'}};
+ my ($name, $gradiant);
+ while (($name, $gradiant) = each(%gradiants)) {
+ # création des gradiants nommés
+ $zinc->gname($gradiant, $name) unless $zinc->gname($gradiant);
+ # the previous test is usefull only
+ # when this script is executed many time in the same process
+ # (it is typically the case in zinc-demos)
+
+ push(@stripGradiants, $name);
+ }
+ }
+
+ # initialise les jeux de fontes
+ unless (%stripFontset) {
+ %stripFontset = %{$style->{'-fontset'}};
+ }
+
+ # création du groupe de base : coords
+ my $g1 = $zinc->add('group', 1, -priority => 100, -tags => ["base".$index]);
+ $zinc->coords($g1, [$x, $y]);
+
+ # group de transfo 1 : scaling (à partir du coin haut droit)
+ my $g2 = $zinc->add('group', $g1, -tags => ["scaling".$index]);
+
+
+ #-------------------------------------------------------------
+ # réalisation du strip lui même (papier support + ombre portée
+ #-------------------------------------------------------------
+
+ # params strip
+ my $stripw = $style->{'-width'};
+ my $striph = $style->{'-height'};
+
+ # ombre portée
+ $zinc->add('rectangle', $g2,
+ $style->{'-shadowcoords'},
+ -filled => 1,
+ -linewidth => 0,
+ -fillcolor => $style->{'-shadowcolor'},
+ -priority => 10,
+ -tags => ["shadow".$index],
+ );
+
+
+ # strip
+ my $sstyle = $style->{'-strip'};
+ my $strip = $zinc->add('rectangle', $g2,
+ [0, 0, $stripw, $striph],
+ -filled => 1,
+ -linewidth => $sstyle->{'-linewidth'},
+ -linecolor => $sstyle->{'-linecolor'},
+ -fillcolor => $sstyle->{'-fillcolor'},
+ -relief => $sstyle->{'-relief'},
+ -priority => 20,
+ -tags => ["strip".$index],
+ );
+
+ if ($sstyle->{'-texture'}) {
+ if (!exists($textures{'-strip'})) {
+ my $texture = $zinc->Photo($sstyle->{'-texture'}, -file => "$image_path/$sstyle->{'-texture'}");
+ $textures{'-strip'} = $texture;
+ }
+
+ $zinc->itemconfigure($strip, -tile => $textures{'-strip'});
+ }
+
+
+ #-------------------------------------------------
+ # ajout de la zone des boutons (à droite du strip)
+ #-------------------------------------------------
+ if ($style->{'-buttons'}) {
+ my $bstyle = $style->{'-buttons'};
+
+ # le groupe de la zone bouton
+ my $btngroup = $zinc->add('group', $g2, -priority => 40);
+ $zinc->coords($btngroup, $bstyle->{'-coords'});
+
+ # sa zone de clipping
+ my $btnclip = $zinc->add('rectangle', $btngroup,
+ $bstyle->{'-clipcoords'},
+ -filled => 0,
+ -visible => 0,
+ );
+
+ # le clipping du groupe bouton
+ $zinc->itemconfigure($btngroup, -clip => $btnclip);
+
+ # zone bouton
+ $zinc->add('rectangle', $btngroup,
+ $bstyle->{'-zone'}->{'-coords'},
+ -filled => 1,
+ -linewidth => $bstyle->{'-zone'}->{'-linewidth'},
+ -fillcolor => $bstyle->{'-zone'}->{'-fillcolor'},
+ -composescale => 0,
+ -tags => ["content".$index],
+ );
+
+
+ my %btns = %{$bstyle->{'-btns'}};
+ my ($name, $btnstyle);
+ while (($name, $btnstyle) = each(%btns)) {
+# print "bouton $name $btnstyle\n";
+
+ my $sgroup = $zinc->add('group', $btngroup,
+ -atomic => 1,
+ -sensitive => 1,
+ -composescale => 0,
+ -tags => [$name.$index, "content".$index],
+ );
+
+ $zinc->add('rectangle', $sgroup,
+ $btnstyle->{'-coords'},
+ -filled => 1,
+ -visible => 0,
+ -priority => 100,
+ );
+
+ $zinc->add('curve', $sgroup,
+ $btnstyle->{'-arrow'},
+ -closed => 1,
+ -filled => 1,
+ -linewidth => $btnstyle->{'-linewidth'},
+ -linecolor => $btnstyle->{'-linecolor'},
+ -fillcolor => $btnstyle->{'-fillcolor'},
+ -priority => 50,
+ );
+
+ $zinc->add('text', $sgroup,
+ -position => $btnstyle->{'-label'}->{'-coords'},
+ -text => $btnstyle->{'-label'}->{'-text'},
+ -font => $btnstyle->{'-label'}->{'-font'},
+ -color => $btnstyle->{'-label'}->{'-color'},
+ -anchor => $btnstyle->{'-label'}->{'-anchor'},
+ -priority => 60,
+ );
+ }
+
+ # bindings boutons Up et Down du Strip
+ $zinc->bind('btnup'.$index, '<1>', \&extendedStrip);
+ $zinc->bind('btndn'.$index, '<1>', \&smallStrip);
+
+ }
+
+ # construction du contenu du strip
+ &buildContent($index, $g2, 100, $style);
+
+ # et de la barre d'extension info (extended format)
+ &buildExtent($index, $g2, $style->{'-zinfo'});
+
+}
+
+
+# Construction des zones internes du Strips
+sub buildContent {
+ my ($index, $parent, $priority, $style) = @_;
+
+ # group content
+ my $g3 = $zinc->add('group', $parent, -priority => $priority);
+
+ # zone de clipping
+ my $clip = $zinc->add('rectangle', $g3,
+ $style->{'-clipcoords'},
+ -filled => 0,
+ -visible => 0,
+ );
+
+ # clipping du groupe content
+ $zinc->itemconfigure($g3, -clip => $clip);
+
+ # création d'un group intermédiaire pour bloquer le scaling
+ my $g4 = $zinc->add('group', $g3,
+ -composescale => 0,
+ -tags => ["content".$index],
+ );
+
+ # création des zones
+ my %zones = %{$style->{'-zones'}};
+ my ($name, $zonestyle);
+ while (($name, $zonestyle) = each(%zones)) {
+ # group de zone
+ my $gz = $zinc->add('group', $g4);
+
+ if ($zonestyle->{'-atomic'}) {
+ $zinc->itemconfigure($gz, -atomic => 1,
+ -sensitive => $zonestyle->{'-sensitive'},
+ -priority => $zonestyle->{'-priority'},
+ -tags => [$name.$index, $zonestyle->{'-tags'}],
+ );
+ }
+
+ my $rectzone = $zinc->add('rectangle', $gz,
+ $zonestyle->{'-coords'},
+ -filled => $zonestyle->{'-filled'},
+ -linewidth => $zonestyle->{'-linewidth'},
+ -linecolor => $zonestyle->{'-linecolor'},
+ -fillcolor => $zonestyle->{'-fillcolor'},
+ -relief => $zonestyle->{'-relief'},
+ -priority => 10,
+ -tags => [$name.$index],
+ );
+
+ if ($zonestyle->{'-texture'}) {
+ if (!exists($textures{$name})) {
+ my $texture = $zinc->Photo($zonestyle->{'-texture'}, -file => "$image_path/$zonestyle->{'-texture'}");
+ $textures{$name} = $texture;
+ }
+
+ $zinc->itemconfigure($rectzone, -tile => $textures{$name});
+ }
+
+
+ my %fields;
+ %fields = %{$zonestyle->{'-fields'}} if (defined $zonestyle->{'-fields'}) ;
+ my ($field, $fieldstyle);
+ my $fontsty = $stripFontset{'normal'};
+ while ( ($field, $fieldstyle) = each(%fields) ) {
+ if ($fieldstyle->{'-type'} and $fieldstyle->{'-type'} eq 'rect') {
+ $zinc->add('rectangle', $gz,
+ $fieldstyle->{'-coords'},
+ -filled => $fieldstyle->{'-filled'},
+ -fillcolor => $fieldstyle->{'-fillcolor'},
+ -linewidth => $fieldstyle->{'-linewidth'},
+ -linecolor => $fieldstyle->{'-linecolor'},
+ -priority => 20,
+ );
+ } else {
+
+ my $font = $fieldstyle->{'-font'};
+# print "buildContent field:$field font:$font\n";
+ $zinc->add('text', $gz,
+ -position => $fieldstyle->{'-coords'},
+ -text => $fieldstyle->{'-text'},
+ -font => $fontsty->{$font},
+ -color => $fieldstyle->{'-color'},
+ -anchor => $fieldstyle->{'-anchor'},
+ -priority => 30,
+ -tags => [$font.$index],
+ );
+ }
+
+ }
+
+ }
+}
+
+
+# Construction de la barre d'extension info du Strip
+sub buildExtent {
+ my ($index, $parent, $infostyle) = @_;
+
+ # group content
+ my $extgroup = $zinc->add('group', $parent);
+ $zinc->coords($extgroup, $infostyle->{'-coords'});
+
+ $zinc->itemconfigure($extgroup,
+ -atomic => $infostyle->{'-atomic'},
+ -sensitive => $infostyle->{'-sensitive'},
+ -priority => $infostyle->{'-priority'},
+ -visible => 0,
+ -tags => ["zinfo".$index, $infostyle->{'-tags'}],
+ );
+
+ # ombre portée
+ $zinc->add('rectangle', $extgroup,
+ $infostyle->{'-shadowcoords'},
+ -filled => 1,
+ -linewidth => 0,
+ -fillcolor => $infostyle->{'-shadowcolor'},
+ -priority => 10,
+ -tags => ["shadow".$index],
+ );
+
+ my $rectzone = $zinc->add('rectangle', $extgroup,
+ $infostyle->{'-rectcoords'},
+ -filled => 1,
+ -linewidth => $infostyle->{'-linewidth'},
+ -linecolor => $infostyle->{'-linecolor'},
+ -fillcolor => $infostyle->{'-fillcolor'},
+ -relief => $infostyle->{'-relief'},
+ -priority => 20,
+ );
+
+ if ($infostyle->{'-texture'}) {
+ if (!exists($textures{'-zinfo'})) {
+ my $texture = $zinc->Photo($infostyle->{'-texture'}, -file => "$image_path/$infostyle->{'-texture'}");
+ $textures{'-zinfo'} = $texture;
+ }
+ $zinc->itemconfigure($rectzone, -tile => $textures{'-zinfo'});
+
+ }
+
+ my %fields = %{$infostyle->{'-fields'}};
+ my ($field, $fieldstyle);
+ my $fontsty = $stripFontset{'normal'};
+ while (($field, $fieldstyle) = each(%fields)) {
+ if ($fieldstyle->{'-type'} and $fieldstyle->{'-type'} eq 'rect') {
+ $zinc->add('rectangle', $extgroup,
+ $fieldstyle->{'-coords'},
+ -filled => $fieldstyle->{'-filled'},
+ -fillcolor => $fieldstyle->{'-fillcolor'},
+ -linewidth => $fieldstyle->{'-linewidth'},
+ -linecolor => $fieldstyle->{'-linecolor'},
+ -priority => 40,
+ );
+ } else {
+
+ my $font = $fieldstyle->{'-font'};
+# print "buildContent field:$field font:$font\n";
+ $zinc->add('text', $extgroup,
+ -position => $fieldstyle->{'-coords'},
+ -text => $fieldstyle->{'-text'},
+ -font => $fontsty->{$font},
+ -color => $fieldstyle->{'-color'},
+ -anchor => $fieldstyle->{'-anchor'},
+ -priority => 50,
+ -tags => [$font.$index],
+ );
+ }
+
+ }
+
+}
+
+# initialisation des bindings généraux dy Strip
+sub initBindings {
+ my ($movetag, $scaletag) = @_;
+
+ $zinc->bind($movetag, '<1>', \&catchStrip);
+ $zinc->bind($movetag, '<ButtonRelease>', \&releaseStrip);
+ $zinc->bind($movetag, '<B1-Motion>', \&motionStrip);
+
+ $zinc->bind($scaletag, '<Double-Button-1>', \&microStrip);
+
+}
+
+# Callback CATCH de début de déplacement du Strip
+sub catchStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+
+ my ($x, $y) = $zinc->coords("base".$index);
+ my $ev = $zinc->XEvent;
+ ($dx, $dy) = ($x - $ev->x, $y - $ev->y);
+
+ $zinc->itemconfigure("base".$index, -priority => 200);
+
+}
+
+# Callback MOVE de fin de déplacement du Strip
+sub motionStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+ my $ev = $zinc->XEvent;
+ $zinc->coords("base".$index, [$ev->x + $dx, $ev->y + $dy]);
+
+}
+
+# Callback RELEASE de fin de déplacement du Strip
+sub releaseStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+ $zinc->itemconfigure("base".$index, -priority => 100);
+}
+
+# Zoom Strip : normal format
+sub normalStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+
+ $zinc->itemconfigure("input".$index, -sensitive => 1);
+
+ &displayRecoZone($index, 1);
+ &displayExtentZone($index, 0);
+ &configButtons($index, \&extendedStrip, \&smallStrip);
+ &changeStripFormat($index, 1, 1, 0, 1);
+}
+
+# Zoom Strip : small format (lignes 1 et 2)
+sub smallStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+
+ &displayRecoZone($index, 0);
+ &configButtons($index, \&normalStrip, 0);
+ &changeStripFormat($index, 1, .63, 0, 1);
+}
+
+# Zoom Strip : micro format (zone ident)
+sub microStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+
+ &configButtons($index, \&normalStrip, 0);
+ &changeStripFormat($index, .28, .63, 0, 1);
+
+}
+
+# Zoom Strip : extendedFormat
+sub extendedStrip {
+ my $index = substr(($zinc->itemcget('current', -tags))[0],5);
+
+ $zinc->itemconfigure("input".$index, -sensitive => 0);
+ $zinc->itemconfigure("base".$index, -priority => 150);
+ &displayRecoZone($index, 0);
+ &displayExtentZone($index, 1);
+ &configButtons($index, 0, \&normalStrip);
+ &changeStripFormat($index, 1.3, 1.3, 1, 1.3);
+}
+
+
+# affiche/masque la zone Reco
+sub displayRecoZone {
+ my ($index, $state) = @_;
+ my $priority = ($state) ? 200 : 0;
+ $zinc->itemconfigure("zreco".$index, -priority => $priority);
+}
+
+
+# affiche/masque la zone Extent
+sub displayExtentZone {
+ my ($index, $state) = @_;
+
+ $zinc->itemconfigure("zinfo".$index,
+ -visible => $state,
+ -sensitive => $state);
+}
+
+# Configure affichage et callbacks des boutons du Strip
+sub configButtons {
+ my ($index, $funcUp, $funcDown) = @_;
+
+ # button Up
+ $zinc->itemconfigure("btnup".$index, -visible => $funcUp);
+ $zinc->bind('btnup'.$index, '<1>', $funcUp) if $funcUp;
+
+ # button Down
+ $zinc->itemconfigure("btndn".$index, -visible => $funcDown);
+ $zinc->bind('btndn'.$index, '<1>', $funcDown) if $funcDown;
+
+}
+
+
+# this function has been hacked to provide the user with an animation
+# The animation is (too) simple but provide a better feedback than without
+sub changeStripFormat {
+ my ($index, $xratio, $yratio, $composeflag, $fontratio) = @_;
+
+ # réinitialisation du groupe scaling
+ $zinc->treset("scaling".$index);
+
+ # configure le blocage de transformation du format des champs
+ $zinc->itemconfigure("content".$index, -composescale => $composeflag);
+
+ # applique le nouveau scaling
+ $scales{$index} = [1,1] unless defined $scales{$index};
+ my ($oldXratio,$oldYratio) = @{$scales{$index}};
+ $scales{$index}=[$xratio, $yratio];
+ my $dx = ($xratio - $oldXratio) / $steps;
+ my $dy = ($yratio - $oldYratio) / $steps;
+ &_resize($index, $delay, $oldXratio+$dx, $oldYratio+$dy, $dx, $dy, $steps);
+}
+
+sub _resize {
+ my ($index, $delay, $newXratio, $newYratio, $dx, $dy, $steps) = @_;
+ $zinc->treset("scaling".$index);
+ $zinc->scale("scaling".$index, $newXratio, $newYratio);
+ # jeu de fontes
+ &setFontes($index, $newYratio);
+ $steps--;
+ $zinc->after($delay, sub {&_resize ($index, $delay, $newXratio+$dx, $newYratio+$dy, $dx, $dy, $steps)})
+ if $steps > 0;
+}
+
+sub getFKey {
+ my ($ratio) = @_;
+ my $newfkey;
+
+ foreach my $param (@ratio2fontset) {
+ my ($maxratio, $fkey) = @{$param};
+ $newfkey = $fkey;
+ if ($ratio < $maxratio) {
+ return $newfkey;
+ }
+ }
+
+ return $newfkey;
+}
+
+
+sub setFontes {
+ my ($index, $ratio) = @_;
+ my $newfkey = &getFKey($ratio);
+
+ if (!$oldfkey or $oldfkey ne $newfkey) {
+ my $fontsty = $stripFontset{$newfkey};
+# print "setFontes $oldfkey -> $newfkey\n";
+ if ($fontsty) {
+ foreach my $type ('callsign', 'type1', 'type2', 'type3') {
+ $zinc->itemconfigure($type.$index, -font => $fontsty->{$type});
+ }
+ }
+
+ $oldfkey = $newfkey;
+ }
+}
+
diff --git a/demos/groupsPriority.tcl b/demos/groupsPriority.tcl
index eaef4c8..1272fea 100644
--- a/demos/groupsPriority.tcl
+++ b/demos/groupsPriority.tcl
@@ -6,7 +6,7 @@ if {![info exists zincDemo]} {
}
-set w .groups_priority
+set w .groupsPriority
catch {destroy $w}
toplevel $w
wm title $w "Zinc Groups priority Demonstration"
diff --git a/demos/labelformat.tcl b/demos/labelformat.tcl
index 9584d3c..9095992 100644
--- a/demos/labelformat.tcl
+++ b/demos/labelformat.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .label
+set w .labelformat
catch {destroy $w}
toplevel $w
wm title $w "Zinc Label Format Demonstration"
diff --git a/demos/pathTags.tcl b/demos/pathTags.tcl
index cce6b86..de2779b 100644
--- a/demos/pathTags.tcl
+++ b/demos/pathTags.tcl
@@ -2,10 +2,11 @@
# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
# tcl version by Jean-Paul Imbert imbert@cena.fr
-load /usr/lib/tkzinc3.2.so
-
+if {![info exists zincDemo]} {
+ error "This script should be run from the zinc-widget demo."
+}
-set w .path_tags
+set w .pathTags
catch {destroy $w}
toplevel $w
wm title $w "Zinc Path tags Demonstration"
@@ -43,19 +44,18 @@ pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
# |
# --- i_ccb
#the same objects are cloned and put in an other hierarchy where
-#gr_top is replaced by gr_other_top
+#grTop is replaced by grOtherTop
-set defaultForecolor sienna
+set defaultForeColor sienna
###########################################
# Text zone
###########################################
-text $w.text -relief sunken -borderwidth 2 -height 5 -font 10x20
+text $w.text -relief sunken -borderwidth 2 -height 5
pack $w.text -expand yes -fill both
-$w.text insert 0.0 {
- This represents a group hierarchy:
+$w.text insert end {This represents a group hierarchy:
- groups are represented by a rectangle and a Title.
- non-group items are represented by a text.
Select a pathTag or a tag with one of the radio-button
@@ -73,7 +73,7 @@ pack $w.zinc
pack [frame $w.tagsfm]
-set pathtag
+set pathtag {}
pack [frame $w.left] -side left -expand 1 -padx .5c -pady .2c
pack [frame $w.middle] -side left -expand 1 -padx .5c -pady .2c
pack [frame $w.right] -side left -expand 1 -padx .5c -pady .2c
@@ -84,85 +84,86 @@ pack [frame $w.rbot_right] -side left -expand 1 -padx .5c -pady .2c
set i 0
foreach p {top .top .top. .top* .top*cca .5.} {
- radiobutton $w.left.r$i -text "$p" -font 10x20 -command displayPathtag -variable pathtag -relief flat -value $p
- incr i
+ radiobutton $w.left.r$i -text $p -command displayPathtag \
+ -variable pathtag -relief flat -value $p
pack $w.left.r$i -side top -pady 2 -anchor w
+ incr i
}
set i 0
foreach p {.top*aa .top*aa. .top*aa* .top*aaa .top*aaa. .5*} {
- radiobutton $w.middle.r$i-text "$p" -font 10x20 -command displayPathtag -variable pathtag -relief flat -value $p
- incr i
+ radiobutton $w.middle.r$i -text $p -command displayPathtag \
+ -variable pathtag -relief flat -value $p
pack $w.middle.r$i -side top -pady 2 -anchor w
+ incr i
}
-label $w.rtop.label -font 10x20 -relief flat -text your own tag :
+label $w.rtop.label -relief flat -text {your own tag:}
pack $w.rtop.label -side left
-entry $w.rtop.entry -font 10x20 -width 15 ->pack -side left
+entry $w.rtop.entry -width 15
+pack $w.rtop.entry -side left
bind $w.rtop.entry <Key-Return> " "
#sub {$pathtag $_"0"->get &displayPathtag}
set i 0
-foreach p {.top*aa*aaa .top*aa*aaa. .top*aa*aaa* .other_top*aa* .5*ca*} {
- radiobutton $w.rbot_left.r$i -text "$p" -font {10x20} -command displayPathtag -variable pathtag -relief flat -value $p
- incr i
+foreach p {.top*aa*aaa .top*aa*aaa. .top*aa*aaa* .otherTop*aa* .5*ca*} {
+ radiobutton $w.rbot_left.r$i -text $p -command displayPathtag \
+ -variable pathtag -relief flat -value $p
pack $w.rbot_left.r$i -side top -pady 2 -anchor w
+ incr i
}
+set i 0
foreach p "{*aa*aaaa *aaa} {aa || ca} none all" {
- radiobutton $w.rbot_right.r$i -text "$p" -font 10x20 -command displayPathtag -variable pathtag -relief flat -value p
- incr i
+ radiobutton $w.rbot_right.r$i -text $p -command displayPathtag \
+ -variable pathtag -relief flat -value p
pack $w.rbot_right.r$i -side top -pady 2 -anchor w
+ incr i
}
-# creating the item hierarchy
-$w.zinc add group 1 -tags top
-createSubHierarchy top
-
-# creating a parallel hierarchy
-zinc add group 1 -tags other_top
-createSubHierarchy other_top
-
### Here we create the genuine hierarchy of groups and items
### Later we will create graphical objects to display groups
-sub createSubHierarchy {gr} {
+proc createSubHierarchy {gr} {
global w
$w.zinc add group $gr -tags a
- $w.zinc add text $gr -tags b text -text b -position {270 150}
+ $w.zinc add text $gr -tags {b text} -text b -position {270 150}
$w.zinc add group $gr -tags c
$w.zinc add group a -tags aa
- $w.zinc add text a -tags ab text -text ab -position {60 220}
+ $w.zinc add text a -tags {ab text} -text ab -position {60 220}
$w.zinc add group a -tags ac
$w.zinc add group aa -tags aaa
- $w.zinc add text aa -tags aab text -text aab -position {90 190}
+ $w.zinc add text aa -tags {aab text} -text aab -position {90 190}
$w.zinc add group aaa -tags aaaa
- $w.zinc add text aaaa -tags aaaaa text -text aaaaa -position {150 110}
- $w.zinc add text aaaa -tags aaaab text -text aaaab -position {150 130}
- $w.zinc add text aaa -tags aaab text -text aaab -position {120 160}
+ $w.zinc add text aaaa -tags {aaaaa text} -text aaaaa -position {150 110}
+ $w.zinc add text aaaa -tags {aaaab text} -text aaaab -position {150 130}
+ $w.zinc add text aaa -tags {aaab text} -text aaab -position {120 160}
$w.zinc add text ac -tags aca -text aca -position {90 260}
- $w.zinc add text ac -tags acb text -text acb -position {90 290}
+ $w.zinc add text ac -tags {acb text} -text acb -position {90 290}
$w.zinc add group c -tags ca
- $w.zinc add text c -tags cb text -text cb -position {330 160}
+ $w.zinc add text c -tags {cb text} -text cb -position {330 160}
$w.zinc add group c -tags cc
- $w.zinc add text ca -tags caa text -text caa -position {360 110}
- $w.zinc add text ca -tags cab text -text cab -position {360 130}
-
- $w.zinc add text cc -tags cca text -text cca -position {360 200}
- $w.zinc add text cc -tags ccb text -text ccb -position {360 220}
+ $w.zinc add text ca -tags {caa text} -text caa -position {360 110}
+ $w.zinc add text ca -tags {cab text} -text cab -position {360 130}
+
+ $w.zinc add text cc -tags {cca text} -text cca -position {360 200}
+ $w.zinc add text cc -tags {ccb text} -text ccb -position {360 220}
}
# converts a list of items ids in a list of sorted tags the first tag of each item
-sub items2tags {items} {
+proc items2tags {items} {
+ global w
- foreach my item $items {
+ foreach item $items {
set tags [$w.zinc itemcget $item -tags ]
- if {[lindex $tags 0]=="frame" || [lindex $tags 0]=="title"} {continue}
+ if {[lindex $tags 0]=="frame" || [lindex $tags 0]=="title"} {
+ continue
+ }
lappend selected_tags [lindex $tags 0]
}
return [lsort selected_tags]
@@ -176,23 +177,24 @@ sub items2tags {items} {
set backgrounds {grey90 grey82 grey75 grey68 grey60 grey52 grey45}
proc drawHierarchy {group level} {
- global w
+ global w backgrounds
+
set tags [$w.zinc gettags $group]
foreach g [$w.zinc find withtype group ".$group."] {
drawHierarchy $g [expr $level+1]
}
set coords [$w.zinc bbox $group]
- set x [lindex $coords 0]
- set y [lindex $coords 1]
- set x2 [lindex $coords 2]
- set y2 [lindex $coords 3]
- $w.zinc add text $group -position my $x $y $x2 $y2
- "[expr $x-5] [expr$y-4]" -text "[lindex $tags 0]" -anchor w -alignment left -underlined 1 -priority 20 -tags "title_.[lindex $tags 0]group_title"
+ foreach {x y x2 y2} $coords break
+ $w.zinc add text $group -position [list [expr $x-5] [expr $y-4]] \
+ -text [lindex $tags 0] -anchor w -alignment left \
+ -underlined 1 -priority 20 -tags [list "title_.[lindex $tags 0]" group_title]
if {$x} {
set background [lindex $backgrounds $level]
- $w.zinc add rectangle $group "[expr $x+0] [expr $y+5] [expr $x2+5] [expr $y2+2]" -filled 1 -fillcolor $background -priority $level -tags "frame_.[lindex $tags 0]group_frame"
+ $w.zinc add rectangle $group [list [expr $x+0] [expr $y+5] [expr $x2+5] [expr $y2+2]]\
+ -filled 1 -fillcolor $background -priority $level \
+ -tags [list frame_.[lindex $tags 0]group_frame]
} else {
puts "undefined bbox for $group : $tags\n"
@@ -206,7 +208,7 @@ proc extractTextAndFrames {} {
global w
foreach group_title [$w.zinc find withtag {group_title || group_frame}] {
set ancestors [$w.zinc find ancestor $group_title]
- # print "$group_title @ancestors\n"
+ # puts "$group_title @ancestors\n"
set grandFather [lindex $ancestors 1]
$w.zinc chggroup $group_title $grandFather 1
}
@@ -215,54 +217,63 @@ proc extractTextAndFrames {} {
## this sub modifies the color/line color of texts and rectangles
## representing selected items.
proc displayPathtag {} {
- global w
- global pathtag
- set selected [zinc find withtag $pathtag]
+ global w pathtag defaultForeColor
+
+ set selected [$w.zinc find withtag $pathtag]
set tags [items2tags $selected]
puts "selected: $tags\n"
- # print "selected= "
- # foreach @selected { print $_ " " $w.zinc type $_ " "
- # join " " $w.zinc gettags $_ " / "}
- # print "\n"
+ # puts "selected= "
+ # foreach sel $selected {
+ # puts "$sel [$w.zinc type $sel] [join [$w.zinc gettags $sel] ,] /\n"
+ # }
+ #
## unselecting all items
foreach item [$w.zinc find withtype text] {
- $w.zinc itemconfigure $item -color $defaultForecolor
+ $w.zinc itemconfigure $item -color $defaultForeColor
}
foreach item [$w.zinc find withtype rectangle] {
- $w.zinc itemconfigure $item -linecolor $defaultForecolor
+ $w.zinc itemconfigure $item -linecolor $defaultForeColor
}
## highlighting selected items
foreach item $selected {
set type [$w.zinc type $item ]
# print $item " " $w.zinc type $item " " join " " $w.zinc gettags $item "\n"
- if {$type == text} {
- $w.zinc itemconfigure $item -color black
- } else if { $type == "rectangle"} {
- $w.zinc itemconfigure $item -linecolor black
- } else if {$type == "group"} {
- set tag [$w.zinc gettags $item 0]
- set grandFather [$w.zinc find ancestors $item 1]
- if {$grandFather} {
- ## as there is 2 // hierachy we must refine the tag used
- ## to restrict to the proper hierarchy
- $w.zinc itemconfigure "*$grandFather*frame_$tag" -linecolor black
- $w.zinc itemconfigure "*$grandFather*title_$tag" -color black
- } else {
- ## when a group as no grandfather it can only be top or other_top
- ## as their tags are non-ambiguous no need to refine!
- $w.zinc itemconfigure "frame_$tag" -linecolor black
- $w.zinc itemconfigure "title_$tag" -color black
+ switch -- $type {
+ text {
+ $w.zinc itemconfigure $item -color black
+ }
+ rectangle {
+ $w.zinc itemconfigure $item -linecolor black
+ }
+ group {
+ set tag [lindex [$w.zinc gettags $item] 0]
+ set grandFather [$w.zinc find ancestors $item top]
+ if {$grandFather == 1} {
+ ## as there is 2 // hierachy we must refine the tag used
+ ## to restrict to the proper hierarchy
+ $w.zinc itemconfigure "*$grandFather*frame_$tag" -linecolor black
+ $w.zinc itemconfigure "*$grandFather*title_$tag" -color black
+ } else {
+ ## when a group as no grandfather it can only be top or otherTop
+ ## as their tags are non-ambiguous no need to refine!
+ $w.zinc itemconfigure "frame_$tag" -linecolor black
+ $w.zinc itemconfigure "title_$tag" -color black
+ }
}
}
}
}
-drawHierarchy top 0
-drawHierarchy other_top 0
-$w.zinc translate other_top 4000
-extractTextAndFrames
-
-
+# creating the item hierarchy
+$w.zinc add group 1 -tags top
+createSubHierarchy top
+# creating a parallel hierarchy
+$w.zinc add group 1 -tags otherTop
+createSubHierarchy otherTop
+drawHierarchy top 0
+drawHierarchy otherTop 0
+$w.zinc translate otherTop 400 0
+extractTextAndFrames
diff --git a/demos/simpleInteractionTrack.tcl b/demos/simpleInteractionTrack.tcl
index 1ac3966..c24c09c 100644
--- a/demos/simpleInteractionTrack.tcl
+++ b/demos/simpleInteractionTrack.tcl
@@ -6,7 +6,7 @@ if {![info exists zincDemo]} {
}
-set w .simple_interation_track
+set w .simpleInteractionTrack
catch {destroy $w}
toplevel $w
wm title $w "Zinc Track Interaction Demonstration"
diff --git a/demos/textInput.tcl b/demos/textInput.tcl
index e36dd6b..3de2821 100644
--- a/demos/textInput.tcl
+++ b/demos/textInput.tcl
@@ -8,7 +8,7 @@ if {![info exists zincDemo]} {
#
# We need the text input support
-package require ZincText
+package require zincText
set w .textInput
@@ -35,7 +35,10 @@ pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
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.}
+$w.text insert end {This demo demonstrates the use of the zincText package.
+This module is designed for facilitating text input.
+It works on text items or on fields of items such as
+tracks, waypoints or tabulars.}
###########################################
@@ -45,7 +48,7 @@ zinc $w.zinc -width 500 -height 300 -font 10x20 -borderwidth 0
pack $w.zinc
#
-# Activate text input support from ZincText
+# Activate text input support from zincText
zn_TextBindings $w.zinc
### creating a tabular with 3 fields 2 of them being editable
diff --git a/demos/tiger.tcl b/demos/tiger.tcl
index 46eee31..b0ac265 100644
--- a/demos/tiger.tcl
+++ b/demos/tiger.tcl
@@ -528,7 +528,7 @@ $w.zinc add curve __g__472 {{301.5 191.5} {284 179.5} {284 179.5 c} {303 196.5 c
$w.zinc translate $topGroup 200 150
-### some binding useful for debugging
+##### bindings for moving rotating scaling the items
bind $w.zinc <ButtonPress-1> "press motion %x %y"
bind $w.zinc <ButtonRelease-1> release
@@ -536,7 +536,6 @@ bind $w.zinc <ButtonPress-2> "press zoom %x %y"
bind $w.zinc <ButtonRelease-2> release
-##### bindings for moving rotating scaling the items
set curX 0
set curY 0
set curAngle 0
diff --git a/demos/tkZincLogo.tcl b/demos/tkZincLogo.tcl
index 9806212..6db4031 100644
--- a/demos/tkZincLogo.tcl
+++ b/demos/tkZincLogo.tcl
@@ -1,16 +1,25 @@
+#
+# $Id$
# 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
+# Ported to Tcl by P.Lecoanet
if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .tkZincLogo
+#
+# We need the zincLogo support
+package require zincLogo
+
+
+set w .zincLogo
catch {destroy $w}
toplevel $w
-wm title $w "Zinc Logo Demonstration"
-wm iconname $w Logo
+wm title $w "Zinc logo Demonstration"
+wm iconname $w zincLogo
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m
@@ -18,138 +27,130 @@ 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
+
+
+###########################################
+# Text zone
+#######################
+####################
+
+text $w.text -relief sunken -borderwidth 2 -height 5
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.}
+$w.text insert end {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
+###########################################
+# Zinc
+##########################################
+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 group [$w.zinc add group 1]
+set logo [zincLogo::create $w.zinc $group 800 40 70 0.6 0.6]
-set logo = $w.zinc LogoZinc -parent $group -position {40 70} -priority 800 -scale {.6 .6}
+#
+# Controls for the window transform.
+#
+bind $w.zinc <ButtonPress-1> "press motion %x %y"
+bind $w.zinc <ButtonRelease-1> release
+bind $w.zinc <ButtonPress-2> "press zoom %x %y"
+bind $w.zinc <ButtonRelease-2> release
+#
+# Controls for alpha and gradient
+#
+bind $w.zinc <Shift-ButtonPress-1> "press modifyAlpha %x %y"
+bind $w.zinc <Shift-ButtonRelease-1> release
+bind $w.zinc <Shift-ButtonPress-2> "press modifyGradient %x %y"
+bind $w.zinc <Shift-ButtonRelease-2> release
-$w.zinc Tk::bind <ButtonPress-1> "press $w.zinc motion"
-$w.zinc Tk::bind <ButtonRelease-1> "release $w.zinc"
+set curX 0
+set curY 0
+set curAngle 0
-$w.zinc Tk::bind <ButtonPress-2> "press $w.zinc zoom"
-$w.zinc Tk::bind <ButtonRelease-2> "release $w.zinc"
+proc press {action x y} {
+ global w curAngle curX curY
-$w.zinc Tk::bind <ButtonPress-3> "press $w.zinc rotate"
-$w.zinc Tk::bind <ButtonRelease-3> "release $w.zinc"
+ set curX $x
+ set curY $y
+ set curAngle [expr atan2($y, $x)]
+ bind $w.zinc <Motion> "$action %x %y"
+}
+proc motion {x y} {
+ global w topGroup curX curY
-$w.zinc Tk::bind <Shift-ButtonPress-1> "press $w.zinc modifyAlpha"
-$w.zinc Tk::bind <Shift-ButtonRelease-1> "release $w.zinc"
+ foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \
+ [list $x $y $curX $curY]] break
+ $w.zinc translate $topGroup [expr $x1 - $x2] [expr $y1 - $y2]
+ set curX $x
+ set curY $y
+}
-$w.zinc Tk::bind <Shift-ButtonPress-2> "press $w.zinc modifyGradient"
-$w.zinc Tk::bind <Shift-ButtonRelease-2> "release $w.zinc"
+proc zoom {x y} {
+ global w topGroup curX curY
+ if {$x > $curX} {
+ set maxX $x
+ } else {
+ set maxX $curX
+ }
+ if {$y > $curY} {
+ set maxY $y
+ } else {
+ set maxY $curY
+ }
+ if {($maxX == 0) || ($maxY == 0)} {
+ return;
+ }
+ set sx [expr 1.0 + (double($x - $curX) / $maxX)]
+ set sy [expr 1.0 + (double($y - $curY) / $maxY)]
+ $w.zinc scale $topGroup $sx $sx
-#
-# 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
+ set curX $x
+ set curY $y
}
-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 mouseRotate {x y} {
+ global w curAngle topGroup
-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"
+ set lAngle [expr atan2($y, $x)]
+ $w.zinc rotate $topGroup [expr -($lAngle - $curAngle)]
+ set curAngle $lAngle
}
+proc release {} {
+ global w
-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
+ bind $w.zinc <Motion> {}
}
-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 modifyAlpha {x y} {
+ global w
-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
+ set xRate [expr double($x) / [$w.zinc cget -width]]
+ set xRate [expr ($xRate < 0) ? 0 : ($xRate > 1) ? 1 : $xRate]
+ set alpha [expr $xRate * 100]
+
+ $w.zinc itemconfigure $group -alpha $alpha
}
-proc release {zinc} {
- $zinc bind <Motion> ""
+proc modifyGradient {x y} {
+ global w
+
+ set yRate [expr double($ly) / [$w.zinc cget -height]]
+ set yRate [expr ($yRate < 0) ? 0 : ($yRate > 1) ? 1 : $yRate]
+ set gradientPercent [expr int($yRate * 100)]
+
+ $w.zinc itemconfigure letters -fillcolor => "=axial 270|#ffffff;100 0 28|#66848c;100 $gradientpercent|#7192aa;100 100"
}
diff --git a/demos/transforms.tcl b/demos/transforms.tcl
index 09e0d61..04ef251 100644
--- a/demos/transforms.tcl
+++ b/demos/transforms.tcl
@@ -69,7 +69,7 @@ set drag 0
set itemType Rectangle
set currentItem 0
-image create photo logo -file zinc_anti.gif
+image create photo logo -file [file join $zinc_library demos images zinc.gif]
frame $w.f
pack $w.f -expand 0 -fill x
diff --git a/demos/windowContours.tcl b/demos/windowContours.tcl
index 0d4ff75..32d30ab 100644
--- a/demos/windowContours.tcl
+++ b/demos/windowContours.tcl
@@ -5,7 +5,7 @@ if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
-set w .window-contours
+set w .windowContours
catch {destroy $w}
toplevel $w
wm title $w "Zinc Contours Demonstration"
diff --git a/demos/zinc-widget b/demos/zinc-widget
index edc57e8..d468e3e 100644
--- a/demos/zinc-widget
+++ b/demos/zinc-widget
@@ -11,7 +11,7 @@ set zincRoot [file join [file dirname [info script]] ..]
# And adjust the paths accordingly.
#
lappend auto_path $zincRoot
-set tk_library $zincRoot
+set zinc_library $zincRoot
package require Tkzinc 3.2
@@ -25,9 +25,13 @@ menu .menuBar -tearoff 0
.menuBar add cascade -menu .menuBar.file -label File -underline 0
menu .menuBar.file -tearoff 0
+.menuBar.file add command -label "About..." -command "aboutBox" \
+ -underline 0 -accelerator "<F1>"
+.menuBar.file add sep
.menuBar.file add command -label Quit -command exit -underline 0 \
-accelerator Meta-Q
. configure -menu .menuBar
+bind . <F1> aboutBox
frame .statusBar
label .statusBar.lab -text " " -relief sunken -bd 1 \
@@ -108,39 +112,43 @@ set lastLine ""
.t insert end {
This application provides a front end for several short scripts in Tcl/Tk that demonstrate what you can do with the TkZinc widget. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration.
}
-.t insert end " \n " {}
-.t insert end "All Items\n" title
+.t insert end "\n" {} "Small applications\n" title
+.t insert end "1. The famous tiger (better with openGL).\n" {demo demo-tiger}
+
+.t insert end "\n" {} "All Items\n" title
.t insert end "1. Exemples of all items.\n" {demo demo-items}
-.t insert end "2. All items options (and their types).\n" {demo demo-all_options}
+.t insert end "2. All items options (and their types).\n" {demo demo-allOptions}
.t insert end "3. Examples of line style and line termination.\n" {demo demo-lines}
.t insert end "4. Curves with multiple contours.\n" {demo demo-contours}
.t insert end "5. Examples of labelformat.\n" {demo demo-labelformat}
.t insert end "6. Use of mapinfos.\n" {demo demo-mapinfo}
-.t insert end "7. Curves with cubic bezier control points.\n" {demo demo-curve_bezier}
-.t insert end "8. Curves with multiple contours and various fillrule.\n" {demo demo-fillrule}
+.t insert end "7. Curves with cubic bezier control points.\n" {demo demo-curveBezier}
+.t insert end "8. Curves with multiple contours and various fillrule.\n" {demo demo-fillRule}
-.t insert end \n {} "Groups, Priority, Clipping and PathTags\n" title
-.t insert end "1. Groups and Priorities.\n" {demo demo-groups_priority}
+.t insert end "\n" {} "Groups, Priority, Clipping and PathTags\n" title
+.t insert end "1. Groups and Priorities.\n" {demo demo-groupsPriority}
.t insert end "2. Clipping examples (with simple or multiple contours).\n" {demo demo-clipping}
-.t insert end "3. Group atomicity.\n" {demo demo-atomic-groups}
-.t insert end "4. \"Windows\" with four glasses using curve with multiple contours.\n" {demo demo-window-contours}
+.t insert end "3. Group atomicity.\n" {demo demo-atomicGroups}
+.t insert end "4. \"Windows\" with four glasses using curve with multiple contours.\n" {demo demo-windowContours}
+.t insert end "5. Pathtags demonstration.\n" {demo demo-pathTags}
-.t insert end \n {} "Interactions\n" title
-.t insert end "1. Simple interaction on a track.\n" {demo demo-simple_interaction_track}
+.t insert end "\n" {} "Interactions\n" title
+.t insert end "1. Simple interaction on a track.\n" {demo demo-simpleInteractionTrack}
.t insert end "2. Text input in a text item and a track item.\n" {demo demo-textInput}
-.t insert end \n {} "Transformation\n" title
+.t insert end "\n" {} "Transformation\n" title
.t insert end "1. Translating.\n" {demo demo-translation}
.t insert end "2. Rotating.\n" {demo demo-rotation}
.t insert end "3. Zooming.\n" {demo demo-zoom}
.t insert end "4. Transformation testbed.\n" {demo demo-transforms}
-.t insert end \n {} "Use of open GL\n" title
-#.t insert end "1. The TkZinc Logo (requires openGL).\n" {demo demo-tkZincLogo}
-.t insert end "1. Axial color variation on the X axis (requires openGL).\n" {demo demo-color-x}
-.t insert end "2. Axial color variation on the Y axis (requires openGL).\n" {demo demo-color-y}
-.t insert end "3. Circular color variation (requires openGL).\n" {demo demo-color-circular}
-.t insert end "4. The triangles item (requires openGL).\n" {demo demo-triangles}
+.t insert end "\n" {} "Use of open GL\n" title
+.t insert end "1. The TkZinc Logo.\n" {demo demo-tkZincLogo}
+.t insert end "2. Applying transformations to an icon.\n" {demo demo-iconTransform}
+.t insert end "3. Axial color variation on the X axis.\n" {demo demo-colorX}
+.t insert end "4. Axial color variation on the Y axis.\n" {demo demo-colorY}
+.t insert end "5. Circular color variation.\n" {demo demo-colorCircular}
+.t insert end "6. The triangles item.\n" {demo demo-triangles}
.t configure -state disabled
focus .s
@@ -198,7 +206,7 @@ proc showVars {w args} {
# index - The index of the character that the user clicked on.
proc invoke index {
- global tk_library
+ global zinc_library
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
@@ -209,7 +217,7 @@ proc invoke index {
.t configure -cursor watch
update
set demo [string range [lindex $tags $i] 5 end]
- uplevel [list source [file join $tk_library demos $demo.tcl]]
+ uplevel [list source [file join $zinc_library demos $demo.tcl]]
update
.t configure -cursor $cursor
@@ -222,7 +230,7 @@ proc invoke index {
# is called when the user moves the cursor over a demo description.
#
proc showStatus index {
- global tk_library
+ global zinc_library
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
set cursor [.t cget -cursor]
@@ -249,7 +257,7 @@ proc showStatus index {
# used to derive the name of the file containing its code.
proc showCode w {
- global tk_library
+ global zinc_library
set file [string range $w 1 end].tcl
if ![winfo exists .code] {
toplevel .code
@@ -285,9 +293,9 @@ proc showCode w {
wm deiconify .code
raise .code
}
- wm title .code "Demo code: [file join $tk_library demos $file]"
+ wm title .code "Demo code: [file join $zinc_library demos $file]"
wm iconname .code $file
- set id [open [file join $tk_library demos $file]]
+ set id [open [file join $zinc_library demos $file]]
.code.text delete 1.0 end
.code.text insert 1.0 [read $id]
.code.text mark set insert 1.0
@@ -299,7 +307,9 @@ proc showCode w {
# Pops up a message box with an "about" message
#
proc aboutBox {} {
- tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
- "Tk widget demonstration\n\n\
+ tk_messageBox -icon info -type ok -title "About Zinc Demo" -message \
+ "Tkzinc widget demonstration\n\n\
+Copyright (c) 2003 CENA\n\n
+The demo framework \n
Copyright (c) 1996-1997 Sun Microsystems, Inc."
}