ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/MapWidget.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/MapWidget.pm (file contents):
Revision 1.160 by root, Tue Dec 22 01:37:41 2009 UTC vs.
Revision 1.165 by root, Fri Nov 9 22:53:57 2012 UTC

1package DC::MapWidget; 1package DC::MapWidget;
2 2
3use strict; 3use common::sense;
4use utf8;
5 4
6use List::Util qw(min max); 5use List::Util qw(min max);
6
7use AnyEvent ();
7 8
8use DC; 9use DC;
9use DC::OpenGL; 10use DC::OpenGL;
10use DC::UI; 11use DC::UI;
11use DC::Macro; 12use DC::Macro;
… …
214# push @items, [ 215# push @items, [
215# "Edit this map <span size='xx-small'>(" . (DC::asxml $::CONN->{map_info}[0]) . ")</span>", 216# "Edit this map <span size='xx-small'>(" . (DC::asxml $::CONN->{map_info}[0]) . ")</span>",
216# \&editor_invoke, 217# \&editor_invoke,
217# ]; 218# ];
218 219
219 for my $type (qw(test name)) { 220 for my $type (@{ $::CONN->{editor_support}{servertypes} }) {
220 $::CONN->{editor_support}{type} ne $type 221 $::CONN->{editor_support}{servertype} ne $type
221 or next; 222 or next;
222 my $server = $::CONN->{editor_support}{"${type}server"} 223 my $server = $::CONN->{editor_support}{"${type}server"}
223 or next; 224 or next;
224 225
225 push @items, [ 226 push @items, [
… …
432sub movement_update { 433sub movement_update {
433 my ($self) = @_; 434 my ($self) = @_;
434 435
435 if ($::CFG->{smooth_movement}) { 436 if ($::CFG->{smooth_movement}) {
436 if ($self->{sdx} || $self->{sdy}) { 437 if ($self->{sdx} || $self->{sdy}) {
437 my $diff = EV::time - ($self->{last_update} || $::LAST_REFRESH); 438 my $diff = AE::time - ($self->{last_update} || $::LAST_REFRESH);
438 my $spd = $::CONN->{stat}{DC::Protocol::CS_STAT_SPEED}; 439 my $spd = $::CONN->{stat}{DC::Protocol::CS_STAT_SPEED};
439 440
440 # the minimum time for a single tile movement 441 # the minimum time for a single tile movement
441 my $mintime = DC::Protocol::TICK * DC::ceil 1 / ($spd * DC::Protocol::TICK || 1); 442 my $mintime = DC::Protocol::TICK * DC::ceil 1 / ($spd * DC::Protocol::TICK || 1);
442 443
… …
463 } 464 }
464 } else { 465 } else {
465 $self->{sdx} = $self->{sdy} = 0; 466 $self->{sdx} = $self->{sdy} = 0;
466 } 467 }
467 468
468 $self->{last_update} = EV::time; 469 $self->{last_update} = AE::time;
469} 470}
470 471
471sub refresh_hook { 472sub refresh_hook {
472 my ($self) = @_; 473 my ($self) = @_;
473 474
… …
515 glTranslate $sx0, $sy0; 516 glTranslate $sx0, $sy0;
516 glScale $::CFG->{map_scale}, $::CFG->{map_scale}; 517 glScale $::CFG->{map_scale}, $::CFG->{map_scale};
517 glTranslate DC::ceil $self->{sdx}, DC::ceil $self->{sdy}; 518 glTranslate DC::ceil $self->{sdx}, DC::ceil $self->{sdy};
518 519
519 $::MAP->draw ($dx, $dy, $sw, $sh, 520 $::MAP->draw ($dx, $dy, $sw, $sh,
520 $self->{tilesize}, 521 ($self->{tilesize}) x 2,
521 $::CONN->{player}{tag}, 522 $::CONN->{player}{tag},
522 -$self->{sdx}, -$self->{sdy}); 523 -$self->{sdx}, -$self->{sdy});
523 524
524 glScale $self->{tilesize}, $self->{tilesize}; 525 glScale $self->{tilesize}, $self->{tilesize};
525 526
… …
608 $self->SUPER::DESTROY; 609 $self->SUPER::DESTROY;
609} 610}
610 611
611package DC::MapWidget::MapMap; 612package DC::MapWidget::MapMap;
612 613
613use strict; 614use common::sense;
614use utf8;
615 615
616our @ISA = DC::UI::Base::; 616our @ISA = DC::UI::Base::;
617 617
618use Time::HiRes qw(time);
619use DC::OpenGL; 618use DC::OpenGL;
620 619
621sub size_request { 620sub size_request {
622 ($::HEIGHT * 0.2, $::HEIGHT * 0.2) 621 ($::HEIGHT * 0.2, $::HEIGHT * 0.2)
623} 622}
624 623
625sub refresh_hook { 624sub refresh_hook {
626 my ($self) = @_; 625 my ($self) = @_;
627 626
628 if ($::MAP && $self->{texture_atime} < time) { 627 if ($::MAP && $self->{texture_atime} < AE::now) {
629 my ($w, $h) = @$self{qw(w h)}; 628 my ($w, $h) = @$self{qw(w h)};
630 629
631 return unless $w && $h; 630 return unless $w && $h;
632 631
633 my $sw = int $::WIDTH / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99; 632 my $sw = int $::WIDTH / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99;
… …
648 $self->{sh} = $sh; 647 $self->{sh} = $sh;
649 648
650 $self->{x0} = $x0; 649 $self->{x0} = $x0;
651 $self->{y0} = $y0; 650 $self->{y0} = $y0;
652 651
653 $self->{texture_atime} = time + 1/3; 652 $self->{texture_atime} = AE::now + 1/2;
654 653
655 $self->{texture} = 654 $self->{texture} =
656 new DC::Texture 655 new DC::Texture
657 w => $w, 656 w => $w,
658 h => $h, 657 h => $h,
… …
713 glDisable GL_BLEND; 712 glDisable GL_BLEND;
714} 713}
715 714
716package DC::MapWidget::Command; 715package DC::MapWidget::Command;
717 716
718use strict; 717use common::sense;
719 718
720use DC::OpenGL; 719use DC::OpenGL;
721 720
722our @ISA = DC::UI::Frame::; 721our @ISA = DC::UI::Frame::;
723 722
… …
876 } else { 875 } else {
877 # @match is [command, penalty, command with arguments] until sort 876 # @match is [command, penalty, command with arguments] until sort
878 877
879 my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/; 878 my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/;
880 879
880 my $first_char = substr $cmd, 0, 1;
881
881 my $regexp_abbrev = do { 882 my $regexp_abbrev = do {
882 my ($beg, @chr) = split //, lc $cmd; 883 my ($beg, @chr) = split //, lc $cmd;
883 884
884 # the following regex is used to match our "completion entry" 885 # the following regex is used to match our "completion entry"
885 # to an actual command - the parentheses match kind of "overhead" 886 # to an actual command - the parentheses match kind of "overhead"
886 # - the more characters the parentheses match, the less attractive 887 # - the more characters the parentheses match, the less attractive
887 # is the match. 888 # is the match.
888 my $regexp = "^\Q$beg\E" 889 my $regexp = "^\Q$beg\E"
889 . join "", map "(?:.*?[ \\\\]\Q$_\E|(.*?)\Q$_\E)", @chr; 890 . join "", map "(?:.*?[ \\\\]|(.*?))\Q$_\E", @chr;
890 qr<$regexp> 891 qr<$regexp>
891 }; 892 };
892 893
893 my $regexp_partial = do { 894 my $regexp_partial = do {
894 my $regexp = "^\Q$text\E(.*)"; 895 my $regexp = "^\Q$text\E(.*)";
895 qr<$regexp> 896 qr<$regexp>
896 }; 897 };
897 898
898 for (keys %{$self->{command}}) { 899 for (keys %{$self->{command}}) {
900 # we only match and score if the first character matches,
901 # so quickly rule out all others first.
902 next unless $first_char = substr $_, 0, 1;
903
899 my @scores; 904 my @scores;
900 905
901 # 1. Complete command [with args] 906 # 1. Complete command [with args]
902 # command is a prefix of the text 907 # command is a prefix of the text
903 # score is length of complete command matched 908 # score is length of complete command matched
904 # e.g. "invoke summon pet monster bat" 909 # e.g. "invoke summon pet monster bat"
905 # "invoke" "summon pet monster bat" = 6 910 # "invoke" "summon pet monster bat" = 6
906 # "invoke summon pet monster" "bat" = 25 911 # "invoke summon pet monster" "bat" = 25
907 if ($text =~ /^\Q$_\E(.*)/) { 912 if ((substr $text, 0, length $_) eq $_) {
908 push @scores, [$_, length $_, $text]; 913 push @scores, [$_, length $_, $text];
909 } 914 }
910 915
911 # 2. Partial command 916 # 2. Partial command
912 # text is a prefix of the full command 917 # text is a prefix of the full command

Diff Legend

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