package Tk::Zinc::TraceUtils;

use vars qw( $VERSION );
($VERSION) = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\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;