ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.60 by root, Tue May 23 23:14:44 2006 UTC vs.
Revision 1.75 by root, Mon May 29 21:10:47 2006 UTC

18 $VERSION = '0.1'; 18 $VERSION = '0.1';
19 19
20 use XSLoader; 20 use XSLoader;
21 XSLoader::load "CFClient", $VERSION; 21 XSLoader::load "CFClient", $VERSION;
22} 22}
23
24use utf8;
23 25
24use Carp (); 26use Carp ();
25use AnyEvent (); 27use AnyEvent ();
26use BerkeleyDB; 28use BerkeleyDB;
27
28use CFClient::OpenGL;
29
30our %GL_EXT;
31our $GL_VERSION;
32
33our $GL_NPOT;
34our $GL_DEBUG = 1;
35
36sub gl_init {
37 $GL_VERSION = gl_version * 1;
38 %GL_EXT = map +($_ => 1), split /\s+/, gl_extensions;
39
40 $GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} || $GL_VERSION >= 2;
41 $GL_NPOT = 0 if gl_vendor =~ /ATI Technologies/; # ATI doesn't get it right...
42
43 glDisable GL_COLOR_MATERIAL;
44 glShadeModel GL_FLAT;
45 glDisable GL_DITHER;
46 glDisable GL_DEPTH_TEST;
47 glDepthMask 0;
48 glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST;
49
50 CFClient::Texture::restore_state ();
51}
52
53sub gl_check {
54 return unless $GL_DEBUG;
55
56 if (my $error = glGetError) {
57 Carp::cluck sprintf "opengl error %x while %s", $error, &sprintf(@_);
58 }
59}
60 29
61sub find_rcfile($) { 30sub find_rcfile($) {
62 my $path; 31 my $path;
63 32
64 for (grep !ref, @INC) { 33 for (grep !ref, @INC) {
99 } 68 }
100 69
101 close CFG; 70 close CFG;
102} 71}
103 72
104mkdir "$Crossfire::VARDIR/pclient", 0777; 73mkdir "$Crossfire::VARDIR/cfplus", 0777;
105 74
106our $DB_ENV = new BerkeleyDB::Env 75our $DB_ENV = new BerkeleyDB::Env
107 -Home => "$Crossfire::VARDIR/pclient", 76 -Home => "$Crossfire::VARDIR/cfplus",
108 -Cachesize => 1_000_000, 77 -Cachesize => 1_000_000,
109 -ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt", 78 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
110# -ErrPrefix => "DATABASE", 79# -ErrPrefix => "DATABASE",
111 -Verbose => 1, 80 -Verbose => 1,
112 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN, 81 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN,
113 or die "unable to create/open database home $Crossfire::VARDIR/pclient: $BerkeleyDB::Error"; 82 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
114 83
115sub db_table($) { 84sub db_table($) {
116 my ($table) = @_; 85 my ($table) = @_;
117 86
118 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; 87 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
168 . $_[1]->content->present ($_[0]) 137 . $_[1]->content->present ($_[0])
169} 138}
170 139
171sub view_verbatim { 140sub view_verbatim {
172 (join "", 141 (join "",
173 map +("\t" x ($indent / 2)) . "$_\n", 142 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
174 split /\n/, CFClient::UI::Label::escape ($_[1])) 143 split /\n/, CFClient::UI::Label::escape ($_[1]))
175 . "\n" 144 . "\n"
176} 145}
177 146
178sub view_textblock { 147sub view_textblock {
179 ("\t" x ($indent / 2)) . "$_[1]\n\n" 148 ("\t" x ($indent / 2)) . "$_[1]\n\n"
180} 149}
181 150
182sub view_head1 { 151sub view_head1 {
183 "<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n" 152 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
184 . $_[1]->content->present ($_[0]) 153 . $_[1]->content->present ($_[0])
185}; 154};
186 155
187sub view_head2 { 156sub view_head2 {
188 "<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n" 157 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
158 . $_[1]->content->present ($_[0])
159};
160
161sub view_head3 {
162 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
189 . $_[1]->content->present ($_[0]) 163 . $_[1]->content->present ($_[0])
190}; 164};
191 165
192sub view_over { 166sub view_over {
193 local $indent = $indent + $_[1]->indent; 167 local $indent = $indent + $_[1]->indent;
214 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 188 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
215 189
216 $db->db_put ($key => $data) 190 $db->db_put ($key => $data)
217} 191}
218 192
219package CFClient::Texture; 193package CFClient::Item;
220 194
221use strict; 195use strict;
196use Crossfire::Protocol::Constants;
222 197
223use Scalar::Util; 198sub desc_string {
224
225use CFClient::OpenGL;
226
227my %TEXTURES;
228
229sub new {
230 my ($class, %data) = @_;
231
232 my $self = bless {
233 internalformat => GL_RGBA,
234 format => GL_RGBA,
235 type => GL_UNSIGNED_BYTE,
236 %data,
237 }, $class;
238
239 Scalar::Util::weaken ($TEXTURES{$self+0} = $self);
240
241 $self->upload;
242
243 $self
244}
245
246sub new_from_image {
247 my ($class, $image, %arg) = @_;
248
249 $class->new (image => $image, %arg)
250}
251
252sub new_from_file {
253 my ($class, $path, %arg) = @_;
254
255 open my $fh, "<:raw", $path
256 or die "$path: $!";
257
258 local $/;
259 $class->new_from_image (<$fh>, %arg)
260}
261
262#sub new_from_surface {
263# my ($class, $surface) = @_;
264#
265# $surface->rgba;
266#
267# $class->new (
268# data => $surface->pixels,
269# w => $surface->width,
270# h => $surface->height,
271# )
272#}
273
274sub new_from_layout {
275 my ($class, $layout, %arg) = @_;
276
277 my ($w, $h, $data, $format, $internalformat) = $layout->render;
278
279 $class->new (
280 w => $w,
281 h => $h,
282 data => $data,
283 format => $format,
284 internalformat => $format,
285 type => GL_UNSIGNED_BYTE,
286 %arg,
287 )
288}
289
290sub new_from_opengl {
291 my ($class, $w, $h, $cb) = @_;
292
293 $class->new (w => $w || 1, h => $h || 1, render_cb => $cb)
294}
295
296sub topot {
297 (grep $_ >= $_[0], 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768)[0]
298}
299
300sub upload {
301 my ($self) = @_; 199 my ($self) = @_;
302 200
303 return unless $GL_VERSION; 201 my $desc =
202 $self->{nrof} < 2
203 ? $self->{name}
204 : "$self->{nrof} × $self->{name_pl}";
304 205
305 my $data; 206 $self->{flags} & F_OPEN
207 and $desc .= " (open)";
208 $self->{flags} & F_APPLIED
209 and $desc .= " (applied)";
210 $self->{flags} & F_UNPAID
211 and $desc .= " (unpaid)";
212 $self->{flags} & F_MAGIC
213 and $desc .= " (magic)";
214 $self->{flags} & F_CURSED
215 and $desc .= " (cursed)";
216 $self->{flags} & F_DAMNED
217 and $desc .= " (damned)";
218 $self->{flags} & F_LOCKED
219 and $desc .= " *";
306 220
307 if (exists $self->{data}) { 221 $desc
308 $data = $self->{data}; 222}
309 223
310 } elsif (exists $self->{render_cb}) { 224sub weight_string {
311 glViewport 0, 0, $self->{w}, $self->{h}; 225 my ($self) = @_;
312 glMatrixMode GL_PROJECTION;
313 glLoadIdentity;
314 glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000;
315 glMatrixMode GL_MODELVIEW;
316 glLoadIdentity;
317 $self->{render_cb}->($self, $self->{w}, $self->{h});
318 226
319 } else { 227 my $weight = ($self->{nrof} || 1) * $self->{weight};
320 ($self->{w}, $self->{h}, $data, $self->{internalformat}, $self->{format}, $self->{type}) 228
321 = CFClient::load_image_inline $self->{image}; 229 $weight < 0 ? "?" : $weight * 0.001
230}
231
232sub update_widgets {
233 my ($self) = @_;
234
235 my $button_cb = sub {
236 my (undef, $ev, $x, $y) = @_;
237
238 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
239 my $targ = $::CONN->{player}{tag};
240
241 if ($self->{container} == $::CONN->{player}{tag}) {
242 $targ = $::CONN->{open_container};
243 }
244
245 $::CONN->send ("move $targ $self->{tag} 0");
246 } elsif ($ev->{button} == 1) {
247 $::CONN->send ("examine $self->{tag}");
248 } elsif ($ev->{button} == 2) {
249 $::CONN->send ("apply $self->{tag}");
250 } elsif ($ev->{button} == 3) {
251 my @menu_items = (
252 ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
253 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
254 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
255 (
256 $self->{flags} & F_LOCKED
257 ? (
258 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
259 )
260 : (
261 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
262 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],
263 )
264 ),
265 );
266
267 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
268 }
269
270 1
271 };
272
273 my $tooltip_std = "<small>"
274 . "Left click - examine item\n"
275 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
276 . "Middle click - apply\n"
277 . "Right click - further options"
278 . "</small>\n";
279
280 $self->{face_widget} ||= new CFClient::UI::Face
281 can_events => 1,
282 can_hover => 1,
283 anim => $self->{anim},
284 animspeed => $self->{animspeed}, # TODO# must be set at creation time
285 on_button_down => $button_cb,
286 ;
287 $self->{face_widget}{face} = $self->{face};
288 $self->{face_widget}{anim} = $self->{anim};
289 $self->{face_widget}{animspeed} = $self->{animspeed};
290 $self->{face_widget}->set_tooltip (
291 "<b>Face/Animation.</b>\n"
292 . "Item uses face #$self->{face}. "
293 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
294 . "\n\n$tooltip_std"
295 );
296
297 $self->{desc_widget} ||= new CFClient::UI::Label
298 can_events => 1,
299 can_hover => 1,
300 ellipsise => 2,
301 align => -1,
302 on_button_down => $button_cb,
303 ;
304 my $desc = CFClient::Item::desc_string $self;
305 $self->{desc_widget}->set_text ($desc);
306 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
307
308 $self->{weight_widget} ||= new CFClient::UI::Label
309 can_events => 1,
310 can_hover => 1,
311 ellipsise => 0,
312 align => 0,
313 on_button_down => $button_cb,
314 ;
315 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
316
317 $self->{weight_widget}->set_tooltip (
318 "<b>Weight</b>.\n"
319 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
320 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
321 . "\n\n$tooltip_std"
322 );
323}
324
325package CFClient::Recorder;
326
327our $RECORD_WINDOW;
328
329my $CMDBOX;
330my $CURRENT_CMDS;
331my $REC_BTN;
332
333my @ALLOWED_MODIFIER_KEYS = (
334 (CFClient::SDLK_LSHIFT) => "LSHIFT",
335 (CFClient::SDLK_LCTRL ) => "LCTRL",
336 (CFClient::SDLK_LALT ) => "LALT",
337 (CFClient::SDLK_LMETA ) => "LMETA",
338
339 (CFClient::SDLK_RSHIFT) => "RSHIFT",
340 (CFClient::SDLK_RCTRL ) => "RCTRL",
341 (CFClient::SDLK_RALT ) => "RALT",
342 (CFClient::SDLK_RMETA ) => "RMETA",
343);
344
345my %ALLOWED_MODIFIERS = (
346 (CFClient::KMOD_LSHIFT) => "LSHIFT",
347 (CFClient::KMOD_LCTRL ) => "LCTRL",
348 (CFClient::KMOD_LALT ) => "LALT",
349 (CFClient::KMOD_LMETA ) => "LMETA",
350
351 (CFClient::KMOD_RSHIFT) => "RSHIFT",
352 (CFClient::KMOD_RCTRL ) => "RCTRL",
353 (CFClient::KMOD_RALT ) => "RALT",
354 (CFClient::KMOD_RMETA ) => "RMETA",
355);
356
357my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
358my @DIRECT_BIND_KEYS = (
359 CFClient::SDLK_F1,
360 CFClient::SDLK_F2,
361 CFClient::SDLK_F3,
362 CFClient::SDLK_F4,
363 CFClient::SDLK_F5,
364 CFClient::SDLK_F6,
365 CFClient::SDLK_F7,
366 CFClient::SDLK_F8,
367 CFClient::SDLK_F9,
368 CFClient::SDLK_F10,
369 CFClient::SDLK_F11,
370 CFClient::SDLK_F12,
371 CFClient::SDLK_F13,
372 CFClient::SDLK_F14,
373 CFClient::SDLK_F15,
374);
375
376# this binding dialog asks for a key-combo to be pressed
377# and if successful it binds the modifier+symbol to the
378# supplied actions in $cmd.
379# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
380sub open_binding_dialog {
381 my ($cmd) = @_;
382
383 my $w = new CFClient::UI::FancyFrame
384 title => "Bind Action";
385
386 $w->add (my $vb = new CFClient::UI::VBox);
387 $vb->add (new CFClient::UI::Label
388 text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
389 ."You can only bind 0-9 and F1-F15 without modifiers."
390 );
391 $vb->add (my $entry = new CFClient::UI::Entry
392 text => "",
393 on_key_down => sub {
394 my ($entry, $ev) = @_;
395
396 my $mod = $ev->{mod};
397 my $sym = $ev->{sym};
398
399 # XXX: This seems a little bit hackisch to me, but i have to ignore them
400 if (grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS) {
401 return;
402 }
403
404 if ($mod == CFClient::KMOD_NONE
405 and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
406 and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
407 {
408 $::STATUSBOX->add (
409 "Can't bind key ".CFClient::SDL_GetKeyName ($sym)
410 ." directly without modifier! It would damage the completer handling."
411 );
412 return;
413 }
414
415 $entry->focus_out;
416
417 $::CFG->{bindings}->{$mod}->{$sym} = $cmd;
418 $::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
419
420 $w->destroy
421 });
422
423 $entry->focus_in;
424 $w->center;
425 $w->show;
426}
427
428sub keycombo_to_name {
429 my ($mod, $sym) = @_;
430
431 my $mods = join '+',
432 map { $ALLOWED_MODIFIERS{$_} }
433 grep { $_ & $mod }
434 keys %ALLOWED_MODIFIERS;
435 $mods .= "+" if $mods ne '';
436
437 return $mods . CFClient::SDL_GetKeyName ($sym);
438}
439
440sub clear_command_list {
441 $CMDBOX->clear () if $CMDBOX;
442}
443
444sub set_command_list {
445 my ($list) = @_;
446
447 return unless $CMDBOX;
448
449 $CMDBOX->clear ();
450 $CURRENT_CMDS = $list;
451
452 my $idx = 0;
453
454 for (@$list) {
455 $CMDBOX->add (my $hb = new CFClient::UI::HBox);
456
457 my $i = $idx;
458 $hb->add (new CFClient::UI::Button
459 text => "delete",
460 tooltip => "Deletes the action from the record",
461 on_activate => sub {
462 $CMDBOX->remove ($hb);
463 $list->[$i] = undef;
464 });
465
466 $hb->add (new CFClient::UI::Label text => $_);
467
468 $idx++
322 } 469 }
470}
323 471
324 my ($tw, $th) = @$self{qw(w h)}; 472# if $show is 1 the recorder will be shown
473sub start {
474 my ($show) = @_;
325 475
326 unless ($tw > 0 && $th > 0) { 476 $RECORD_WINDOW->show if $show;
327 $tw = $th = 1; 477
328 $data = "\x00" x 64; 478 $REC_BTN->set_text ("stop recording");
479 $REC_BTN->{recording} = 1;
480 clear_command_list;
481 $::CONN->start_record;
482}
483
484# if $autobind is 1 the recorder will be automatically
485# jump into the binding query and hide the recorder window
486sub stop {
487 my ($autobind) = @_;
488
489 $REC_BTN->set_text ("start recording");
490 $REC_BTN->{recording} = 0;
491
492 my $rec = $::CONN->stop_record;
493 return unless ref $rec eq 'ARRAY';
494 set_command_list ($rec);
495
496 if ($autobind) {
497 open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
498 $RECORD_WINDOW->hide;
329 } 499 }
500}
330 501
331 $self->{minified} = [CFClient::average $tw, $th, $data] 502sub make_window {
332 if $self->{minify}; 503 $RECORD_WINDOW = new CFClient::UI::FancyFrame
504 req_y => 1,
505 req_x => -1,
506 title => "Action Recorder";
333 507
334 unless ($GL_NPOT) { 508 $RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
335 # TODO: does not work for zero-sized textures 509 $vb->add ($REC_BTN = new CFClient::UI::Button
336 $tw = topot $tw; 510 text => "start recording",
337 $th = topot $th; 511 tooltip => "Start/Stops recording of actions."
512 ."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)"
513 ."All subsequent actions after the recording started will be captured."
514 ."The actions are displayed after the record was stopped."
515 ."To bind the action you have to click on the 'Bind' button",
516 on_activate => sub {
517 my ($btn) = @_;
338 518
339 if (($tw != $self->{w} || $th != $self->{h}) && defined $data) { 519 unless ($btn->{recording}) {
340 my $bpp = (length $data) / ($self->{w} * $self->{h}); 520 start;
341 $data = pack "(a" . ($tw * $bpp) . ")*", 521 } else {
342 unpack "(a" . ($self->{w} * $bpp) . ")*", $data; 522 stop;
343 $data .= ("\x00" x ($tw * $bpp)) x ($th - $self->{h}); 523 }
344 } 524 });
345 } 525 $vb->add ($CMDBOX = new CFClient::UI::VBox);
526 $vb->add (new CFClient::UI::Button
527 text => "bind",
528 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
529 on_activate => sub {
530 open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
531 });
346 532
347 $self->{s} = $self->{w} / $tw; 533 $RECORD_WINDOW
348 $self->{t} = $self->{h} / $th;
349
350 $self->{name} ||= glGenTexture;
351
352 glBindTexture GL_TEXTURE_2D, $self->{name};
353
354 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP;
355 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP;
356
357 if ($::FAST) {
358 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST;
359 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;
360 } elsif ($self->{mipmap} && $GL_VERSION >= 1.4) {
361 # alternatively check for 0x8191
362 glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1;
363 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
364 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
365 } else {
366 glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap};
367 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
368 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;
369 }
370
371 glGetError;
372
373 if (defined $data) {
374 glTexImage2D GL_TEXTURE_2D, 0,
375 $self->{internalformat},
376 $tw, $th,
377 0,
378 $self->{format},
379 $self->{type},
380 $data;
381 CFClient::gl_check "uploading texture %dx%d if=%x f=%x t=%x",
382 $tw, $th, $self->{internalformat}, $self->{format}, $self->{type};
383 } else {
384 glCopyTexImage2D GL_TEXTURE_2D, 0,
385 $self->{internalformat},
386 0, 0,
387 $tw, $th,
388 0;
389 CFClient::gl_check "copying to texture %dx%d if=%x",
390 $tw, $th, $self->{internalformat};
391 }
392
393 glBindTexture GL_TEXTURE_2D, 0; # just to be on the safe side
394}
395
396sub DESTROY {
397 my ($self) = @_;
398
399 delete $TEXTURES{$self+0};
400
401 glDeleteTexture delete $self->{name}
402 if $self->{name};
403}
404
405sub restore_state {
406 $_->upload
407 for values %TEXTURES;
408} 534}
409 535
4101; 5361;
411 537
412=back 538=back

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines