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 OSRIC::Util qw/d con_mod/;
|
||||||
use POSIX qw/ceil/;
|
use POSIX qw/ceil/;
|
||||||
use JSON qw/to_json/;
|
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
|
# These functions are ordered in this file in the order they are to be
|
||||||
# called in:
|
# called in:
|
||||||
@ -238,6 +239,43 @@ sub generate_hp
|
|||||||
$self->{personal}->{hp} = ceil($self->{personal}->{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:
|
# Encodes the character to JSON:
|
||||||
sub as_json
|
sub as_json
|
||||||
{
|
{
|
||||||
|
@ -25,4 +25,7 @@ sub minimum_scores
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# The allowed alignments
|
||||||
|
sub get_alignments { }
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Assassin;
|
package OSRIC::Class::Assassin;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Cleric;
|
package OSRIC::Class::Cleric;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Druid;
|
package OSRIC::Class::Druid;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Fighter;
|
package OSRIC::Class::Fighter;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Illusionist;
|
package OSRIC::Class::Illusionist;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::MagicUser;
|
package OSRIC::Class::MagicUser;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Paladin;
|
package OSRIC::Class::Paladin;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Ranger;
|
package OSRIC::Class::Ranger;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Class::Thief;
|
package OSRIC::Class::Thief;
|
||||||
use parent qw(OSRIC::Class);
|
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
|
# A sub to get the maximum amount of starting gold (for sorting) and one to get
|
||||||
# an actual amount of starting gold:
|
# 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;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
package OSRIC::Util;
|
package OSRIC::Util;
|
||||||
use Exporter qw/import/;
|
use Exporter qw/import/;
|
||||||
our @EXPORT = qw/d con_mod/;
|
our @EXPORT = qw/d con_mod alignments/;
|
||||||
|
|
||||||
# Rolls a dice of the specified number:
|
# Rolls a dice of the specified number:
|
||||||
sub d
|
sub d
|
||||||
@ -83,4 +83,21 @@ sub con_mod
|
|||||||
return $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;
|
1;
|
||||||
|
Loading…
Reference in New Issue
Block a user