--- deliantra/Deliantra-Client/DC/MapWidget.pm 2008/07/19 20:40:53 1.134 +++ deliantra/Deliantra-Client/DC/MapWidget.pm 2010/04/03 02:58:25 1.162 @@ -1,7 +1,6 @@ package DC::MapWidget; -use strict; -use utf8; +use common::sense; use List::Util qw(min max); @@ -12,8 +11,13 @@ 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_file DC::Texture DC::find_rcfile "magicmap.png", + new_from_resource DC::Texture "magicmap.png", mipmap => 1, wrap => 0, internalformat => GL_ALPHA; sub new { @@ -165,7 +169,7 @@ if ($ev->{button} == 1) { $self->grab_focus; - return unless $::CONN; + 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}; @@ -203,12 +207,6 @@ ["Inventory…\tF5", sub { ::toggle_player_page ($::INVENTORY_PAGE) }], ["Setup… \tF9", sub { $::SETUP_DIALOG->toggle_visibility }], # ["Server Messages…", sub { $::MESSAGE_WINDOW->toggle_visibility }], - [ - $::PICKUP_ENABLE->{state} - ? "Disable automatic pickup" - : "Enable automatic pickup", - sub { $::PICKUP_ENABLE->toggle } - ], ); if ($::CONN && $::CONN->{editor_support}) { @@ -217,8 +215,8 @@ # \&editor_invoke, # ]; - for my $type (qw(test name)) { - $::CONN->{editor_support}{type} ne $type + for my $type (@{ $::CONN->{editor_support}{servertypes} }) { + $::CONN->{editor_support}{servertype} ne $type or next; my $server = $::CONN->{editor_support}{"${type}server"} or next; @@ -287,24 +285,29 @@ } my %DIR = ( - ( "," . DC::SDLK_KP5 ), [0, "stay fire"], - ( "," . DC::SDLK_KP8 ), [1, "north"], - ( "," . DC::SDLK_KP9 ), [2, "northeast"], - ( "," . DC::SDLK_KP6 ), [3, "east"], - ( "," . DC::SDLK_KP3 ), [4, "southeast"], - ( "," . DC::SDLK_KP2 ), [5, "south"], - ( "," . DC::SDLK_KP1 ), [6, "southwest"], - ( "," . DC::SDLK_KP4 ), [7, "west"], - ( "," . DC::SDLK_KP7 ), [8, "northwest"], - - ( "," . DC::SDLK_UP ), [1, "north"], - ("1," . DC::SDLK_UP ), [2, "northeast"], - ( "," . DC::SDLK_RIGHT), [3, "east"], - ("1," . DC::SDLK_RIGHT), [4, "southeast"], - ( "," . DC::SDLK_DOWN ), [5, "south"], - ("1," . DC::SDLK_DOWN ), [6, "southwest"], - ( "," . DC::SDLK_LEFT ), [7, "west"], - ("1," . DC::SDLK_LEFT ), [8, "northwest"], + ( "," . DC::SDLK_KP5 ), [0, "stay fire"], + ( "," . DC::SDLK_KP8 ), [1, "north"], + ( "," . DC::SDLK_KP9 ), [2, "northeast"], + ( "," . DC::SDLK_KP6 ), [3, "east"], + ( "," . DC::SDLK_KP3 ), [4, "southeast"], + ( "," . DC::SDLK_KP2 ), [5, "south"], + ( "," . DC::SDLK_KP1 ), [6, "southwest"], + ( "," . DC::SDLK_KP4 ), [7, "west"], + ( "," . DC::SDLK_KP7 ), [8, "northwest"], + + ( "," . DC::SDLK_PAGEUP ), [2, "northeast"], + ( "," . DC::SDLK_PAGEDOWN ), [4, "southeast"], + ( "," . DC::SDLK_END ), [6, "southwest"], + ( "," . DC::SDLK_HOME ), [8, "northwest"], + + ( "," . DC::SDLK_UP ), [1, "north"], + ("1," . DC::SDLK_UP ), [2, "northeast"], + ( "," . DC::SDLK_RIGHT ), [3, "east"], + ("1," . DC::SDLK_RIGHT ), [4, "southeast"], + ( "," . DC::SDLK_DOWN ), [5, "south"], + ("1," . DC::SDLK_DOWN ), [6, "southwest"], + ( "," . DC::SDLK_LEFT ), [7, "west"], + ("1," . DC::SDLK_LEFT ), [8, "northwest"], ); sub invoke_key_down { @@ -314,14 +317,16 @@ my $sym = $ev->{sym}; my $uni = $ev->{unicode}; - $mod &= DC::KMOD_CTRL | DC::KMOD_ALT | DC::KMOD_SHIFT; + $mod &= DC::KMOD_CTRL | DC::KMOD_ALT | DC::KMOD_META | DC::KMOD_SHIFT; # ignore repeated keypresses return if $self->{last_mod} == $mod && $self->{last_sym} == $sym; $self->{last_mod} = $mod; $self->{last_sym} = $sym; - if ($::CONN && (my $dir = $DIR{(!!($mod & DC::KMOD_ALT)) . ",$sym"})) { + my $dir = $DIR{ (!!($mod & (DC::KMOD_ALT | DC::KMOD_META))) . ",$sym" }; + + if ($::CONN && $dir) { if ($mod & DC::KMOD_SHIFT) { $self->{shft}++; if ($dir->[0] != $self->{fire_dir}) { @@ -358,7 +363,9 @@ $res = 1; } } else { - if (exists $DIR{(!!($mod & DC::KMOD_ALT)) . ",$sym"} && delete $self->{shft}) { + my $dir = $DIR{ (!!($mod & (DC::KMOD_ALT | DC::KMOD_META))) . ",$sym" }; + + if ($dir && delete $self->{shft}) { $::CONN->user_send ("fire_stop"); delete $self->{fire_dir}; $res = 1; @@ -370,7 +377,7 @@ } } - if (!($mod & DC::KMOD_CTRL ) && delete $self->{ctrl}) { + if (!($mod & DC::KMOD_CTRL) && delete $self->{ctrl}) { $::CONN->user_send ("run_stop"); $res = 1; } @@ -395,12 +402,19 @@ sub scroll { my ($self, $dx, $dy) = @_; - $::MAP->scroll ($dx, $dy); - $self->movement_update; $self->{sdx} += $dx * $self->{tilesize}; # smooth displacement $self->{sdy} += $dy * $self->{tilesize}; + + # save old fow texture, if applicable + $self->{prev_fow_texture} = $::CFG->{smooth_transitions} && $self->{fow_texture}; + $self->{lfdx} = $dx; + $self->{lfdy} = $dy; + $self->{lmdx} = $self->{dx}; + $self->{lmdy} = $self->{dy}; + + $::MAP->scroll ($dx, $dy); } sub set_magicmap { @@ -423,28 +437,28 @@ 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); + my $mintime = DC::Protocol::TICK * DC::ceil 1 / ($spd * DC::Protocol::TICK || 1); + + $spd *= $self->{tilesize}; # jump if "impossibly high" speed if ( (max abs $self->{sdx}, abs $self->{sdy}) - > $spd * $self->{tilesize} * $mintime * 1.1 + > $spd * $mintime * 2.1 ) { - #warn "jump ", (max abs $self->{sdx}, abs $self->{sdy}), " ", $spd * $mintime * 1.0;#d# + #warn "jump ", (max abs $self->{sdx}, abs $self->{sdy}), " ", $spd * $mintime * 2.1;#d# $self->{sdx} = $self->{sdy} = 0; } else { - my $upd = 0; - - $spd *= $self->{tilesize} * $diff * 1.0001; # 1.0001 so that we don't accumulate rounding errors the wrong direction + $spd *= $diff * 1.0001; # 1.0001 so that we don't accumulate rounding errors the wrong direction my $dx = $self->{sdx} < 0 ? -$spd : $spd; my $dy = $self->{sdy} < 0 ? -$spd : $spd; - if ($self->{sdx} * ($self->{sdx} - $dx) <= 0) { $self->{sdx} = 0 } else { $self->{sdx} -= $dx; $upd = 1 } - if ($self->{sdy} * ($self->{sdy} - $dy) <= 0) { $self->{sdy} = 0 } else { $self->{sdy} -= $dy; $upd = 1 } - - $self->update if $upd; + if ($self->{sdx} * ($self->{sdx} - $dx) <= 0) { $self->{sdx} = 0 } else { $self->{sdx} -= $dx } + if ($self->{sdy} * ($self->{sdy} - $dy) <= 0) { $self->{sdy} = 0 } else { $self->{sdy} -= $dy } } + + $self->update; } } else { $self->{sdx} = $self->{sdy} = 0; @@ -462,13 +476,16 @@ my $tilesize = $self->{ctilesize} = (int $self->{tilesize} * $::CFG->{map_scale}) || 1; + my $sdx_t = DC::ceil $self->{sdx} / $tilesize; + my $sdy_t = DC::ceil $self->{sdy} / $tilesize; + # width/height of map, in tiles - my $sw = $self->{sw} = 1 + DC::ceil $self->{w} / $tilesize; - my $sh = $self->{sh} = 1 + DC::ceil $self->{h} / $tilesize; + my $sw = $self->{sw} = 2 + DC::ceil $self->{w} / $tilesize; + my $sh = $self->{sh} = 2 + DC::ceil $self->{h} / $tilesize; # the map displacement, in tiles - my $sx = DC::ceil $::CFG->{map_shift_x} / $tilesize + $self->{sdx} / $self->{tilesize}; - my $sy = DC::ceil $::CFG->{map_shift_y} / $tilesize + $self->{sdy} / $self->{tilesize}; + my $sx = DC::ceil $::CFG->{map_shift_x} / $tilesize + $sdx_t; + my $sy = DC::ceil $::CFG->{map_shift_y} / $tilesize + $sdy_t; # the upper left "visible" corner, in pixels my $sx0 = $self->{sx0} = $::CFG->{map_shift_x} - $sx * $tilesize; @@ -478,6 +495,7 @@ my $dy = $self->{dy} = DC::ceil 0.5 * ($::MAP->h - $sh) - $sy; if ($::CFG->{fow_enable}) { + # draw_fow_texture REQUIRES the fow texture to stay the same size. my ($w, $h, $data) = $::MAP->fow_texture ($dx, $dy, $sw, $sh); $self->{fow_texture} = new DC::Texture @@ -495,7 +513,7 @@ glPushMatrix; glTranslate $sx0, $sy0; glScale $::CFG->{map_scale}, $::CFG->{map_scale}; - glTranslate $self->{sdx}, $self->{sdy}; + glTranslate DC::ceil $self->{sdx}, DC::ceil $self->{sdy}; $::MAP->draw ($dx, $dy, $sw, $sh, $self->{tilesize}, @@ -505,16 +523,27 @@ glScale $self->{tilesize}, $self->{tilesize}; if (my $tex = $self->{fow_texture}) { - glPushMatrix; - glScale 1/3, 1/3; - glEnable GL_TEXTURE_2D; - glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; + my @prev_fow_params; - glColor +($::CFG->{fow_intensity}) x 3, 0.9; - $self->{fow_texture}->draw_quad_alpha (0, 0); + 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) { + @prev_fow_params = ( + (min 1, $d1 / $d2), + $self->{lmdx} - $dx - $self->{lfdx}, + $self->{lmdy} - $dy - $self->{lfdy}, + @{$self->{prev_fow_texture}}{qw(name data)} + ); + } + } - glDisable GL_TEXTURE_2D; - glPopMatrix; + DC::Texture::draw_fow_texture + $::CFG->{fow_intensity}, + $TEX_HIDDEN[$::CFG->{fow_texture}]{name}, + @{$self->{fow_texture}}{qw(name data s t w h)}, + @prev_fow_params; } if ($self->{magicmap}) { @@ -525,13 +554,16 @@ glTranslate - $x - 1, - $y - 1; glBindTexture GL_TEXTURE_2D, $magicmap_tex->{name}; - $::MAP->draw_magicmap ($x, $y, $w, $h, $data); + $::MAP->draw_magicmap ($w, $h, $data); } glPopMatrix; glEndList; } } else { + delete $self->{last_fow_texture}; + delete $self->{fow_texture}; + glDeleteList delete $self->{list} if $self->{list}; } @@ -577,8 +609,7 @@ package DC::MapWidget::MapMap; -use strict; -use utf8; +use common::sense; our @ISA = DC::UI::Base::; @@ -595,6 +626,8 @@ if ($::MAP && $self->{texture_atime} < time) { my ($w, $h) = @$self{qw(w h)}; + return unless $w && $h; + my $sw = int $::WIDTH / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99; my $sh = int $::HEIGHT / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99; @@ -680,7 +713,7 @@ package DC::MapWidget::Command; -use strict; +use common::sense; use DC::OpenGL; @@ -832,15 +865,18 @@ length $text or return $self->hide; - my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/; - if ($text ne $self->{last_search}) { my @match; if ($text =~ /^(.*?)\s+$/) { - @match = [$cmd, "(appended whitespace suppresses completion)"]; + my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/; + @match = ([[$cmd,'(appended whitespace suppresses completion)'],$text]); } else { - my $regexp = do { + # @match is [command, penalty, command with arguments] until sort + + my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/; + + my $regexp_abbrev = do { my ($beg, @chr) = split //, lc $cmd; # the following regex is used to match our "completion entry" @@ -852,17 +888,53 @@ qr<$regexp> }; - my @penalty; + my $regexp_partial = do { + my $regexp = "^\Q$text\E(.*)"; + qr<$regexp> + }; for (keys %{$self->{command}}) { - if (@penalty = $_ =~ $regexp) { - push @match, [$_, length join "", map "::$_", grep defined, @penalty]; + my @scores; + + # 1. Complete command [with args] + # command is a prefix of the text + # score is length of complete command matched + # e.g. "invoke summon pet monster bat" + # "invoke" "summon pet monster bat" = 6 + # "invoke summon pet monster" "bat" = 25 + if ($text =~ /^\Q$_\E(.*)/) { + 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]; } - @match = map $self->{command}{$_->[0]}, + # @match is now [command object, command with arguments] + @match = map [$self->{command}{$_->[0]}, $_->[2]], sort { - $a->[1] <=> $b->[1] + $b->[1] <=> $a->[1] or $self->{command}{$a->[0]}[4] <=> $self->{command}{$b->[0]}[4] or (length $b->[0]) <=> (length $a->[0]) } @match; @@ -891,20 +963,20 @@ } if (@matches) { - $self->{select} = "$matches[0][0]$arg"; + $self->{select} = "$matches[0][1]"; $labels[0]->{fg} = [0, 0, 0, 1]; $labels[0]->{bg} = [1, 1, 1, 0.8]; } else { - $self->{select} = "$cmd$arg"; + $self->{select} = "$text"; } for my $match (@matches) { my $label = shift @labels; if (@labels) { - $label->set_text ("$match->[0]$arg"); - $label->set_tooltip ($match->[1]); + $label->set_text ("$match->[1]"); + $label->set_tooltip ("$match->[0][1]"); } else { $label->set_text ("..."); $label->set_tooltip ("Use Cursor-Down to view more matches");