BalanceOfPower

 view release on metacpan or  search on metacpan

lib/BalanceOfPower/World.pm  view on Meta::CPAN

    $prestige += $bonus;
    my @wins = $nation->get_events("WAR BETWEEN .* AND .* WON BY ". $nation_name, prev_turn($nation->current_year));
    if(@wins > 0)
    {
        $prestige += WAR_PRESTIGE_BONUS;
    }
    return $prestige;
}

# PRESTIGE MANAGEMENT END #####################################################

# DECISIONS ###############################################################

# Decisions are collected and executed
sub execute_decisions
{   
    my $self = shift;
    my @decisions = @{$self->ia_orders};
    my @route_adders = ();
    #foreach my $d (@decisions)
    foreach my $n (@{$self->nation_names})
    {
        my $command = $self->control($n);
        if(! $command)
        {
            my @nation_orders = grep { $_ =~ /^$n: / } @decisions;           if(@nation_orders > 0)
            {
                $nation_orders[0] =~ /^(.*): (.*)$/;
                $command = $2;
            }
            else
            {
                next;
            }
        }
        my $nation = $self->get_nation($n);
        if($command =~ /^DELETE TRADEROUTE (.*)->(.*)$/)
        {
            $self->delete_route($1, $2);
        }
        elsif($command =~ /^ADD ROUTE$/)
        {
            push @route_adders, $nation->name;
        }
        elsif($command =~ /^LOWER DISORDER$/)
        {
           $nation->lower_disorder($self);
        }
        elsif($command =~ /^BUILD TROOPS$/)
        {
           $nation->build_troops();
        }
        elsif($command =~ /^BOOST PRODUCTION$/)
        {
           $nation->boost_production();
        }
        elsif($command =~ /DECLARE WAR TO (.*)$/)
        {
            my $attacker = $nation;
            my $defender = $self->get_nation($1);
            if(! $self->war_busy($attacker->name) && ! $self->war_busy($defender->name))
            {
                $self->create_war($attacker, $defender);
            }
        }
        elsif($command =~ /^MILITARY SUPPORT (.*)$/)
        {
            my $supporter = $nation;
            my $supported = $self->get_nation($1);
            if($supported->accept_military_support($supporter->name, $self))
            {
                $self->start_military_support($supporter, $supported);
            }
            else
            {
                $self->broadcast_event({ code => 'suprefused',
                                         text => $supported->name . " REFUSED MILITARY SUPPORT FROM " . $supporter->name,
                                         involved => [$supporter->name, $supported->name] }, $supporter->name, $supported->name);
            }
        }
        elsif($command =~ /^RECALL MILITARY SUPPORT (.*)$/)
        {
           my $supporter = $nation;
           my $supported = $self->get_nation($1);
           $self->stop_military_support($supporter, $supported);
        }
        elsif($command =~ /^AID INSURGENTS IN (.*)$/)
        {
            my $victim = $self->get_nation($1);
            $self->aid_insurgents($nation, $victim);
        }
        elsif($command =~ /^TREATY (.*) WITH (.*)$/)
        {
            my $nation2 = $self->get_nation($2);
            $self->stipulate_treaty($nation, $nation2, $1);
        }
        elsif($command =~ /^ECONOMIC AID FOR (.*)$/)
        {
            my $nation2 = $self->get_nation($1);
            $self->economic_aid($nation, $nation2);
        }
        elsif($command =~ /^REBEL MILITARY SUPPORT (.*)$/)
        {
            my $nation2 = $self->get_nation($1);
            my $rebsup = $self->rebel_supported($nation2->name);
            if($self->at_civil_war($nation2->name))
            {
                $self->start_rebel_military_support($nation, $nation2);
            }
            else
            {
                say "ERROR: NO CIVIL WAR " . $nation2->name;
            }
        }
        elsif($command =~ /^DIPLOMATIC PRESSURE ON (.*)$/)
        {
            my $n2 = $1;
            if($nation->prestige >= DIPLOMATIC_PRESSURE_PRESTIGE_COST)
            {
                my $under_infl = $self->is_under_influence($n2); 
                $under_infl ||= "";

lib/BalanceOfPower/World.pm  view on Meta::CPAN

            $self->set_statistics_value($n, 'growth', 'X' );
        }
    }
}
sub economic_aid
{
    my $self = shift;
    my $nation1 = shift;
    my $nation2 = shift;
    $nation1->subtract_production('export', ECONOMIC_AID_COST);
    $nation2->receive_aid($nation1->name);
    $self->broadcast_event({ code => 'economicaid' , 
                             text => "ECONOMIC AID FROM " . $nation1->name . " TO " . $nation2->name, 
                             involved => [$nation1->name, $nation2->name] }, $nation1->name, $nation2->name);
    $self->change_diplomacy($nation1->name, $nation2->name, ECONOMIC_AID_DIPLOMACY_FACTOR, "ECONOMIC AID FROM " . $nation1->name);

}

# ECONOMY END #############################################################

# INTERNAL DISORDER #######################################################

sub internal_conflict
{
    my $self = shift;
    foreach my $n (@{$self->nations})
    {
        if(! $self->get_civil_war($n->name))
        {
            $n->calculate_disorder($self);
            if($n->internal_disorder_status eq 'Civil war')
            {
                $self->start_civil_war($n);
            }
        }
        $self->set_statistics_value($n, 'internal disorder', $n->internal_disorder);
    }
}

sub aid_insurgents
{
    my $self = shift;
    my $nation1 = shift;
    my $nation2 = shift;
    if($nation1->production_for_export >= AID_INSURGENTS_COST && $nation2->internal_disorder_status ne 'Civil war')
    {
        $self->broadcast_event({ code => 'insurgentsaid' ,
                                 text => "AIDS FOR INSURGENTS OF " . $nation2->name . " FROM " . $nation1->name, 
                                 involved => [$nation1->name, $nation2->name] },
                                $nation1->name, $nation2->name);
        $nation1->subtract_production('export', AID_INSURGENTS_COST);
        $nation2->add_internal_disorder(INSURGENTS_AID, $self);
    }
}


# INTERNAL DISORDER END ######################################################

# WAR ######################################################################

sub war_busy
{
    my $self = shift;
    my $n = shift;
    return $self->at_civil_war($n) || $self->at_war($n);
}

sub warfare
{
    my $self = shift;
    $self->fight_wars();
    foreach my $n (@{$self->nations})
    {
        $self->set_statistics_value($n, 'army', $n->army);    
    }    
}

sub civil_warfare
{
    my $self = shift;
    foreach my $cw (@{$self->civil_wars})
    {
        my $winner = $cw->fight($self);
        if($winner)
        {
            $cw->win($winner, $self);
            $self->delete_civil_war($cw->nation_name);
        }
    }
}

sub military_aid
{
    my $self = shift;
    my $nation1 = shift;
    my $nation2 = shift;
    $nation1->subtract_production('export', MILITARY_AID_COST);
    $nation2->add_army(ARMY_UNIT);
    $self->broadcast_event({ code => 'militaryaid',
                             text => "MILITARY AID FROM " . $nation1->name . " TO " . $nation2->name,
                             involved => [$nation1->name, $nation2->name] }, $nation1->name, $nation2->name);
    $self->change_diplomacy($nation1->name, $nation2->name, MILITARY_AID_DIPLOMACY_FACTOR, "MILITARY AID FROM " . $nation1->name );
}

sub war_report
{
    my $self = shift;
    my $message = shift;
    my $nation = shift;
    my @wars = $self->get_wars($nation);
    for(@wars)
    {
         $_->register_event($message);
    }
}

sub civil_war_report
{
    my $self = shift;
    my $message = shift;
    my $nation = shift;

lib/BalanceOfPower/World.pm  view on Meta::CPAN

        {
            $self->create_treaty($nation1->name, $nation2->name, 'alliance');
            $self->broadcast_event({ code => 'alliancetreatynew',
                                     text => "ALLIANCE BETWEEN " . $nation1->name . " AND " . $nation2->name, 
                                     involved => [$nation1->name, $nation2->name] }, $nation1->name, $nation2->name);
        }
        else
        {
            if($type eq 'COM')
            {
                if(! $present_treaty)
                {
                    if($self->route_exists($nation1->name, $nation2->name))
                    {
                        $self->create_treaty($nation1->name, $nation2->name, 'commercial');
                        $self->broadcast_event({ code => "comtreatynew",
                                                text => "COMMERCIAL TREATY BETWEEN " . $nation1->name . " AND " . $nation2->name, 
                                                involved => [$nation1->name, $nation2->name] }, $nation1->name, $nation2->name);
                    }
                    else
                    {
                        $self->broadcast_event({ code => "uselesstreaty",
                                                text => "COMMERCIAL TREATY BETWEEN " . $nation1->name . " AND " . $nation2->name . " MADE USELESS BY ROUTE CANCELATION", 
                                                involved => [$nation1->name, $nation2->name] }, $nation1->name, $nation2->name);
                    }
                }
            }
            elsif($type eq 'NAG')
            {
                $self->create_treaty($nation1->name, $nation2->name, 'no aggression');
                $self->broadcast_event({ code => 'nagtreatynew',
                                         text => "NO AGGRESSION TREATY BETWEEN " . $nation1->name . " AND " . $nation2->name, 
                                         involved => [$nation1->name, $nation2->name] }, $nation1->name, $nation2->name);
            }
        }
    }
}



# TRATIES END ##############################################################

# TRAVELS ##################################################################

sub make_travel_plan
{
    my $self = shift;
    my $from = shift;
    my @already = ();
    my %plan;
    $plan{'ground'} = {};
    $plan{'air'} = {};
    my @for_commerce = $self->route_destinations_for_node($from);
    
    my @at_borders = $self->near_nations($from, 1);
    foreach my $n(@for_commerce)
    {
        if(! grep { $_ eq $n } @already)
        {
            my $youcan = 'OK';
            $youcan = 'KO' if($self->war_busy($from) || $self->war_busy($n));
            $plan{'air'}->{$n}->{status} = $youcan;
            my $cost = $self->distance($from, $n) * AIR_TRAVEL_COST_FOR_DISTANCE;
            $cost = AIR_TRAVEL_CAP_COST if $cost > AIR_TRAVEL_CAP_COST;
            $plan{'air'}->{$n}->{cost} = $cost if($youcan eq 'OK');
            push @already, $n if $youcan eq 'OK';
        }
    }
    foreach my $n(@at_borders)
    {
        if(! grep { $_ eq $n } @already)
        {
            $plan{'ground'}->{$n}->{status} = 'OK';
            $plan{'ground'}->{$n}->{cost} = GROUND_TRAVEL_COST;
            push @already, $n;
        }
    }
    return %plan;
}

# END TRAVELS ########################################################################

# MISSIONS ###########################################################################

sub generate_mission
{
    my $self = shift;
    my $type = shift;
    my @nations = @{$self->nation_names};
    my %out;
    
    if($type eq 'parcel')
    {
        @nations = $self->shuffle("Nations for mission - assignment", @nations); 
        $out{'assignment'} = $nations[0];
        @nations = $self->shuffle("Nations for mission - from", @nations); 
        $out{'from'} = $nations[0];
        @nations = $self->shuffle("Nations for mission - to", @nations); 
        $out{'to'} = $nations[0] ne $out{'from'} ? $nations[0] : $nations[1];
        my $time = $self->random(0, 2, "Time available for mission");
        $out{'expire'} = next_turn($self->current_year);
        for(my $i = 0; $i < $time; $i++)
        {
            $out{'expire'} = next_turn($out{'expire'});
        }
        $out{'reward'}->{'friendship'}->{'assignment'} =  $self->random(FRIENDSHIP_RANGE_FOR_MISSION->{$type}->[0], 
                                                                        FRIENDSHIP_RANGE_FOR_MISSION->{$type}->[1], 
                                                                        "Friendship for mission - assignment");
        $out{'reward'}->{'friendship'}->{'from'} =  $self->random(FRIENDSHIP_RANGE_FOR_MISSION->{$type}->[0], 
                                                                  FRIENDSHIP_RANGE_FOR_MISSION->{$type}->[1], 
                                                                  "Friendship for mission - from");
        $out{'reward'}->{'friendship'}->{'to'} =  $self->random(FRIENDSHIP_RANGE_FOR_MISSION->{$type}->[0], 
                                                                FRIENDSHIP_RANGE_FOR_MISSION->{$type}->[1], 
                                                                "Friendship for mission - to");
        my $tot_friendship = $out{'reward'}->{'friendship'}->{'assignment'} +  $out{'reward'}->{'friendship'}->{'from'} +  $out{'reward'}->{'friendship'}->{'to'};
        my $money_bonus = $tot_friendship * BONUS_FACTOR_FOR_BAD_FRIENSHIP;
        $out{'reward'}->{'money'} = $self->random(MONEY_RANGE_FOR_MISSION->{$type}->[0] - $money_bonus, MONEY_RANGE_FOR_MISSION->{$type}->[1], "Money for mission");
    }
    else
    {
        die "Wrong type of mission";