692 lines
18 KiB
Perl
692 lines
18 KiB
Perl
package LasTres::Schema::Result::PJ;
|
|
|
|
use v5.36.0;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use feature 'signatures';
|
|
use utf8;
|
|
|
|
use parent 'DBIx::Class::Core';
|
|
|
|
use UUID::URandom qw/create_uuid_string/;
|
|
use List::AllUtils;
|
|
use Data::Dumper;
|
|
|
|
use JSON qw/to_json from_json/;
|
|
|
|
use Moo;
|
|
|
|
use LasTres::Words;
|
|
|
|
__PACKAGE__->table('player_pjs');
|
|
|
|
__PACKAGE__->add_columns(
|
|
uuid => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
},
|
|
owner => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
is_foreign_key => 1,
|
|
},
|
|
full_name => {
|
|
data_type => 'text',
|
|
is_nullable => 0,
|
|
},
|
|
short_name => {
|
|
data_type => 'text',
|
|
is_nullable => 0,
|
|
},
|
|
nick => {
|
|
data_type => 'text',
|
|
is_nullable => 0,
|
|
},
|
|
race => {
|
|
data_type => 'text',
|
|
is_nullable => 0,
|
|
accessor => "race_string",
|
|
},
|
|
team => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
},
|
|
creation_date => {
|
|
data_type => 'timestamp',
|
|
default_value => \'NOW()',
|
|
is_nullable => 0,
|
|
},
|
|
last_activity => {
|
|
data_type => 'timestamp',
|
|
default_value => \'NOW()',
|
|
is_nullable => 0,
|
|
},
|
|
experience => {
|
|
data_type => 'integer',
|
|
default_value => \'1',
|
|
is_nullable => 0,
|
|
},
|
|
equipment => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
is_foreign_key => 1,
|
|
},
|
|
born_stats => {
|
|
data_type => 'uuid',
|
|
is_foreign_key => 1,
|
|
is_nullable => 0,
|
|
},
|
|
training_stats => {
|
|
data_type => 'uuid',
|
|
is_foreign_key => 1,
|
|
is_nullable => 0,
|
|
},
|
|
skills => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
is_foreign_key => 1,
|
|
},
|
|
spells => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
is_foreign_key => 1,
|
|
},
|
|
inventory => {
|
|
data_type => 'uuid',
|
|
is_nullable => 0,
|
|
},
|
|
health => {
|
|
data_type => 'integer',
|
|
accessor => '_health',
|
|
is_nullable => 0,
|
|
},
|
|
mana => {
|
|
data_type => 'integer',
|
|
accessor => '_mana',
|
|
is_nullable => 0,
|
|
},
|
|
combat_target => {
|
|
data_type => 'uuid',
|
|
is_nullable => 1,
|
|
},
|
|
combat_action => {
|
|
data_type => 'text',
|
|
is_nullable => 1,
|
|
},
|
|
);
|
|
|
|
__PACKAGE__->set_primary_key('uuid');
|
|
|
|
__PACKAGE__->has_many( 'npcs', 'LasTres::Schema::Result::CompanionNPC',
|
|
'owner' );
|
|
__PACKAGE__->has_many( 'logs', 'LasTres::Schema::Result::PJLog', 'owner' );
|
|
__PACKAGE__->has_many( 'known_places',
|
|
'LasTres::Schema::Result::PJKnownPlaces', 'owner' );
|
|
__PACKAGE__->has_many( 'flags', 'LasTres::Schema::Result::PJFlag', 'owner' );
|
|
__PACKAGE__->has_many( 'vars', 'LasTres::Schema::Result::PJVar', 'owner' );
|
|
__PACKAGE__->has_many( 'known_words', 'LasTres::Schema::Result::PJKnownWord',
|
|
'owner' );
|
|
__PACKAGE__->belongs_to( 'born_stats', 'LasTres::Schema::Result::Stats' );
|
|
__PACKAGE__->belongs_to( 'training_stats', 'LasTres::Schema::Result::Stats' );
|
|
__PACKAGE__->belongs_to( 'inventory', 'LasTres::Schema::Result::Inventory' );
|
|
__PACKAGE__->belongs_to( 'skills', 'LasTres::Schema::Result::SkillLikeList' );
|
|
__PACKAGE__->belongs_to( 'spells', 'LasTres::Schema::Result::SkillLikeList' );
|
|
__PACKAGE__->belongs_to( 'equipment', 'LasTres::Schema::Result::Equipment' );
|
|
__PACKAGE__->belongs_to( 'team', 'LasTres::Schema::Result::Team' );
|
|
__PACKAGE__->belongs_to( 'owner', 'LasTres::Schema::Result::Player' );
|
|
|
|
sub knows_word ( $self, $word ) {
|
|
$self = $self->get_from_storage;
|
|
if ( !$word->does('LasTres::Word') ) {
|
|
die 'The received word does not implement LasTres::Word.';
|
|
}
|
|
my @words =
|
|
$self->known_words->search( { identifier => $word->identifier } );
|
|
if ( !scalar @words ) {
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub known_words_hash ($self) {
|
|
$self = $self->get_from_storage;
|
|
my @words = $self->known_words;
|
|
my $words_factory = LasTres::Words->new;
|
|
my %result_words = map { ( $_->identifier => $_ ) }
|
|
map { $words_factory->get( $_->identifier ) } @words;
|
|
return \%result_words;
|
|
}
|
|
|
|
sub get_word ( $self, $word_identifier ) {
|
|
return $self->known_words_hash->{$word_identifier};
|
|
}
|
|
|
|
sub known_words_hash_serialized ($self) {
|
|
my %words = %{ $self->known_words_hash };
|
|
my @identifiers = keys %words;
|
|
%words =
|
|
map { ( $words{$_}->identifier => $words{$_}->serialize ) } @identifiers;
|
|
return \%words;
|
|
}
|
|
|
|
sub teach_word ( $self, $word ) {
|
|
require LasTres::Schema;
|
|
my $schema = LasTres::Schema->Schema;
|
|
my $result_set_words = $schema->resultset('PJKnownWord');
|
|
$self = $self->get_from_storage;
|
|
if ( !$word->does('LasTres::Word') ) {
|
|
die 'The received word does not implement LasTres::Word.';
|
|
}
|
|
if ( $self->knows_word($word) ) {
|
|
return;
|
|
}
|
|
my $known_word = $result_set_words->new(
|
|
{ identifier => $word->identifier, owner => $self->uuid } );
|
|
$known_word->insert_or_update;
|
|
my $team = $self->team;
|
|
$team->append_log_line(
|
|
[
|
|
{
|
|
color => 'green',
|
|
text => $self->nick,
|
|
},
|
|
{
|
|
text => ' aprendió la palabra '
|
|
},
|
|
{
|
|
color => 'purple',
|
|
text => $word->name,
|
|
},
|
|
{
|
|
text => '.'
|
|
}
|
|
]
|
|
);
|
|
|
|
}
|
|
|
|
sub knows_location ( $self, $location ) {
|
|
require LasTres::Schema;
|
|
my $schema = LasTres::Schema->Schema;
|
|
my $array = $location->to_array;
|
|
my ( $planet, $super_area, $area ) = @$array[ 0 .. 2 ];
|
|
$location = $array->[3];
|
|
my @places = $schema->resultset('PJKnownPlaces')->search(
|
|
{
|
|
owner => $self->uuid,
|
|
planet => $planet,
|
|
super_area => $super_area,
|
|
area => $area,
|
|
location => $location
|
|
}
|
|
);
|
|
if (@places) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub set_known_location ( $self, $location ) {
|
|
require LasTres::Schema;
|
|
my $array = $location->to_array;
|
|
my ( $planet, $super_area, $area, $location_id ) = @$array[ 0 .. 3 ];
|
|
my $schema = LasTres::Schema->Schema;
|
|
if ( !$self->knows_location($location) ) {
|
|
$schema->resultset('PJKnownPlaces')->new(
|
|
{
|
|
owner => $self->uuid,
|
|
planet => $planet,
|
|
super_area => $super_area,
|
|
area => $area,
|
|
location => $location_id
|
|
}
|
|
)->insert;
|
|
}
|
|
}
|
|
|
|
sub hash ($self) {
|
|
my $image;
|
|
my $race = $self->race;
|
|
if ( $race->can('image') ) {
|
|
$image = $race->image;
|
|
}
|
|
return {
|
|
uuid => $self->uuid,
|
|
full_name => $self->full_name,
|
|
short_name => $self->short_name,
|
|
nick => $self->nick,
|
|
race => $self->race,
|
|
health => $self->health,
|
|
max_health => $self->max_health,
|
|
mana => $self->mana,
|
|
level => $self->level,
|
|
experience_to_next_level_complete =>
|
|
$self->experience_to_next_level_complete,
|
|
experience_to_next_level_current =>
|
|
$self->experience_to_next_level_current,
|
|
max_mana => $self->max_mana,
|
|
(
|
|
( defined $image )
|
|
? ( image => $image )
|
|
: ()
|
|
),
|
|
};
|
|
}
|
|
|
|
sub experience_to_next_level_complete ($self) {
|
|
return ( $self->level + 1 )**3 - $self->level**3;
|
|
}
|
|
|
|
sub experience_to_next_level_current ($self) {
|
|
return $self->experience - $self->level**3;
|
|
}
|
|
|
|
my $columns = __PACKAGE__->columns_info;
|
|
for my $column_name ( keys %$columns ) {
|
|
my $column = $columns->{$column_name};
|
|
my $is_nullable = $column->{is_nullable};
|
|
$is_nullable //= 0;
|
|
my $required = !$is_nullable;
|
|
if ( defined $column->{default_value} ) {
|
|
$required = 0;
|
|
}
|
|
has $column_name => (
|
|
is => 'rw',
|
|
required => $required,
|
|
accessor => "_moo_$column_name",
|
|
);
|
|
}
|
|
|
|
sub last_50_log ($self) {
|
|
return $self->logs->search( {},
|
|
{ limit => 50, order_by => { -desc => 'date' } } );
|
|
}
|
|
|
|
sub update_team_sprites ($self) {
|
|
require LasTres::Redis;
|
|
my $redis = LasTres::Redis->new;
|
|
$redis->publish( $redis->pj_subscription($self),
|
|
to_json( { command => 'update-team-sprites' } ) );
|
|
}
|
|
|
|
sub update ($self) {
|
|
$self->SUPER::update();
|
|
if ( !defined $self->team->battle && $self->team->is_defeated ) {
|
|
|
|
# Out of combat blackout.
|
|
$self->team->on_blackout();
|
|
}
|
|
}
|
|
|
|
sub on_level_up ( $self, $old_level ) {
|
|
my $old_experience = $self->experience;
|
|
my $team = $self->team;
|
|
my $enemy_team = $self->_enemy_team;
|
|
$self = $self->get_from_storage;
|
|
$self->health( $self->max_health );
|
|
$self->update;
|
|
for my $member ( $team->combat_members->@* ) {
|
|
$member->update_team_sprites;
|
|
$member->append_log_line(
|
|
[
|
|
{
|
|
text => $self->nick,
|
|
color => 'green',
|
|
},
|
|
{
|
|
text => ' subió al nivel ' . $self->level
|
|
}
|
|
]
|
|
);
|
|
}
|
|
if ( defined $enemy_team ) {
|
|
for my $member ( $enemy_team->combat_members->@* ) {
|
|
$member->update_team_sprites;
|
|
$member->append_log_line(
|
|
[
|
|
{
|
|
text => $self->nick,
|
|
color => 'red',
|
|
},
|
|
{
|
|
text => ' subió al nivel ' . $self->level
|
|
}
|
|
]
|
|
);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _enemy_team ($self) {
|
|
my $team = $self->team;
|
|
my $enemy_team;
|
|
my $current_battle = $team->current_battle;
|
|
{
|
|
if ( !defined $current_battle ) {
|
|
next;
|
|
}
|
|
my $battle = LasTres::Battle->get_redis($current_battle);
|
|
if ( !defined $battle ) {
|
|
next;
|
|
}
|
|
$enemy_team = $battle->get_enemy_team($team);
|
|
}
|
|
return $enemy_team;
|
|
}
|
|
|
|
sub gain_experience ( $self, $experience_to_gain ) {
|
|
$experience_to_gain = int($experience_to_gain);
|
|
my $redis = LasTres::Redis->new;
|
|
my $old_experience = $self->experience;
|
|
my $old_level = $self->level;
|
|
my $team = $self->team;
|
|
my $current_battle = $team->current_battle;
|
|
$self->experience( $old_experience + $experience_to_gain );
|
|
$self->update;
|
|
|
|
for my $member ( $team->combat_members->@* ) {
|
|
$member->append_log_line(
|
|
[
|
|
{
|
|
text => $self->nick,
|
|
color => 'green',
|
|
},
|
|
{
|
|
text => " ganó $experience_to_gain puntos de experiencia."
|
|
}
|
|
]
|
|
);
|
|
}
|
|
my $enemy_team = $self->_enemy_team;
|
|
if ( defined $enemy_team ) {
|
|
for my $member ( $enemy_team->combat_members->@* ) {
|
|
$member->append_log_line(
|
|
[
|
|
{
|
|
text => $self->nick,
|
|
color => 'red',
|
|
},
|
|
{
|
|
text =>
|
|
" ganó $experience_to_gain puntos de experiencia."
|
|
}
|
|
]
|
|
);
|
|
}
|
|
}
|
|
if ( $old_level != $self->level ) {
|
|
$self->on_level_up($old_level);
|
|
}
|
|
}
|
|
|
|
sub append_log_line ( $self, $content ) {
|
|
require LasTres::Schema;
|
|
require LasTres::Redis;
|
|
my $redis = LasTres::Redis->new;
|
|
if ( ref $content ne 'ARRAY' ) {
|
|
die 'Bad log content, not a arrayref.';
|
|
}
|
|
for my $section (@$content) {
|
|
if ( ref $section ne 'HASH' ) {
|
|
die 'Invalid section, not a hashref.';
|
|
}
|
|
my @recognized_log_keys = qw/color background text/;
|
|
if (
|
|
List::AllUtils::any {
|
|
my $key = $_;
|
|
(
|
|
List::AllUtils::none {
|
|
$key eq $_
|
|
}
|
|
@recognized_log_keys
|
|
)
|
|
}
|
|
keys %$section
|
|
)
|
|
{
|
|
die 'The section '
|
|
. ( Data::Dumper::Dumper $section)
|
|
. ' has an unrecognized key';
|
|
}
|
|
if ( !defined $section->{text} ) {
|
|
die 'The section has no text.';
|
|
}
|
|
}
|
|
my $uuid = create_uuid_string;
|
|
my $log =
|
|
LasTres::Schema->Schema->resultset('PJLog')
|
|
->new(
|
|
{ uuid => $uuid, owner => $self->uuid, content => to_json($content) } );
|
|
$log->insert;
|
|
$log = $log->get_from_storage;
|
|
|
|
$redis->publish( $redis->pj_subscription($self),
|
|
to_json( { command => 'append-log', log => $log->hash } ) );
|
|
}
|
|
|
|
sub location ($self) {
|
|
return $self->team->location;
|
|
}
|
|
|
|
sub get_var_json ( $self, $name ) {
|
|
my $value_raw = $self->get_var($name);
|
|
if ( !defined $value_raw ) {
|
|
return;
|
|
}
|
|
my $value;
|
|
eval { $value = from_json($value_raw); };
|
|
if ($@) {
|
|
warn $@;
|
|
return;
|
|
}
|
|
return $value;
|
|
}
|
|
|
|
sub set_var_json ( $self, $name, $value ) {
|
|
my $value_raw = to_json($value);
|
|
$self->set_var( $name, $value_raw );
|
|
}
|
|
|
|
sub _temporal_var_retrieve ( $self, $name ) {
|
|
my $temporal = $self->get_var_json($name);
|
|
if ( !defined $temporal ) {
|
|
$temporal = {
|
|
flags => {},
|
|
vars => {}
|
|
};
|
|
}
|
|
return $temporal;
|
|
}
|
|
|
|
sub set_location_flag ( $self, $name ) {
|
|
require LasTres::Vars;
|
|
my $location_temporal =
|
|
$self->_temporal_var_retrieve( LasTres::Vars::LOCATION_TEMPORAL() );
|
|
$location_temporal->{flags}{$name} = $JSON::true;
|
|
$self->set_var_json( LasTres::Vars::LOCATION_TEMPORAL(),
|
|
$location_temporal );
|
|
}
|
|
|
|
sub get_location_flag ( $self, $name ) {
|
|
require LasTres::Vars;
|
|
my $location_temporal =
|
|
$self->_temporal_var_retrieve( LasTres::Vars::LOCATION_TEMPORAL() );
|
|
if ( defined $location_temporal->{flags}{$name} ) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub set_flag ( $self, $name ) {
|
|
require LasTres::Schema;
|
|
my $schema = LasTres::Schema->Schema;
|
|
my $result_set_flags = $schema->resultset('PJFlag');
|
|
my $flag = $result_set_flags->new( { name => $name, owner => $self->uuid } )
|
|
->update_or_insert;
|
|
}
|
|
|
|
sub set_var ( $self, $name, $value ) {
|
|
require LasTres::Schema;
|
|
my $schema = LasTres::Schema->Schema;
|
|
my $result_set_vars = $schema->resultset('PJVar');
|
|
|
|
my $var = $result_set_vars->new(
|
|
{ name => $name, owner => $self->uuid, value => $value } );
|
|
eval {
|
|
$var->insert;
|
|
};
|
|
if ($@ && $@ =~ /duplicate/) {
|
|
$var->update;
|
|
undef $@;
|
|
}
|
|
if ($@) {
|
|
warn $@;
|
|
}
|
|
}
|
|
|
|
sub get_flag ( $self, $name ) {
|
|
my @flags = $self->flags->search( { name => $name } );
|
|
if ( scalar @flags ) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub get_var ( $self, $name ) {
|
|
my @vars = $self->vars->search( { name => $name } );
|
|
if ( scalar @vars ) {
|
|
return $vars[0]->value;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub clear_flag ( $self, $name ) {
|
|
$self->flags->search( { name => $name } )->delete;
|
|
}
|
|
|
|
sub clear_var ( $self, $name ) {
|
|
$self->vars->search( { name => $name } )->delete;
|
|
}
|
|
|
|
sub health {
|
|
my $self = shift;
|
|
my $health_to_set = shift;
|
|
require LasTres::Schema;
|
|
my $schema = LasTres::Schema->Schema;
|
|
$schema->txn_do(
|
|
sub {
|
|
if ( defined $health_to_set ) {
|
|
$self->_health($health_to_set);
|
|
$self->update;
|
|
}
|
|
my $health = $self->_health;
|
|
if ( $health < 0 ) {
|
|
$self->_health(0);
|
|
$self->update;
|
|
}
|
|
if ( $health > $self->max_health ) {
|
|
$self->_health( $self->max_health );
|
|
$self->update;
|
|
}
|
|
}
|
|
);
|
|
return $self->_health;
|
|
}
|
|
|
|
sub mana {
|
|
my $self = shift;
|
|
my $mana_to_set = shift;
|
|
require LasTres::Schema;
|
|
my $schema = LasTres::Schema->Schema;
|
|
$schema->txn_do(
|
|
sub {
|
|
if ( defined $mana_to_set ) {
|
|
$self->_mana($mana_to_set);
|
|
$self->update;
|
|
}
|
|
my $mana = $self->_mana;
|
|
if ( $mana < 0 ) {
|
|
$self->_mana(0);
|
|
$self->update;
|
|
}
|
|
if ( $mana > $self->max_mana ) {
|
|
$self->_mana( $self->max_mana );
|
|
$self->update;
|
|
}
|
|
}
|
|
);
|
|
return $self->_mana;
|
|
}
|
|
|
|
sub update_location ($self) {
|
|
require LasTres::Redis;
|
|
my $redis = LasTres::Redis->new;
|
|
$redis->publish( $redis->pj_subscription($self),
|
|
to_json( { command => 'update-location' } ) );
|
|
}
|
|
|
|
sub update_actions ($self) {
|
|
require LasTres::Redis;
|
|
my $redis = LasTres::Redis->new;
|
|
$redis->publish( $redis->pj_subscription($self),
|
|
to_json( { command => 'update-actions' } ) );
|
|
}
|
|
|
|
sub actions ($self) {
|
|
my @actions;
|
|
$self = $self->get_from_storage;
|
|
my $team = $self->team;
|
|
my $location = $team->location;
|
|
if ( defined $team->battle ) {
|
|
|
|
# Here should go the battle actions.
|
|
return [];
|
|
}
|
|
if ( $team->is_moving ) {
|
|
|
|
# Probably there should go the actions still doable when moving.
|
|
return [];
|
|
}
|
|
|
|
# TODO: Handle explore when implemented.
|
|
# These are static actions.
|
|
if ( $location->is_spawn ) {
|
|
push @actions, $location->healing_action;
|
|
}
|
|
my $location_actions = $location->actions($self);
|
|
@actions = ( @actions, @$location_actions );
|
|
return \@actions;
|
|
}
|
|
|
|
sub talk_npcs ($self) {
|
|
my @npcs;
|
|
$self = $self->get_from_storage;
|
|
my $team = $self->team;
|
|
my $location = $team->location;
|
|
if ( defined $team->battle ) {
|
|
return {};
|
|
}
|
|
if ( $team->is_moving ) {
|
|
|
|
# There will be random encounters for
|
|
# some movement frames in certain areas.
|
|
return $self->_npc_list_to_hash( \@npcs );
|
|
}
|
|
my $location_npcs = $location->npcs($self);
|
|
@npcs = ( @npcs, @$location_npcs );
|
|
return $self->_npc_list_to_hash( \@npcs );
|
|
}
|
|
|
|
sub _npc_list_to_hash ( $self, $npcs ) {
|
|
return { map { ( $_->identifier => $_ ) } @$npcs };
|
|
}
|
|
|
|
sub talking_npcs ($self) {
|
|
return [];
|
|
}
|
|
|
|
with 'LasTres::CombatCapableEntity';
|
|
1;
|