view release on metacpan or  search on metacpan

DC/MapWidget.pm  view on Meta::CPAN

   $tooltip =~ s/^\s+//;
   $tooltip = "<big>$data</big>\n\n$tooltip";
   $tooltip =~ s/\s+$//;

   $::COMPLETER->{command}{$command} = [$data, $tooltip, $widget, $cb, ++$self->{command_id}];
}

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

   %{$::COMPLETER->{command}} = ();

   $::COMPLETER->hide
      if $::COMPLETER;
}

sub server_login {
   my ($server) = @_;

   ::stop_game ();
   local $::PROFILE->{host} = $server;
   ::start_game ();
}

sub editor_invoke {
   my $editsup = $::CONN && $::CONN->{editor_support}
      or return;

   DC::background {
      print "preparing editor startup...\n";

      my $server = $editsup->{gameserver} || "default";
      $server =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;

      local $ENV{CROSSFIRE_MAPDIR} = my $mapdir = "$Deliantra::VARDIR/map.$server"; mkdir $mapdir;
      local $ENV{CROSSFIRE_LIBDIR} = my $libdir = "$Deliantra::VARDIR/lib.$server"; mkdir $libdir;

      print "map directory is $mapdir\n";
      print "lib directory is $libdir\n";

      my $ua = DC::lwp_useragent;

      for my $file (qw(archetypes crossfire.0)) {
         my $url = "$editsup->{lib_root}$file";
         print "mirroring $url...\n";
         DC::lwp_check $ua->mirror ($url, "$libdir/$file");
         printf "%s size %d octets\n", $file, -s "$libdir/$file";
      }

      if (1) { # upload a map
         my $mapname = $::CONN->{map_info}[0];

         my $mappath = "$mapdir/$mapname";

         -e $mappath and die "$mappath already exists\n";

         print "getting map revision for $mapname...\n";

         # try to get the most recent head revision, what a hack,
         # this should have been returned while downloading *sigh*
         my $log = (DC::lwp_check $ua->get ("$editsup->{cvs_root}/$mapname?view=log&logsort=rev"))->decoded_content;

         if ($log =~ /\?rev=(\d+\.\d+)"/) {
            my $rev = $1;

            print "downloading revision $rev...\n";

            my $map = (DC::lwp_check $ua->get ("$editsup->{cvs_root}/$mapname?rev=$rev"))->decoded_content;

            my $meta = {
               %$editsup,
               path     => $mapname,
               revision => $rev,
               cf_login => $::PROFILE->{user},
            };

            require File::Basename;
            require File::Path;

            File::Path::mkpath (File::Basename::dirname ($mappath));
            open my $fh, ">:raw:perlio", "$mappath.meta"
               or die "$mappath.meta: $!\n";
            print $fh DC::encode_json $meta;
            close $fh;
            open my $fh, ">:raw:perlio:utf8", $mappath
               or die "$mappath: $!\n";
            print $fh $map;
            close $fh;

            print "saved as $mappath\n";

            print "invoking editor...\n";
            exec "/root/s2/gce $mappath";#d#

            # now upload it
#           require HTTP::Request::Common;
#
#           my $res = $ua->post (
#              $ENV{CFPLUS_UPLOAD},
#              Content_Type => 'multipart/form-data',
#              Content      => [
#                 path        => $mapname,
#                 mapdir      => $ENV{CROSSFIRE_MAPDIR},
#                 map         => $map,
#                 revision    => $rev,
#                 cf_login    => $ENV{CFPLUS_LOGIN},
#                 cf_password => $ENV{CFPLUS_PASSWORD},
#                 comment     => "",
#              ]
#           );
#
#           if ($res->is_error) {
#              # fatal condition
#              warn $res->status_line;
#           } else {
#              # script replies are marked as {{..}}
#              my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g;
#              warn map "$_\n", @msgs;
#           }
         } else {
            die "viewvc parse error, unable to detect revision\n";
         }
      }
   }
}

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   if ($ev->{button} == 1) {
      $self->grab_focus;
      return unless $::CONN && $self->{ctilesize};

      my $x = $self->{dx} + DC::floor +($ev->{x} - $self->{sx0}) / $self->{ctilesize};
      my $y = $self->{dy} + DC::floor +($ev->{y} - $self->{sy0}) / $self->{ctilesize};

      $x -= DC::floor $::MAP->w * 0.5;
      $y -= DC::floor $::MAP->h * 0.5;

      if ($::CONN) {
         $::CONN->lookat ($x, $y)
      }

   } elsif ($ev->{button} == 2) {
      $self->grab_focus;
      return unless $::CONN;
      
      my ($ox, $oy) = ($ev->{x}, $ev->{y});
      my ($bw, $bh) = ($::CFG->{map_shift_x}, $::CFG->{map_shift_y});

      $self->{motion} = sub {
         my ($ev, $x, $y) = @_;

         ($x, $y) = ($ev->{x}, $ev->{y});

         $::CFG->{map_shift_x} = $bw + $x - $ox;
         $::CFG->{map_shift_y} = $bh + $y - $oy;

         $self->update;
      };
   } elsif ($ev->{button} == 3) {
      my @items = (
            ["Help Browser…\tF1", sub { $::HELP_WINDOW->toggle_visibility }],
            ["Statistics\tF2",    sub { ::toggle_player_page ($::STATS_PAGE) }],
            ["Skills\tF3",        sub { ::toggle_player_page ($::SKILL_PAGE) }],
            ["Spells…\tF4",       sub { ::toggle_player_page ($::SPELL_PAGE) }],
            ["Inventory…\tF5",    sub { ::toggle_player_page ($::INVENTORY_PAGE) }],
            ["Setup… \tF9",       sub { $::SETUP_DIALOG->toggle_visibility }],
#            ["Server Messages…",  sub { $::MESSAGE_WINDOW->toggle_visibility }],
      );

      if ($::CONN && $::CONN->{editor_support}) {
#         push @items, [
#            "Edit this map <span size='xx-small'>(" . (DC::asxml $::CONN->{map_info}[0]) . ")</span>",
#            \&editor_invoke,
#         ];