package LasTres::Location;

use v5.36.0;

use strict;
use warnings;

use feature 'signatures';

use LasTres::Planets;
use Moo::Role;

use JSON qw/to_json from_json/;
use utf8;

requires qw/identifier name description parent actions npcs/;

## Implement action($self, $pj);
## Implement npcs($self, $pj);
## Implement description($self, $pj = undef);
## Implement name($self, $pj = undef);
## Implement identifier($self, $pj = undef);

my $planets = LasTres::Planets->new;

## OVERRIDE
# Whenever a player can visit this place.
# The player to compute will always be the leader.
sub can_visit ( $self, $pj ) {
    return 1;
}

## OVERRIDE
# Whenever a player can discover this location with explore.
# The player will be always the leader.
# Alternative methods to explore will be able to discover this place
# for the pj.
sub can_discover ( $self, $pj ) {
    return 1;
}

## OVERRIDE
# The percentual chance to discover this place with explore.
sub chance_discover ( $self, $pj ) {
    return 50;
}

## OVERRIDE
# Whenever this can be the last discovery option in explore to let the
# player discover at least something.
sub allow_forced_discovery ( $self, $pj ) {
    return 1;
}

## OVERRIDE
# The order for the percentual random calculation, the higher the less priority
# it has for discover and the later it will be forcedfully discovered.
sub order ($self) {
    return 1000;
}

## OVERRIDE
# A place that is a spawn will have a healing action that can be changed 
# and if a team faints they will be teleported there and the action will
# be triggered, the healing action may cost some resource when the action
# is triggered manually by the user, if the player cannot pay it the
# action may appear as disabled.
sub is_spawn($self) {
    return 0;
}

## OVERRIDE
# Return object should ideally extend LasTres::PJAction::DefaultHeal
# following the advice in this file.
sub healing_action($self) {
    if ($self->is_spawn) {
        require LasTres::PJAction::DefaultHeal;
        return LasTres::PJAction::DefaultHeal->new;
    }
}

## OVERRIDE (Always use $self->SUPER::on_team_arrival.)
# The code to be executed when a team reachs this location.
# It is important that you call super or you will lose
# REALLY important behaviour such as knows_location.
sub on_team_arrival ( $self, $team ) {
    $team = $team->get_from_storage;
    for my $pj ( $team->members ) {
        $self->on_pj_arrival($pj);
    }
}

## OVERRIDE (Always use $self->SUPER::on_pj_arrival.)
# The code to be executed when a pj reachs this location.
# Call super or bad things will happen such as losing
# knows_location and update-location.
sub on_pj_arrival ( $self, $pj ) {
    require LasTres::Redis;
    $pj = $pj->get_from_storage;
    my $redis = LasTres::Redis->new;
    if ( !$pj->knows_location($self) ) {
        $pj->set_known_location($self);
    }
    $self->show_intro($pj);
    $pj->update_location;
    $pj->update_team_sprites;
    $pj->update_actions;
}

## DO NOT EXTEND NOT SUPPORTED.
sub show_intro ( $self, $pj ) {
    $pj->append_log_line(
        [
            { text  => 'Estas en ' },
            { color => 'red', text => $self->parent->name($pj) },
            { text  => '/' },
            { color => 'green', text => $self->name($pj) },
        ]
    );
    $pj->append_log_line( [ { text => $pj->location->description }, ] );
}

## DO NOT EXTEND NOT SUPPORTED.
sub move ( $self, $team ) {
    $team = $team->get_from_storage;
    my $current_location = $team->location;
    my $json_array_until_area_current_location =
      to_json( [ $current_location->to_array->@[ 0 .. 2 ] ] );
    my $json_array_until_area_destination =
      to_json( [ $self->to_array->@[ 0 .. 2 ] ] );
    if ( $json_array_until_area_current_location ne
           $json_array_until_area_destination
        || $self->parent->frames_to_move <= 0 )
    {
        $self->place_team($team);
        return;
    }
    my $schema;
    $team->is_moving(1);
    $team->action_frame(0);
    $team->moving_to( $self->to_json_array );
    $team->update;
    $self->on_team_moving($team);
}

## OVERRIDE (Always use $self->SUPER::on_team_moving.)
# This is called when a team starts their travel
# to this location, always call SUPER.
sub on_team_moving ( $self, $team ) {
    $team = $team->get_from_storage;
    for my $pj ( $team->members ) {
        $self->on_pj_moving($pj);
    }
    $team->send_frame_to_members;
}

## OVERRIDE (Always use $self->SUPER::on_pj_moving.)
# This is called when a pj is approaching this location
# via move. It is really important to call super.
sub on_pj_moving ( $self, $pj ) {
    require LasTres::Redis;
    my $redis = LasTres::Redis->new;
    $pj = $pj->get_from_storage;
    $pj->append_log_line(
        [
            { text  => 'Tu equipo se está moviendo a ' },
            { color => 'red', text => $self->parent->name($pj) },
            { text  => '/' },
            { color => 'green', text => $self->name($pj) },
        ]
    );
    $pj->update_location;
    $pj->update_actions;
    $pj->update_team_sprites;
}

## DO NOT EXTEND NOT SUPPORTED.
sub place_team ( $self, $team ) {
    $team = $team->get_from_storage;
    if ($self->is_spawn) {
        $team->last_spawn( $self->to_json_array );
    }
    $team->location($self);
    $team->update;
    $self->on_team_arrival($team);
}

## DO NOT EXTEND NOT SUPPORTED.
sub to_array ($self) {
    my $hash = $self->hash;
    return [
        $hash->{planet}{identifier}, $hash->{super_area}{identifier},
        $hash->{area}{identifier},   $hash->{location}{identifier}
    ];
}

## DO NOT EXTEND NOT SUPPORTED.
sub to_json_array ($self) {
    return to_json( $self->to_array );
}

## DO NOT EXTEND NOT SUPPORTED.
sub is_connected_by_move ( $self, $otherLocation, $pj = undef ) {
    if ( !defined $otherLocation ) {
        die '$otherLocation must be defined in is_connected.';
    }
    my $json_array_other_location = $otherLocation->to_json_array;
    if ( grep { $_->to_json_array eq $json_array_other_location }
        @{ $self->get_available_locations_to_move_to($pj) } )
    {
        return 1;
    }
    return 0;
}

## DO NOT EXTEND NOT SUPPORTED.
sub get_available_locations_to_move_to ( $self, $pj = undef ) {
    if ( defined $pj ) {
        $pj = $pj->get_from_storage;
    }
    my $location = $self;

    my $connected_places = [];
    if ( !$self->pj_is_moving($pj) && $location->can('connected_places') ) {
        @$connected_places = ( @{ $self->connected_places } );
    }
    @$connected_places = (
        @$connected_places, @{ $self->_get_neighbour_locations_accesible($pj) }
    );
    @$connected_places =
      grep { $_->to_json_array ne $location->to_json_array }
      grep { $_->to_json_array; $_->to_json_array ne to_json(from_json($pj->team->moving_to)) }
      @$connected_places;
    if ( defined $pj ) {
        @$connected_places = grep { $_->can_visit($pj) } @$connected_places;
    }
    return $connected_places;
}

## DO NOT EXTEND NOT SUPPORTED.
sub pj_is_moving ( $self, $pj = undef ) {
    if ( defined $pj ) {
        $pj = $pj->get_from_storage;
    }
    return defined $pj && $pj->team->is_moving;
}

## DO NOT EXTEND NOT SUPPORTED.
sub _get_neighbour_locations_accesible ( $self, $pj ) {
    my $places = [];
    @$places = @{ $self->parent->children };
    if ( !$self->parent->get_auto_discover && defined $pj ) {
        @$places = grep { $pj->knows_location($_) } @$places;
        @$places = grep { $pj->knows_location($_) } @$places;
    }
    return $places;
}

## DO NOT EXTEND NOT SUPPORTED.
sub get ( $planet_id, $super_area_id, $area_id, $location_id ) {
    my $planet = $planets->hash->{$planet_id};
    if ( !defined $planet ) {
        die "No such planet $planet_id.";
    }
    my $super_area = $planet->super_areas->{$super_area_id};
    if ( !defined $super_area ) {
        die "No such super_area $super_area_id in planet $planet_id.";
    }
    my $area = $super_area->areas->{$area_id};
    if ( !defined $area ) {
        die
"No such area $area_id in super_area $super_area_id in planet $planet_id.";
    }
    my $location = $area->locations->{$location_id};
    if ( !defined $location ) {
        die
"No such location $location_id in area $area_id in super_area $super_area_id in planet $planet_id.";

    }
    return $location;
}

## DO NOT EXTEND NOT SUPPORTED.
sub hash ($self) {
    my $location = $self;
    if ( !Moo::Role::does_role( $location, 'LasTres::Location' ) ) {
        die "$location does not implement LasTres::Location.";
    }
    my $area = $location->parent;
    if ( !Moo::Role::does_role( $area, 'LasTres::Area' ) ) {
        die "$area does not implement LasTres::Area.";
    }
    my $super_area = $area->parent;
    if ( !Moo::Role::does_role( $super_area, 'LasTres::SuperArea' ) ) {
        die "$super_area does not implement LasTres::SuperArea.";
    }
    my $planet = $super_area->parent;
    if ( !Moo::Role::does_role( $planet, 'LasTres::Planet' ) ) {
        die "$planet does not implement LasTres::Planet.";
    }
    return {
        planet => {
            name       => $planet->name,
            identifier => $planet->identifier,
        },
        super_area => {
            name       => $super_area->name,
            identifier => $super_area->identifier,
        },
        area => {
            name        => $area->name,
            identifier  => $area->identifier,
            can_explore => ( $area->can_explore ? $JSON::true : $JSON::false ),
        },
        location => {
            name       => $location->name,
            identifier => $location->identifier,
        },
    };
}
1;
