view release on metacpan or  search on metacpan

lib/BalanceOfPower/Role/Warlord.pm  view on Meta::CPAN

package BalanceOfPower::Role::Warlord;
$BalanceOfPower::Role::Warlord::VERSION = '0.400115';
use strict;
use v5.10;

use Moo::Role;

use Term::ANSIColor;

use BalanceOfPower::Constants ':all';
use BalanceOfPower::Printer;
use BalanceOfPower::Relations::Crisis;
use BalanceOfPower::Relations::War;

requires 'empire';
requires 'border_exists';
requires 'get_nation';
requires 'get_hates';
requires 'occupy';
requires 'broadcast_event';
requires 'send_event';
requires 'get_group_borders';
requires 'get_allies';
requires 'supported';
requires 'supporter';
requires 'military_support_garbage_collector';
requires 'random';
requires 'change_diplomacy';
requires 'get_crises';
requires 'delete_crisis';
requires 'discard_war_bonds';
requires 'cash_war_bonds';
requires 'war_busy';

has wars => (
    is => 'ro',
    default => sub { BalanceOfPower::Relations::RelPack->new() },
    handles => { at_war => 'first_link_for_node',
                 add_war => 'add_link',
                 get_wars => 'links_for_node',
                 war_exists => 'exists_link',
                 delete_war_link => 'delete_link',
                 get_attackers => 'links_for_node2'
               }
);

has memorial => (
    is => 'rw',
    default => sub { [] }
);





sub in_military_range
{
    my $self = shift;
    my $nation1 = shift;
    my $nation2 = shift;
    my $hostile = shift || 1;
    if($self->border_exists($nation1, $nation2))
    {
        return { how => 'border', who => undef };
    }
    my @supported = $self->supporter($nation1);
    for(@supported)
    {
        my $nation_supported = $_->destination($nation1);
        my $treaty = $self->exists_treaty_by_type($nation_supported, $nation2, 'no aggression');
        if(! $hostile || ! $treaty)
        {
            if(! $self->war_busy($nation_supported))
            {
                if($nation_supported eq $nation2)
                {
                    return { how => 'supporting', who => undef};
                }
                if($self->border_exists($nation_supported, $nation2))
                {
                    return { how => 'support', who => $nation_supported};
                }
            }
            else
            {
            }
        }
    }
    my @empire = $self->empire($nation1);
    for(@empire)
    {
        my $ally = $_;
        if(! $self->war_busy($ally))
        {
                return { how => 'linked', who => undef } if $ally eq $nation2;
                return { how => 'control', who => $ally } if $self->border_exists($ally, $nation2);
        }
    }
    return 0;
}

sub war_current_year
{
    my $self = shift;
    for($self->wars->all)
    {
        $_->current_year($self->current_year);
    }
}

sub create_war
{
    my $self = shift;
    my $attacker = shift || "";
    my $defender = shift || "";

    if(! $self->war_exists($attacker->name, $defender->name))
    {
        $self->broadcast_event({ code => 'crisisescalate', 
                                 text => "CRISIS BETWEEN " . $attacker->name . " AND " . $defender->name . " BECAME WAR", 
                                 involved => [$attacker->name, $defender->name] }, $attacker->name, $defender->name); 
        my @attacker_coalition = $self->empire($attacker->name);
        @attacker_coalition = grep { ! $self->war_busy($_) } @attacker_coalition;
        my @defender_coalition = $self->empire($defender->name);
        @defender_coalition = grep { ! $self->war_busy($_) } @defender_coalition;
    
        #Allies management
        my @attacker_allies = $self->get_allies($attacker->name);
        my @defender_allies = $self->get_allies($defender->name);
        for(@attacker_allies)
        {
            my $ally_name = $_->destination($attacker->name);
            my $ally = $self->get_nation( $ally_name );
            if($ally->good_prey($defender, $self, ALLY_CONFLICT_LEVEL_FOR_INVOLVEMENT, 0 ))
            {
                if(! grep { $_ eq $ally_name } @attacker_coalition)
                {
                    push @attacker_coalition, $ally_name;
                    $ally->register_event("JOIN WAR AS ALLY OF " . $attacker->name ." AGAINST " . $defender->name);
                }
            }
        }
        for(@defender_allies)
        {
            my $ally_name = $_->destination($defender->name);
            my $ally = $self->get_nation( $ally_name );
            if($ally->good_prey($attacker, $self, ALLY_CONFLICT_LEVEL_FOR_INVOLVEMENT, 0 ))
            {
                if(! grep { $_ eq $ally_name } @defender_coalition)
                {
                    push @defender_coalition, $ally_name;
                    $ally->register_event("JOIN WAR AS ALLY OF " . $defender->name ." AGAINST " . $attacker->name);
                }
            }
        }

        my @attacker_targets = $self->get_group_borders(\@attacker_coalition, \@defender_coalition);
        my @defender_targets = $self->get_group_borders(\@defender_coalition, \@attacker_coalition);
        my @war_couples;
        my @couples_factions;
        my %used;
        for(@attacker_coalition, @defender_coalition)
        {
            $used{$_} = 0;
        }
        #push @war_couples, [$attacker->name, $defender->name];
        $used{$attacker->name} = 1;
        $used{$defender->name} = 1;
        my $faction = 1;
        my $done = 0;
        my $faction0_done = 0;
        my $faction1_done = 0;
        while(! $done)
        {
            my @potential_attackers;
            if($faction == 0)
            {
                @potential_attackers = grep { $used{$_} == 0 } @attacker_coalition;
            }
            elsif($faction == 1)
            {
                @potential_attackers = grep { $used{$_} == 0 } @defender_coalition;
            }
            if(@potential_attackers == 0)
            {