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.165 by root, Fri Nov 9 22:53:57 2012 UTC vs.
Revision 1.171 by root, Mon Nov 26 13:14:43 2012 UTC

… …
31 tilesize => 32, 31 tilesize => 32,
32 @_ 32 @_
33 ); 33 );
34 34
35 $self 35 $self
36}
37
38sub add_command {
39 my ($self, $command, $tooltip, $widget, $cb) = @_;
40
41 (my $data = $command) =~ s/\\//g;
42
43 $tooltip =~ s/^\s+//;
44 $tooltip = "<big>$data</big>\n\n$tooltip";
45 $tooltip =~ s/\s+$//;
46
47 $::COMPLETER->{command}{$command} = [$data, $tooltip, $widget, $cb, ++$self->{command_id}];
48}
49
50sub clr_commands {
51 my ($self) = @_;
52
53 %{$::COMPLETER->{command}} = ();
54
55 $::COMPLETER->hide
56 if $::COMPLETER;
57} 36}
58 37
59sub server_login { 38sub server_login {
60 my ($server) = @_; 39 my ($server) = @_;
61 40
… …
722 701
723sub new { 702sub new {
724 my $class = shift; 703 my $class = shift;
725 704
726 my $self = $class->SUPER::new ( 705 my $self = $class->SUPER::new (
706 min_w => $::WIDTH * 0.25, # workaround for layout problems #d#
727 bg => [0, 0, 0, 0.8], 707 bg => [0, 0, 0, 0.8],
728 @_, 708 @_,
729 ); 709 );
730 710
731 $self->add ($self->{vbox} = new DC::UI::VBox); 711 $self->add ($self->{vbox} = new DC::UI::VBox);
… …
818 ); 798 );
819 799
820 $self 800 $self
821} 801}
822 802
803sub reset {
804 my ($self) = @_;
805
806 $self->hide;
807 delete $self->{command_lists};
808 delete $self->{command_list};
809}
810
823sub set_prefix { 811sub set_prefix {
824 my ($self, $prefix) = @_; 812 my ($self, $prefix) = @_;
825 813
826 $self->{entry}->set_text ($prefix); 814 $self->{entry}->set_text ($prefix);
827 $self->show; 815 $self->show;
… …
859} 847}
860 848
861sub update_labels { 849sub update_labels {
862 my ($self) = @_; 850 my ($self) = @_;
863 851
852 use sort qw(stable);
853
864 my $text = $self->{entry}->get_text; 854 my $text = $self->{entry}->get_text;
865 855
866 length $text 856 length $text
867 or return $self->hide; 857 or return $self->hide;
868 858
859 return unless $::CONN;
860
861 # regenerate spell list if necessary
862 $self->{command_list}{spells} ||= [
863 map { ("cast $_->{name}", "invoke $_->{name}") }
864 values %{ $::CONN->{spell} }
865 ];
866
869 if ($text ne $self->{last_search}) { 867 if ($text ne $self->{last_search}) {
870 my @match; 868 my @match;
871 869
872 if ($text =~ /^(.*?)\s+$/) { 870 if ($text =~ /^(.*?)\s+$/) {
873 my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/; 871 my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/;
874 @match = ([[$cmd,'(appended whitespace suppresses completion)'],$text]); 872 @match = ([[$cmd,' (appended whitespace suppresses completion)'], $text]);
875 } else { 873 } else {
876 # @match is [command, penalty, command with arguments] until sort 874 # @match is [command, penalty, command with arguments] until sort
877 875
878 my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/; 876 my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/;
879 877
… …
885 # the following regex is used to match our "completion entry" 883 # the following regex is used to match our "completion entry"
886 # to an actual command - the parentheses match kind of "overhead" 884 # to an actual command - the parentheses match kind of "overhead"
887 # - the more characters the parentheses match, the less attractive 885 # - the more characters the parentheses match, the less attractive
888 # is the match. 886 # is the match.
889 my $regexp = "^\Q$beg\E" 887 my $regexp = "^\Q$beg\E"
890 . join "", map "(?:.*?[ \\\\]|(.*?))\Q$_\E", @chr; 888 . join "", map "(?:.*?[ _\-]|(.*?))\Q$_\E", @chr;
891 qr<$regexp> 889 qr<$regexp>
892 }; 890 };
893 891
894 my $regexp_partial = do { 892 my $regexp_partial = do {
895 my $regexp = "^\Q$text\E(.*)"; 893 my $regexp = "^\Q$text\E(.*)";
896 qr<$regexp> 894 qr<$regexp>
897 }; 895 };
898 896
899 for (keys %{$self->{command}}) { 897 for my $list (@{ $self->{command_lists} }, "spells") {
898 for (@{ $self->{command_list}{$list} }) {
900 # we only match and score if the first character matches, 899 # we only match and score if the first character matches,
901 # so quickly rule out all others first. 900 # so quickly rule out all others first.
902 next unless $first_char = substr $_, 0, 1; 901 next unless $first_char = substr $_, 0, 1;
903 902
904 my @scores; 903 my @scores;
905 904
906 # 1. Complete command [with args] 905 # 1. Complete command [with args]
907 # command is a prefix of the text 906 # command is a prefix of the text
908 # score is length of complete command matched 907 # score is length of complete command matched
909 # e.g. "invoke summon pet monster bat" 908 # e.g. "invoke summon pet monster bat"
910 # "invoke" "summon pet monster bat" = 6 909 # "invoke" "summon pet monster bat" = 6
911 # "invoke summon pet monster" "bat" = 25 910 # "invoke summon pet monster" "bat" = 25
912 if ((substr $text, 0, length $_) eq $_) { 911 if ((substr $text, 0, length $_) eq $_) {
913 push @scores, [$_, length $_, $text]; 912 push @scores, [$_, length $_, $text];
913 }
914
915 # 2. Partial command
916 # text is a prefix of the full command
917 # score is the length of the input text
918 # e.g. "invoke s"
919 # "invoke small fireball" = 8
920 # "invoke summon pet monster" = 8
921
922 if ($_ =~ $regexp_partial) {
923 push @scores, [$_, length $text, $_];
924 }
925
926 # 3. Abbreviation match
927 # attempts to use first word of text as an abbreviated command
928 # score is length of word + 1 - 3 per non-word-initial character
929
930 if (my @penalty = $_ =~ $regexp_abbrev) {
931 push @scores, [$_, (length $cmd) + 1 - (length join "", map "::$_", grep defined, @penalty), "$_$arg"];
932 }
933
934 # Pick the best option for this command
935 push @match, (sort { $b->[1] <=> $a->[1] } @scores)[0];
914 } 936 }
915
916 # 2. Partial command
917 # text is a prefix of the full command
918 # score is the length of the input text
919 # e.g. "invoke s"
920 # "invoke small fireball" = 8
921 # "invoke summon pet monster" = 8
922
923 if ($_ =~ $regexp_partial) {
924 push @scores, [$_, length $text, $_];
925 }
926
927 # 3. Abbreviation match
928 # attempts to use first word of text as an abbreviated command
929 # score is length of word + 1 - 3 per non-word-initial character
930
931 if (my @penalty = $_ =~ $regexp_abbrev) {
932 push @scores, [$_, (length $cmd) + 1 - (length join "", map "::$_", grep defined, @penalty), "$_$arg"];
933 }
934
935 # Pick the best option for this command
936 push @match, (sort {
937 $b->[1] <=> $a->[1]
938 } @scores)[0];
939 } 937 }
940 938
941 # @match is now [command object, command with arguments] 939 # @match is now [command object, command with arguments]
942 @match = map [$self->{command}{$_->[0]}, $_->[2]], 940 @match = map [$_->[0], $_->[2]],
943 sort {
944 $b->[1] <=> $a->[1] 941 sort { $b->[1] <=> $a->[1] }
945 or $self->{command}{$a->[0]}[4] <=> $self->{command}{$b->[0]}[4]
946 or (length $b->[0]) <=> (length $a->[0])
947 } @match; 942 @match;
948 } 943 }
949 944
950 $self->{last_search} = $text; 945 $self->{last_search} = $text;
951 $self->{last_match} = \@match; 946 $self->{last_match} = \@match;
952 947
… …
981 for my $match (@matches) { 976 for my $match (@matches) {
982 my $label = shift @labels; 977 my $label = shift @labels;
983 978
984 if (@labels) { 979 if (@labels) {
985 $label->set_text ("$match->[1]"); 980 $label->set_text ("$match->[1]");
986 $label->set_tooltip ("$match->[0][1]"); 981 $label->set_tooltip ("#(command/$match->[1])");
987 } else { 982 } else {
988 $label->set_text ("..."); 983 $label->set_text ("...");
989 $label->set_tooltip ("Use Cursor-Down to view more matches"); 984 $label->set_tooltip ("Use Cursor-Down to view more matches");
990 last; 985 last;
991 } 986 }

Diff Legend

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