UPDATE Got rid of huge ugly array.

#!/usr/bin/perl
use Tk;

my $STEP    = 20;
my $BOXSIZE = 70;
my $WINDOWX = 700;
my $WINDOWY = 500;

my $mw = new MainWindow(
    -title  => "This is a test",
    -width  => $WINDOWX,
    -height => $WINDOWY,
);
my $canvas = $mw->Canvas(
    -bg     => "black",
    -width  => $WINDOWX,
    -height => $WINDOWY
)->pack();

$canvas->repeat( $STEP, sub { rect($canvas); } );
$canvas->repeat( $STEP, sub { oval($canvas); } );

MainLoop();

sub oval {
    my $c = shift;

    my $x     = rand $WINDOWX;
    my $y     = rand $WINDOWY;
    my $sizex = rand $BOXSIZE;
    my $sizey = rand $BOXSIZE;

    my $o = $c->createOval(
        $x,          $y,
        $x + $sizex, $y + $sizey,
        -fill => getcolor(),
    );
    push ( @ovals, $o );
    while ( @ovals > 1000 ) {
        $c->delete( shift (@ovals) );
    }
}

sub rect {
    my $c = shift;

    my $x    = rand $WINDOWX;
    my $y    = rand $WINDOWY;
    my $size = rand $BOXSIZE;

    my $r = $c->createRectangle(
        $x,         $y,
        $x + $size, $y + $size,
        -fill => getcolor(),
    );
    push ( @rects, $r );
    while ( @rects > 1000 ) {
        $c->delete( shift (@rects) );
    }
}

sub getcolor{
 my($string) = '#';
 my($length) = 7;
 my(@chars) = ('a' .. 'f', 0 .. 9);
 while (length($string) != $length) {
 $string .= $chars[ rand($#chars) ];
  }
return $string;
}
[download]