ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/MapWidget.pm
Revision: 1.119
Committed: Tue Aug 28 01:23:47 2007 UTC (16 years, 9 months ago) by root
Branch: MAIN
Changes since 1.118: +9 -60 lines
Log Message:
- generalise keyboard handling a bit into a default
  keymapping + macro functions (such as "!completer shout").
- default keymappings ahve a lower priority, so its possible to
  (in theory) override them. a UI for this has not yet been created.
- re-enable NPOT texture usage, if available.

File Contents

# User Rev Content
1 root 1.80 package CFPlus::MapWidget;
2 root 1.1
3     use strict;
4 root 1.14 use utf8;
5 root 1.1
6     use List::Util qw(min max);
7    
8 root 1.80 use CFPlus;
9     use CFPlus::OpenGL;
10     use CFPlus::UI;
11 root 1.95 use CFPlus::Macro;
12 root 1.1
13 root 1.80 our @ISA = CFPlus::UI::Base::;
14 root 1.1
15 root 1.61 my $magicmap_tex =
16 root 1.80 new_from_file CFPlus::Texture CFPlus::find_rcfile "magicmap.png",
17 root 1.61 mipmap => 1, wrap => 0, internalformat => GL_ALPHA;
18    
19 root 1.1 sub new {
20     my $class = shift;
21    
22 root 1.20 my $self = $class->SUPER::new (
23 root 1.1 z => -1,
24     can_focus => 1,
25 root 1.104 tilesize => 32,
26 root 1.1 @_
27 root 1.20 );
28    
29     $self
30 root 1.1 }
31    
32 root 1.104 sub set_tilesize {
33     my ($self, $tilesize) = @_;
34    
35     $self->{tilesize} = $tilesize;
36     }
37    
38 root 1.36 sub 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 root 1.119 $::COMPLETER->{command}{$command} = [$data, $tooltip, $widget, $cb, ++$self->{command_id}];
48 root 1.36 }
49 root 1.4
50 root 1.36 sub clr_commands {
51     my ($self) = @_;
52 root 1.4
53 root 1.119 %{$::COMPLETER->{command}} = ();
54 elmex 1.76
55 root 1.119 $::COMPLETER->hide
56     if $::COMPLETER;
57 root 1.4 }
58    
59 root 1.85 sub server_login {
60     my ($server) = @_;
61 root 1.83
62     ::stop_game ();
63     local $::PROFILE->{host} = $server;
64     ::start_game ();
65     }
66    
67     sub editor_invoke {
68 root 1.85 my $editsup = $::CONN && $::CONN->{editor_support}
69     or return;
70 root 1.83
71 root 1.88 CFPlus::background {
72 root 1.85 print "preparing editor startup...\n";
73    
74     my $server = $editsup->{gameserver} || "default";
75     $server =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
76    
77     local $ENV{CROSSFIRE_MAPDIR} = my $mapdir = "$Crossfire::VARDIR/map.$server"; mkdir $mapdir;
78     local $ENV{CROSSFIRE_LIBDIR} = my $libdir = "$Crossfire::VARDIR/lib.$server"; mkdir $libdir;
79    
80     print "map directory is $mapdir\n";
81     print "lib directory is $libdir\n";
82    
83 root 1.93 my $ua = CFPlus::lwp_useragent;
84 root 1.84
85 root 1.85 for my $file (qw(archetypes crossfire.0)) {
86     my $url = "$editsup->{lib_root}$file";
87     print "mirroring $url...\n";
88 root 1.93 CFPlus::lwp_check $ua->mirror ($url, "$libdir/$file");
89 root 1.85 printf "%s size %d octets\n", $file, -s "$libdir/$file";
90     }
91    
92     if (1) { # upload a map
93     my $mapname = $::CONN->{map_info}[0];
94    
95 root 1.87 my $mappath = "$mapdir/$mapname";
96    
97     -e $mappath and die "$mappath already exists\n";
98    
99 root 1.85 print "getting map revision for $mapname...\n";
100    
101     # try to get the most recent head revision, what a hack,
102     # this should have been returned while downloading *sigh*
103 root 1.93 my $log = (CFPlus::lwp_check $ua->get ("$editsup->{cvs_root}/$mapname?view=log&logsort=rev"))->decoded_content;
104 root 1.84
105     if ($log =~ /\?rev=(\d+\.\d+)"/) {
106     my $rev = $1;
107    
108 root 1.85 print "downloading revision $rev...\n";
109 root 1.84
110 root 1.93 my $map = (CFPlus::lwp_check $ua->get ("$editsup->{cvs_root}/$mapname?rev=$rev"))->decoded_content;
111 root 1.84
112 root 1.86 my $meta = {
113     %$editsup,
114     path => $mapname,
115     revision => $rev,
116     cf_login => $::PROFILE->{user},
117     };
118    
119     require File::Basename;
120     require File::Path;
121    
122     File::Path::mkpath (File::Basename::dirname ($mappath));
123     open my $fh, ">:raw:perlio", "$mappath.meta"
124 root 1.87 or die "$mappath.meta: $!\n";
125 root 1.86 print $fh CFPlus::to_json $meta;
126     close $fh;
127     open my $fh, ">:raw:perlio:utf8", $mappath
128 root 1.87 or die "$mappath: $!\n";
129 root 1.86 print $fh $map;
130     close $fh;
131    
132     print "saved as $mappath\n";
133    
134     print "invoking editor...\n";
135     exec "/root/s2/gce $mappath";#d#
136    
137 root 1.85 # now upload it
138     # require HTTP::Request::Common;
139     #
140     # my $res = $ua->post (
141     # $ENV{CFPLUS_UPLOAD},
142     # Content_Type => 'multipart/form-data',
143     # Content => [
144     # path => $mapname,
145     # mapdir => $ENV{CROSSFIRE_MAPDIR},
146     # map => $map,
147     # revision => $rev,
148     # cf_login => $ENV{CFPLUS_LOGIN},
149     # cf_password => $ENV{CFPLUS_PASSWORD},
150     # comment => "",
151     # ]
152     # );
153     #
154     # if ($res->is_error) {
155     # # fatal condition
156     # warn $res->status_line;
157     # } else {
158     # # script replies are marked as {{..}}
159     # my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g;
160     # warn map "$_\n", @msgs;
161     # }
162 root 1.84 } else {
163 root 1.85 die "viewvc parse error, unable to detect revision\n";
164 root 1.84 }
165     }
166     }
167 root 1.83 }
168    
169 root 1.63 sub invoke_button_down {
170 root 1.1 my ($self, $ev, $x, $y) = @_;
171    
172 root 1.71 if ($ev->{button} == 1) {
173     $self->grab_focus;
174     return unless $::CONN;
175 root 1.1
176 root 1.106 my $x = $self->{dx} + CFPlus::floor +($ev->{x} - $self->{sx0}) / $self->{ctilesize};
177     my $y = $self->{dy} + CFPlus::floor +($ev->{y} - $self->{sy0}) / $self->{ctilesize};
178 root 1.49
179 root 1.91 $x -= CFPlus::floor $::MAP->w * 0.5;
180     $y -= CFPlus::floor $::MAP->h * 0.5;
181 root 1.54
182 elmex 1.94 if ($::CONN) {
183 elmex 1.115 $::CONN->lookat ($x, $y)
184 elmex 1.94 }
185 root 1.49
186     } elsif ($ev->{button} == 2) {
187 root 1.71 $self->grab_focus;
188     return unless $::CONN;
189    
190 root 1.5 my ($ox, $oy) = ($ev->{x}, $ev->{y});
191 root 1.1 my ($bw, $bh) = ($::CFG->{map_shift_x}, $::CFG->{map_shift_y});
192    
193     $self->{motion} = sub {
194     my ($ev, $x, $y) = @_;
195    
196 root 1.5 ($x, $y) = ($ev->{x}, $ev->{y});
197 root 1.1
198     $::CFG->{map_shift_x} = $bw + $x - $ox;
199     $::CFG->{map_shift_y} = $bh + $y - $oy;
200    
201     $self->update;
202     };
203 root 1.71 } elsif ($ev->{button} == 3) {
204 root 1.85 my @items = (
205 root 1.74 ["Help Browser…\tF1", sub { $::HELP_WINDOW->toggle_visibility }],
206     ["Statistics\tF2", sub { ::toggle_player_page ($::STATS_PAGE) }],
207     ["Skills\tF3", sub { ::toggle_player_page ($::SKILL_PAGE) }],
208 root 1.75 ["Spells…\tF4", sub { ::toggle_player_page ($::SPELL_PAGE) }],
209     ["Inventory…\tF5", sub { ::toggle_player_page ($::INVENTORY_PAGE) }],
210 root 1.74 ["Setup… \tF9", sub { $::SETUP_DIALOG->toggle_visibility }],
211     ["Server Messages…", sub { $::MESSAGE_WINDOW->toggle_visibility }],
212 root 1.71 [
213     $::PICKUP_ENABLE->{state}
214     ? "Disable automatic pickup"
215     : "Enable automatic pickup",
216     sub { $::PICKUP_ENABLE->toggle }
217     ],
218 root 1.85 );
219    
220 root 1.90 if ($::CONN && $::CONN->{editor_support}) {
221 root 1.85 push @items, [
222     "Edit this map <span size='xx-small'>(" . (CFPlus::asxml $::CONN->{map_info}[0]) . ")</span>",
223     \&editor_invoke,
224     ];
225    
226     for my $type (qw(test name)) {
227     $::CONN->{editor_support}{type} ne $type
228     or next;
229     my $server = $::CONN->{editor_support}{"${type}server"}
230     or next;
231    
232     push @items, [
233     "Login on $type server <span size='xx-small'>(" . (CFPlus::asxml $server) . ")</span>",
234     sub { server_login $server },
235     ];
236     }
237     }
238    
239     push @items,
240     ["Quit",
241     sub {
242     if ($::CONN) {
243     &::open_quit_dialog;
244     } else {
245     exit;
246 elmex 1.79 }
247 root 1.85 }
248 root 1.71 ],
249 root 1.85 ;
250    
251     (new CFPlus::UI::Menu
252     items => \@items,
253 root 1.71 )->popup ($ev);
254 root 1.1 }
255 root 1.47
256     1
257 root 1.1 }
258    
259 root 1.63 sub invoke_button_up {
260 root 1.1 my ($self, $ev, $x, $y) = @_;
261    
262     delete $self->{motion};
263 root 1.47
264     1
265 root 1.1 }
266    
267 root 1.63 sub invoke_mouse_motion {
268 root 1.1 my ($self, $ev, $x, $y) = @_;
269    
270 root 1.47 if ($self->{motion}) {
271     $self->{motion}->($ev, $x, $y);
272     } else {
273     return 0;
274     }
275    
276     1
277 root 1.1 }
278    
279     sub size_request {
280 root 1.104 my ($self) = @_;
281    
282 root 1.1 (
283 root 1.104 $self->{tilesize} * CFPlus::ceil $::WIDTH / $self->{tilesize},
284     $self->{tilesize} * CFPlus::ceil $::HEIGHT / $self->{tilesize},
285 root 1.1 )
286     }
287    
288     sub update {
289     my ($self) = @_;
290    
291     $self->{need_update} = 1;
292     $self->SUPER::update;
293     }
294    
295 root 1.36 my %DIR = (
296 root 1.112 ( "," . CFPlus::SDLK_KP5 ), [0, "stay fire"],
297     ( "," . CFPlus::SDLK_KP8 ), [1, "north"],
298     ( "," . CFPlus::SDLK_KP9 ), [2, "northeast"],
299     ( "," . CFPlus::SDLK_KP6 ), [3, "east"],
300     ( "," . CFPlus::SDLK_KP3 ), [4, "southeast"],
301     ( "," . CFPlus::SDLK_KP2 ), [5, "south"],
302     ( "," . CFPlus::SDLK_KP1 ), [6, "southwest"],
303     ( "," . CFPlus::SDLK_KP4 ), [7, "west"],
304     ( "," . CFPlus::SDLK_KP7 ), [8, "northwest"],
305    
306     ( "," . CFPlus::SDLK_UP ), [1, "north"],
307     ("1," . CFPlus::SDLK_UP ), [2, "northeast"],
308     ( "," . CFPlus::SDLK_RIGHT), [3, "east"],
309     ("1," . CFPlus::SDLK_RIGHT), [4, "southeast"],
310     ( "," . CFPlus::SDLK_DOWN ), [5, "south"],
311     ("1," . CFPlus::SDLK_DOWN ), [6, "southwest"],
312     ( "," . CFPlus::SDLK_LEFT ), [7, "west"],
313     ("1," . CFPlus::SDLK_LEFT ), [8, "northwest"],
314 root 1.36 );
315    
316 root 1.63 sub invoke_key_down {
317 root 1.36 my ($self, $ev) = @_;
318    
319     my $mod = $ev->{mod};
320     my $sym = $ev->{sym};
321     my $uni = $ev->{unicode};
322    
323 root 1.80 $mod &= CFPlus::KMOD_CTRL | CFPlus::KMOD_ALT | CFPlus::KMOD_SHIFT;
324 root 1.71
325 root 1.119 if ($::CONN && (my $dir = $DIR{(!!($mod & CFPlus::KMOD_ALT)) . ",$sym"})) {
326 root 1.80 if ($mod & CFPlus::KMOD_SHIFT) {
327 root 1.36 $self->{shft}++;
328 root 1.112 if ($dir->[0] != $self->{fire_dir}) {
329     $::CONN->user_send ("fire $dir->[0]");
330 elmex 1.58 }
331     $self->{fire_dir} = $DIR{$sym}[0];
332 root 1.80 } elsif ($mod & CFPlus::KMOD_CTRL) {
333 root 1.36 $self->{ctrl}++;
334 root 1.112 $::CONN->user_send ("run $dir->[0]");
335 root 1.36 } else {
336 root 1.112 $::CONN->user_send ("$dir->[1]");
337 root 1.36 }
338 root 1.119
339     return 1;
340 root 1.36 }
341 root 1.47
342 root 1.119 0
343 root 1.36 }
344    
345 root 1.63 sub invoke_key_up {
346 root 1.36 my ($self, $ev) = @_;
347    
348 root 1.47 my $res = 0;
349 root 1.36 my $mod = $ev->{mod};
350     my $sym = $ev->{sym};
351    
352 elmex 1.58 if ($::CFG->{shift_fire_stop}) {
353 root 1.80 if (!($mod & CFPlus::KMOD_SHIFT) && delete $self->{shft}) {
354 elmex 1.58 $::CONN->user_send ("fire_stop");
355     delete $self->{fire_dir};
356     $res = 1;
357     }
358     } else {
359     if (exists $DIR{$sym} && delete $self->{shft}) {
360     $::CONN->user_send ("fire_stop");
361     delete $self->{fire_dir};
362     $res = 1;
363 root 1.80 } elsif (($sym == CFPlus::SDLK_LSHIFT || $sym == CFPlus::SDLK_RSHIFT) && delete $self->{shft}) { # XXX: is RSHIFT ok?
364 elmex 1.58 $::CONN->user_send ("fire_stop");
365     delete $self->{fire_dir};
366     $res = 1;
367     }
368 root 1.36 }
369 root 1.47
370 root 1.80 if (!($mod & CFPlus::KMOD_CTRL ) && delete $self->{ctrl}) {
371 root 1.36 $::CONN->user_send ("run_stop");
372 root 1.47 $res = 1;
373 root 1.36 }
374 root 1.47
375     $res
376 root 1.36 }
377    
378 root 1.110 sub invoke_visibility_change {
379     my ($self) = @_;
380    
381     $self->refresh_hook;
382    
383     0
384     }
385    
386 root 1.61 sub set_magicmap {
387     my ($self, $w, $h, $x, $y, $data) = @_;
388    
389 root 1.92 $x -= $::MAP->ox + 1 + int 0.5 * $::MAP->w;
390     $y -= $::MAP->oy + 1 + int 0.5 * $::MAP->h;
391 root 1.61
392     $self->{magicmap} = [$x, $y, $w, $h, $data];
393    
394     $self->update;
395     }
396    
397 root 1.110 sub refresh_hook {
398 root 1.1 my ($self) = @_;
399    
400 root 1.116 if ($::MAP && $::CONN) {
401 root 1.114 if (delete $self->{need_update}) {
402     my $tilesize = $self->{ctilesize} = (int $self->{tilesize} * $::CFG->{map_scale}) || 1;
403    
404     my $sw = $self->{sw} = 1 + CFPlus::ceil $self->{w} / $tilesize;
405     my $sh = $self->{sh} = 1 + CFPlus::ceil $self->{h} / $tilesize;
406    
407     my $sx = CFPlus::ceil $::CFG->{map_shift_x} / $tilesize;
408     my $sy = CFPlus::ceil $::CFG->{map_shift_y} / $tilesize;
409    
410     my $sx0 = $self->{sx0} = $::CFG->{map_shift_x} - $sx * $tilesize;
411     my $sy0 = $self->{sy0} = $::CFG->{map_shift_y} - $sy * $tilesize;
412    
413     my $dx = $self->{dx} = CFPlus::ceil 0.5 * ($::MAP->w - $sw) - $sx;
414     my $dy = $self->{dy} = CFPlus::ceil 0.5 * ($::MAP->h - $sh) - $sy;
415    
416     if ($::CFG->{fow_enable}) {
417     my ($w, $h, $data) = $::MAP->fow_texture ($dx, $dy, $sw, $sh);
418    
419     $self->{fow_texture} = new CFPlus::Texture
420     w => $w,
421     h => $h,
422     data => $data,
423     internalformat => GL_ALPHA,
424     format => GL_ALPHA;
425     } else {
426     delete $self->{fow_texture};
427     }
428 root 1.60
429 root 1.114 glNewList ($self->{list} ||= glGenList);
430 root 1.60
431 root 1.114 glPushMatrix;
432     glTranslate $sx0, $sy0;
433     glScale $::CFG->{map_scale}, $::CFG->{map_scale};
434 root 1.91
435 root 1.117 $::MAP->draw ($dx, $dy, $sw, $sh, $self->{tilesize});
436 root 1.60
437 root 1.114 glScale $self->{tilesize}, $self->{tilesize};
438 root 1.59
439 root 1.114 if (my $tex = $self->{fow_texture}) {
440     glPushMatrix;
441     glScale 1/3, 1/3;
442     glEnable GL_TEXTURE_2D;
443     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
444 root 1.60
445 root 1.114 glColor +($::CFG->{fow_intensity}) x 3, 0.9;
446     $self->{fow_texture}->draw_quad_alpha (0, 0);
447 root 1.60
448 root 1.114 glDisable GL_TEXTURE_2D;
449     glPopMatrix;
450     }
451 root 1.1
452 root 1.114 if ($self->{magicmap}) {
453     my ($x, $y, $w, $h, $data) = @{ $self->{magicmap} };
454 root 1.31
455 root 1.114 $x += $::MAP->ox + $self->{dx};
456     $y += $::MAP->oy + $self->{dy};
457 root 1.1
458 root 1.114 glTranslate - $x - 1, - $y - 1;
459     glBindTexture GL_TEXTURE_2D, $magicmap_tex->{name};
460     $::MAP->draw_magicmap ($x, $y, $w, $h, $data);
461     }
462 root 1.1
463 root 1.109 glPopMatrix;
464 root 1.114 glEndList;
465 root 1.1 }
466 root 1.114 } else {
467     glDeleteList delete $self->{list}
468     if $self->{list};
469 root 1.1 }
470 root 1.110 }
471    
472     sub draw {
473     my ($self) = @_;
474    
475     $self->{root}->on_post_alloc (prepare => sub { $self->refresh_hook });
476    
477     return unless $self->{list};
478    
479     my $focused = $CFPlus::UI::FOCUS == $self
480 root 1.119 || $CFPlus::UI::FOCUS == $::COMPLETER{entry};
481 root 1.110
482     return
483     unless $focused || !$::FAST;
484    
485 root 1.1 glCallList $self->{list};
486    
487 root 1.29 # TNT2 emulates logops in software (or worse :)
488 root 1.60 unless ($focused) {
489 root 1.32 glColor 0.4, 0.2, 0.2, 0.6;
490 root 1.29 glEnable GL_BLEND;
491     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
492 root 1.1 glBegin GL_QUADS;
493     glVertex 0, 0;
494     glVertex 0, $::HEIGHT;
495     glVertex $::WIDTH, $::HEIGHT;
496     glVertex $::WIDTH, 0;
497     glEnd;
498 root 1.29 glDisable GL_BLEND;
499 root 1.1 }
500     }
501    
502 root 1.36 sub DESTROY {
503     my $self = shift;
504 root 1.3
505 root 1.36 glDeleteList $self->{list};
506 root 1.1
507 root 1.36 $self->SUPER::DESTROY;
508 root 1.8 }
509    
510 root 1.80 package CFPlus::MapWidget::MapMap;
511 root 1.18
512 root 1.105 use strict;
513     use utf8;
514    
515 root 1.80 our @ISA = CFPlus::UI::Base::;
516 root 1.18
517     use Time::HiRes qw(time);
518 root 1.80 use CFPlus::OpenGL;
519 root 1.18
520     sub size_request {
521 root 1.111 ($::HEIGHT * 0.2, $::HEIGHT * 0.2)
522 root 1.18 }
523    
524 root 1.110 sub refresh_hook {
525     my ($self) = @_;
526    
527     if ($::MAP && $self->{texture_atime} < time) {
528     my ($w, $h) = @$self{qw(w h)};
529    
530     my $sw = int $::WIDTH / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99;
531     my $sh = int $::HEIGHT / ($::MAPWIDGET->{tilesize} * $::CFG->{map_scale}) + 0.99;
532    
533     my $ox = 0.5 * ($w - $sw);
534     my $oy = 0.5 * ($h - $sh);
535    
536     my $sx = int $::CFG->{map_shift_x} / $::MAPWIDGET->{tilesize};
537     my $sy = int $::CFG->{map_shift_y} / $::MAPWIDGET->{tilesize};
538    
539     #TODO: map scale is completely borked
540    
541     my $x0 = int $ox - $sx + 0.5;
542     my $y0 = int $oy - $sy + 0.5;
543    
544     $self->{sw} = $sw;
545     $self->{sh} = $sh;
546    
547     $self->{x0} = $x0;
548     $self->{y0} = $y0;
549    
550     $self->{texture_atime} = time + 1/3;
551    
552     $self->{texture} =
553     new CFPlus::Texture
554     w => $w,
555     h => $h,
556     data => $::MAP->mapmap (-$ox, -$oy, $w, $h),
557     type => $CFPlus::GL_VERSION >= 1.2 ? GL_UNSIGNED_INT_8_8_8_8_REV : GL_UNSIGNED_BYTE;
558     }
559     }
560    
561     sub invoke_visibility_change {
562     my ($self) = @_;
563    
564     $self->refresh_hook;
565    
566     0
567     }
568    
569 root 1.63 sub invoke_size_allocate {
570 root 1.18 my ($self, $w, $h) = @_;
571    
572     $self->update;
573 root 1.63
574     1
575 root 1.18 }
576    
577     sub update {
578     my ($self) = @_;
579    
580     delete $self->{texture_atime};
581     $self->SUPER::update;
582     }
583    
584     sub _draw {
585     my ($self) = @_;
586    
587 root 1.110 $self->{root}->on_post_alloc (texture => sub { $self->refresh_hook });
588 root 1.18
589 root 1.110 $self->{texture} or return;
590 root 1.18
591     glEnable GL_BLEND;
592     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
593     glEnable GL_TEXTURE_2D;
594     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
595    
596     $self->{texture}->draw_quad (0, 0);
597    
598     glDisable GL_TEXTURE_2D;
599    
600     glTranslate 0.375, 0.375;
601    
602     glColor 1, 1, 0, 1;
603     glBegin GL_LINE_LOOP;
604 root 1.110 glVertex $self->{x0} , $self->{y0} ;
605     glVertex $self->{x0} , $self->{y0} + $self->{sh};
606     glVertex $self->{x0} + $self->{sw}, $self->{y0} + $self->{sh};
607     glVertex $self->{x0} + $self->{sw}, $self->{y0} ;
608 root 1.18 glEnd;
609    
610     glDisable GL_BLEND;
611     }
612    
613 root 1.80 package CFPlus::MapWidget::Command;
614 root 1.8
615     use strict;
616    
617 root 1.80 use CFPlus::OpenGL;
618 root 1.8
619 root 1.80 our @ISA = CFPlus::UI::Frame::;
620 root 1.8
621     sub new {
622     my $class = shift;
623    
624     my $self = $class->SUPER::new (
625 root 1.23 bg => [0, 0, 0, 0.8],
626 root 1.8 @_,
627 root 1.23 );
628    
629 root 1.80 $self->add ($self->{vbox} = new CFPlus::UI::VBox);
630 root 1.23
631     $self->{label} = [
632     map
633 root 1.80 CFPlus::UI::Label->new (
634 root 1.25 can_hover => 1,
635     can_events => 1,
636     tooltip_width => 0.33,
637     fontsize => $_,
638 root 1.27 ), (0.8) x 16
639 root 1.23 ];
640    
641 root 1.80 $self->{entry} = new CFPlus::UI::Entry
642 root 1.40 on_changed => sub {
643 root 1.23 $self->update_labels;
644 root 1.63 0
645 root 1.36 },
646 elmex 1.57 on_button_down => sub {
647     my ($entry, $ev, $x, $y) = @_;
648    
649     if ($ev->{button} == 3) {
650 root 1.80 (new CFPlus::UI::Menu
651 elmex 1.57 items => [
652 root 1.80 ["bind <i>" . (CFPlus::asxml $self->{select}) . "</i> to a key"
653 root 1.95 => sub { CFPlus::Macro::quick_macro [$self->{select}], sub { $entry->grab_focus } }]
654 elmex 1.57 ],
655     )->popup ($ev);
656     return 1;
657     }
658     0
659     },
660 root 1.40 on_key_down => sub {
661 root 1.36 my ($entry, $ev) = @_;
662    
663     my $self = $entry->{parent}{parent};
664    
665     if ($ev->{sym} == 13) {
666     if (exists $self->{select}) {
667 root 1.37 $self->{last_command} = $self->{select};
668 root 1.36 $::CONN->user_send ($self->{select});
669 elmex 1.52
670 elmex 1.68 unshift @{$self->{history}}, $self->{entry}->get_text;
671 elmex 1.52 $self->{hist_ptr} = 0;
672    
673 root 1.36 $self->hide;
674     }
675     } elsif ($ev->{sym} == 27) {
676 elmex 1.52 $self->{hist_ptr} = 0;
677 root 1.36 $self->hide;
678 root 1.80 } elsif ($ev->{sym} == CFPlus::SDLK_DOWN) {
679 elmex 1.52 if ($self->{hist_ptr} > 1) {
680     $self->{hist_ptr}--;
681     $self->{entry}->set_text ($self->{history}->[$self->{hist_ptr} - 1]);
682     } elsif ($self->{hist_ptr} > 0) {
683     $self->{hist_ptr}--;
684     $self->{entry}->set_text ($self->{hist_saveback});
685     } else {
686     ++$self->{select_offset}
687     if $self->{select_offset} < $#{ $self->{last_match} || [] };
688     }
689 root 1.36 $self->update_labels;
690 root 1.80 } elsif ($ev->{sym} == CFPlus::SDLK_UP) {
691 elmex 1.52 if ($self->{select_offset}) {
692     --$self->{select_offset}
693     } else {
694     unless ($self->{hist_ptr}) {
695     $self->{hist_saveback} = $self->{entry}->get_text;
696     }
697     if ($self->{hist_ptr} <= $#{$self->{history}}) {
698     $self->{hist_ptr}++;
699     }
700     $self->{entry}->set_text ($self->{history}->[$self->{hist_ptr} - 1])
701     if exists $self->{history}->[$self->{hist_ptr} - 1];
702     }
703 root 1.36 $self->update_labels;
704     } else {
705     return 0;
706     }
707    
708     1
709     }
710     ;
711 root 1.23
712     $self->{vbox}->add (
713     $self->{entry},
714     @{$self->{label}},
715 root 1.8 );
716    
717     $self
718     }
719    
720 root 1.36 sub set_prefix {
721     my ($self, $prefix) = @_;
722    
723     $self->{entry}->set_text ($prefix);
724     $self->show;
725     }
726    
727 root 1.63 sub invoke_size_allocate {
728 root 1.8 my ($self, $w, $h) = @_;
729    
730 root 1.44 $self->move_abs (($::WIDTH - $w) * 0.5, ($::HEIGHT - $h) * 0.6, 10);
731 root 1.63
732     $self->SUPER::invoke_size_allocate ($w, $h)
733 root 1.8 }
734    
735 root 1.36 sub show {
736     my ($self) = @_;
737    
738     $self->SUPER::show;
739 root 1.63 $self->{entry}->grab_focus;
740 root 1.36 }
741    
742     sub hide {
743     my ($self) = @_;
744    
745 elmex 1.76 $self->{hist_ptr} = 0;
746    
747 root 1.36 $self->SUPER::hide;
748     $self->{entry}->set_text ("");
749     }
750    
751 root 1.77 sub inject_key_down {
752 root 1.23 my ($self, $ev) = @_;
753    
754 root 1.77 $self->{entry}->grab_focus;
755     $self->{entry}->emit (key_down => $ev);
756 root 1.23 }
757    
758 root 1.8 sub update_labels {
759     my ($self) = @_;
760    
761 root 1.23 my $text = $self->{entry}->get_text;
762    
763     length $text
764 root 1.36 or return $self->hide;
765 root 1.23
766     my ($cmd, $arg) = $text =~ /^\s*([^[:space:]]*)(.*)$/;
767    
768 root 1.36 if ($text ne $self->{last_search}) {
769     my @match;
770 root 1.23
771 root 1.36 if ($text =~ /^(.*?)\s+$/) {
772     @match = [$cmd, "(appended whitespace suppresses completion)"];
773     } else {
774     my $regexp = do {
775     my ($beg, @chr) = split //, lc $cmd;
776 root 1.23
777 root 1.36 # the following regex is used to match our "completion entry"
778     # to an actual command - the parentheses match kind of "overhead"
779     # - the more characters the parentheses match, the less attractive
780     # is the match.
781     my $regexp = "^\Q$beg\E"
782     . join "", map "(?:.*?[ \\\\]\Q$_\E|(.*?)\Q$_\E)", @chr;
783     qr<$regexp>
784     };
785    
786     my @penalty;
787    
788     for (keys %{$self->{command}}) {
789     if (@penalty = $_ =~ $regexp) {
790     push @match, [$_, length join "", map "::$_", grep defined, @penalty];
791     }
792 root 1.23 }
793 root 1.36
794     @match = map $self->{command}{$_->[0]},
795     sort {
796     $a->[1] <=> $b->[1]
797     or $self->{command}{$a->[0]}[4] <=> $self->{command}{$b->[0]}[4]
798 root 1.39 or (length $b->[0]) <=> (length $a->[0])
799 root 1.36 } @match;
800 root 1.8 }
801 root 1.23
802 root 1.39 $self->{last_search} = $text;
803 root 1.23 $self->{last_match} = \@match;
804    
805     $self->{select_offset} = 0;
806 root 1.8 }
807    
808 root 1.23 my @labels = @{ $self->{label} };
809     my @matches = @{ $self->{last_match} || [] };
810 root 1.8
811 root 1.23 if ($self->{select_offset}) {
812     splice @matches, 0, $self->{select_offset}, ();
813 root 1.8
814 root 1.23 my $label = shift @labels;
815     $label->set_text ("...");
816     $label->set_tooltip ("Use Cursor-Up to view previous matches");
817 root 1.8 }
818    
819 root 1.23 for my $label (@labels) {
820     $label->{fg} = [1, 1, 1, 1];
821     $label->{bg} = [0, 0, 0, 0];
822     }
823    
824     if (@matches) {
825     $self->{select} = "$matches[0][0]$arg";
826    
827     $labels[0]->{fg} = [0, 0, 0, 1];
828     $labels[0]->{bg} = [1, 1, 1, 0.8];
829     } else {
830 root 1.24 $self->{select} = "$cmd$arg";
831 root 1.23 }
832    
833     for my $match (@matches) {
834     my $label = shift @labels;
835    
836     if (@labels) {
837     $label->set_text ("$match->[0]$arg");
838     $label->set_tooltip ($match->[1]);
839     } else {
840     $label->set_text ("...");
841     $label->set_tooltip ("Use Cursor-Down to view more matches");
842     last;
843     }
844     }
845 root 1.8
846 root 1.23 for my $label (@labels) {
847     $label->set_text ("");
848     $label->set_tooltip ("");
849 root 1.8 }
850    
851 root 1.23 $self->update;
852 root 1.8 }
853    
854 root 1.23 sub _draw {
855     my ($self) = @_;
856 root 1.8
857 root 1.23 # hack
858 root 1.80 local $CFPlus::UI::FOCUS = $self->{entry};
859 root 1.10
860 root 1.23 $self->SUPER::_draw;
861 root 1.2 }
862    
863 root 1.1 1
864 root 1.85