view release on metacpan or  search on metacpan

lib/Games/Construder/Server/Player.pm  view on Meta::CPAN

# Games::Construder - A 3D Game written in Perl with an infinite and modifiable world.
# Copyright (C) 2011  Robin Redeker
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
package Games::Construder::Server::Player;
#d#use Devel::FindRef;
use common::sense;
use AnyEvent;
use Games::Construder::Server::World;
use Games::Construder::Server::UI;
use Games::Construder::Server::Objects;
use Games::Construder::Server::PatStorHandle;
use Games::Construder::Logging;
use Games::Construder::Vector;
use Time::HiRes qw/time/;
use base qw/Object::Event/;
use Scalar::Util qw/weaken/;
use Compress::LZF;

=head1 NAME

Games::Construder::Server::Player - Implementation of Player central Game Mechanics (the heart of the game)

=over 4

=cut

my $PL_VIS_RAD = 3;
my $PL_MAX_INV = 24;
my $PL_MAX_QUEUE_SIZE = 100; # max 100 chunks

sub new {
   my $this  = shift;
   my $class = ref ($this) || $this;
   my $self  = { @_ };
   bless $self, $class;

   $self->init_object_events;

   return $self
}

sub _check_file {
   my ($self) = @_;
   my $pld = $Games::Construder::Server::Resources::PLAYERDIR;
   my $file = "$pld/$self->{name}.json";
   return unless -e "$file";

   if (open my $plf, "<", $file) {
      binmode $plf, ":raw";
      my $cont = do { local $/; <$plf> };
      my $data = eval { JSON->new->relaxed->utf8->decode ($cont) };
      if ($@) {
         ctr_log (error => "Couldn't parse player data from file '%s': %s", $file, $!);
         return;
      }

      return $data

   } else {
      ctr_log (error => "Couldn't open player file '%s': %s", $file, $!);
      return;
   }
}

sub _initialize_player {
   my ($self) = @_;
   my $inv = $Games::Construder::Server::RES->get_initial_inventory;
   my $data = {
      name      => $self->{name},
      happyness => 100,
      bio       => 100,
      score     => 0,
 #     pos       => [1.1 * 60, -29 * 60, 1.1 * 60],
      pos       => [
         map { 60 * $_ } $Games::Construder::Server::RES->get_initial_position
      ],
      time      => 0,
      inv       => $inv,
      next_encounter => 15 * 60, # 15 minutes newbie safety
      slots => {
         selection => [],
         selected  => 0
      },
   };

   $data
}

sub load {
   my ($self) = @_;

   my $data = $self->_check_file;
   unless (defined $data) {
      $data = $self->_initialize_player;
   }

   $self->{data} = $data;
}

sub save {
   my ($self) = @_;
   my $cont = JSON->new->pretty->utf8->encode ($self->{data});
   my $pld = $Games::Construder::Server::Resources::PLAYERDIR;
   my $file = "$pld/$self->{name}.json";

   if (open my $plf, ">", "$file~") {
      binmode $plf, ":raw";
      print $plf $cont;
      close $plf;

      if (-s "$file~" != length ($cont)) {
         ctr_log (error => "Couldn't write out player file completely to '%s': %s", $file, $!);
         return;
      }

      unless (rename "$file~", "$file") {
         ctr_log (error => "Couldn't rename $file~ to $file: $!");;
         return;
      }

      ctr_log (info => "Saved player %s to %s", $self->{name}, $file);

   } else {
      ctr_log (error => "Couldn't open player file $file~ for writing: $!");
      return;
   }
}

sub init {
   my ($self) = @_;
   $self->load;
   $self->save;
   $self->set_vis_rad;

   my $wself = $self;
   weaken $wself;
   my $tick_time = time;
   my $msg_beacon_upd = 0;
   my $save_tmr = 0;

   $self->{tick_timer} = AE::timer 0.25, 0.25, sub {
      my $cur = time;
      my $dt = $cur - $tick_time;

      $msg_beacon_upd += $dt;
      if ($msg_beacon_upd > 2)
         {
            $msg_beacon_upd = 0;
            $self->check_message_beacons;

            $self->check_assignment_offers (2);

            $self->check_signal_jamming;
         }

      $wself->player_tick ($dt);
      $tick_time = $cur;
      $save_tmr       += $dt;
      $self->{data}->{time} += $dt;

      if (defined $self->{data}->{next_encounter}) {
         $self->{data}->{next_encounter} -= $dt;
         #d# warn "next encounter in $self->{data}->{next_encounter} seconds!\n";
         if ($self->{data}->{next_encounter} <= 0) {
            $self->create_encounter;
         }
      }

      if ($save_tmr >= 30)
         {
            $save_tmr = 0;
            $self->save;
         }
   };

   $self->new_ui (bio_warning   => "Games::Construder::Server::UI::BioWarning");
   $self->new_ui (msgbox        => "Games::Construder::Server::UI::MsgBox");
   $self->new_ui (score         => "Games::Construder::Server::UI::Score");
   $self->new_ui (slots         => "Games::Construder::Server::UI::Slots");
   $self->new_ui (status        => "Games::Construder::Server::UI::Status");
   $self->new_ui (server_info   => "Games::Construder::Server::UI::ServerInfo");
   $self->new_ui (material_view => "Games::Construder::Server::UI::MaterialView");
   $self->new_ui (inventory     => "Games::Construder::Server::UI::Inventory");
   $self->new_ui (cheat         => "Games::Construder::Server::UI::Cheat");
   $self->new_ui (sector_finder => "Games::Construder::Server::UI::SectorFinder");
   $self->new_ui (navigator     => "Games::Construder::Server::UI::Navigator");
   $self->new_ui (navigation_programmer
                                => "Games::Construder::Server::UI::NavigationProgrammer");
   $self->new_ui (assignment      => "Games::Construder::Server::UI::Assignment");
   $self->new_ui (assignment_time => "Games::Construder::Server::UI::AssignmentTime");
   $self->new_ui (pattern_storage => "Games::Construder::Server::UI::PatternStorage");
   $self->new_ui (material_handbook => "Games::Construder::Server::UI::MaterialHandbook");
   $self->new_ui (notebook      => "Games::Construder::Server::UI::Notebook");
   $self->new_ui (msg_beacon    => "Games::Construder::Server::UI::MessageBeacon");
   $self->new_ui (msg_beacon_list => "Games::Construder::Server::UI::MessageBeaconList");
   $self->new_ui (teleporter    => "Games::Construder::Server::UI::Teleporter");

lib/Games/Construder/Server/Player.pm  view on Meta::CPAN

      $assign->{left}->{$_} > 0
   } keys %{$assign->{left}};

   push @left, @left;
   for (my $i = 0; $i < (@left / 2); $i++) {
      if ($left[$i] == $assign->{sel_mat}) {
         $assign->{sel_mat} = $left[$i + 1];
         last;
      }
   }

   delete $self->{assign_ment_hl};
   $self->update_assignment_highlight;
   $self->{uis}->{assignment_time}->show;
}

sub update_assignment_highlight {
   my ($self) = @_;

   my $assign = $self->{data}->{assignment};
   my $selected = $assign->{sel_mat};
   if ($assign->{left}->{$selected} <= 0) {
      ($assign->{sel_mat}) = grep {
         $assign->{left}->{$_} > 0
      } keys %{$assign->{left}};
      delete $self->{assign_ment_hl};
   }

   unless ($self->{assign_ment_hl}) {
      $self->{assign_ment_hl} = 1;
      my $mat = $assign->{sel_mat};

      $self->send_client ({
         cmd   => "model_highlight",
         pos   => $assign->{pos},
         model => $assign->{mat_models}->{$mat},
         id    => "assignment",
      });
   }
}

sub check_assignment {
   my ($self) = @_;

   my $assign = $self->{data}->{assignment};
   unless ($assign) {
      $self->{uis}->{assignment_time}->hide;
      $self->send_client ({
         cmd => "model_highlight",
         id => "assignment"
      });
      return;
   }

   $self->check_assignment_positions;
   # was it finished?!
   return unless $self->{data}->{assignment};

   $self->{uis}->{assignment_time}->show;
   my $wself = $self;
   weaken $wself;
   $self->{assign_timer} = AE::timer 1, 1, sub {
      $wself->check_assignment_positions;
      # was it finished?!
      return unless $self->{data}->{assignment};

      $wself->{data}->{assignment}->{time} -= 1;
      $wself->{uis}->{assignment_time}->show;
      if ($wself->{data}->{assignment}->{time} <= 0) {
         $wself->cancel_assignment;
      }
   };
}

sub finished_assignmenet {
   my ($self) = @_;
   my $score = $self->{data}->{assignment}->{score};
   $self->push_tick_change (score => $score);
   $self->msg (0, "Congratulations! You finished the assignment and got $score score.");
   $self->{data}->{assignment} = undef;
   delete $self->{assign_timer};
   $self->check_assignment;
}

sub cancel_assignment {
   my ($self) = @_;
   my $ass = $self->{data}->{assignment};
   $self->push_tick_change (score_punishment => $ass->{punishment});
   $self->msg (1, "Sorry, you failed to finish the assignment. You lose $ass->{punishment} score.");
   $self->{data}->{assignment} = undef;
   delete $self->{assign_timer};
   $self->check_assignment;
}

sub create_encounter {
   my ($self) = @_;
   my $dir = [0,0,0];
   while (vlength ($dir) < 1) {
      $dir = vnorm (vrand ());
   }
   my $dist = 10 + rand (40); # hardcoded, if farther than 60, drone will not detect player
   my $pos = vsmul ($dir, $dist);
   viadd ($pos, $self->{data}->{pos});
   my $new_pos = world_find_free_spot ($pos, 0);

   my ($teledist, $nxttime, $lifetime) =
      $Games::Construder::Server::RES->encounter_values ();

   ctr_log (debug => "next encounter for player %s is %d (%d, %d)", $self->{name}, $nxttime, $teledist, $lifetime);
   $self->{data}->{next_encounter} = $nxttime;

   world_mutate_at ($new_pos, sub {
      my ($data) = @_;
      $data->[0] = 50;
      $data->[5] =
         Games::Construder::Server::Objects::instance (
            50, int ($dist * 1.5 + $lifetime), $teledist);
      return 1;
   });
}