view release on metacpan or  search on metacpan

RTB/RTB.pm  view on Meta::CPAN

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;
}

###
sub game_option
{
        my $self = shift;