package Tk::Zinc::TraceUtils; use vars qw( $VERSION ); ($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); use Tk; use Tk::Font; use Tk::Photo; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(printItem printArray printList Item Array List); use strict; sub printItem { print &Item (@_); } sub printArray { print &Array (@_); } sub printList { print &List (@_); } ### to print something sub Item { my ($value) = @_; my $ref = ref($value); # print "VALUE=$value REF=$ref\n"; if ($ref eq 'ARRAY') { return Array ( @{$value} ); } elsif ($ref eq 'CODE') { return "{CODE}"; } elsif ($ref eq 'Tk::Photo') { # print " **** $value ***** "; return "Tk::Photo(\"". scalar $value->cget('-file') . "\")"; } elsif ($ref eq 'Tk::Font') { return "'$value'"; } elsif ($ref eq '') { # scalar if (defined $value) { if ($value =~ /^-[a-zA-Z]([\w])*$/) { # -option1 or -option-1 return $value; } elsif ($value =~ /^-?\d+(\.\d*(e[+-]?\d+)?)?$/) { # -1. or 1.0 or -1.2e+22 or 1.02e+034 if ($value =~ /(.*[-+]e)0+(\d+)/) { # removing the 0 after e+ or e- return $1.$2; } else { return $value; } } elsif ($value eq '' or $value =~ /\s/ or $value =~ /^[a-zA-Z]/ or $value =~ /^[\W]/ ) { return "'$value'"; } else { return $value; } } else { return "_undef"; } } else { # some class instance return $value; } } # end Item ### to print a list of something sub Array { my (@values) = @_; if (! scalar @values) { return "[]"; } else { # the list is not empty my $res = "["; while (@values) { my $value = shift @values; $res .= &Item ($value); $res .= ", " if (@values); } return $res. "]" ; } } # end Array sub List { my $res = "("; while (@_) { my $v = shift @_; $res .= Item ($v); if (@_ > 0) { ## still some elements if ($v =~ /^-\d+$/) { $res .= ", "; } elsif ($v =~ /^-\w+$/) { $res .= " => "; } else { $res .= ", "; } } } return $res. ")"; } # end List 1;