ajout de la demo labelformat

2 files changed, 109 insertions, 1 deletions

diff --git a/Perl/demos/Tk/demos/zinc_lib/labelformat.pl b/Perl/demos/Tk/demos/zinc_lib/labelformat.pl
new file mode 100644
index 0000000..5587a4e
--- /dev/null
+++ b/Perl/demos/Tk/demos/zinc_lib/labelformat.pl
@@ -0,0 +1,107 @@
+#!/usr/bin/perl -w
+# $Id$
+# This simple demo has been developped by C. Mertz <mertz@cena.fr>
+
+
+use Tk;
+use Tk::Zinc;
+use strict;
+
+my $mw = MainWindow->new();
+
+
+###########################################
+# Text zone
+###########################################
+
+my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true
+	      -height 4 -scrollbars e/);
+$text->pack(qw/-expand yes -fill both/);
+
+$text->insert('0.0',
+'This toy-appli demonstrates the use of labelformat for tabular items.
+The fieldPos (please, refer to the "labelformat type" description 
+in the "Zinc reference manual") of each fields as described in
+the the labelformat is displayed inside the field.');
+
+
+###########################################
+# Zinc
+##########################################
+my $zinc = $mw->Zinc(-width => 600, -height => 500,
+		     -font => "10x20",
+		     -borderwidth => 3, -relief => 'sunken',
+		     )->pack;
+
+###########################################
+# Tabulars
+###########################################
+
+### first labelformat and tabular
+my $labelformat1 = "300x300 x100x20+0+0 x100x20+100+0 x100x20+0+20 x100x20+100+20 x100x20+50+55";
+
+my $tabular1 = $zinc->add('tabular',1, 5,
+		    -position => [10,10],
+		    -labelformat => $labelformat1,
+		   );
+
+&setLabelContent ($tabular1,$labelformat1);
+
+$zinc->add('text', 1, -position => [10,100], -text =>
+	   "All fields positions
+are given in pixels");
+
+
+### second labelformat and tabular
+my $labelformat2 = "300x300 x110x20+100+30 x80x20<0<0 x80x20<0>0 x80x20>0>0 x80x20>0<0";
+
+my $tabular2 = $zinc->add('tabular',1, 5,
+                    -position => [300,10],
+		    -labelformat => $labelformat2,
+		    );
+&setLabelContent ($tabular2,$labelformat2);
+
+$zinc->add('text', 1, -position => [270,100], -text =>
+	   "All fields positions are given
+relatively to field 0.
+They are either on the left /
+right and up/down the field 0.");
+
+
+### third labelformat and tabular
+my $labelformat3 = "300x300 x200x20+50+40 x80x20^0<0 x80x20^0>0 x80x20\$0>0 x80x20\$0<0 x90x20\$1<1 x90x20\$2>2 x90x20^4<4 x90x20^3>3";
+
+my $tabular3 = $zinc->add('tabular',1, 9,
+                    -position => [150,250],
+                    -labelformat => $labelformat3,
+                    );
+&setLabelContent ($tabular3,$labelformat3);
+
+$zinc->add('text', 1, -position => [40,360], -text =>
+	   "Fields 1-4 are positionned relatively to field 0.
+Field 5 is positionned relatively to field 1,
+Field 6 is positionned relatively to field 2..."
+);
+
+
+sub setLabelContent {
+  my ($item,$labelformat) = @_;
+
+  my @fieldsSpec = split (/ / , $labelformat);
+  shift @fieldsSpec;
+
+  my $i=0;
+  foreach my $fieldSpec (@fieldsSpec) {
+    my ($posSpec) = $fieldSpec =~ /\d+.?\d+(.*)/ ;
+#    print "$fieldSpec\t$i\t$posSpec\n";
+    $zinc->itemconfigure ($item,$i,
+                          -text => "$i: $posSpec",
+  			  -border => "contour",
+			  );
+    $i++;
+  }
+}
+
+
+
+MainLoop;
diff --git a/Perl/demos/zinc-demos b/Perl/demos/zinc-demos
index 7fdfd45..cbf447d 100644
--- a/Perl/demos/zinc-demos
+++ b/Perl/demos/zinc-demos
@@ -151,7 +151,8 @@ $T->insert('end', "1. Exemples of all items.\n", [qw/demo demo-items/]);
 $T->insert('end', "2. All items options (and their types).\n", [qw/demo demo-all_options/]);
 $T->insert('end', "3. Examples of line style and line termination.\n", [qw/demo demo-lines/]);
 $T->insert('end', "4. Curves with multiple contours.\n", [qw/demo demo-contours/]);
-$T->insert('end', "5. Use of mapinfos.\n", [qw/demo demo-mapinfo/]);
+$T->insert('end', "5. Examples of labelformat.\n", [qw/demo demo-labelformat/]);
+$T->insert('end', "6. Use of mapinfos.\n", [qw/demo demo-mapinfo/]);
 
 
 $T->insert('end', "\n", '', "Groups, Priority and Clipping\n", 'title');