Acme-RTB
view release on metacpan or search on metacpan
package Acme::RTB;
use 5.008;
use strict;
use warnings;
use IO::Select;
use IO::Handle;
our $VERSION = '0.01';
=head1 NAME
Acme::RTB - Perl extension for building realtimebattle bots
=head1 SYNOPSIS
use Acme::RTB;
my $robot = Acme::RTB->new({ Name => 'Anarion PerlBot 1.0',
Colour => 'ff0000 ff0000',
Log => '/home/anarion/perl/rtb/robot.log'} );
$robot->Start;
=head1 DESCRIPTION
This module will allow you to create bots for battling with realtimebattle.
L<http://realtimebattle.sourceforge.net/>
=head1 METHODS
=over 4
=head2 new
=back
First create an object, you should pass a hashref with the Name, Colour and if you
will the logfile.
my $robot = Acme::RTB->new({ Name => 'Anarion PerlBot 1.0',
Colour => 'ff0000 ff0000',
Log => '/home/anarion/perl/rtb/robot.log'} );
=over 4
=head2 modify_action
=back
With this method you can change all the actions that your bot do when it recieves
a msg from the server, the possible actions are:
Initialize
YourName
YourColour
GameOption
GameStarts
Radar
Info
RobotInfo
RotationReached
Energy
RobotsLeft
Collision
Warning
Dead
GameFinishes
Unknown
$robot->modify_action( Radar => \&my_radar );
$robot->modify_action( GameStarts => \&my_gamestart);
$robot->modify_action( Collision => \&my_collision);
Here are the parameters that you recieve from the server:
=head3 Initialize [first? (int)]
This is the very first message the robot will get. If the argument is one, it is the first sequence in the tournament and it should send Name and Colour to the server, otherwise it should wait for YourName and YourColour messages (see below).
=head3 YourName [name (string)]
Current name of the robot, don't change it if you don't have very good reasons.
=head3 YourColour [colour (hex)]
Current colour of the robot, change it if you find it ugly.
=head3 GameOption [optionnr (int)] [value (double)]
At the beginning of each game the robots will be sent a number of settings, which can be useful for the robot. For a complete list of these, look in the file Messagetypes.h for the game_option_type enum. In the options chapter you can get more detail...
=head3 GameStarts
This message is sent when the game starts (surprise!)
=head3 Radar [distance (double)] [observed object type (int)] [radar angle (double)]
=over 4
=head2 Brake [portion (double)]
=back
Set the brake. Full brake (portion = 1.0) means that the friction in the robot direction is equal to Slide friction.
=over 4
=head2 Shoot [shot energy (double)]
=back
Shoot with the given energy. The shot options give more information.
=over 4
=head2 Print [message (string)]
=back
Print message on the message window.
=over 4
=head2 Debug [message (string)]
=back
Print message on the message window if in debug-mode.
=over 4
=head2 DebugLine [angle1 (double)] [radius1 (double)] [angle2 (double)] [radius2 (double)]
=back
Draw a line direct to the arena. This is only allowed in the highest debug level(5), otherwise a warning message is sent. The arguments are the start and end point of the line given in polar coordinates relative to the robot.
=over 4
=head2 DebugCircle [center angle (double)] [center radius (double)] [circle radius (double)]
=back
Similar to DebugLine above, but draws a circle. The first two arguments are the angle and radius of the central point of the circle relative to the robot. The third argument gives the radius of the circle.
=head1 EXAMPLES
My hello botworld:
use Acme::RTB;
my $robot = Acme::RTB->new({ Name => 'Anarion PerlBot 1.0',
Colour => 'ff0000 ff0000',
Log => '/home/anarion/perl/rtb/robot.log'} );
$robot->Start;
Example two:
#!/usr/bin/perl
use strict;
use warnings;
use lib "/home/anarion/perl/rtb";
use Acme::RTB;
my $robot = Acme::RTB->new({ Name => 'Killer Montses',
Colour => 'ff0000 ff0000',
Log => '/home/anarion/perl/rtb/anarion.log'} );
$robot->modify_action( Radar => \&my_radar );
$robot->modify_action( GameStarts => \&my_gamestart);
$robot->modify_action( Collision => \&my_collision);
$robot->Start;
sub my_radar
{
my ($self, $dist, $obj, $angle) = @_;
for($obj)
{
/0/ && do { robot($dist,$angle) };
/1/ && do { dodge($dist,$angle) };
/2/ && do { turn($dist,$angle) };
/3/ && do { cookie($dist,$angle) };
/4/ && do { mine($dist,$angle) };
}
}
sub my_gamestart
{
my $self = shift;
my $speed = rand(1)+1;
my $angle = rand(0.4)-0.8;
$self->Accelerate($speed);
$self->RotateAmount(7,rand(2),rand(5));
}
sub my_collision
{
my ($self, $object_type, $angle) = @_;
$robot->RotateAmount(7,rand(2),rand(5)-2.5);
}
sub robot
{
my ($dist, $angle) = @_;
$robot->RotateTo(7,2,$angle-0.2);
$robot->Shoot(10);
}
sub dodge
{
$robot->RotateAmount(7,2,1);
}
sub turn
{
my ($dist, $angle) = @_;
if($dist < 10)
{
my ($dist, $angle) = @_;
$robot->RotateAmount(7,2,$angle);
}
sub mine
{
my ($dist, $angle) = @_;
$robot->RotateTo(7,2,$angle);
$robot->Shoot(1);
}
=head1 AUTHOR
Debian User, E<lt>anarion@7a69ezine.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2003 by Anarion
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
STDOUT->autoflush(1);
STDERR->autoflush(1);
my $select = IO::Select->new();
$select->add(*STDIN);
my %actions = ( Initialize => \&initialize,
YourName => \&your_name,
YourColour => \&your_color,
GameOption => \&game_option,
GameStarts => \&game_starts,
Radar => \&radar,
Info => \&info,
RobotInfo => \&robot_info,
RotationReached => \&rotation_reached,
Energy => \&energy,
RobotsLeft => \&robots_left,
Collision => \&collision,
Warning => \&warning,
Dead => \&dead,
GameFinishes => \&game_finish,
Unknown => \&unknown, );
my %options;
local *LOG;
sub new
{
my ($class, $options) = @_;
my $self = { Name => $options->{Name} || "RTB v$VERSION",
Colour => $options->{Colour} || 'ff0000 ff0000',
Log => $options->{Log} };
if($options->{Log})
{
open(LOG,">$options->{Log}")
or die "Cant write to logfile: $options->{Log}: $!";
LOG->autoflush(1);
}
my $obj = bless $self,$class;
$obj->RobotOption(3,1); # Use Select
$obj->RobotOption(1,1); # Rotation reached
return $obj
}
###
sub modify_action
{
my ($self, $key , $code) = @_;
if(exists $actions{$key} and ref($code) eq "CODE")
{
$actions{$key} = $code;
}
}
###
sub process_lines
{
my $self = shift;
while(my @l = $select->can_read(0.1))
{
my $hd = $l[0];
my $msg = <$hd>;
chomp($msg);
print LOG "<--- $msg\n" if $self->{Log};
my ($cmd, @options) = split' ',$msg;
$cmd = 'Unknown' unless exists $actions{ $cmd };
$actions{ $cmd }->($self, @options)
}
}
###
sub initialize
{
my ($self, $num) = @_;
if ($num == 1)
{
$self->Name;
$self->Colour;
}
}
###
sub your_name
{
my ($self, $name) = @_;
$self->{Name} = $name;
}
###
sub your_colour
{
my ($self, $name) = @_;
$self->{Colour} = $name;
}
( run in 1.574 second using v1.01-cache-2.11-cpan-ceb78f64989 )