[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/MapWidget.pm

Comparing deliantra/Deliantra-Client/DC/MapWidget.pm (file contents):
Revision 1.158 by root, Mon Dec 21 23:52:34 2009 UTC vs.
Revision 1.167 by root, Tue Nov 20 14:32:12 2012 UTC

 package DC::MapWidget;
-use strict;
+use common::sense;
-use utf8;
 use List::Util qw(min max);
+use AnyEvent ();
 use DC;
 use DC::OpenGL;
 use DC::UI;
 use DC::Macro;
 our @ISA = DC::UI::Base::;
+our @TEX_HIDDEN = map {
+   new_from_resource DC::Texture # MUST be POT
+        "hidden-$_.png", mipmap => 1, wrap => 1
+   } 0, 1, 2;
 my $magicmap_tex =
       new_from_resource DC::Texture "magicmap.png",
          mipmap => 1, wrap => 0, internalformat => GL_ALPHA;
    );
    $self
 }
-sub add_command {
+sub add_command {#d# remove
    my ($self, $command, $tooltip, $widget, $cb) = @_;
    (my $data = $command) =~ s/\\//g;
    $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) = @_;
 #         push @items, [
 #            "Edit this map <span size='xx-small'>(" . (DC::asxml $::CONN->{map_info}[0]) . ")</span>",
 #            \&editor_invoke,
 #         ];
-         for my $type (qw(test name)) {
+         for my $type (@{ $::CONN->{editor_support}{servertypes} }) {
-            $::CONN->{editor_support}{type} ne $type
+            $::CONN->{editor_support}{servertype} ne $type
                or next;
             my $server = $::CONN->{editor_support}{"${type}server"}
                or next;
             push @items, [
    $self->{sdx} += $dx * $self->{tilesize}; # smooth displacement
    $self->{sdy} += $dy * $self->{tilesize};
    # save old fow texture, if applicable
-   $self->{last_fow_texture} = $self->{fow_texture}
+   $self->{prev_fow_texture} = $::CFG->{smooth_transitions} && $self->{fow_texture};
-      if $::CFG->{smooth_transitions};
    $self->{lfdx} = $dx;
    $self->{lfdy} = $dy;
    $self->{lmdx} = $self->{dx};
    $self->{lmdy} = $self->{dy};
 sub movement_update {
    my ($self) = @_;
    if ($::CFG->{smooth_movement}) {
       if ($self->{sdx} || $self->{sdy}) {
-         my $diff = EV::time - ($self->{last_update} || $::LAST_REFRESH);
+         my $diff = AE::time - ($self->{last_update} || $::LAST_REFRESH);
          my $spd  = $::CONN->{stat}{DC::Protocol::CS_STAT_SPEED};
          # the minimum time for a single tile movement
          my $mintime = DC::Protocol::TICK * DC::ceil 1 / ($spd * DC::Protocol::TICK || 1);
       }
    } else {
       $self->{sdx} = $self->{sdy} = 0;
    }
-   $self->{last_update} = EV::time;
+   $self->{last_update} = AE::time;
 }
 sub refresh_hook {
    my ($self) = @_;
          glTranslate $sx0, $sy0;
          glScale $::CFG->{map_scale}, $::CFG->{map_scale};
          glTranslate DC::ceil $self->{sdx}, DC::ceil $self->{sdy};
          $::MAP->draw ($dx, $dy, $sw, $sh,
-                       $self->{tilesize},
+                       ($self->{tilesize}) x 2,
                        $::CONN->{player}{tag},
                        -$self->{sdx}, -$self->{sdy});
          glScale $self->{tilesize}, $self->{tilesize};
          if (my $tex = $self->{fow_texture}) {
+            my @prev_fow_params;
-            if ($DC::OpenGL::GL_MULTITEX && $self->{last_fow_texture}) {#d#
+            if ($DC::OpenGL::GL_MULTITEX && $self->{prev_fow_texture}) {
                my $d1 = DC::distance $self->{sdx}, $self->{sdy};
                my $d2 = (DC::distance $self->{lfdx}, $self->{lfdy}) * $tilesize;
                if ($d1 * $d2) {
-                  DC::Texture::draw_fow_texture
+                  @prev_fow_params = (
-                     $::CFG->{fow_intensity},
-                     $self->{hidden_tex}{name},
-                     @{$self->{fow_texture}}{qw(name data s t w h)},
                      (min 1, $d1 / $d2),
                      $self->{lmdx} - $dx - $self->{lfdx},
                      $self->{lmdy} - $dy - $self->{lfdy},
-                     @{$self->{last_fow_texture}}{qw(name data)};
+                     @{$self->{prev_fow_texture}}{qw(name data)}
-               } else {
+                  );
-                  delete $self->{last_fow_texture};
                }
             }
-            unless ($self->{last_fow_texture}) {
-               DC::Texture::draw_fow_texture
+            DC::Texture::draw_fow_texture
-                  $::CFG->{fow_intensity},
+               $::CFG->{fow_intensity},
-                  $self->{hidden_tex}{name},
+               $TEX_HIDDEN[$::CFG->{fow_texture}]{name},
-                  @{$self->{fow_texture}}{qw(name data s t w h)};
+               @{$self->{fow_texture}}{qw(name data s t w h)},
-            }
+               @prev_fow_params;
          }
          if ($self->{magicmap}) {
             my ($x, $y, $w, $h, $data) = @{ $self->{magicmap} };
    $self->SUPER::DESTROY;
 }
 package DC::MapWidget::MapMap;
-use strict;
+use common::sense;
-use utf8;
 our @ISA = DC::UI::Base::;
-use Time::HiRes qw(time);
 use DC::OpenGL;
 sub size_request {
    ($::HEIGHT * 0.2, $::HEIGHT * 0.2)
 }
 sub refresh_hook {
    my ($self) = @_;
-   if ($::MAP && $self->{texture_atime} < time) {
+   if ($::MAP && $self->{texture_atime} < AE::now) {
       my ($w, $h) = @$self{qw(w h)};
       return unless $w && $h;
       my $sw = int $::WIDTH  / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99;
       $self->{sh} = $sh;
       $self->{x0} = $x0;
       $self->{y0} = $y0;
-      $self->{texture_atime} = time + 1/3;
+      $self->{texture_atime} = AE::now + 1/2;
       $self->{texture} =
          new DC::Texture
             w    => $w,
             h    => $h,
    glDisable GL_BLEND;
 }
 package DC::MapWidget::Command;
-use strict;
+use common::sense;
 use DC::OpenGL;
 our @ISA = DC::UI::Frame::;
    );
    $self
 }
+sub reset {
+   my ($self) = @_;
+   $self->hide;
+   delete $self->{command_list};
+}
 sub set_prefix {
    my ($self, $prefix) = @_;
    $self->{entry}->set_text ($prefix);
    $self->show;
    my $text = $self->{entry}->get_text;
    length $text
       or return $self->hide;
+   return unless $::CONN;
+   # regenerate spell list if necessary
+   $self->{command_list}{spells} ||= [
+      map { ("cast $_->{name}", "invoke $_->{name}") }
+          values %{ $::CONN->{spell} }
+   ];
    if ($text ne $self->{last_search}) {
       my @match;
       if ($text =~ /^(.*?)\s+$/) {
       } else {
          # @match is [command, penalty, command with arguments] until sort
          my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/;
+         my $first_char = substr $cmd, 0, 1;
          my $regexp_abbrev = do {
             my ($beg, @chr) = split //, lc $cmd;
             # the following regex is used to match our "completion entry"
             # to an actual command - the parentheses match kind of "overhead"
             # - the more characters the parentheses match, the less attractive
             # is the match.
             my $regexp = "^\Q$beg\E"
-                       . join "", map "(?:.*?[ \\\\]\Q$_\E|(.*?)\Q$_\E)", @chr;
+                       . join "", map "(?:.*?[ _\-]|(.*?))\Q$_\E", @chr;
             qr<$regexp>
          };
          my $regexp_partial = do {
             my $regexp = "^\Q$text\E(.*)";
             qr<$regexp>
          };
-         for (keys %{$self->{command}}) {
+         for my $list (values %{ $self->{command_list} }) {
+            for (@$list) {
+               # we only match and score if the first character matches,
+               # so quickly rule out all others first.
+               next unless $first_char = substr $_, 0, 1;
-            my @scores;
+               my @scores;
-            # 1. Complete command [with args]
+               # 1. Complete command [with args]
-            #    command is a prefix of the text
+               #    command is a prefix of the text
-            #    score is length of complete command matched
+               #    score is length of complete command matched
-            #    e.g. "invoke summon pet monster bat"
+               #    e.g. "invoke summon pet monster bat"
-            #         "invoke" "summon pet monster bat" = 6
+               #         "invoke" "summon pet monster bat" = 6
-            #         "invoke summon pet monster" "bat" = 25
+               #         "invoke summon pet monster" "bat" = 25
-            if ($text =~ /^\Q$_\E(.*)/) {
+               if ((substr $text, 0, length $_) eq $_) {
-               push @scores, [$_, length $_, $text];
+                  push @scores, [$_, length $_, $text];
+               }
+               # 2. Partial command
+               #    text is a prefix of the full command
+               #    score is the length of the input text
+               #    e.g. "invoke s"
+               #         "invoke small fireball" = 8
+               #         "invoke summon pet monster" = 8
+               if ($_ =~ $regexp_partial) {
+                  push @scores, [$_, length $text, $_];
+               }
+               # 3. Abbreviation match
+               #    attempts to use first word of text as an abbreviated command
+               #    score is length of word + 1 - 3 per non-word-initial character
+               if (my @penalty = $_ =~ $regexp_abbrev) {
+                  push @scores, [$_, (length $cmd) + 1 - (length join "", map "::$_", grep defined, @penalty), "$_$arg"];
+               }
+               # Pick the best option for this command
+               push @match, (sort {
+                                $b->[1] <=> $a->[1]
+                             } @scores)[0];
             }
-            # 2. Partial command
-            #    text is a prefix of the full command
-            #    score is the length of the input text
-            #    e.g. "invoke s"
-            #         "invoke small fireball" = 8
-            #         "invoke summon pet monster" = 8
-            if ($_ =~ $regexp_partial) {
-               push @scores, [$_, length $text, $_];
-            }
-            # 3. Abbreviation match
-            #    attempts to use first word of text as an abbreviated command
-            #    score is length of word + 1 - 3 per non-word-initial character
-            if (my @penalty = $_ =~ $regexp_abbrev) {
-               push @scores, [$_, (length $cmd) + 1 - (length join "", map "::$_", grep defined, @penalty), "$_$arg"];
-            }
-            # Pick the best option for this command
-            push @match, (sort {
-                             $b->[1] <=> $a->[1]
-                          } @scores)[0];
          }
          # @match is now [command object, command with arguments]
          @match = map [$self->{command}{$_->[0]}, $_->[2]],
                      sort {

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/Deliantra-Client/DC/MapWidget.pm (file contents): Revision 1.158 by root, Mon Dec 21 23:52:34 2009 UTC vs. Revision 1.167 by root, Tue Nov 20 14:32:12 2012 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/MapWidget.pm (file contents):
Revision 1.158 by root, Mon Dec 21 23:52:34 2009 UTC vs.
Revision 1.167 by root, Tue Nov 20 14:32:12 2012 UTC