view release on metacpan or  search on metacpan

DC/Protocol.pm  view on Meta::CPAN

sub map_scroll {
   my ($self, $dx, $dy) = @_;

   $self->{map_widget}->scroll ($dx, $dy);
}

sub feed_map1a {
   my ($self, $data) = @_;

   my $missing = $self->{map}->map1a_update ($data, $self->{setup}{extmap});
   my $delay;

   for my $tile (@$missing) {
      next if $self->{delay}{$tile};

      $delay = 1;

      if (my $tex = $self->{texture}[$tile]) {
         $tex->upload;
      } else {
         $self->{delay}{$tile} = 1;

         # we assume the face is in-flight and will eventually arrive
         push @{$self->{tile_cb}{$tile}}, sub {
            delete $self->{delay}{$tile};
            $_[0]->upload;
         };
      }
   }

   if ($delay) {
      # delay the map drawing a tiny bit in the hope of getting the missing tiles fetched
      EV::once undef, 0, 0.03, sub {
         $self->{map_widget}->update
            if $self->{map_widget};
      };
   } else {
      $self->{map_widget}->update;
   }
}

sub magicmap {
   my ($self, $w, $h, $x, $y, $data) = @_;

   $self->{map_widget}->set_magicmap ($w, $h, $x, $y, $data);
}

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

   return unless $self->{map_info};

   for my $map_info (values %{ $self->{map_cache} || {} }) {
      my ($hash, $rdata, $x, $y, $w, $h) = @$map_info;

      my $data = $self->{map}->get_rect ($x, $y, $w, $h);

      if ($data ne $$rdata) {
         $map_info->[1] = \$data;
         my $cdata = Compress::LZF::compress $data;
         DC::DB::put $self->{mapcache} => $hash => $cdata, sub { };
      }
   }
}

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

   $self->flush_map;
   delete $self->{map_info};
   delete $self->{neigh_map};

   $self->{map}->clear;
   delete $self->{map_widget}{magicmap};
}

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

   my $tile;
   
   do {
      $tile = pop @{$self->{bg_fetch}}
         or return;
   } while $self->{texture}[$tile];

   DC::DB::get tilecache => $tile, sub {
      my ($data) = @_;

      return unless $self->{map}; # stop when destroyed

      if (defined $data) {
         $self->have_tile ($tile, $data);
         $self->{texture}[$tile]->upload;
      }

      $self->bg_fetch;
   };
}

sub load_map($$$$$$) {
   my ($self, $hash, $x, $y, $w, $h) = @_;

   my $map_info = $self->{map_cache}{$hash} = [$hash, \"", $x, $y, $w, $h];

   my $cb = sub {
      $map_info->[1] = \$_[0];

      my $inprogress = @{ $self->{bg_fetch} || [] };
      unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $_[0]);
      $self->bg_fetch unless $inprogress;
   };

   if (my $map_info = $self->{map_cache_old}{$hash}) {
      $cb->(${ $map_info->[1] });
   } else {
      my $gen = $self->{map_change_gen};

      DC::DB::get $self->{mapcache} => $hash, sub {
         return unless $gen == $self->{map_change_gen};
         return unless defined $_[0];