#!/usr/bin/perl -w
use strict;

use Tk;
my $moveX = 1;
my $moveY = 1;
my ($stop, $speed);

my $mw = tkinit();

my $field = $mw->Canvas(-background => 'white')
   ->pack(-side => 'top', 
          -fill => 'both', 
          -expand => 1
          );

my $rect = $field -> createRectangle(0, 0, 10, 10, -fill => 'blue');
my $b1 = $mw->Button(-text => 'Move it!', 
               
      -command => sub{
               
               
        $stop = 0;
               
               
        &moveSquare();
               
               
        }) 
->pack(-side => 'left');

$mw->Scale(-from => 1, 
           -to => 10, 
           -label => 'Speed', 
           -orient => 'horizontal', 
           -variable => \$speed)
        ->pack(-side => 'left');

my $b2 = $mw->Button(-text => 'Stop it!', 
               
      -command => sub{ $stop = 1 })
->pack(-side => 'left');
MainLoop;

sub moveSquare {
  my @colors = qw/red yellow blue orange pink green gray white/;
  for (;;) {
    last if $stop;
    my $height = $field->height;
    my $width = $field->width;

    my @coords = $field->coords($rect);
    print join ';', @coords;
    print $/;

    #generate random colors
    my $rect_color = $colors[rand(scalar @colors)];
    my $bg_color;

    do {$bg_color = $colors[rand(scalar @colors )]} while ($rect_color eq $bg_color);

    #prevent rectangle from going out at left side
    if ($coords[0] < 1) {
      $moveX = 1;
      conf_field($field, $bg_color, $rect_color);
    }
    #prevent rectangle from going out at top
    if ($coords[1] < 1) {
      $moveY = 1;
      conf_field($field, $bg_color, $rect_color);
    }
    #prevent rectangle from going out at right side 
    if ($coords[2]+1 > $width-1) {
      $moveX = -1;
      conf_field($field, $bg_color, $rect_color);
    }
    #prevent rectangle from going out at bottom
    if ($coords[3]+1 > $height-1) {
      $moveY = -1;
      conf_field($field, $bg_color, $rect_color);
    }
    $field->move($rect, $moveX, $moveY);
    $mw->after(10-$speed);
    $mw->update;
  }
}

sub conf_field {
    my ($field, $bg_color, $rect_color) = @_;
    $field->configure(-background => $bg_color);
    $field->itemconfigure($rect, -fill => $rect_color);
}

.
.
.
332;104;342;114
331;103;341;113
330;102;340;112
329;101;339;111
328;99.9999999999999;338;110
327;98.9999999999999;337;109
326;97.9999999999999;336;108
.
.
.