blob: 60628a848bbbd9f2bcdd749304ce761854d72645 (
plain)
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
|
package ZincTraceUtils;
use Tk;
use strict;
use Tk::Font;
use Tk::Photo;
use vars qw(@EXPORT);
@EXPORT = qw(printItem printArray printList);
### to print something
sub printItem {
my ($value) = @_;
my $ref = ref($value);
# print "VALUE=$value REF=$ref\n";
if ($ref eq 'ARRAY') {
printArray ( @{$value} );
}
elsif ($ref eq 'CODE') {
print "{CODE}";
}
elsif ($ref eq 'Tk::Photo') {
# print " **** $value ***** ";
print "Tk::Photo(\"". scalar $value->cget('-file') . "\")";
}
elsif ($ref eq 'Tk::Font') {
print "'$value'";
}
elsif ($ref eq '') { # scalar
if (defined $value) {
if ($value eq '') {
print "''";
} elsif ($value =~ /\s/
or $value =~ /^[a-zA-Z]/
or $value =~ /^[\W]$/ ) {
print "'$value'";
} else {
print $value;
}
}
else {
print "undef";
}
}
else { # some class instance
return $value;
}
} # end printitem
### to print a list of something
sub printArray {
my (@values) = @_;
if (! scalar @values) {
print "[]";
}
else { # the list is not empty
my @res;
print "[";
while (@values) {
my $value = shift @values;
&printItem ($value);
print ", " if (@values);
}
print "]" ;
}
} # end printArray
sub printList {
print "(";
while (@_) {
my $v = shift @_;
printItem $v;
if ($v =~ /^-\w+/) {
print " => ";
} elsif (@_) {
print ", ";
}
}
print ")";
} # end printList
1;
|
