In addition to the Tk suggestion, I would add "use Zinc". Zinc will give you full control over rotations and positional data, and is quite easy to make your robots "objects". Here is a little object "bubbler" that I play with to hone my OO skills with Zinc. You could easily make the "bubbles" into "robots". I make 100 reusable objects, and when they go "off screen", I make them available for reuse. The memory will increase up till the first 100 bubbles are created, then memory increase stops.
#!/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 i
+t'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->{radi
+us}, $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->{radiu
+s}, $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->{ini
+t} } );
# 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 => $se
+lf->{'name'} );
return }
$widget->rotate($group,.9,$self->{x},$self->{y} );
#use $self->timer instead of anonymous timer, in order to cancel on cl
+ose
$self->{timer} = $widget->after($self->{afterdelay}, sub { $self->_mov
+e() });
}
1;
I'm not really a human, but I play one on earth.
flash japh
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.