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.23 by root, Wed May 17 00:26:55 2006 UTC vs.
Revision 1.132 by root, Sun Jul 13 12:17:00 2008 UTC

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

Diff Legend

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