Added alignment support
This commit is contained in:
parent
2b7010bb27
commit
b5db153e03
@ -23,6 +23,7 @@ use OSRIC::Class::Thief;
|
||||
use OSRIC::Util qw/d con_mod/;
|
||||
use POSIX qw/ceil/;
|
||||
use JSON qw/to_json/;
|
||||
use List::Compare qw/new get_intersection/;
|
||||
|
||||
# These functions are ordered in this file in the order they are to be
|
||||
# called in:
|
||||
@ -238,6 +239,43 @@ sub generate_hp
|
||||
$self->{personal}->{hp} = ceil($self->{personal}->{hp});
|
||||
}
|
||||
|
||||
# Gets all of the player's available alignments:
|
||||
sub get_available_alignments
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
# Store all the returned alignment options:
|
||||
my @alignments;
|
||||
|
||||
# Loop over the player's classes:
|
||||
my $classes = $self->{personal}->{classes};
|
||||
for my $class(@{$classes})
|
||||
{
|
||||
push @alignments, "OSRIC::Class::$class"->get_alignments;
|
||||
}
|
||||
|
||||
# Return the intersection of all the arrays obtained:
|
||||
if(@alignments > 1)
|
||||
{
|
||||
my $lc = List::Compare->new({
|
||||
lists => \@alignments,
|
||||
unsorted => 1,
|
||||
});
|
||||
return $lc->get_intersection;
|
||||
}
|
||||
else
|
||||
{
|
||||
return @{$alignments[0]};
|
||||
}
|
||||
}
|
||||
|
||||
# Sets the player's alignment:
|
||||
sub set_alignment
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{personal}->{alignment} = shift;
|
||||
}
|
||||
|
||||
# Encodes the character to JSON:
|
||||
sub as_json
|
||||
{
|
||||
|
@ -25,4 +25,7 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments { }
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Assassin;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = grep { $_ =~ /^evil/i } alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Cleric;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Druid;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = grep { $_ =~ /^neutral$/i } alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Fighter;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Illusionist;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::MagicUser;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Paladin;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = grep { $_ =~ /^lawful good$/i } alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Ranger;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = grep { $_ =~ /^good/i } alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Class::Thief;
|
||||
use parent qw(OSRIC::Class);
|
||||
use OSRIC::Util qw/d/;
|
||||
use OSRIC::Util qw/d alignments/;
|
||||
|
||||
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||
# an actual amount of starting gold:
|
||||
@ -23,4 +23,11 @@ sub minimum_scores
|
||||
}
|
||||
}
|
||||
|
||||
# The allowed alignments
|
||||
sub get_alignments
|
||||
{
|
||||
my @a = grep { $_ =~ /(?:neutral|evil)$/i } alignments;
|
||||
return \@a;
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -1,6 +1,6 @@
|
||||
package OSRIC::Util;
|
||||
use Exporter qw/import/;
|
||||
our @EXPORT = qw/d con_mod/;
|
||||
our @EXPORT = qw/d con_mod alignments/;
|
||||
|
||||
# Rolls a dice of the specified number:
|
||||
sub d
|
||||
@ -83,4 +83,21 @@ sub con_mod
|
||||
return $mod;
|
||||
}
|
||||
|
||||
# Generates the alignments because I'm too lazy to write them out:
|
||||
sub alignments
|
||||
{
|
||||
my @a = qw/Lawful Neutral Chaotic/;
|
||||
my @b = qw/Good Neutral Evil/;
|
||||
my @alignments;
|
||||
for my $a(@a)
|
||||
{
|
||||
for my $b(@b)
|
||||
{
|
||||
unless($a eq $b) { push @alignments, ($a . " " . $b); }
|
||||
else { push @alignments, $a; }
|
||||
}
|
||||
}
|
||||
return @alignments;
|
||||
}
|
||||
|
||||
1;
|
||||
|
Loading…
Reference in New Issue
Block a user