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

Game::Lawn - Lawn

=head1 SYNOPSIS

Nah...

=cut





package Game::Lawn;
#MI with common base class from Game::Object::Worm


use strict;
use Data::Dumper;



=head1 PROPERTIES

=head2 width

width

Default: 0

=cut

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





=head2 height

height coordinate

Default: 0

=cut

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





=head2 rhGrid

Hash ref with left->top->object hash ref tree.

Default: {}

=cut

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





=head2 oUI

Game::UI object, used to display the Lawn and stuff on it.

Default: undef

=cut

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





=head2 oController

Game::Controller object used to steer the game, or undef if there is no app.

Default: undef

=cut

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





=head2 rhPrize

Hash ref with (key: object string, value:
Game::Object::Prize object). These are the Prizes the Lawn
knows about.

Default: {}

=cut

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





=head1 METHODS

=head2 new([$width = 0, $height = 0])

Create new Lawn

=cut
sub new { my $pkg = shift;
    my ($width, $height) = @_;
    $width ||= 0;
    $height ||= 0;

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

    $self->rhPrize({});
    $self->rhGrid({});
    $self->width($width);
    $self->height($height);
    $self->oUI(Game::UI::None->new());

    return($self);
}





=head2 oPlaceWorm($left, $top)

Place a new Worm on the Lawn, at the location $left/$top.

Return the new Game::Object::Worm object on success, else undef.

=cut
sub oPlaceWorm { my $self = shift;
    my ($left, $top) = @_;

    $self->placeObjectAt(my $oWorm = Game::Object::Worm->new($left, $top)) or return(undef);

    return($oWorm);
}





=head2 oPlacePrize($oLocation, $value)

Place a new Prize on the Lawn, at the location $left/$top.

Return the new Game::Object::Prize object on success, else undef.

=cut
sub oPlacePrize { my $self = shift;
    my ($oLocation, $value) = @_;

    $self->placeObjectAt(my $oPrize = Game::Object::Prize->new($oLocation, $value)) or return(undef);

    return($oPrize);
}





=head2 prizeWasClaimedBy($oPrize, $oObject)

The $oPrize was claimed by $oObject. Remove the $oPrize.
Notify the App and the UI.

Return 1 on success, else 0.

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

    $self->removeObject($oPrize);

    $self->oController and ($self->oController->prizeWasClaimedBy($oPrize, $oObject) or return(0));
    $self->oUI and ($self->oUI->prizeWasClaimedBy($oPrize, $oObject) or return(0));

    return(1);
}





=head2 placeObjectAt($oObject)

Place a $oObject on the Lawn, at the object's oLocation().

Return 1 on success, else undef.

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

    $oObject->oLawn($self);

    $self->isObjectLocationValidForPlacement($oObject) or return(0);

    #Collision detection? In the place method?
    $oObject->oLawn($self);   #Second call just to test two calls
    for my $oLocation (@{$oObject->raBodyLocation}) {
        $self->rhGrid->{$oLocation->left}->{$oLocation->top}->{$oObject} = $oObject;
        }

    #If it's prize, keep track of it separately
    $self->rhPrize->{$oObject} = $oObject if($oObject->isa("Game::Object::Prize"));

    $self->oUI->displayObjectAt($oObject);

    return(1);
}





=head2 objectHasMoved($oObject)

Notify the Lawn that $oObject has moved to a new location on
the Lawn, indicated by it's oLocation().

Check collisions and report to colliding objects.

Return 1 on success, else undef.

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

    my ($left, $top) = ($oObject->oLocation->left, $oObject->oLocation->top);

    if(exists $self->rhGrid->{$left}->{$top}) {
        for my $oLawnObject (values %{$self->rhGrid->{$left}->{$top}} ) {
            if($oLawnObject ne $oObject) {
                if($oLawnObject->can("wasCrashedIntoBy")) {
                    $oLawnObject->wasCrashedIntoBy($oObject);
                    }
                }
            }
        }

    return(1);
}





=head2 removeObject($oObject)

Remove the object from the Lawn.

Return 1 on success, else 0.

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

    for my $oLocation (@{$oObject->raBodyLocation}) {
        $self->removeObjectBodyPartAt($oObject, $oLocation);
        }

    $oObject->oLawn(undef);

    #If it's prize, keep track of it separately
    delete $self->rhPrize->{$oObject} if($oObject->isa("Game::Object::Prize"));
    
    return(1);
}





=head2 isObjectAt($oObject, $left, $top)

Is the $oObject on the Lawn, at the location $left/$top?

Return 1 if it is, else 0.

=cut
sub isObjectAt { my $self = shift;
    my ($oObject, $left, $top) = @_;
    $self->isLocationOnLawn(Game::Location->new($left, $top)) or return(0);

    return(1) if(exists $self->rhGrid->{$left}->{$top}->{$oObject});

    return(0);
}





=head2 isAnythingAt($oLocation)

Is there an object on the Lawn, at the Location?

Return 1 if it is, else 0.

=cut
sub isAnythingAt { my $self = shift;
    my ($oLocation) = @_;

    if(exists $self->rhGrid->{$oLocation->left}->{$oLocation->top}) {
        return(1) if( values %{$self->rhGrid->{$oLocation->left}->{$oLocation->top}} );
        }

    return(0);
}





=head2 isAnythingBlockingAt($oLocation)

Is there a blocking object on the Lawn, at the Location?

Return 1 if it is, else 0.

=cut
sub isAnythingBlockingAt { my $self = shift;
    my ($oLocation) = @_;

    if(exists $self->rhGrid->{$oLocation->left}->{$oLocation->top}) {
        for my $oLawnObject (values %{$self->rhGrid->{$oLocation->left}->{$oLocation->top}} ) {
            return(1) if($oLawnObject->isBlocking);
            }
        }

    return(0);
}





=head2 oLocationRandom()

Return Game::Location object with a random Location on the
Lawn.

=cut
sub oLocationRandom { my $self = shift;

    my $left = int(rand( $self->width ));
    my $top = int(rand( $self->height ));

    return( Game::Location->new($left, $top) );
}





=head2 isLocationOnLawn($oLocation)

Is the Location on the Lawn?

Return 1 if it is, else 0.

=cut
sub isLocationOnLawn { my $self = shift;
    my ($oLocation) = @_;
    ($oLocation->left < $self->width) && ($oLocation->top < $self->height) &&
            ($oLocation->left >= 0) && ($oLocation->top >= 0)
                    or return(0);

    return(1);
}





=head2 isLocationValidForMove($oObject, $oLocation)

Is the $oLocation a valid location for $oObject to move to?

Ignore the movement/speed/whatever of $oObject, the only
concern is the validity of the Location in itself (whether
it's occupied by something important).

Return 1 if it is, else 0.

=cut
sub isLocationValidForMove { my $self = shift;
    my ($oObject, $oLocation) = @_;

    return(0) if(!$self->isLocationOnLawn($oLocation));
    return(0) if($self->isAnythingBlockingAt($oLocation));

    return(1);
}





=head2 isLocationValidForPlacement($oLocation)

Is the $oLocation a valid location for $oObject to be place at?

Ignore the movement/speed/whatever of $oObject, the only
concern is the validity of the Location in itself (whether
it's occupied by something).

Return 1 if it is, else 0.

=cut
sub isLocationValidForPlacement { my $self = shift;
    my ($oLocation) = @_;

    return(0) if(!$self->isLocationOnLawn($oLocation));
    return(0) if($self->isAnythingAt($oLocation));

    return(1);
}





=head2 isObjectLocationValidForPlacement($oObject)

Is the raBodyLocation of the $oObject valid for placement on 
the Lawn. The entire raBodyLocation of $oObject must be 
valid.

Return 1 if it is, else 0.

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

    for my $oLocation (@{$oObject->raBodyLocation}) {
        $self->isLocationValidForPlacement($oLocation) or return(0);
        }    

    return(1);
}





=head2 oDirectionToPrize($oLocation)

Is there any Prize located in a straight line from
$oLocation? If so, return a Game::Direction object with the
direction to the prize.

If there are many applicable Prizes, pick any.

Return the Game::Direction object on success, else undef.

=cut
sub oDirectionToPrize { my $self = shift;
    my ($oLocation) = @_;

    my $dir = "";
    my ($left, $top) = ($oLocation->left, $oLocation->top);
    for my $oPrize (values %{$self->rhPrize}) {
        if($left == $oPrize->oLocation->left) {
            $dir = "up" if($oPrize->oLocation->top < $top);
            $dir = "down" if($oPrize->oLocation->top > $top);
            }
        elsif($top == $oPrize->oLocation->top) {
            $dir = "left" if($oPrize->oLocation->left < $left);
            $dir = "right" if($oPrize->oLocation->left > $left);
            }
        }
    $dir and return(Game::Direction->new($dir));

    return(undef);
}





=head2 placeObjectBodyPartAt($oObject, $oLocation, $char)

Put the $char of $oObject at $oLocation on the Lawn.

Return 1 on success, else 0.

=cut
sub placeObjectBodyPartAt { my $self = shift;
    my ($oObject, $oLocation, $char) = @_;

    $self->rhGrid->{$oLocation->left}->{$oLocation->top}->{$oObject} = $oObject;
    $self->oUI->displayObjectBodyPartAt($oLocation, $char, $oObject);

    return(1);
}





=head2 removeObjectBodyPartAt($oObject, $oLocation)

Remove the $oObject at $oLocation on the Lawn.

Return 1 on success, else 0.

=cut
sub removeObjectBodyPartAt { my $self = shift;
    my ($oObject, $oLocation) = @_;

    delete $self->rhGrid->{$oLocation->left}->{$oLocation->top}->{$oObject};
    $self->oUI->displayObjectBodyPartAt($oLocation);

    return(1);
}





=head2 wormHasCrashed($oObject)

The worm $oObject has crashed.

Notify the UI.

Return 1 on success, else 0.

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

    $self->oUI and ($self->oUI->wormHasCrashed($oObject) or return(0));
    $self->oController and ($self->oController->wormHasCrashed($oObject) or return(0));

    return(1);
}





END {
    my ($oObject) = @_;

    $oObject->oLawn(undef);
}




1;





#EOF