ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/MapWidget.pm
Revision: 1.78
Committed: Sun Jul 23 16:11:12 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.77: +3 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 package CFClient::MapWidget;
2    
3     use strict;
4 root 1.14 use utf8;
5 root 1.1
6     use List::Util qw(min max);
7    
8 root 1.78 use CFClient;
9 root 1.4 use CFClient::OpenGL;
10 root 1.78 use CFClient::UI;
11 root 1.1
12     our @ISA = CFClient::UI::Base::;
13    
14 root 1.61 my $magicmap_tex =
15     new_from_file CFClient::Texture CFClient::find_rcfile "magicmap.png",
16     mipmap => 1, wrap => 0, internalformat => GL_ALPHA;
17    
18 root 1.1 sub new {
19     my $class = shift;
20    
21 root 1.20 my $self = $class->SUPER::new (
22 root 1.1 z => -1,
23     can_focus => 1,
24 root 1.4 list => glGenList,
25 root 1.51
26     smooth_matrix => [
27     0.05, 0.13, 0.05,
28     0.13, 0.30, 0.13,
29     0.05, 0.13, 0.05,
30     ],
31    
32 root 1.1 @_
33 root 1.20 );
34    
35 root 1.36 $self->{completer} = new CFClient::MapWidget::Command::
36     command => $self->{command},
37 root 1.37 tooltip => "<b>The Command Completer</b>\n\n"
38     . "This is your central interface to send text commands to the server. "
39     . "To enter a verbatim command to send to the server, just type the command, "
40     . "followed by a space, and press return. "
41     . "Typing the initial letters of words (or just any letters) displays guesses "
42     . "for commands you might want to use.\n"
43     . "You can use the cursor-up and cursor-down keys to select between those guesses.\n"
44 root 1.64 . "<b>Right-Click</b> opens a menu where you cna select further options, sich as redefining key bindings.",
45 root 1.36 ;
46    
47 root 1.20 $self
48 root 1.1 }
49    
50 root 1.36 sub add_command {
51     my ($self, $command, $tooltip, $widget, $cb) = @_;
52    
53     (my $data = $command) =~ s/\\//g;
54    
55     $tooltip =~ s/^\s+//;
56     $tooltip = "<big>$data</big>\n\n$tooltip";
57     $tooltip =~ s/\s+$//;
58    
59     $self->{completer}{command}{$command} = [$data, $tooltip, $widget, $cb, ++$self->{command_id}];
60     }
61 root 1.4
62 root 1.36 sub clr_commands {
63     my ($self) = @_;
64 root 1.4
65 root 1.36 %{$self->{completer}{command}} = ();
66 elmex 1.76
67     $self->{completer}->hide
68     if $self->{completer};
69 root 1.4 }
70    
71 root 1.63 sub invoke_button_down {
72 root 1.1 my ($self, $ev, $x, $y) = @_;
73    
74 root 1.71 if ($ev->{button} == 1) {
75     $self->grab_focus;
76     return unless $::CONN;
77 root 1.1
78 root 1.66 my $x = 1 + CFClient::floor +($ev->{x} - $self->{sx0}) / $self->{tilesize} - $self->{sx};
79     my $y = 1 + CFClient::floor +($ev->{y} - $self->{sy0}) / $self->{tilesize} - $self->{sy};
80 root 1.49
81 root 1.60 $x -= int 0.5 * $self->{sw};
82     $y -= int 0.5 * $self->{sh};
83 root 1.54
84 root 1.56 $::CONN->lookat ($x, $y)
85 root 1.53 if $::CONN;
86 root 1.49
87     } elsif ($ev->{button} == 2) {
88 root 1.71 $self->grab_focus;
89     return unless $::CONN;
90    
91 root 1.5 my ($ox, $oy) = ($ev->{x}, $ev->{y});
92 root 1.1 my ($bw, $bh) = ($::CFG->{map_shift_x}, $::CFG->{map_shift_y});
93    
94     $self->{motion} = sub {
95     my ($ev, $x, $y) = @_;
96    
97 root 1.5 ($x, $y) = ($ev->{x}, $ev->{y});
98 root 1.1
99     $::CFG->{map_shift_x} = $bw + $x - $ox;
100     $::CFG->{map_shift_y} = $bh + $y - $oy;
101    
102     $self->update;
103     };
104 root 1.71 } elsif ($ev->{button} == 3) {
105     (new CFClient::UI::Menu
106     items => [
107 root 1.74 ["Help Browser…\tF1", sub { $::HELP_WINDOW->toggle_visibility }],
108     ["Statistics\tF2", sub { ::toggle_player_page ($::STATS_PAGE) }],
109     ["Skills\tF3", sub { ::toggle_player_page ($::SKILL_PAGE) }],
110 root 1.75 ["Spells…\tF4", sub { ::toggle_player_page ($::SPELL_PAGE) }],
111     ["Inventory…\tF5", sub { ::toggle_player_page ($::INVENTORY_PAGE) }],
112 root 1.74 ["Setup… \tF9", sub { $::SETUP_DIALOG->toggle_visibility }],
113     ["Server Messages…", sub { $::MESSAGE_WINDOW->toggle_visibility }],
114 root 1.71 [
115     $::PICKUP_ENABLE->{state}
116     ? "Disable automatic pickup"
117     : "Enable automatic pickup",
118     sub { $::PICKUP_ENABLE->toggle }
119     ],
120     ],
121     )->popup ($ev);
122 root 1.1 }
123 root 1.47
124     1
125 root 1.1 }
126    
127 root 1.63 sub invoke_button_up {
128 root 1.1 my ($self, $ev, $x, $y) = @_;
129    
130     delete $self->{motion};
131 root 1.47
132     1
133 root 1.1 }
134    
135 root 1.63 sub invoke_mouse_motion {
136 root 1.1 my ($self, $ev, $x, $y) = @_;
137    
138 root 1.47 if ($self->{motion}) {
139     $self->{motion}->($ev, $x, $y);
140     } else {
141     return 0;
142     }
143    
144     1
145 root 1.1 }
146    
147     sub size_request {
148     (
149 root 1.66 32 * CFClient::ceil $::WIDTH / 32,
150     32 * CFClient::ceil $::HEIGHT / 32,
151 root 1.1 )
152     }
153    
154     sub update {
155     my ($self) = @_;
156    
157     $self->{need_update} = 1;
158     $self->SUPER::update;
159     }
160    
161 root 1.36 my %DIR = (
162     CFClient::SDLK_KP8, [1, "north"],
163     CFClient::SDLK_KP9, [2, "northeast"],
164     CFClient::SDLK_KP6, [3, "east"],
165     CFClient::SDLK_KP3, [4, "southeast"],
166     CFClient::SDLK_KP2, [5, "south"],
167     CFClient::SDLK_KP1, [6, "southwest"],
168     CFClient::SDLK_KP4, [7, "west"],
169     CFClient::SDLK_KP7, [8, "northwest"],
170    
171     CFClient::SDLK_UP, [1, "north"],
172     CFClient::SDLK_RIGHT, [3, "east"],
173     CFClient::SDLK_DOWN, [5, "south"],
174     CFClient::SDLK_LEFT, [7, "west"],
175     );
176    
177 root 1.63 sub invoke_key_down {
178 root 1.36 my ($self, $ev) = @_;
179    
180     my $mod = $ev->{mod};
181     my $sym = $ev->{sym};
182     my $uni = $ev->{unicode};
183    
184 root 1.71 $mod &= CFClient::KMOD_CTRL | CFClient::KMOD_ALT | CFClient::KMOD_SHIFT;
185    
186     if ($uni == ord "\t") {
187     $::PL_WINDOW->toggle_visibility;
188     } elsif ($sym == CFClient::SDLK_F1 && !$mod) {
189     $::HELP_WINDOW->toggle_visibility;
190     } elsif ($sym == CFClient::SDLK_F2 && !$mod) {
191     ::toggle_player_page ($::STATS_PAGE);
192     } elsif ($sym == CFClient::SDLK_F3 && !$mod) {
193 root 1.74 ::toggle_player_page ($::SKILL_PAGE);
194     } elsif ($sym == CFClient::SDLK_F4 && !$mod) {
195 root 1.75 ::toggle_player_page ($::SPELL_PAGE);
196     } elsif ($sym == CFClient::SDLK_F5 && !$mod) {
197 root 1.71 ::toggle_player_page ($::INVENTORY_PAGE);
198 root 1.74 } elsif ($sym == CFClient::SDLK_F9 && !$mod) {
199 root 1.71 $::SETUP_DIALOG->toggle_visibility;
200     } elsif ($sym == CFClient::SDLK_INSERT && $mod & CFClient::KMOD_CTRL) {
201     $::BIND_EDITOR->set_binding (undef, undef, [],
202     sub {
203     my ($mod, $sym, $cmds) = @_;
204     $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
205     });
206     $::BIND_EDITOR->start;
207     $::BIND_EDITOR->show;
208     } elsif ($sym == CFClient::SDLK_INSERT && not ($mod & CFClient::KMOD_CTRL)) {
209     $::BIND_EDITOR->stop;
210     $::BIND_EDITOR->ask_for_bind_and_commit;
211     $::BIND_EDITOR->hide;
212     } elsif (!$::CONN) {
213     return 0; # bindings further down need a valid connection
214    
215     } elsif ($sym == CFClient::SDLK_KP5 && !$mod) {
216 root 1.36 $::CONN->user_send ("stay fire");
217     } elsif ($uni == ord ",") {
218     $::CONN->user_send ("take");
219     } elsif ($uni == ord " ") {
220     $::CONN->user_send ("apply");
221 root 1.37 } elsif ($uni == ord ".") {
222     $::CONN->user_send ($self->{completer}{last_command})
223     if exists $self->{completer}{last_command};
224 root 1.71 } elsif (my $bind_cmd = $::CFG->{profile}{default}{bindings}{$mod}{$sym}) {
225     $::CONN->user_send ($_) for @$bind_cmd;
226     } elsif (($sym == CFClient::SDLK_KP_PLUS && !$mod) || $uni == ord "+") {
227 root 1.36 $::CONN->user_send ("rotateshoottype +");
228 root 1.71 } elsif (($sym == CFClient::SDLK_KP_MINUS && !$mod) || $uni == ord "-") {
229 root 1.36 $::CONN->user_send ("rotateshoottype -");
230     } elsif ($uni == ord '"') {
231     $self->{completer}->set_prefix ("$::CFG->{say_command} ");
232     $self->{completer}->show;
233     } elsif ($uni == ord "'") {
234     $self->{completer}->set_prefix ("");
235     $self->{completer}->show;
236     } elsif (exists $DIR{$sym}) {
237     if ($mod & CFClient::KMOD_SHIFT) {
238     $self->{shft}++;
239 elmex 1.58 if ($DIR{$sym}[0] != $self->{fire_dir}) {
240     $::CONN->user_send ("fire $DIR{$sym}[0]");
241     }
242     $self->{fire_dir} = $DIR{$sym}[0];
243 root 1.36 } elsif ($mod & CFClient::KMOD_CTRL) {
244     $self->{ctrl}++;
245     $::CONN->user_send ("run $DIR{$sym}[0]");
246     } else {
247     $::CONN->user_send ("$DIR{$sym}[1]");
248     }
249 root 1.42 } elsif ((ord 'a') <= $uni && $uni <= (ord 'z')) {
250 root 1.77 $self->{completer}->inject_key_down ($ev);
251 root 1.36 $self->{completer}->show;
252 root 1.47 } else {
253     return 0;
254 root 1.36 }
255 root 1.47
256     1
257 root 1.36 }
258    
259 root 1.63 sub invoke_key_up {
260 root 1.36 my ($self, $ev) = @_;
261    
262 root 1.47 my $res = 0;
263 root 1.36 my $mod = $ev->{mod};
264     my $sym = $ev->{sym};
265    
266 elmex 1.58 if ($::CFG->{shift_fire_stop}) {
267     if (!($mod & CFClient::KMOD_SHIFT) && delete $self->{shft}) {
268     $::CONN->user_send ("fire_stop");
269     delete $self->{fire_dir};
270     $res = 1;
271     }
272     } else {
273     if (exists $DIR{$sym} && delete $self->{shft}) {
274     $::CONN->user_send ("fire_stop");
275     delete $self->{fire_dir};
276     $res = 1;
277     } elsif (($sym == CFClient::SDLK_LSHIFT || $sym == CFClient::SDLK_RSHIFT) && delete $self->{shft}) { # XXX: is RSHIFT ok?
278     $::CONN->user_send ("fire_stop");
279     delete $self->{fire_dir};
280     $res = 1;
281     }
282 root 1.36 }
283 root 1.47
284 root 1.36 if (!($mod & CFClient::KMOD_CTRL ) && delete $self->{ctrl}) {
285     $::CONN->user_send ("run_stop");
286 root 1.47 $res = 1;
287 root 1.36 }
288 root 1.47
289     $res
290 root 1.36 }
291    
292 root 1.61 sub set_magicmap {
293     my ($self, $w, $h, $x, $y, $data) = @_;
294    
295 root 1.62 $x -= $::MAP->ox + int 0.5 * $::MAP->w;
296     $y -= $::MAP->oy + int 0.5 * $::MAP->h;
297 root 1.61
298     $self->{magicmap} = [$x, $y, $w, $h, $data];
299    
300     $self->update;
301     }
302    
303 root 1.1 sub draw {
304     my ($self) = @_;
305    
306 root 1.60 return unless $::MAP;
307    
308 root 1.36 my $focused = $CFClient::UI::FOCUS == $self
309     || $CFClient::UI::FOCUS == $self->{completer}{entry};
310    
311 root 1.26 return
312 root 1.60 unless $focused || !$::FAST;
313 root 1.26
314 root 1.1 if (delete $self->{need_update}) {
315 root 1.60 my $tilesize = $self->{tilesize} = int 32 * $::CFG->{map_scale};
316    
317     my $sx = $self->{sx} = CFClient::ceil $::CFG->{map_shift_x} / $tilesize;
318     my $sy = $self->{sy} = CFClient::ceil $::CFG->{map_shift_y} / $tilesize;
319    
320     my $sx0 = $self->{sx0} = $::CFG->{map_shift_x} - $sx * $tilesize;
321     my $sy0 = $self->{sy0} = $::CFG->{map_shift_y} - $sy * $tilesize;
322 root 1.59
323 root 1.61 my $sw = $self->{sw} = 1 + CFClient::ceil $self->{w} / $tilesize;
324     my $sh = $self->{sh} = 1 + CFClient::ceil $self->{h} / $tilesize;
325 root 1.60
326     if ($::CFG->{fow_enable}) {
327     my ($w, $h, $data) = $::MAP->fow_texture ($sx, $sy, 0, 0, $sw, $sh);
328    
329     if ($::CFG->{fow_smooth} && $CFClient::OpenGL::GL_VERSION >= 1.2) { # smooth fog of war
330     glConvolutionParameter (GL_CONVOLUTION_2D, GL_CONVOLUTION_BORDER_MODE, GL_CONSTANT_BORDER);
331     glConvolutionFilter2D (
332     GL_CONVOLUTION_2D,
333     GL_ALPHA,
334     3, 3,
335     GL_ALPHA, GL_FLOAT,
336     (pack "f*", @{ $self->{smooth_matrix} }),
337     );
338     glEnable GL_CONVOLUTION_2D;
339     }
340    
341     $self->{fow_texture} = new CFClient::Texture
342     w => $w,
343     h => $h,
344     data => $data,
345     internalformat => GL_ALPHA,
346     format => GL_ALPHA;
347 root 1.1
348 root 1.60 glDisable GL_CONVOLUTION_2D if $::CFG->{fow_smooth};
349     } else {
350     delete $self->{fow_texture};
351     }
352 root 1.1
353 root 1.60 glNewList $self->{list};
354 root 1.31
355 root 1.60 glPushMatrix;
356     glTranslate $sx0, $sy0;
357     glScale $::CFG->{map_scale}, $::CFG->{map_scale};
358 root 1.1
359 root 1.60 $::MAP->draw ($sx, $sy, 0, 0, $sw, $sh);
360 root 1.1
361 root 1.61 glScale 32, 32;
362    
363 root 1.60 if (my $tex = $self->{fow_texture}) {
364     glEnable GL_TEXTURE_2D;
365     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
366 root 1.1
367 root 1.60 glColor +($::CFG->{fow_intensity}) x 3, 0.9;
368     $self->{fow_texture}->draw_quad_alpha (0, 0);
369 root 1.1
370 root 1.60 glDisable GL_TEXTURE_2D;
371 root 1.1 }
372    
373 root 1.61 if ($self->{magicmap}) {
374     my ($x, $y, $w, $h, $data) = @{ $self->{magicmap} };
375    
376 root 1.62 $x += $::MAP->ox - $sx + int 0.5 * ($::MAP->w - $sw + 1);
377     $y += $::MAP->oy - $sy + int 0.5 * ($::MAP->h - $sh + 1);
378 root 1.61
379     glTranslate - $x - 1, - $y - 1;
380     glBindTexture GL_TEXTURE_2D, $magicmap_tex->{name};
381     $::MAP->draw_magicmap ($x, $y, $w, $h, $data);
382     }
383    
384 root 1.60 glPopMatrix;
385 root 1.1 glEndList;
386     }
387    
388     glCallList $self->{list};
389    
390 root 1.29 # TNT2 emulates logops in software (or worse :)
391 root 1.60 unless ($focused) {
392 root 1.32 glColor 0.4, 0.2, 0.2, 0.6;
393 root 1.29 glEnable GL_BLEND;
394     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
395 root 1.1 glBegin GL_QUADS;
396     glVertex 0, 0;
397     glVertex 0, $::HEIGHT;
398     glVertex $::WIDTH, $::HEIGHT;
399     glVertex $::WIDTH, 0;
400     glEnd;
401 root 1.29 glDisable GL_BLEND;
402 root 1.1 }
403     }
404    
405 root 1.36 sub DESTROY {
406     my $self = shift;
407 root 1.3
408 root 1.36 glDeleteList $self->{list};
409 root 1.1
410 root 1.36 $self->SUPER::DESTROY;
411 root 1.8 }
412    
413 root 1.18 package CFClient::MapWidget::MapMap;
414    
415 root 1.19 our @ISA = CFClient::UI::Base::;
416 root 1.18
417     use Time::HiRes qw(time);
418     use CFClient::OpenGL;
419    
420     sub size_request {
421     ($::HEIGHT * 0.25, $::HEIGHT * 0.25)
422     }
423    
424 root 1.63 sub invoke_size_allocate {
425 root 1.18 my ($self, $w, $h) = @_;
426    
427     $self->update;
428 root 1.63
429     1
430 root 1.18 }
431    
432     sub update {
433     my ($self) = @_;
434    
435     delete $self->{texture_atime};
436     $self->SUPER::update;
437     }
438    
439     sub _draw {
440     my ($self) = @_;
441    
442     $::MAP or return;
443    
444     my ($w, $h) = @$self{qw(w h)};
445    
446     my $sw = int $::WIDTH / (32 * $::CFG->{map_scale}) + 0.99;
447     my $sh = int $::HEIGHT / (32 * $::CFG->{map_scale}) + 0.99;
448    
449     my $sx = int $::CFG->{map_shift_x} / 32;
450     my $sy = int $::CFG->{map_shift_y} / 32;
451    
452     my $ox = 0.5 * ($w - $sw);
453     my $oy = 0.5 * ($h - $sh);
454    
455     glEnable GL_BLEND;
456     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
457     glEnable GL_TEXTURE_2D;
458     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
459    
460     if ($self->{texture_atime} < time) {
461     $self->{texture_atime} = time + 1/3;
462    
463     $self->{texture} =
464     new CFClient::Texture
465     w => $w,
466     h => $h,
467     data => $::MAP->mapmap (-$ox, -$oy, $w, $h),
468     type => $CFClient::GL_VERSION >= 1.2 ? GL_UNSIGNED_INT_8_8_8_8_REV : GL_UNSIGNED_BYTE;
469     }
470    
471     $self->{texture}->draw_quad (0, 0);
472    
473     glDisable GL_TEXTURE_2D;
474    
475     glTranslate 0.375, 0.375;
476    
477     #TODO: map scale is completely borked
478    
479     my $x0 = int $ox - $sx + 0.5;
480     my $y0 = int $oy - $sy + 0.5;
481    
482     glColor 1, 1, 0, 1;
483     glBegin GL_LINE_LOOP;
484     glVertex $x0 , $y0 ;
485     glVertex $x0 , $y0 + $sh;
486     glVertex $x0 + $sw, $y0 + $sh;
487     glVertex $x0 + $sw, $y0 ;
488     glEnd;
489    
490     glDisable GL_BLEND;
491     }
492    
493 root 1.8 package CFClient::MapWidget::Command;
494    
495     use strict;
496    
497     use CFClient::OpenGL;
498    
499 root 1.23 our @ISA = CFClient::UI::Frame::;
500 root 1.8
501     sub new {
502     my $class = shift;
503    
504     my $self = $class->SUPER::new (
505 root 1.23 bg => [0, 0, 0, 0.8],
506 root 1.8 @_,
507 root 1.23 );
508    
509     $self->add ($self->{vbox} = new CFClient::UI::VBox);
510    
511     $self->{label} = [
512     map
513 root 1.8 CFClient::UI::Label->new (
514 root 1.25 can_hover => 1,
515     can_events => 1,
516     tooltip_width => 0.33,
517     fontsize => $_,
518 root 1.27 ), (0.8) x 16
519 root 1.23 ];
520    
521     $self->{entry} = new CFClient::UI::Entry
522 root 1.40 on_changed => sub {
523 root 1.23 $self->update_labels;
524 root 1.63 0
525 root 1.36 },
526 elmex 1.57 on_button_down => sub {
527     my ($entry, $ev, $x, $y) = @_;
528    
529     if ($ev->{button} == 3) {
530     (new CFClient::UI::Menu
531     items => [
532 root 1.78 ["bind <i>" . (CFClient::asxml $self->{select}) . "</i> to a key"
533 root 1.69 => sub { $::BIND_EDITOR->do_quick_binding ([$self->{select}], sub { $entry->grab_focus }) }]
534 elmex 1.57 ],
535     )->popup ($ev);
536     return 1;
537     }
538     0
539     },
540 root 1.40 on_key_down => sub {
541 root 1.36 my ($entry, $ev) = @_;
542    
543     my $self = $entry->{parent}{parent};
544    
545     if ($ev->{sym} == 13) {
546     if (exists $self->{select}) {
547 root 1.37 $self->{last_command} = $self->{select};
548 root 1.36 $::CONN->user_send ($self->{select});
549 elmex 1.52
550 elmex 1.68 unshift @{$self->{history}}, $self->{entry}->get_text;
551 elmex 1.52 $self->{hist_ptr} = 0;
552    
553 root 1.36 $self->hide;
554     }
555     } elsif ($ev->{sym} == 27) {
556 elmex 1.52 $self->{hist_ptr} = 0;
557 root 1.36 $self->hide;
558     } elsif ($ev->{sym} == CFClient::SDLK_DOWN) {
559 elmex 1.52 if ($self->{hist_ptr} > 1) {
560     $self->{hist_ptr}--;
561     $self->{entry}->set_text ($self->{history}->[$self->{hist_ptr} - 1]);
562     } elsif ($self->{hist_ptr} > 0) {
563     $self->{hist_ptr}--;
564     $self->{entry}->set_text ($self->{hist_saveback});
565     } else {
566     ++$self->{select_offset}
567     if $self->{select_offset} < $#{ $self->{last_match} || [] };
568     }
569 root 1.36 $self->update_labels;
570     } elsif ($ev->{sym} == CFClient::SDLK_UP) {
571 elmex 1.52 if ($self->{select_offset}) {
572     --$self->{select_offset}
573     } else {
574     unless ($self->{hist_ptr}) {
575     $self->{hist_saveback} = $self->{entry}->get_text;
576     }
577     if ($self->{hist_ptr} <= $#{$self->{history}}) {
578     $self->{hist_ptr}++;
579     }
580     $self->{entry}->set_text ($self->{history}->[$self->{hist_ptr} - 1])
581     if exists $self->{history}->[$self->{hist_ptr} - 1];
582     }
583 root 1.36 $self->update_labels;
584     } else {
585     return 0;
586     }
587    
588     1
589     }
590     ;
591 root 1.23
592     $self->{vbox}->add (
593     $self->{entry},
594     @{$self->{label}},
595 root 1.8 );
596    
597     $self
598     }
599    
600 root 1.36 sub set_prefix {
601     my ($self, $prefix) = @_;
602    
603     $self->{entry}->set_text ($prefix);
604     $self->show;
605     }
606    
607 root 1.63 sub invoke_size_allocate {
608 root 1.8 my ($self, $w, $h) = @_;
609    
610 root 1.44 $self->move_abs (($::WIDTH - $w) * 0.5, ($::HEIGHT - $h) * 0.6, 10);
611 root 1.63
612     $self->SUPER::invoke_size_allocate ($w, $h)
613 root 1.8 }
614    
615 root 1.36 sub show {
616     my ($self) = @_;
617    
618     $self->SUPER::show;
619 root 1.63 $self->{entry}->grab_focus;
620 root 1.36 }
621    
622     sub hide {
623     my ($self) = @_;
624    
625 elmex 1.76 $self->{hist_ptr} = 0;
626    
627 root 1.36 $self->SUPER::hide;
628     $self->{entry}->set_text ("");
629     }
630    
631 root 1.77 sub inject_key_down {
632 root 1.23 my ($self, $ev) = @_;
633    
634 root 1.77 $self->{entry}->grab_focus;
635     $self->{entry}->emit (key_down => $ev);
636 root 1.23 }
637    
638 root 1.8 sub update_labels {
639     my ($self) = @_;
640    
641 root 1.23 my $text = $self->{entry}->get_text;
642    
643     length $text
644 root 1.36 or return $self->hide;
645 root 1.23
646     my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/;
647    
648 root 1.36 if ($text ne $self->{last_search}) {
649     my @match;
650 root 1.23
651 root 1.36 if ($text =~ /^(.*?)\s+$/) {
652     @match = [$cmd, "(appended whitespace suppresses completion)"];
653     } else {
654     my $regexp = do {
655     my ($beg, @chr) = split //, lc $cmd;
656 root 1.23
657 root 1.36 # the following regex is used to match our "completion entry"
658     # to an actual command - the parentheses match kind of "overhead"
659     # - the more characters the parentheses match, the less attractive
660     # is the match.
661     my $regexp = "^\Q$beg\E"
662     . join "", map "(?:.*?[ \\\\]\Q$_\E|(.*?)\Q$_\E)", @chr;
663     qr<$regexp>
664     };
665    
666     my @penalty;
667    
668     for (keys %{$self->{command}}) {
669     if (@penalty = $_ =~ $regexp) {
670     push @match, [$_, length join "", map "::$_", grep defined, @penalty];
671     }
672 root 1.23 }
673 root 1.36
674     @match = map $self->{command}{$_->[0]},
675     sort {
676     $a->[1] <=> $b->[1]
677     or $self->{command}{$a->[0]}[4] <=> $self->{command}{$b->[0]}[4]
678 root 1.39 or (length $b->[0]) <=> (length $a->[0])
679 root 1.36 } @match;
680 root 1.8 }
681 root 1.23
682 root 1.39 $self->{last_search} = $text;
683 root 1.23 $self->{last_match} = \@match;
684    
685     $self->{select_offset} = 0;
686 root 1.8 }
687    
688 root 1.23 my @labels = @{ $self->{label} };
689     my @matches = @{ $self->{last_match} || [] };
690 root 1.8
691 root 1.23 if ($self->{select_offset}) {
692     splice @matches, 0, $self->{select_offset}, ();
693 root 1.8
694 root 1.23 my $label = shift @labels;
695     $label->set_text ("...");
696     $label->set_tooltip ("Use Cursor-Up to view previous matches");
697 root 1.8 }
698    
699 root 1.23 for my $label (@labels) {
700     $label->{fg} = [1, 1, 1, 1];
701     $label->{bg} = [0, 0, 0, 0];
702     }
703    
704     if (@matches) {
705     $self->{select} = "$matches[0][0]$arg";
706    
707     $labels[0]->{fg} = [0, 0, 0, 1];
708     $labels[0]->{bg} = [1, 1, 1, 0.8];
709     } else {
710 root 1.24 $self->{select} = "$cmd$arg";
711 root 1.23 }
712    
713     for my $match (@matches) {
714     my $label = shift @labels;
715    
716     if (@labels) {
717     $label->set_text ("$match->[0]$arg");
718     $label->set_tooltip ($match->[1]);
719     } else {
720     $label->set_text ("...");
721     $label->set_tooltip ("Use Cursor-Down to view more matches");
722     last;
723     }
724     }
725 root 1.8
726 root 1.23 for my $label (@labels) {
727     $label->set_text ("");
728     $label->set_tooltip ("");
729 root 1.8 }
730    
731 root 1.23 $self->update;
732 root 1.8 }
733    
734 root 1.23 sub _draw {
735     my ($self) = @_;
736 root 1.8
737 root 1.23 # hack
738     local $CFClient::UI::FOCUS = $self->{entry};
739 root 1.10
740 root 1.23 $self->SUPER::_draw;
741 root 1.2 }
742    
743 root 1.1 1