Adding sending words.

This commit is contained in:
Sergiotarxz 2023-07-12 18:41:59 +02:00
parent e272f0f299
commit f43070ffee
5 changed files with 97 additions and 30 deletions

View File

@ -80,6 +80,7 @@ sub handle ( $self, $ws, $session, $data ) {
clear => $JSON::true, clear => $JSON::true,
$self->_available_actions($pj), $self->_available_actions($pj),
$self->_npcs($pj), $self->_npcs($pj),
$self->_available_words($pj),
); );
$info_packet_to_send->send($ws); $info_packet_to_send->send($ws);
my $redis = LasTres::Redis->new; my $redis = LasTres::Redis->new;
@ -174,10 +175,16 @@ sub _on_redis_event ( $self, $ws, $session, $message, $topic, $topics ) {
if ( $data->{command} eq 'update-actions' ) { if ( $data->{command} eq 'update-actions' ) {
LasTres::Controller::Websocket::OutputPacket::Info->new( LasTres::Controller::Websocket::OutputPacket::Info->new(
$self->_available_actions($pj), $self->_available_actions($pj),
$self->_npcs($pj) )->send($ws); $self->_npcs($pj),
$self->_available_words($pj))->send($ws);
} }
} }
sub _available_words($self, $pj) {
my $known_words = $pj->known_words_hash_serialized;
return ( known_words => $known_words );
}
sub _available_actions ( $self, $pj ) { sub _available_actions ( $self, $pj ) {
return ( available_actions => return ( available_actions =>
{ map { $_->identifier => $_->hash($pj) } $pj->actions->@* }, ); { map { $_->identifier => $_->hash($pj) } $pj->actions->@* }, );

View File

@ -147,6 +147,22 @@ sub knows_word ( $self, $word ) {
return 1; 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 known_words_hash_serialized ($self) {
my %words = %{$self->known_words_hash};
my @identifiers = keys %words;
%words = map { ($_->identifier => $_->serialize) } @identifiers;
return \%words;
}
sub teach_word ( $self, $word ) { sub teach_word ( $self, $word ) {
require LasTres::Schema; require LasTres::Schema;
my $schema = LasTres::Schema->Schema; my $schema = LasTres::Schema->Schema;
@ -155,29 +171,31 @@ sub teach_word ( $self, $word ) {
if ( !$word->does('LasTres::Word') ) { if ( !$word->does('LasTres::Word') ) {
die 'The received word does not implement LasTres::Word.'; die 'The received word does not implement LasTres::Word.';
} }
if ($self->knows_word($word)) { if ( $self->knows_word($word) ) {
return; return;
} }
my $known_word = $result_set_words->new( my $known_word = $result_set_words->new(
{ identifier => $word->identifier, owner => $self->uuid } ); { identifier => $word->identifier, owner => $self->uuid } );
$known_word->insert_or_update; $known_word->insert_or_update;
my $team = $self->team; my $team = $self->team;
$team->append_log_line([ $team->append_log_line(
{ [
color => 'green', {
text => $self->nick, color => 'green',
}, text => $self->nick,
{ },
text => ' aprendió la palabra ' {
}, text => ' aprendió la palabra '
{ },
color => 'purple', {
text => $word->name, color => 'purple',
}, text => $word->name,
{ },
text => '.' {
} text => '.'
]); }
]
);
} }
@ -207,7 +225,7 @@ sub set_known_location ( $self, $location ) {
my $array = $location->to_array; my $array = $location->to_array;
my ( $planet, $super_area, $area, $location_id ) = @$array[ 0 .. 3 ]; my ( $planet, $super_area, $area, $location_id ) = @$array[ 0 .. 3 ];
my $schema = LasTres::Schema->Schema; my $schema = LasTres::Schema->Schema;
if (!$self->knows_location($location)) { if ( !$self->knows_location($location) ) {
$schema->resultset('PJKnownPlaces')->new( $schema->resultset('PJKnownPlaces')->new(
{ {
owner => $self->uuid, owner => $self->uuid,
@ -563,6 +581,7 @@ sub talk_npcs ($self) {
return {}; return {};
} }
if ( $team->is_moving ) { if ( $team->is_moving ) {
# There will be random encounters for # There will be random encounters for
# some movement frames in certain areas. # some movement frames in certain areas.
return $self->_npc_list_to_hash( \@npcs ); return $self->_npc_list_to_hash( \@npcs );

View File

@ -29,4 +29,12 @@ requires qw/name identifier/;
return $hash{$class}; return $hash{$class};
} }
} }
## DO NOT EXTEND NOT SUPPORTED.
sub serialize ($self) {
return {
name => $self->name,
identifier => $self->identifier,
};
}
1; 1;

View File

@ -15,18 +15,20 @@ use Module::Pluggable search_path => ['LasTres::Word'],
die $error; die $error;
}; };
has hash => ( {
is => 'rw',
lazy => 1,
builder => \&_build_hash,
);
sub _build_hash($self) {
my @words = $self->plugins();
my %hash; my %hash;
for my $word (@words) { sub hash($self) {
$hash{$word->identifier} = $word; if (!scalar %hash) {
my @words = $self->plugins();
for my $word (@words) {
$hash{$word->identifier} = $word;
}
}
return {%hash};
} }
return \%hash; }
sub get($self, $identifier) {
return $self->hash->{$identifier};
} }
1; 1;

31
t/02-words.t Normal file
View File

@ -0,0 +1,31 @@
#!/usr/bin/env perl
use v5.36.0;
use strict;
use warnings;
use feature 'signatures';
use Scalar::Util qw/blessed/;
use Test::Most qw/bail no_plan/;
{
use_ok 'LasTres::Words';
}
{
my $words_factory = LasTres::Words->new;
my $words = $words_factory->hash;
for my $identifier (keys %$words) {
my $word = $words->{$identifier};
test_word($word);
}
}
sub test_word($word) {
ok $word->does('LasTres::Word'), (blessed $word)
. ' implements LasTres::Word.';
ok defined $word->name, (blessed $word) . ' has name.';
ok defined $word->identifier, (blessed $word) . ' has identifier.';
}