Group
Extension

Games-Construder/lib/Games/Construder/Server/World.pm

# 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::World;
use common::sense;
use Games::Construder::Vector;
use Games::Construder;
use Time::HiRes qw/time/;
use Carp qw/confess/;
use Compress::LZF qw/decompress compress/;
use JSON;
use Storable qw/dclone/;
use Games::Construder::Logging;

require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/
   world_init
   world_pos2id
   world_id2pos
   world_pos2chnkpos
   world_chnkpos2secpos
   world_secpos2chnkpos
   world_pos2relchnkpos
   world_mutate_at
   world_mutate_entity_at
   world_load_at
   world_find_free_spot
   world_at
   world_entity_at
   world_sector_info
   world_touch_sector
   world_load_at_player
   world_load_around_at
   world_save_all
   world_find_random_teleport_destination_at_dist
/;


=head1 NAME

Games::Construder::Server::World - Server side world management and utility functions

=over 4

=cut

our $CHNK_SIZE = 12;
our $CHNKS_P_SEC = 5;

our $REGION_SEED = 42;
our $REGION_SIZE = 100; # 100x100x100 sections
our $REGION;

our %SECTORS;

our $STORE_SCHED_TMR;
our $FREE_TMR;
our $TICK_TMR;
our @SAVE_SECTORS_QUEUE;

our @LIGHTQUEUE;
our %LIGHTQUEUE;

our $SRV;

# neccessary so we can start other mutates
# from inside loading or mutate callbacks:
our $in_mutate;
our @mutate_cont;

sub world_init {
   my ($server, $region_cmds) = @_;

   $SRV = $server;

   Games::Construder::World::init (
      sub {
         my ($x, $y, $z) = @_;
         my $chnk = [$x, $y, $z];

         my $sec = world_chnkpos2secpos ($chnk);
         my $id  = world_pos2id ($sec);
         unless (exists $SECTORS{$id}) {
            # this might happen either due to bugs or when sectors are loaded
            # and light is calculated.
#            warn "updated sector which is not loaded "
#                 . "(chunk $x,$y,$z [@$sec]) $id. "
#                 . "but this should be okay :-)\n";
            return; # don't set dirty
         }
         world_sector_dirty ($sec);

         for (values %{$server->{players}}) {
            $_->chunk_updated ($chnk);
         }
      },
      sub {
         my ($x, $y, $z, $type, $ent) = @_;
         ctr_log (debug => "change active cell: %d (%d,%d,%d) (%s)",
                  $type, $x, $y, $z, $ent);
         my $sec = world_chnkpos2secpos (world_pos2chnkpos ([$x, $y, $z]));
         my $id  = world_pos2id ($sec);
         return unless exists $SECTORS{$id};
         my $eid = world_pos2id ([$x, $y, $z]);

         my $e = delete $SECTORS{$id}->{entities}->{$eid};
         if ($e) {
            ctr_log (debug => "entity %s destroy at sector %s entid %s",
                     $e, $id, $eid);
            Games::Construder::Server::Objects::destroy ($e);
         }

         unless ($ent) {
            $ent = Games::Construder::Server::Objects::instance ($type);
            ctr_log (debug => "instance entity %s at sector %s type %s: %s",
                     $eid, $id, $type, $ent);
         } else {
            ctr_log (debug => "put entity %s at sector %s type %s: %s",
                     $eid, $id, $type, $ent);
         }

         $SECTORS{$id}->{entities}->{$eid} = $ent if $ent;
      }
   );

   Games::Construder::VolDraw::init ();

   $STORE_SCHED_TMR = AE::timer 0, 1, sub {
      NEXT:
      my $s = shift @SAVE_SECTORS_QUEUE
         or return;
      return unless exists $SECTORS{$s->[0]};
      if ($SECTORS{$s->[0]}->{dirty}) {
         _world_save_sector ($s->[1]);
      } else {
         goto NEXT;
      }
   };

   $FREE_TMR = AE::timer 10, 5, sub {
      my (@invisible_sectors) = grep {
         my $s = $_;
         my $vis = 0;
         for (values %{$SRV->{players}}) {
            if ($_->{visible_sectors}->{$s}) {
               $vis = 1;
               last;
            }
         }
         not $vis
      } keys %SECTORS;

      for (@invisible_sectors) {
         ctr_log (debug => "freeing invisible sector %s", $_);
         world_free_sector ($_);
      }
      my $cntloaded = scalar (keys %SECTORS);
      ctr_log (debug => "sectors loaded after free: %d, %s",
               $cntloaded, join (", ", keys %SECTORS));
   };

   $TICK_TMR = AE::timer 0, 0.15, sub {
      for my $s (values %SECTORS) {
         for my $eid (keys %{$s->{entities}}) {
            my $e = $s->{entities}->{$eid};
            next unless $e->{time_active};
            my $pos = world_id2pos ($eid);
            Games::Construder::Server::Objects::tick ($pos, $e, $e->{type}, 0.15);
         }
      }

      $SRV->schedule_chunk_upd;

      _calc_some_lights ();
   };

   region_init ($region_cmds);
}

sub world_save_all {
   my ($self) = @_;
   for my $s (@SAVE_SECTORS_QUEUE) {
      return unless exists $SECTORS{$s->[0]};
      if ($SECTORS{$s->[0]}->{dirty}) {
         _world_save_sector ($s->[1]);
      }
   }
}

sub world_sector_dirty {
   my ($sec) = @_;
   my $id  = world_pos2id ($sec);
   return unless exists $SECTORS{$id};
   unless ($SECTORS{$id}->{dirty}) {
      $SECTORS{$id}->{dirty} = 1;
      push @SAVE_SECTORS_QUEUE, [$id, $sec];
   }
}

# still unused:
#sub world_touch_sector {
#   my ($self, $sec) = @_;
#   my $id = world_pos2id ($sec);
#   my $s = $SECTORS{$id}
#      or return;
#   $s->{last_touch} = time;
#}

sub world_free_sector {
   my ($id) = @_;
   my $sec = world_id2pos ($id);
   my $s = $SECTORS{$id}
      or return;
   if ($s->{dirty}) {
      _world_save_sector ($sec);
   }
   return if $s->{dirty};
   delete $SECTORS{$id};
   my $fchunk = world_secpos2chnkpos ($sec);
   for my $x (0..4) {
      for my $y (0..4) {
         for my $z (0..4) {
            Games::Construder::World::purge_chunk (
               $fchunk->[0] + $x,
               $fchunk->[1] + $y,
               $fchunk->[2] + $z
            );
         }
      }
   }

   ctr_log (debug => "chunks from @$fchunk +5x5x5 purged");
}

my $light_upd_chunks_wait;

sub _calc_some_lights {
   my $alloced_time = 0.07;
   my $t1 = time;
   my $calced;

   {
      while ((time - $t1) < $alloced_time) {
         my $pos = shift @LIGHTQUEUE
            or last;
         delete $LIGHTQUEUE{world_pos2id ($pos)};
         my $secid = world_pos2id (world_chnkpos2secpos (world_pos2chnkpos ($pos)));
         unless (exists $SECTORS{$secid}) {
            next;
         }

         Games::Construder::World::flow_light_query_setup (@$pos, @$pos);
         Games::Construder::World::flow_light_at (@$pos);
         my $dirty = Games::Construder::World::query_desetup ();
         ctr_log (debug => "%d chunks dirty after light calculation at @$pos", $dirty);
         $calced++;
      }
   }
   if ($calced) {
      ctr_log (profile => "calclight step %0.4f, calced %d lights, %d lights to go\n",
               time - $t1, $calced, scalar @LIGHTQUEUE);
   }
}

sub _query_push_lightqueue {
   my $lightposes = Games::Construder::World::query_search_types (35, 41, 40);
   while (@$lightposes) {
      my $pos = [shift @$lightposes, shift @$lightposes, shift @$lightposes];
      my $id = world_pos2id ($pos);
      unless ($LIGHTQUEUE{$id}) {
         $LIGHTQUEUE{$id} = 1;
         push @LIGHTQUEUE, $pos;
      }
   }
}

sub _world_make_sector {
   my ($sec) = @_;

   my $tcreate = time;

   my $val = Games::Construder::Region::get_sector_value ($REGION, @$sec);

   my ($stype, $param) =
      $Games::Construder::Server::RES->get_sector_desc_for_region_value ($val);

   my $seed = Games::Construder::Region::get_sector_seed (@$sec);

   ctr_log (info => "create sector @$sec, with seed %d value %f and tyoe %s and param %f", 
            $seed, $val, $stype->{type}, $param);

   my $cube = $CHNKS_P_SEC * $CHNK_SIZE;
   Games::Construder::VolDraw::alloc ($cube);

   Games::Construder::VolDraw::draw_commands (
     $stype->{cmds},
     { size => $cube, seed => $seed, param => $param }
   );

   Games::Construder::VolDraw::dst_to_world (@$sec, $stype->{ranges} || []);

   my $pospos = Games::Construder::World::query_possible_light_positions ();

   Games::Construder::World::query_desetup (1);

   my $lower_left  = vsmul ($sec, $CHNK_SIZE * $CHNKS_P_SEC);
   my $upper_right =
      vaddd ($lower_left,
             $CHNKS_P_SEC * $CHNK_SIZE,
             $CHNKS_P_SEC * $CHNK_SIZE,
             $CHNKS_P_SEC * $CHNK_SIZE);

   Games::Construder::World::flow_light_query_setup (@$lower_left, @$upper_right);

   my $t1 = time;

   my $plcnt = 0;
   my $tsum;
   my @poses;
   while (@$pospos) {
      push @poses,
         [shift @$pospos, shift @$pospos, shift @$pospos];
   }
   my $cnt = scalar @poses;
   my @types = qw/40 41 41 35 35 35 35/;
   my %type_cnt = (
      40 => 25,
      41 => 100,
      35 => 60,
   );
   my $rnd_type = Games::Construder::Random::rnd_xor ($seed);
   my $flot = Games::Construder::Random::rnd_float ($rnd_type) * 6.99999;
   my $type = $types[int $flot];

   my $nxt = $rnd_type;
   my $type_cnt = $type_cnt{$type};
   for (my $i = 0; $i < $type_cnt; $i++) {
      $nxt        = Games::Construder::Random::rnd_xor ($nxt);
      my $nxt_flt = Games::Construder::Random::rnd_float ($nxt) - 0.00000001;
      $nxt_flt    = 0 if $nxt_flt < 0;
      my $idx     = int ($nxt_flt * @poses);
#d# print "INDEX $nxt_flt | $idx from " . scalar (@poses) . "\n";

      my $p = splice @poses, $idx, 1, ();
      last unless $p;

      Games::Construder::World::query_set_at_abs (
         @$p, [$type, 0, 0, 0, 0]);
      $plcnt++;
   }

   _query_push_lightqueue ();
   $tsum += time - $t1;

   my $smeta = $SECTORS{world_pos2id ($sec)} = {
      created    => time,
      pos        => [@$sec],
      region_val => $val,
      seed       => $seed,
      param      => $param,
      light_type => $type,
      light_cnt  => $cnt,
      creation_time => (time - $tcreate),
      type       => $stype->{type},
      entities   => { },
   };
   _world_save_sector ($sec);
   ctr_log (profile => "created sector @$sec in $smeta->{creation_time} seconds");

   {
      Games::Construder::World::query_desetup (2);
   }

   ctr_log (debug => "placed $cnt / $plcnt lights $type ($flot) in $tsum!\n");
}

sub _world_load_sector {
   my ($sec) = @_;

   my $t1 = time;

   my $id   = world_pos2id ($sec);
   my $mpd  = $Games::Construder::Server::Resources::MAPDIR;
   my $file = "$mpd/$id.sec";

   return 1 if ($SECTORS{$id}
                && !$SECTORS{$id}->{broken});

   unless (-e $file) {
      return 0;
   }

   if (open my $mf, "<", "$file") {
      binmode $mf, ":raw";
      my $cont = eval { decompress (do { local $/; <$mf> }) };
      if ($@) {
         ctr_log (error => "map sector data corrupted '$file': $@\n");
         return -1;
      }

      warn "read " . length ($cont) . "bytes\n";

      my ($metadata, $mapdata, $data) = split /\n\n\n*/, $cont, 3;
      unless ($mapdata =~ /MAPDATA/) {
         ctr_log (error =>
              "map sector file '$file' corrupted! Can't find 'MAPDATA'. "
              . "Please delete or move it away!");
         return -1;
      }

      my ($md, $datalen, @lens) = split /\s+/, $mapdata;
      #d#warn "F $md, $datalen, @lens\n";
      unless (length ($data) == $datalen) {
         ctr_log (error =>
              "map sector file '$file' corrupted, sector data truncated, "
              . "expected $datalen bytes, but only got ".length ($data)."!");
         return -1;
      }

      my $meta = eval { JSON->new->relaxed->utf8->decode ($metadata) };
      if ($@) {
         ctr_log (error => "map sector meta data corrupted '$file': $@");
         return -1;
      }

      $SECTORS{$id} = $meta;
      $meta->{load_time} = time;

      {
         my $offs;
         my $first_chnk = world_secpos2chnkpos ($sec);
         my @chunks;
         for my $dx (0..($CHNKS_P_SEC - 1)) {
            for my $dy (0..($CHNKS_P_SEC - 1)) {
               for my $dz (0..($CHNKS_P_SEC - 1)) {
                  my $chnk = vaddd ($first_chnk, $dx, $dy, $dz);

                  my $len = shift @lens;
                  my $chunk = substr $data, $offs, $len;
                  Games::Construder::World::set_chunk_data (
                     @$chnk, $chunk, length ($chunk));
                  $offs += $len;
               }
            }
         }

         my $lower_left  = vsmul ($sec, $CHNK_SIZE * $CHNKS_P_SEC);
         my $upper_right =
            vaddd ($lower_left,
                   $CHNKS_P_SEC * $CHNK_SIZE,
                   $CHNKS_P_SEC * $CHNK_SIZE,
                   $CHNKS_P_SEC * $CHNK_SIZE);

         Games::Construder::World::flow_light_query_setup (@$lower_left, @$upper_right);
         _query_push_lightqueue ();
         Games::Construder::World::query_desetup (2);
      }


      my ($ecnt) = scalar (keys %{$SECTORS{$id}->{entities}});

      delete $SECTORS{$id}->{dirty}; # saved with the sector
      ctr_log (info => "loaded sector %s from '%s', got %d entities, loading took %0.3f seconds",
               $id, $file, $ecnt, time - $t1);
      return 1;

   } else {
      ctr_log (error => "couldn't open sector file '$file': $!");
      return -1;
   }
}

sub _world_save_sector {
   my ($sec) = @_;

   my $t1 = time;

   my $id   = world_pos2id ($sec);
   my $meta = $SECTORS{$id};

   if ($meta->{broken}) {
      ctr_log (error => "map sector '$id' marked as broken, won't save!");
      return;
   }

   $meta->{save_time} = time;

   my $first_chnk = world_secpos2chnkpos ($sec);
   my @chunks;
   for my $dx (0..($CHNKS_P_SEC - 1)) {
      for my $dy (0..($CHNKS_P_SEC - 1)) {
         for my $dz (0..($CHNKS_P_SEC - 1)) {
            my $chnk = vaddd ($first_chnk, $dx, $dy, $dz);
            push @chunks,
               Games::Construder::World::get_chunk_data (@$chnk);
         }
      }
   }

   my ($ecnt) = scalar (keys %{$SECTORS{$id}->{entities}});

   $meta = dclone ($meta);
   for (values %{$meta->{entities}}) {
      $_->{tmp} = {}; # don't store entity temporary data (might contain objects)
   }
   my $meta_data = JSON->new->utf8->pretty->encode ($meta || {});

   my $data = join "", @chunks;
   my $filedata = compress (
      $meta_data . "\n\nMAPDATA "
      . join (' ', map { length $_ } ($data, @chunks))
      . "\n\n" . $data
   );

   my $mpd = $Games::Construder::Server::Resources::MAPDIR;
   my $file = "$mpd/$id.sec";

   if (open my $mf, ">", "$file~") {
      binmode $mf, ":raw";
      print $mf $filedata;
      close $mf;
      unless (-s "$file~" == length ($filedata)) {
         ctr_log (error => "couldn't save sector completely to '$file~': $!");
         return;
      }

      if (rename "$file~", $file) {
         delete $SECTORS{$id}->{dirty};
         ctr_log (info =>
              "saved sector $id to '$file', saved $ecnt entities, took %.3f seconds, wrote %d bytes",
              time - $t1, length($filedata));

      } else {
         ctr_log (error => "couldn't rename sector file '$file~' to '$file': $!");
      }

   } else {
      ctr_log (error => "couldn't save sector $id to '$file~': $!");
   }
}

sub region_init {
   my ($cmds) = @_;

   my $t1 = time;

   ctr_log (info => "calculating region map with seed %d", $REGION_SEED);
   Games::Construder::VolDraw::alloc ($REGION_SIZE);

   Games::Construder::VolDraw::draw_commands (
     $cmds,
     { size => $REGION_SIZE, seed => $REGION_SEED, param => 1 }
   );

   $REGION = Games::Construder::Region::new_from_vol_draw_dst ();
   ctr_log (info => "calculating region map with seed %d took %.3f",
            $REGION_SEED, time - $t1);
}

sub world_sector_info_at {
   world_sector_info (world_pos2chnkpos ($_[0]))
}

sub world_sector_info {
   my ($chnk) = @_;
   my $sec = world_chnkpos2secpos ($chnk);
   my $id  = world_pos2id ($sec);
   unless (exists $SECTORS{$id}) {
      return undef;
   }
   $SECTORS{$id}
}

sub world_pos2id {
   my ($pos) = @_;
   join "x", map { $_ < 0 ? "N" . abs ($_) : $_ } @{vfloor ($pos)};
}

sub world_id2pos {
   my ($id) = @_;
   [map { s/^N/-/; $_ } split /x/, $id]
}

sub world_pos2chnkpos {
   vfloor (vsdiv ($_[0], $CHNK_SIZE))
}

sub world_chnkpos2secpos {
   vfloor (vsdiv ($_[0], $CHNKS_P_SEC))
}

sub world_secpos2chnkpos {
   vsmul ($_[0], $CHNKS_P_SEC);
}

sub world_pos2relchnkpos {
   my ($pos) = @_;
   my $chnk = world_pos2chnkpos ($pos);
   vsub ($pos, vsmul ($chnk, $CHNK_SIZE))
}

sub world_load_at_player {
   my ($pl, $cb) = @_;

   my $cnt = scalar keys %{$pl->{visible_sectors}};
   for (keys %{$pl->{visible_sectors}}) {
#d#warn "VISIBLESEC $_\n";
      unless ($SECTORS{$_}) {
         world_load_sector (world_id2pos ($_), sub {
            $cnt--;
            $cb->() if $cnt <= 0;
         });
      } else {
         $cnt--;
         $cb->() if $cnt <= 0;
#d#     warn "SECTOR $_ IS THERE!\n";
      }
   }
}

sub world_load_around_at {
   my ($pos, $cb) = @_;

   my $chnk = world_pos2chnkpos ($pos);
   my $cnt = 3 ** 3;
   for my $x (-2, 0, 2) {
      for my $y (-2, 0, 2) {
         for my $z (-2, 0, 2) {
            my $ch = vaddd ($chnk, $x, $y, $z);
            world_load_at_chunk ($ch, sub {
               if (--$cnt <= 0) {
                  $cb->();
               }
            });
         }
      }
   }
}

sub world_load_at {
   my ($pos, $cb) = @_;
   world_load_at_chunk (world_pos2chnkpos ($pos), $cb);
}

sub world_load_at_chunk {
   my ($chnk, $cb) = @_;
   my $sec = world_chnkpos2secpos ($chnk);
   world_load_sector ($sec, $cb);
}

sub world_load_sector {
   my ($sec, $cb) = @_;

   if ($in_mutate) {
      push @mutate_cont, sub { world_load_sector ($sec, $cb); };
      return;
   }

   local $in_mutate = 1;

   my $secid = world_pos2id ($sec);
   unless ($SECTORS{$secid}) {
      ctr_log (info => "getting unloaded sector %s", $secid);

      my $r = _world_load_sector ($sec);
      if ($r == 0) {
         _world_make_sector ($sec);
      }
   }
   $cb->() if $cb;

   ctr_log (debug => "%d sectors loaded: %s", scalar (keys %SECTORS), join (", ", keys %SECTORS));

   local $in_mutate = 0;

   while (@mutate_cont) {
      my $m = shift @mutate_cont;
      $m->();
   }
}

sub world_entity_at {
   my ($pos) = @_;
   my $si = world_sector_info_at ($pos)
      or return;
   my $eid = world_pos2id ($pos);
   $si->{entities}->{$eid}
}

sub world_at {
   my ($poses, $cb, %arg) = @_;

   world_mutate_at ($poses, sub {
      my ($cell, $pos) = @_;
      push @$cell, world_entity_at ($pos);
      $cb->($pos, $cell);
      return 0;
   }, need_entity => 1, %arg);
}

sub world_mutate_entity_at {
   my ($pos, $cb, %arg) = @_;

   world_mutate_at ($pos, sub {
      my ($cell, $pos) = @_;
      my $si = world_sector_info_at ($pos);
      push @$cell, world_entity_at ($pos);
      if ($cb->($pos, $cell)) {
         world_sector_dirty ($si->{pos});
      }
      return 0;
   }, need_entity => 1, %arg);
}

sub world_mutate_at {
   my ($poses, $cb, %arg) = @_;

   if ($in_mutate) {
      push @mutate_cont, sub { world_mutate_at ($poses, $cb, %arg); };
      return,
   }

   local $in_mutate = 1;

   if (ref $poses->[0]) {
      my $min = [];
      my $max = [];
      for (@$poses) {
         $min->[0] = $_->[0] if !defined $min->[0] || $min->[0] > $_->[0];
         $min->[1] = $_->[1] if !defined $min->[1] || $min->[1] > $_->[1];
         $min->[2] = $_->[2] if !defined $min->[2] || $min->[2] > $_->[2];
         $max->[0] = $_->[0] if !defined $max->[0] || $max->[0] < $_->[0];
         $max->[1] = $_->[1] if !defined $max->[1] || $max->[1] < $_->[1];
         $max->[2] = $_->[2] if !defined $max->[2] || $max->[2] < $_->[2];
      }

      my $chnk_x = int ((($max->[0] - $min->[0]) / $CHNK_SIZE) + 0.5);
      my $chnk_y = int ((($max->[1] - $min->[1]) / $CHNK_SIZE) + 0.5);
      my $chnk_z = int ((($max->[2] - $min->[2]) / $CHNK_SIZE) + 0.5);
      my $base_chnk = world_pos2chnkpos ($min);

      for (my $x = $base_chnk->[0]; $x < $base_chnk->[0] + $chnk_x; $x++) {
         for (my $y = $base_chnk->[1]; $y < $base_chnk->[1] + $chnk_y; $y++) {
            for (my $z = $base_chnk->[2]; $z < $base_chnk->[2] + $chnk_z; $z++) {
               world_load_at_chunk ([$x, $y, $z]);
            }
         }
      }
     #d# warn "MUTL @$min | @$max\n";
      Games::Construder::World::flow_light_query_setup (@$min, @$max);

   } else {
      world_load_at ($poses); # blocks for now :-/

      Games::Construder::World::flow_light_query_setup (@$poses, @$poses);
      $poses = [$poses];
   }

   for my $pos (@$poses) {
      my $b = Games::Construder::World::at (@$pos);
      my $ent;
      $ent = world_entity_at ($pos) if $arg{need_entity};
      push @$b, $ent;
      #d# print "MULT MUTATING (@$b) (AT @$pos)\n";
      if ($cb->($b, $pos)) {
         #d# print "MULT MUTATING TO => (@$b) (AT @$pos)\n";
         Games::Construder::World::query_set_at_abs (@$pos, $b);
         unless ($arg{no_light}) {
            my $t1 = time;
            Games::Construder::World::flow_light_at (@{vfloor ($pos)});
            ctr_log (profile => "mult light calc at pos @$pos took: %f secs\n", time - $t1);
         }
      }
   }

   {
     my $dirty = Games::Construder::World::query_desetup ();
     ctr_log (debug => "%d chunks dirty after mutation and possible light flow", $dirty);
   }

   local $in_mutate = 0;

   while (@mutate_cont) {
      my $m = shift @mutate_cont;
      $m->();
   }
}

sub world_find_free_spot {
   my ($pos, $wflo) = @_;
   $wflo = 0 unless defined $wflo;
   Games::Construder::World::find_free_spot (@$pos, $wflo);
}

sub world_find_random_teleport_destination_at_dist {
   my ($pos, $dist) = @_;

   my $new_pos = vadd ($pos, vsmul (vnorm (vrand ()), $dist));

   my $sec = world_chnkpos2secpos (world_pos2chnkpos ($new_pos));

   my $coord =
      Games::Construder::Region::get_nearest_sector_in_range (
         $Games::Construder::Server::World::REGION,
         @$sec,
         $Games::Construder::Server::RES->get_teleport_destination_region_range
      );

   my @coords;
   while (@$coord) {
      my $p = [shift @$coord, shift @$coord, shift @$coord];
      push @coords, $p;
   }

   if (!@coords) {
      ctr_log (
         error => "Couldn't find proper teleportation destination at @$new_pos (@$sec), not teleporting player!");
      return ($pos, 0, 0);
   }

   $new_pos = vsmul ($coords[0], $CHNK_SIZE * $CHNKS_P_SEC);
   my $dist = vlength (vsub ($pos, $new_pos));
   ($new_pos, $dist, int ($dist / ($CHNK_SIZE * $CHNKS_P_SEC)))
}


=back

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2011 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Affero General Public License.

=cut

1;



Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.