1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
#!/usr/bin/perl -w
# $Id$
# This simple demo has been developped by C. Mertz <mertz@cena.fr>
use vars qw( $VERSION );
($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
use Tk;
use Tk::Zinc;
use Tk::Pane;
use strict;
my $mw = MainWindow->new();
# The explanation displayed when running this demo
my $label=$mw->Label(-text =>
"Click on one of the following
buttons to get a list of Item
attributes (or zinc options)
with their types.\n",
-justify => 'left')->pack(-padx => 10, -pady => 10);
# Creating the zinc widget
my $zinc = $mw->Zinc(-width => 1, -height => 1,
-font => "10x20", # usually fonts are sets in resources
# but for this example it is set in the code!
-borderwidth => 0, -relief => 'sunken',
)->pack;
# 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 my $type qw(tabular track waypoint) {
$itemtypes{$type} = $zinc->add($type, 1, 0);
}
# These items needs no specific initial values
foreach my $type qw(group icon map reticle text window) {
$itemtypes{$type} = $zinc->add($type, 1);
}
# These items needs some coordinates at creation time
# However curves usually needs more than 2 points.
foreach my $type qw(arc curve rectangle) {
$itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1]);
}
# Triangles item needs at least 3 points for the coordinates
foreach my $type qw(triangles) {
$itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1 , 2,2]);
}
sub showAllOptions {
my ($type) = @_;
my $tl = $mw->Toplevel;
my $title = "All options of an item $type";
my @options;
if ($type eq 'zinc') {
@options = $zinc->configure();
$title = "All options of zinc widget";
}
else {
@options = $zinc->itemconfigure($itemtypes{$type});
$title = "All attributes of an item $type";
}
$tl->title($title);
my $frame = $tl->Scrolled('Pane',
-scrollbars => 'e',
-height => 600,
);
$frame->pack(-padx => 10, -pady => 10,
-ipadx => 10,
-fill => 'both',
-expand => 1,
);
my $fm = $frame->LabFrame(-labelside => 'acrosstop',
-label => $title,
)->pack(-padx => 10, -pady => 10,
-ipadx => 10,
-fill => 'both');
my $bgcolor = 'ivory';
$fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge')
->grid(-row => 1, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
$fm->Label(-text => ($type eq 'zinc') ? 'optionClass' : 'Type',
-background => $bgcolor, -relief => 'ridge')
->grid(-row => 1, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
$fm->Label(-text => ($type eq 'zinc') ? 'defaultValue' : 'ReadOnly',
-background => $bgcolor, -relief => 'ridge')
->grid(-row => 1, -column => 3, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
my $i = 2;
my %options; #we used this hastable to sort the options by their names
if ($type eq 'zinc') {
for my $elem (@options) {
# print "$elem @$elem\n";
my ($optionName, $optionDatabaseName, $optionClass, $default, $optionValue) = @$elem;
$options{$optionName} = [$optionClass, $default, "", $optionValue];
}
}
else {
for my $elem (@options) {
my ($optionName, $optionType, $readOnly, $empty, $optionValue) = @$elem;
$options{$optionName} = [$optionType, $readOnly, $empty, $optionValue];
}
}
for my $optionName (sort keys %options) {
my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$optionName}};
$fm->Label(-text => $optionName, -relief => 'ridge')
->grid(-row => $i, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
$fm->Label(-text => $optionType, -relief => 'ridge')
->grid(-row => $i, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
# $empty is for provision by Zinc
if ($type ne 'zinc') {
if ($readOnly) {$readOnly = "read only"} else { $readOnly = "" }
}
$fm->Label(-text => $readOnly, -relief => 'ridge')
->grid(-row => $i, -column => 3, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
# we do not display $optionValue for these fake items
$i++;
}
$tl->Button(-text => 'Close',
-command => sub {$tl->destroy})->pack;
}
my $col = $mw->Frame()->pack();
my $width=0;
foreach my $type (sort keys %itemtypes) {
if (length ($type) > $width) {
$width = length ($type);
}
}
foreach my $type (sort keys %itemtypes) {
$col->Button(-text => "$type",
-width => $width,
-command => sub {&showAllOptions ($type);},
)->pack(-pady => 4);
}
$col->Button(-text => "zinc widget options",
-command => sub {&showAllOptions ('zinc');},
)->pack(-pady => 4);
MainLoop();
1;
|
