#!/usr/bin/perl
use Tk;
use Tk::Zinc;

# there is a penalty for creating objects, a slight overhead 
# so if you are going to create alot of objects, you must 
# reuse them....this reconfigures and reuses the bubble objects 

my $mw = MainWindow->new;
$mw->geometry("700x600");
$mw->resizable(0,0);

my $launcher;
my $zinc = $mw->Zinc(-width => 700, -height => 565,
                    -backcolor => 'black',
                    -borderwidth => 3, -relief => 'sunken')->pack();

#my $zwidth  = $zinc->reqwidth; 
#my $zheight = $zinc->reqheight; 
#print "$zheight $zwidth\n";     

# Then we create a filled rectangle, in which we will display explain text. 
$zinc->add('rectangle', 1 , [200, 400, 490, 490],
           -linewidth => 2,
           -filled => 1,
           -fillcolor => 'SkyBlue',
           -priority => 1,
           );

my $text = $zinc->add('text', 1,
                      -position => [350, 445],
                      -anchor => 'center',
                      -priority => 3,
                      -width => 200,
                      );

#####setup 100 bubble objects for reuse############################# 
my %bubs;       #reusable object space 
my @bubjects = (1..100);
my @x = (1,-2,3,-4,5, -1,2,-3,4,-5 ); #give random diagonal motion 
my $count = 0;

foreach my $bub (@bubjects){
     $count++;
     $tag = $count;
     push (@x,shift(@x));
     $afterdelay = 1 + int(rand(99));

# Create the 100 ztkbubble object (see Package ztkbubble below) 
 $bubs{$bub} = ZtkBubble->new(
                 -widget => $zinc,
                 -name => $count,
                 -bub => $bub,
                 -tags => $tag,
                 -x => rand 700,
                 -y => 700,
                 -radius => 10 + rand(30),
                 -color => 'green',
                 -dx => $x[0],
                 -dy => -20,
                 -afterdelay => $afterdelay,
                );
}
########################################################### 

# Display comment 
&comment("Strike any key to begin");

# Create Tk binding 
$mw->Tk::bind('<Key>', \&openmode);

my $closebutton = $mw->Button(-text => 'Exit',
    -command => sub{
                 if(defined $launcher){$launcher->cancel};
                exit(0);
                })->pack;

MainLoop;
##################################################### 

sub openmode {
    $mw->Tk::bind('<Key>', \&closemode);
     &comment("Bubbling!!");


# 50 is about my max on a 800 Mhz K6, adjust accordingly 
$launcher = $mw->repeat(100,sub{
         my $bub = shift @bubjects;
        $bubs{$bub}->bubble_move();
   });
}


sub closemode {
    # and then inform user 
    &comment("We are bubbling baby !!");
}

# Just display comment  
sub comment {
    my $string = shift;
    $zinc->itemconfigure($text, -text => $string);
}

#============================================================================= 
#                 Bubble  Class 
#============================================================================= 
package ZtkBubble;

use strict 'vars';
use Carp;
#==================== 
# Object constructor 
#==================== 
sub new {
    my ($class, %arg) = @_;

    # object attributes 
    my $self = {
        'widget' => $arg{-widget},      # widget reference into which it goes 
        'name'  => $arg{-name},         #identifying name  
        'bub'  => $arg{-bub},           #which reusable bubble space it's using 
        'tags' => $arg{-tags},            # tag object of self 
        'x' => $arg{-x},
        'y' => $arg{-y},               # origin coordinates 
        'radius' => $arg{-radius},      # radius 
        'color' => $arg{-color},        # top Group item 
        'dx' => $arg{-dx},              # initial x direction  
        'dy' => $arg{-dy},              # initial y direction  
        'afterdelay' => $arg{-afterdelay},       # repeater time delay 
    };
    bless $self;

#   print "just blessed $self\n"; 

    $self->{topgroup} = $self->{widget}->add('group', 1,
                                       -priority => 2,
                                       -visible => 1);

    $self->{widget}->coords($self->{topgroup}, [$self->{x},$self->{y}]);
    $self->{timer}; #declare variable to store internal timer  
    $self->{'init'} = $self->{widget}->tget( $self->{topgroup}  );
    # print join ' ',@{ $self->{init}  },"\n";  #initial position 

   my $color1 = '#';
   for (0 .. 2){
     my $rgb = unpack('H*', pack('n', (int(rand(192)+64))));
     $rgb =~ s/.+(\w\w)$/$1/;
     $color1 .= $rgb;
}

#add items to self group 

    $self->{arc1} =
    $self->{widget}->add('arc',  $self->{topgroup},
                     [-$self->{radius}, -$self->{radius}, $self->{radius}, $self->{radius}],
                     -visible => 1,
                     -filled => 1,
                     -closed => 1,
                     -extent => 360,
                     -pieslice => 1,
                     -fillcolor => $color1,
                     -linewidth => 1,
                     -startangle => 0 ,
                     -tags => [$self->{tags},'bubble'],
                     );
  $self->{arc2} =
  $self->{widget}->add('arc',  $self->{topgroup},
                     [-$self->{radius}/2, -$self->{radius}/2, $self->{radius}/2, $self->{radius}/2],
                     -visible => 1,
                     -filled => 1,
                     -closed => 1,
                     -extent => 360,
                     -pieslice => 1,
                     -fillcolor => $self->{color},
                     -linewidth => 1,
                     -startangle => 0 ,
                     -tags => [$self,'bubble'],
                     );

    # Create the Text item representing the identifier. 
    $self->{txt} =
    $self->{widget}->add('text', $self->{topgroup},
                 -position => [0, 0],
                 -anchor => 'center',
                 -text => $self->{'name'},
                 );

    $self->{line} =
    $self->{widget}->add('curve',  $self->{topgroup},
                     [-$self->{radius}, -$self->{radius},$self->{radius}, $self->{radius}],
                     -visible => 1,
                     -linecolor => 'white',
                     -linewidth => 3,
                     -tags => [$self,'bubble'],
                     );
    return $self;
}
############################################# 
sub DESTROY{
  my ($self) = @_;
    print "destroying->",$self,' ', $self->{bub}. "\n";
}
########################################### 
#================ 
# Public methods 
#================ 

# Start motion of $self  
sub bubble_move {
    my $self = shift;
$self->_move();
}

#================= 
# Private methods 
#================= 

sub _close {
    my ($self) = @_;
    my $widget = $self->{widget};
    my $group = $self->{topgroup};
    my $name = $self->{name};
    my $bub = $self->{bub};
    my $tag = $self->{tags};

    &main::comment("Poof!!   name->$name    bub#->$bub");
    $widget->dtag($tag);
    $self->{timer}->cancel;
    push @bubjects, $self->{bub};  #return to pool 
#   $self->DESTROY;    #don't use this, since we are reusing them 
}

# Generate motion and  rotation animation. 
sub _move {
    my ($self) = @_;
    my $widget = $self->{widget};
    my $group = $self->{topgroup};
    $widget->translate($group, $self->{'dx'} ,$self->{'dy'});

   $self->{x} += $self->{'dx'};
   $self->{y} += $self->{'dy'};

 #check for side collisions 
   if( ( $self->{x} < 0) or ($self->{x} > $self->{widget}->reqwidth ) )
       { $self->{'dx'} *= -2 }


 #reset bubbles for next run with new name 
 if($self->{y} < -$self->{radius}){
             $self->_close();

             $self->{widget}->tset( $self->{topgroup} , @{ $self->{init} } );
             # print join ' ',@{ $self->{init}  },"\n"; 
             $self->{x} = ${ $self->{init} }[4];
             $self->{y} = ${ $self->{init} }[5];
             # $self->{widget}->coords($self->{topgroup}, [$self->{x},$self->{y}]); 
             $self->{name} = $count++;
             $self->{widget}->itemconfigure($self->{txt}, -text => $self->{'name'} );
             return }

 $widget->rotate($group,.9,$self->{x},$self->{y} );

#use $self->timer instead of anonymous timer, in order to cancel on close  
$self->{timer} = $widget->after($self->{afterdelay}, sub { $self->_move() });
}

1;