The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
=head1 NAME

Game::Controller - Worm Game Controller with a Worm, Lawn, UI etc.

=head1 SYNOPSIS

Nah...

=cut





package Game::Controller;





use strict;
use Data::Dumper;
use Time::HiRes qw( time sleep );

use Game::Lawn;
use Game::Object::Worm;
use Game::Object::Worm::Bot;
use Game::UI;





=head1 PROPERTIES

=head2 oWorm

Game::Object::Worm object controlled by user.

Default: undef

=cut

use Class::MethodMaker get_set => [ "oWorm" ];





=head2 oLawn

Game::Lawn object.

=cut

use Class::MethodMaker get_set => [ "oLawn" ];





=head2 oUI

Game::UI object.

=cut

use Class::MethodMaker get_set => [ "oUI" ];





=head2 rhTimedObject

Hash ref with (key: object, value: object) with objects that 
should be timed in the main loop.

Default: {}

=cut

use Class::MethodMaker get_set => [ "rhTimedObject" ];





=head1 METHODS

=head2 new($offsetLeft, $offsetTop, $lawnWidth, $lawnHeight)

Create new App with a UI located at $offsetLeft/$offsetTop,
with a Lawn with the dimensions $lawnWidth, $lawnHeight.

=cut
sub new { my $pkg = shift;
    my ($offsetLeft, $offsetTop, $lawnWidth, $lawnHeight) = @_;

    my $self = {};
    bless $self, $pkg;

    $self->rhTimedObject({});
    $self->oLawn( Game::Lawn->new($lawnWidth, $lawnHeight) );

    $self->oUI( Game::UI->new() );
    $self->oUI->offsetLeft($offsetLeft);
    $self->oUI->offsetTop($offsetTop);
    $self->oUI->oLocationScore( Game::Location->new($offsetLeft, $offsetTop + $lawnHeight) );
    
    $self->oLawn->oUI($self->oUI);
    $self->oLawn->oController($self);


    $self->oUI->displayLawn($self->oLawn) or return(undef);

    return($self);
}





=head2 placeWormOnLawn($oObject)

Place the $oObject on the Lawn and keep track of it.

Return 1 on success, else 0.

=cut
sub placeWormOnLawn { my $self = shift;
    my ($oObject) = @_;
    $self->oWorm( $oObject );
    $self->addTimedObject($oObject);
    return( $self->placeObjectOnLawn($oObject) );
}





=head2 placeWormBotOnLawn($oObject)

Place the $oObject on the Lawn and keep track of it.

Return 1 on success, else 0.

=cut
sub placeWormBotOnLawn { my $self = shift;
    my ($oObject) = @_;

    $self->placeObjectOnLawn($oObject) or return(0);
    $self->addTimedObject($oObject) or return(0);
    
    return(1);
}





=head2 placePrizeOnLawn($oObject)

Place the $oObject on the Lawn and keep track of it.

Return 1 on success, else 0.

=cut
sub placePrizeOnLawn { my $self = shift;
    my ($oObject) = @_;
    return( $self->placeObjectOnLawn($oObject) );
}





=head2 placeWallOnLawn($oObject)

Place the $oObject on the Lawn and keep track of it.

Return 1 on success, else 0.

=cut
sub placeWallOnLawn { my $self = shift;
    my ($oObject) = @_;
    return( $self->placeObjectOnLawn($oObject) );
}





=head2 placeObjectOnLawn($oObject)

Place the $oObject on the Lawn and keep track of it.

Return 1 on success, else 0.

=cut
sub placeObjectOnLawn { my $self = shift;
    my ($oObject) = @_;

    $oObject->oLawn( $self->oLawn ) if($oObject->can("oLawn"));
    $self->oLawn->placeObjectAt($oObject) or return(0);

    return(1);
}





=head2 addTimedObject($oObject)

Add $oObject to the rhTimedObject, to be timed in the main 
loop.

Return 1 on success, else 0.

=cut
sub addTimedObject { my $self = shift;
    my ($oObject) = @_;

    $self->rhTimedObject->{$oObject} = $oObject;

    return(1);
}





=head2 removeWormFromLawn($oObject)

Remove the Worm $oObject from the Lawn and the App.

Return 1 on success, else 0.

=cut
sub removeWormFromLawn { my $self = shift;
    my ($oObject) = @_;

    delete $self->rhTimedObject->{$oObject};
    
    $self->oLawn->removeObject($oObject) or return(0);

    return(1);
}





=head2 createWormBotLike([$oObject])

Create a new Worm Bot. If $oObject is passed, clone values 
from it. 

Place the new Bot somewhere on the Lawn.

Return 1 on success, else 0.

=cut
sub createWormBotLike { my $self = shift;
    my ($oObject) = @_;
    
    my $length = 10;

    for (1..50) {        #Try at most n times
        my $oLocation = $self->oLawn->oLocationRandom();
        my $oWormBot = Game::Object::Worm::Bot->new($oLocation->left, $oLocation->top, "left", $length);
        if($oObject) {
            $oWormBot->cloneValuesFrom($oObject);    
            }
        else {
            $oWormBot->oEventMove->timeInterval(0.12);
            $oWormBot->probabilityTurnRandomly(0.04);
            $oWormBot->probabilityTurnTowardsPrize(1.00);
            }
        
        $self->placeWormBotOnLawn($oWormBot) and return(1);
        }

    warn("Failed to place new worm\n");
    
    return(0);
}





=head2 run()

Run the main loop.

Return 1 on success, else 0. Die on fatal errors.

=cut
sub run { my $self = shift;

    my %hAction;
    if($self->oWorm) {
        %hAction = (
            "turn left" => sub { $self->oWorm->turn("left"); },
            "turn right" => sub { $self->oWorm->turn("right"); },
            );
        }

    while(1) {
        my $timeWorld = time();

        for my $oObject (values %{$self->rhTimedObject}) {
            
            eval {
                if($oObject->checkTick($timeWorld)) {
                
                    if($oObject eq ($self->oWorm || "")) {
                        #The Worm moved, check for user input
            
                        my $action = $self->oUI->getUserAction();
                        return(1) if($action eq "quit");
                        
                        if(my $rcAction = $hAction{ $action }) {
                            $rcAction->();
                            }
                        }
                        
                    }
                };
            if($@) {
                if(UNIVERSAL::isa($@, "ExceptionCouldNotMoveForward")) {
                    my $oCrashedObject = $@->oObject or die;
                    
                     $oCrashedObject->crash() or die;
                    
                    die if($oCrashedObject->isRealPlayer);
                    }
                else {
                    die;
                    }
                }
            }

        sleep(0.005);
        }


    return(1);
}





=head2 prizeWasClaimedBy($oPrize, $oObject)

The $oPrize was just claimed by $oObject and removed from 
the Lawn.

Update the score display.

Put another Prize on the Lawn

Return 1 on success, else 0.

=cut
sub prizeWasClaimedBy { my $self = shift;
    my ($oPrize, $oObject) = @_;

    $self->oWorm and ($self->oUI->showScore( $self->oWorm->score ) or return(0));

    ##Todo: Configurable whether the Worm should grow
    $oObject->can("grow") and $oObject->grow();

    ##Todo: Configurable whether a new Prize should appear
    for(1..500) {    #Attempt to place a prize n times, then fail. It may fail because the random loc is on something
        $self->oLawn->oPlacePrize( 
                Game::Location->new( 
                        int(rand($self->oLawn->width - 1)), 
                        int(rand($self->oLawn->height - 1))
                ), 100 ) and return(1);
        }
    warn("Failed to place Prize");

    return(0);
}





=head2 wormHasCrashed($oObject)

The Worm $oObject just crashed.

If it was a bot, replace it.

#If it was a player, do something...

Return 1 on success, else 0.

=cut
sub wormHasCrashed { my $self = shift;
    my ($oObject) = @_;

    $oObject->isa("Game::Object::Worm::Bot") or return(1);
    
    $self->removeWormFromLawn($oObject) or return(0);
    $self->createWormBotLike($oObject) or return(0);

    return(1);
}





1;





#EOF