#!/usr/bin/perl

package CanvasDirTree;
use warnings;
use strict;

use Tk::widgets qw/Canvas/;
use base  qw/Tk::Derived Tk::Canvas/;
use File::Spec;
use Tk::JPEG;
use Tk::PNG;


Construct Tk::Widget 'CanvasDirTree';

sub ClassInit
{
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);
    $mw->bind($class, "<1>" =>'pick_one' );
    return $class; 
}

sub bind{
   my $self = shift;
   $self->CanvasBind(@_);
}

sub ConfigChanged {
  my ($self,$args)= @_;
  
   foreach my $opt (keys %{$args} ){
 
          if( $opt eq '-indfilla' ){ 
                    $self->{'indfilla'} = $args->{$opt}; 	  

		    my @items = $self->find('withtag','open');
		     foreach my $item (@items){
		         $self->itemconfigure($item, -fill => $args->{$opt});
                      }
		 };

          if( $opt eq '-indfilln' ){ 
	            $self->{'indfilln'} = $args->{$opt}; 	  
                    
		    my @items = $self->find('withtag','ind');
		     foreach my $item (@items){
		        my @tags = $self->gettags($item);
		        if( grep {$_ eq 'open'} @tags ){next} 
		        $self->itemconfigure($item, -fill => $args->{$opt});
                      }
                  };  
       #---------------------------------------------
    
       #----------- fontcolor updates--------------
          if( $opt eq '-fontcolora' ){ 
                    $self->{'fontcolora'} = $args->{$opt}; 	  
		    $self->itemconfigure('list', -activefill => $args->{$opt});
    	         };
        
          if( $opt eq '-fontcolorn' ){ 
	            $self->{'fontcolorn'} = $args->{$opt}; 	  
                    $self->itemconfigure('list', -fill => $args->{$opt});
                  };  
        #---------------------------------------------

       #----------- background image updates--------------
          if(( $opt eq '-backimage' ) or ( $opt eq '-imx' ) or ( $opt eq '-imy' )){ 
                   my $chipped = $opt;
	           substr $chipped, 0, 1, '' ;  #chip off - off of $opt
	           $self->{ $chipped } = $args->{$opt}; 	  
		    $self->set_background( 
                      $self->{'backimage'} ,$self->{'imx'}, $self->{'imy'}
	             );  
		 };
       #---------------------------------------------
   }
  
$self->idletasks;

} #end config changed   
    
#################################################################
sub Populate {
   my ($self, $args) = @_;
  #-------------------------------------------------------------------
   #take care of args which don't belong to the SUPER, see Tk::Derived
   foreach my $extra ('backimage','imx','imy','font','indfilla',
                      'indfilln','fontcolorn','fontcolora') {
       my $xtra_arg = delete $args->{ "-$extra" };  #delete and read same time 
     if( defined $xtra_arg ) { $self->{$extra} = $xtra_arg }
   }
   #-----------------------------------------------------------------

    $self->SUPER::Populate($args);   

    $self->ConfigSpecs(
     -indfilla => [ 'PASSIVE', undef, undef , undef],  # need to set defaults
     -indfilln => [ 'PASSIVE', undef, undef, undef],   # below for unknown
     -fontcolora => [ 'PASSIVE', undef, undef, undef], # reason ??
     -fontcolorn => [ 'PASSIVE', undef, undef, undef], #
     -backimage => [ 'PASSIVE', undef, undef, undef],
     -imx => [ 'PASSIVE', undef, undef, undef],
     -imy => [ 'PASSIVE', undef, undef, undef],
     -font =>[ 'PASSIVE', undef, undef, undef]
    ); 
    
     #set some defaults
     $self->{'indfilla'} ||= 'red';        
     $self->{'indfilln'} ||= 'blue'; 
     $self->{'fontcolorn'} ||= 'black';
     $self->{'fontcolora'} ||= 'red';
     $self->{'backimage'} ||= '';        
     $self->{'imx'} ||= 0; 
     $self->{'imy'} ||= 0;
     $self->{'font'} ||= 'system';


#---determine font spacing by making a capital W---
   my $fonttest =  $self->createText(0,0,
              -fill    => 'black',
              -text    => 'W',            
              -font => $self->{'font'},
              );
   
    my ($bx,$by,$bx1,$by1) = $self->bbox($fonttest);
    $self->{'f_width'} = $bx1 - $bx;
    $self->{'f_height'} = $by1 - $by;
    $self->delete($fonttest);
#--------------------------------------------------

   $self->make_trunk('.', 0); 
 } # end Populate

########################################################
sub adjust_background{
   my ($self, $photo_obj ) = @_;   
  
   $self->delete( $self->{'background'} );
  
   $self->{'bimage'} =  $photo_obj;
   $self->{'bimg_w'} = $self->{'bimage'}->width;
   $self->{'bimg_h'} = $self->{'bimage'}->height;

   $self->{'background'} = $self->createImage( 
         $self->{'imx'}, $self->{'imy'},
          -anchor => 'nw',
         -image  => $self->{'bimage'},
    );
 
 $self->lower($self->{'background'}, 'list');
 $self->lower($self->{'background'}, 'ind');
 
 }
############################################################
sub set_background{
    my( $self, $image ,$xim, $yim) = @_;     
        
    $self->{'backimage'} = $image;
    $self->{'imx'} = $xim; 
    $self->{'imy'} = $yim;

    if( ref $image eq  'Tk::Photo'){
           $self->adjust_background($image)
    }else{ 
          my $photo_obj =  $self->Photo( -file => $self->{'backimage'} );
          $self->adjust_background( $photo_obj ); 
	 }
}
##############################################################
sub get_subdirs{
  my ($self, $dir) = @_;


   if( length $self->{'backimage'} > 0 ){
       $self->set_background( 
            $self->{'backimage'},$self->{'imx'}, $self->{'imy'}
	    );  
     }

    my @subdirs;
    opendir my $dh, $dir or warn $!;

    while ( my $file = readdir($dh) ) {
        next if $file =~ m[^\.{1,2}$];
         if(-d "$dir/$file"){ 
           push @subdirs, $file;       
  	 }else{ next }
     }

  return @subdirs;
}
###########################################################
sub check_depth_2{
   my ($self, $abs_path) = @_;
    
   my $put_ind = 0;
    opendir my $dh, $abs_path or warn $!;
       while ( my $file = readdir($dh) ) {
         next if $file =~ m[^\.{1,2}$];
             if(-d "$abs_path/$file"){ 
                 $put_ind = 1;
                 last;        
  	         }
        }
 return $put_ind;
}
#############################################################
sub make_trunk{
   my ($self, $dir, $level) = @_;
   my $x = 5; my $y = $self->{'f_height'};

   my @subdirs = $self->get_subdirs( $dir  ); 
   my $abs_root = File::Spec->rel2abs( $dir );
   #for windows compat
   $abs_root =~ tr#\\#/#; 

   #handle special case when toplevel is / or C:/, D:/, etc
   if($abs_root eq '/'){$abs_root = ''}
   #for windows compat
   if ( $abs_root =~ m#^([ABCDEFGHIJKLMNOPQRSTUVWXYZ])\:\/$#  )
               {$abs_root = "$1:"} 

   #add a static entry for the topdir 
   my $root_tag;
   if($abs_root eq ''){$root_tag = '/'}else{ $root_tag = $abs_root }
   my $root = $self->createLine(
           $x , $y - .8 * $self->{'f_height'},
           $x + $self->{'f_height'}, $y - .8 * $self->{'f_height'},
           $x + $self->{'f_height'}, $y - .4 * $self->{'f_height'},
             -width => int( $self->{'f_height'} / 6),
             -fill    => $self->{'fontcolora'},
             -activefill => $self->{'fontcolora'},
             -activewidth => int( $self->{'f_height'} / 6) + 1,
              -arrow => 'last',
             -arrowshape => [5,5,2],
             -tags => ['list', $root_tag,],
           );

   my $max = scalar (@subdirs);
   my $count = 0;
  
    foreach my $subdir ( sort @subdirs ){
          my $abs_path = "$abs_root/$subdir";
          #see if any depth 2 subdir exists
          my $put_ind = $self->check_depth_2($abs_path);      
     
       #make open indicator if a dir --------------------------------------	 
       if( $put_ind ){
	 my $ind = $self->createPolygon(
	           $x + .1 * $self->{'f_width'} ,  $y + $y * $count - .3 * $self->{'f_height'}, 
	           $x +  .5 * $self->{'f_width'},  $y + $y * $count,
		   $x + .1 * $self->{'f_width'},  $y + $y * $count + .3 * $self->{'f_height'} ,
		  
		   -fill    => $self->{'indfilln'},
                   -activefill => 'yellow',
		   -outline => 'black',
		   -width   => 1,
		   -activewidth => 2,
                   -tags =>  ['ind', $abs_path], 
	           );
    }
#------------------------------------------------------------
	 my $id = $self->createText(
	           $x + .8 * $self->{'f_width'}, $y + $y * $count + (.5 *$self->{'f_height'}),
	           -fill    => $self->{'fontcolorn'},
		   -activefill => $self->{'fontcolora'},
                   -text    => $subdir,            
	           -font => $self->{'font'},
	           -anchor => 'sw',
	           -tags => ['list', $abs_path], 
	    );
	$count++;
   }

    my ($bx,$by,$bx1,$by1)= $self->bbox('all');
    
    $self->configure(
                -scrollregion =>[0,0,$bx1,$by1]
	     );
    
} # end make_trunk 
############################################################################    
sub pick_one {
     my ($self) = @_;
     my $item = $self->find('withtag','current'); #returns aref
     my @tags = $self->gettags($item->[0]);
     $item = $item->[0];

     $self->{'selected'} = ''; #default is no selection

     if( grep { $_ eq 'ind' } @tags ){
        my $opened = 0;
        if( grep { $_ eq 'open'} @tags){$opened = 1}    
        @tags =  grep { $_ ne 'ind' and  $_ ne 'current' and $_ ne 'open'} @tags;
        my $dir = $tags[0];

       if( $opened ){
               $self->dtag('current', 'open' );
               $self->rotate_poly($item, -90, undef,undef);
               $self->itemconfigure($item, 'fill' => $self->{'indfilln'} );
               $self->idletasks;
	       $self->close_branch($dir,$item);
	    }else{
	       $self->addtag('open', 'withtag', 'current'  );
	       $self->rotate_poly($item, 90, undef,undef);
               $self->itemconfigure($item, 'fill' => $self->{'indfilla'} );
    	       $self->idletasks;       
	       $self->add_branch($dir);
            }
   }else{
         #picked up an indicator click by this point
         #clicks on list items will be handled by get_selected
         @tags =  grep { $_ ne 'list' and  $_ ne 'current'} @tags;
         $self->{'selected'} = $tags[0];
         $self->{'selected'} ||= '';
     }
          
} # end pick_one    
####################################################################
sub get_selected{
   my ($self) = @_;
   return $self->{'selected'};
}
###################################################################
sub add_branch{
   my ($self, $abs_path) = @_;
   $self->Busy;
  
 #for windows compat
   $abs_path =~ tr#\\#/#; 

   my $item;
   foreach my $it( $self->find('withtag', $abs_path)  ){
         my @tags =  $self->gettags($it);     
         if( grep { $_ eq 'list'} @tags ){ $item = $it }
     }
    
   my ($bx,$by,$bx1,$by1)= $self->bbox($item);
   my $x = $bx + $self->{'f_width'};
   my $y_edge = ($by + $by1)/2;
   my $y = $by1;
   my $count = 0;

   my @subdirs = $self->get_subdirs( $abs_path );  
      
   my $max = scalar @subdirs;
   my $max_add = $max * $self->{'f_height'};

   $self->make_space($y_edge,$max_add);

   # add sub entries
    foreach my $subdir (sort @subdirs  ){
        my $abs_path1 = File::Spec->rel2abs("$abs_path/$subdir");
        #for windows compat
        $abs_path1 =~ tr#\\#/#; 
        #see if any depth 2 subdir exists
        my $put_ind = $self->check_depth_2($abs_path1);      
      
      #make open indicator---------------------------------------------	 
       if( $put_ind ){
	 my $ind = $self->createPolygon(
	          $x - .9 * $self->{'f_width'} , .5*$self->{'f_height'}+ $y + $self->{'f_height'}* $count - .3 * $self->{'f_height'}, 
	          $x -  .5 * $self->{'f_width'}, .5*$self->{'f_height'}+ $y + $self->{'f_height'}* $count,
		  $x - .9 * $self->{'f_width'},  .5*$self->{'f_height'}+ $y +  $self->{'f_height'}* $count + .3 * $self->{'f_height'} ,
		  
		   -fill    => $self->{'indfilln'},
                   -activefill => 'yellow',
		   -outline => 'black',
		   -width   => 1,
		   -activewidth => 2,
                   -tags =>  ['ind', $abs_path1], 
	           );

	}
#------------------------------------------------------------
	 my $id = $self->createText(
	            $x , $y + $self->{'f_height'} * ($count + 1),
	           -fill    => $self->{'fontcolorn'},
		   -activefill => $self->{'fontcolora'},
                   -text    => $subdir,            
	           -font => $self->{'font'},
	           -anchor => 'sw',
	        #   -tags => ['list',$abs_path, $abs_path1], 
		   -tags => ['list', $abs_path1], 
	    );
	
	#add tag to upstream indicator
	
	$count++;
   }

  $self->Unbusy;

    ($bx,$by,$bx1,$by1)= $self->bbox('list');
    $self->configure(
                -scrollregion =>[0,0,$bx1,$by1],
	     );
	
} # end add_branch 
############################################################################    
sub close_branch{
  my($self, $abs_path, $ind ) = @_;

  my @y; my $x;

   foreach my $it( $self->find('all')  ){

         my @tags =  $self->gettags($it);     

	 if( grep { $_ eq 'current'} @tags ){next}
         if( grep { $_ eq $abs_path } @tags ){next}
         if( grep { $_ =~ /^$abs_path(.*)/ } @tags ){
             shift @tags; #shift off ind or list tag           

          if(scalar @tags > 0 ){
    	        my ($bx,$by,$bx1,$by1)= $self->bbox( $tags[0] );
	        push @y,$by; 
	        push @y,$by1;   
	        $self->delete($it);      
             }
          }
    }
     
  my @sorted = sort {$a<=>$b} @y ;
  my $amount = $sorted[-1] - $sorted[0];
  my ($bx,$by,$bx1,$by1)= $self->bbox('all');
 
  my @items = $self->find('enclosed',
          $bx,  $sorted[-1] - $self->{'f_height'} , 
	  $bx1, $by1 + $self->{'f_height'} ); 
 
  foreach my $move (@items){
      $self->move($move,0, -$amount);
   }

#adjust scroll region
   #$c->configure(-scrollregion => [$c->bbox('all')]);    
   ($bx,$by,$bx1,$by1)= $self->bbox('list');
    $self->configure(
                -scrollregion =>[0,0,$bx1,$by1],
	     );

}
##############################################################################
sub make_space{
 my ($self, $y, $amount) = @_;
  
  my ($bx,$by,$bx1,$by1)= $self->bbox('all');
 
  my @items = $self->find('enclosed',$bx,$y,$bx1,$by1 + $self->{'f_height'}); 
  
  foreach my $move (@items){
      $self->move($move,0,$amount);
   }

}
##############################################################################


sub rotate_poly {
    my ($self, $id, $angle, $midx, $midy) = @_;
    
    # Get the old coordinates.
    my @coords = $self->coords($id);

    # Get the center of the poly. We use this to translate the
    # above coords back to the origin, and then rotate about
    # the origin, then translate back. (old)

    ($midx, $midy) = _get_CM(@coords) unless defined $midx;

    my @new;

    # Precalculate the sin/cos of the angle, since we'll call
    # them a few times.
    my $rad = 3.1416*$angle/180;
    my $sin = sin $rad;
    my $cos = cos $rad;

    # Calculate the new coordinates of the line.
    while (my ($x, $y) = splice @coords, 0, 2) {
	my $x1 = $x - $midx;
	my $y1 = $y - $midy;

	push @new => $midx + ($x1 * $cos - $y1 * $sin);
	push @new => $midy + ($x1 * $sin + $y1 * $cos);
    }

    # Redraw the poly.
    $self->coords($id, @new);
}
#################################################################
# This sub finds the center of mass of a polygon.
# I grabbed the algorithm somewhere from the web.
# I grabbed it from Slaven Reszic's RotCanvas :-)
sub _get_CM {
    my ($x, $y, $area);

    my $i = 0;

    while ($i < $#_) {
	my $x0 = $_[$i];
	my $y0 = $_[$i+1];

	my ($x1, $y1);
	if ($i+2 > $#_) {
	    $x1 = $_[0];
	    $y1 = $_[1];
	} else {
	    $x1 = $_[$i+2];
	    $y1 = $_[$i+3];
	}

	$i += 2;

	my $a1 = 0.5*($x0 + $x1);
	my $a2 = ($x0**2 + $x0*$x1 + $x1**2)/6;
	my $a3 = ($x0*$y1 + $y0*$x1 + 2*($x1*$y1 + $x0*$y0))/6;
	my $b0 = $y1 - $y0;

	$area += $a1 * $b0;
	$x    += $a2 * $b0;
	$y    += $a3 * $b0;
    }

    return split ' ', sprintf "%.0f %0.f" => $x/$area, $y/$area;
}

1;
#######################################################################


#######################################################################
package main;
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new();

$mw->fontCreate('big',
          -family=>'arial',
          -weight=>'bold',
          -size=>int(-18*18/14));

my $frame = $mw->Frame()->pack(-expand=>1,-fill=>'both');

# base64encoded png 
my $bunny = $mw->Photo(-data => 
'iVBORw0KGgoAAAANSUhEUgAAAB4AAAAjEAIAAABcJvHFAAAACXBIWXMAAAsSAAALEgHS3X78AAAD
F0lEQVR42u1YL+yqUBj1vfcLbhY3C44is8BIREYSG9FoNBqNkok2aFhp2BhJDWyadCZN/ilOGxan
jRdOuRsPxl/f+23vJKfX7x6+73znu5dK5RviV9QPDMMwDIPP7/f7/X6XTWU0Go1Go06n0+l0PM/z
PC91CNu2bduWZVmW5bLpjsfj8XgcBEEQBJPJZDKZZAw0n8/n8zkCGYZhGIYgCIIgFEt3OBwOh8OA
gKZpmqZlDDedTqfTKRnO933f95GVer1er9fz0BVFURRFxCR3QfyMQfv9fr/fDyLgOI7jONmo419k
JUkMBoPBYJCRNBrxdrvdbrco6qvVarVaIWdFpQO/5tIcFBbE4nQ6nU6nJIpHjlGlEklTFEVRFDIa
T32/3+/3+3jqHMdxHBcfB2sK6HFFURRFeb1er9crfksoNUrr0GvUfxGfnA+FmX+QALDItGLDA6O2
pQyCJFkPqxMDK2p9LodOAhQaLRjfoKRGo2wObl3G8PoDsA0Gb5Q5oonjfSNKTh96AOh+u91ut1uS
FuZrONPJ7bJ06tA9TDDsD6QkCnDltEDRkV1Q9AnENyuk8hcyChkkcZKo5uv1er1er3S6cAPkFXSx
MQodPrXFg2zTEsVANhO2JNdEmVo80ub7K/lSDHPyLkNaXrVarVar2W46LMuyLFsKaZ7neZ4nvwFR
NGKeGjYajUajkXz9z+RLn8/n8/ms/ANIQXq5XC6Xy/v9fr/fvw3p9Xq9Xq9VVVVV9fF4PB6Pokhc
r9fr9Vr6s6Lf4dNpbS6/exQA3BHDt/fkPl3wwT85wlcEcrCHZyHO1tmOSl95iGLcQN80TdM0jTa1
LMuyLF3XdV03TdM0zWaz2Ww2Xdd1XRenDlDHgTbtvj/ykMZpDm/6LpfL5XLBmGi32+12G6Th5RAA
Pne73W63iwfGYFosFovF4kOZrtVqtVoN16TD4XA4HPAAKDp5yZUkSZIk1GGz2Ww2m91ut9vt0Mof
lcfxeDwej7PZbDaboRFbrVar1SJfIsLdYZfn8/l8Pue3y1zyiH9VAMFElb5Yp/+PcvAbH/25ox5S
PYYAAAAASUVORK5CYII=');


my $tux = $mw->Photo(-data =>
'/9j/4AAQSkZJRgABAQIASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMjIyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAA8AEMDASIA
AhEBAxEB/8QAHAAAAgIDAQEAAAAAAAAAAAAAAAQFBwIDCAYB/8QAMBAAAQMCBQMCBQMFAAAAAAAA
AQIDBAARBQYSITEHUXETYSIyQUKBFTOhI1KRscH/xAAaAQEBAQADAQAAAAAAAAAAAAAAAQIDBQYE
/8QAIxEAAgEDAwQDAAAAAAAAAAAAAAECAwQREyExBRJBkVFSof/aAAwDAQACEQMRAD8Ap5brjgSF
uLUEgBIUomwACRb8ADwB2rCl5bymWgU8k2v2oiyPWGk/OP5oBiiilYkbEsanCJhsZ+S8r5Wo6CtR
97DegGqKZw3LWZpk6RDYwiY69GIS+0WiFNk8A34J+gPNaHW3GHVtPIU242opWhYsUkcgg8GgNa3E
Nga1AXr6CFC4NxUXKe9Z24+UbCm4CiWSD9DtQE07jmKvurdXiMrUo3Ol0pA8AbAew2FFR9FY0ofV
F7n8is9N2QexqPQstrCk8ipd1HqNKR3FQ6klKikixFbIS3qhcYuJ/tJ8V7LpFjWV8Pm4rh2aU6Yu
JMJZD11AJsoK0lSTqAJA3Haq9Ze0sutk7Ebb/WiEtpucwt9OppKwVp7i+9R8A6jVO/UcfmTGMBZm
YEsxnI6npBaccdZvpeSLG4sQAFEXCQeDVV9a1uzsyJxVjBZUGO6wht5x1KbLdBVc3SSPl0jm/wAN
WejGn3mmpGH4Yqdh7qApp2K+gK8FKym1uOT+K8x1CzNHiZUmQMSYaRMmJ0sRQ6HFJTt8a7CwII2t
fgb828pa9avalyoSgmm+E91++POV6OzqWlGNPKb29FA1KQkaI4J+43qOab9V1KO53qZAsABwK9Yd
YFFZBtZFwhVvFFTKGDGkpse49VPP3Cnaxct6ar8WNUELW+HEkT5bUSK0t191QQ22gXKiTYACtFWR
0LQ0vqnh/qtayG3Sg2uEq9NW/wDugLEyX0XzHBw0KxDM8jDC4NRiRPj0+VXtfwD5rxHVLpPiOUo/
64nE14nDccCHXHEkONqPGrc3B7966qqMzBgcPMuAy8HnhRjSkaVaDYixBBHuCAfxWFTgpOSW7K5N
rBxFAaGlTvJ48U7Tmasrzsi5qfwmbct31NPWsHWz8qh/33BFJ1shaLs7qHiTpmwoOMRoz/8AUbai
IfDQB3ukEnY882322tRUE9nTMDjzjjeKS46VqKvSYkOIQm+5skKsB7DaigPF0vMVpjH32pik8Q/b
R5oCPrq3ofktnL+UGsYebviOJoDhUoboa+1I87KPe47VyvHSFyWkngrAP+a71jR24kVmMynS0yhL
aE9kgWAoDbRRRQFc9ZsnR8zZJkzUpAn4W2qSy59SgC60n2IF/IHvXLkVZcjpJ5GxrrzqfNdgdM8f
fZ06zFLXxC+yyEH+FGuQIP7Fve9AW9Iw+JIfU7h+TJaoqrFsuy1sqO290FSrb3+p7+1FQKHXEoAW
UuqAtrW2gqPnaivld3BPGGcmkz//2Q==');


my $ztree = $frame->Scrolled('CanvasDirTree',
            -bg =>'lightblue',
            -width =>300,  
	    -height =>300, 
#	    -backimage => 'bridget-5a.jpg',  #either a file
	    -backimage => $bunny,  #or Tk::Photo object data
	    -imx => 200,           # position relative to nw corner
	    -imy => 10,            # to place nw corner of image
	    -font => 'big',        # defaults to system
#	    -fontcolorn => 'cyan', # defaults to black
#	    -fontcolora => 'lightseagreen', #defaults to red
#	    -indfilln => 'hotpink',         #defaults to blue   
#	    -indfilla => 'orange',          #defaults to red
            -scrollbars =>'osw',
            )->pack(-side=>'left',-fill=>'both', -expand=>1); 

my $text = $frame->Scrolled('Text',
                       -bg=>'white',
		       -width => 40,
		       -scrollbars =>'osoe',
	)->pack(-side=>'right',-fill=>'both',-expand=>1);

my $button = $mw->Button(-text=>'Exit',-command=>sub{exit})->pack();

$ztree->bind('<ButtonPress-1>', sub{   
               my $selected = $ztree->get_selected();

	        if(length $selected){
	            $text->insert('end',"$selected\n");
	            $text->see('end');
	         }
	   });


$mw->after(10000, sub{ $ztree->configure('-indfilla' => 'green' );
                       $ztree->configure('-indfilln' => 'black'); 
                       $ztree->configure('-fontcolora' => 'orange');
		       $ztree->configure('-fontcolorn' => 'purple'); 
                       $ztree->configure('-bg' => 'white'); 
		    });

$mw->after(15000, sub{ $ztree->configure('-indfilla' => 'red' );
                       $ztree->configure('-indfilln' => 'orange'); 
                       $ztree->configure('-fontcolora' => 'white');
		       $ztree->configure('-fontcolorn' => 'cyan'); 
                       $ztree->configure('-bg' => 'black');
		   });

$mw->after(20000, sub{ 
                    $ztree->configure('-backimage' => $tux ); 
                   });

my $y = 10;

$mw->after(21000, sub{ 
                       $mw->repeat(100,sub{ 
	                             $ztree->configure('-imy' => $y ); 
                                     $y += 2 });
	  });


MainLoop;