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.75 by root, Mon May 29 21:10:47 2006 UTC vs.
Revision 1.88 by root, Mon Jun 5 05:31:13 2006 UTC

… …
24use utf8; 24use utf8;
25 25
26use Carp (); 26use Carp ();
27use AnyEvent (); 27use AnyEvent ();
28use BerkeleyDB; 28use BerkeleyDB;
29use Pod::POM;
29 30
30sub find_rcfile($) { 31sub find_rcfile($) {
31 my $path; 32 my $path;
32 33
33 for (grep !ref, @INC) { 34 for (grep !ref, @INC) {
… …
68 } 69 }
69 70
70 close CFG; 71 close CFG;
71} 72}
72 73
74my %POD_CACHE;
75
76sub load_pod($) {
77 $POD_CACHE{$_[0]} ||= do {
78 my $pod = do {
79 local $/;
80 open my $pod, "<:utf8", $_[0]
81 or die "$_[0]: $!";
82 <$pod>
83 };
84
85 Pod::POM->new->parse_text ($pod)
86 }
87}
88
89our $DB_ENV;
90
91{
92 use strict;
93
73mkdir "$Crossfire::VARDIR/cfplus", 0777; 94 mkdir "$Crossfire::VARDIR/cfplus", 0777;
95 my $recover = $BerkeleyDB::db_version >= 4.4
96 ? eval "DB_REGISTER | DB_RECOVER"
97 : 0;
74 98
75our $DB_ENV = new BerkeleyDB::Env 99 $DB_ENV = new BerkeleyDB::Env
76 -Home => "$Crossfire::VARDIR/cfplus", 100 -Home => "$Crossfire::VARDIR/cfplus",
77 -Cachesize => 1_000_000, 101 -Cachesize => 1_000_000,
78 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 102 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
79# -ErrPrefix => "DATABASE", 103# -ErrPrefix => "DATABASE",
80 -Verbose => 1, 104 -Verbose => 1,
81 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN, 105 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
106 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
82 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 107 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
108}
83 109
84sub db_table($) { 110sub db_table($) {
85 my ($table) = @_; 111 my ($table) = @_;
86 112
87 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; 113 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
88 114
89 new CFClient::Database 115 new CFClient::Database
90 -Env => $DB_ENV, 116 -Env => $DB_ENV,
91 -Filename => $table, 117 -Filename => $table,
92# -Filename => "database", 118# -Filename => "database",
93# -Subname => $table, 119# -Subname => $table,
94 -Property => DB_CHKSUM, 120 -Property => DB_CHKSUM,
95 -Flags => DB_CREATE | DB_UPGRADE, 121 -Flags => DB_CREATE | DB_UPGRADE,
96 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"; 122 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
97} 123}
98 124
99sub pod_to_pango($) { 125sub pod_to_pango($) {
100 my ($pom) = @_; 126 my ($pom) = @_;
101 127
… …
192 218
193package CFClient::Item; 219package CFClient::Item;
194 220
195use strict; 221use strict;
196use Crossfire::Protocol::Constants; 222use Crossfire::Protocol::Constants;
223
224my $last_enter_count = 1;
197 225
198sub desc_string { 226sub desc_string {
199 my ($self) = @_; 227 my ($self) = @_;
200 228
201 my $desc = 229 my $desc =
… …
227 my $weight = ($self->{nrof} || 1) * $self->{weight}; 255 my $weight = ($self->{nrof} || 1) * $self->{weight};
228 256
229 $weight < 0 ? "?" : $weight * 0.001 257 $weight < 0 ? "?" : $weight * 0.001
230} 258}
231 259
260sub do_n_dialog {
261 my ($cb) = @_;
262
263 my $w = new CFClient::UI::FancyFrame;
264 $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
265 $vb->add (new CFClient::UI::Label text => "Enter item count:");
266 $vb->add (my $entry = new CFClient::UI::Entry
267 text => $last_enter_count,
268 on_activate => sub {
269 my ($entry) = @_;
270 $last_enter_count = $entry->get_text;
271 $cb->($last_enter_count);
272 $w->hide;
273 $w = undef;
274 }
275 );
276 $entry->focus_in;
277 $w->show;
278
279}
280
232sub update_widgets { 281sub update_widgets {
233 my ($self) = @_; 282 my ($self) = @_;
234 283
235 my $button_cb = sub { 284 my $button_cb = sub {
236 my (undef, $ev, $x, $y) = @_; 285 my (undef, $ev, $x, $y) = @_;
237 286
287 my $targ = $::CONN->{player}{tag};
288
289 if ($self->{container} == $::CONN->{player}{tag}) {
290 $targ = $::CONN->{open_container};
291 }
292
238 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { 293 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"); 294 $::CONN->send ("move $targ $self->{tag} 0")
295 if $targ || !($self->{flags} & F_LOCKED);
296 } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
297 $self->{flags} & F_LOCKED
298 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
299 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
246 } elsif ($ev->{button} == 1) { 300 } elsif ($ev->{button} == 1) {
247 $::CONN->send ("examine $self->{tag}"); 301 $::CONN->send ("examine $self->{tag}");
248 } elsif ($ev->{button} == 2) { 302 } elsif ($ev->{button} == 2) {
249 $::CONN->send ("apply $self->{tag}"); 303 $::CONN->send ("apply $self->{tag}");
250 } elsif ($ev->{button} == 3) { 304 } elsif ($ev->{button} == 3) {
… …
258 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], 312 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
259 ) 313 )
260 : ( 314 : (
261 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], 315 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
262 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }], 316 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],
317 ["move n",
318 sub {
319 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
320 }
321 ]
263 ) 322 )
264 ), 323 ),
265 ); 324 );
266 325
267 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 326 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
… …
272 331
273 my $tooltip_std = "<small>" 332 my $tooltip_std = "<small>"
274 . "Left click - examine item\n" 333 . "Left click - examine item\n"
275 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" 334 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
276 . "Middle click - apply\n" 335 . "Middle click - apply\n"
336 . "Shift-Middle click - lock/unlock\n"
277 . "Right click - further options" 337 . "Right click - further options"
278 . "</small>\n"; 338 . "</small>\n";
279 339
280 $self->{face_widget} ||= new CFClient::UI::Face 340 $self->{face_widget} ||= new CFClient::UI::Face
281 can_events => 1, 341 can_events => 1,
… …
320 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") 380 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
321 . "\n\n$tooltip_std" 381 . "\n\n$tooltip_std"
322 ); 382 );
323} 383}
324 384
325package CFClient::Recorder; 385package CFClient::Binder;
326
327our $RECORD_WINDOW;
328
329my $CMDBOX;
330my $CURRENT_CMDS;
331my $REC_BTN;
332 386
333my @ALLOWED_MODIFIER_KEYS = ( 387my @ALLOWED_MODIFIER_KEYS = (
334 (CFClient::SDLK_LSHIFT) => "LSHIFT", 388 CFClient::SDLK_LSHIFT,
335 (CFClient::SDLK_LCTRL ) => "LCTRL", 389 CFClient::SDLK_LCTRL ,
336 (CFClient::SDLK_LALT ) => "LALT", 390 CFClient::SDLK_LALT ,
337 (CFClient::SDLK_LMETA ) => "LMETA", 391 CFClient::SDLK_LMETA ,
338 392
339 (CFClient::SDLK_RSHIFT) => "RSHIFT", 393 CFClient::SDLK_RSHIFT,
340 (CFClient::SDLK_RCTRL ) => "RCTRL", 394 CFClient::SDLK_RCTRL ,
341 (CFClient::SDLK_RALT ) => "RALT", 395 CFClient::SDLK_RALT ,
342 (CFClient::SDLK_RMETA ) => "RMETA", 396 CFClient::SDLK_RMETA ,
343); 397);
344 398
345my %ALLOWED_MODIFIERS = ( 399my %ALLOWED_MODIFIERS = (
346 (CFClient::KMOD_LSHIFT) => "LSHIFT", 400 CFClient::KMOD_LSHIFT => "LSHIFT",
347 (CFClient::KMOD_LCTRL ) => "LCTRL", 401 CFClient::KMOD_LCTRL => "LCTRL",
348 (CFClient::KMOD_LALT ) => "LALT", 402 CFClient::KMOD_LALT => "LALT",
349 (CFClient::KMOD_LMETA ) => "LMETA", 403 CFClient::KMOD_LMETA => "LMETA",
350 404
351 (CFClient::KMOD_RSHIFT) => "RSHIFT", 405 CFClient::KMOD_RSHIFT => "RSHIFT",
352 (CFClient::KMOD_RCTRL ) => "RCTRL", 406 CFClient::KMOD_RCTRL => "RCTRL",
353 (CFClient::KMOD_RALT ) => "RALT", 407 CFClient::KMOD_RALT => "RALT",
354 (CFClient::KMOD_RMETA ) => "RMETA", 408 CFClient::KMOD_RMETA => "RMETA",
355); 409);
356 410
357my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/; 411my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
358my @DIRECT_BIND_KEYS = ( 412my @DIRECT_BIND_KEYS = (
359 CFClient::SDLK_F1, 413 CFClient::SDLK_F1,
… …
372 CFClient::SDLK_F14, 426 CFClient::SDLK_F14,
373 CFClient::SDLK_F15, 427 CFClient::SDLK_F15,
374); 428);
375 429
376# this binding dialog asks for a key-combo to be pressed 430# this binding dialog asks for a key-combo to be pressed
377# and if successful it binds the modifier+symbol to the 431# and if successful it calls the $cb with $mod and $sym as args.
378# supplied actions in $cmd.
379# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
380sub open_binding_dialog { 432sub open_binding_dialog {
381 my ($cmd) = @_; 433 my ($cb) = @_;
382 434
383 my $w = new CFClient::UI::FancyFrame 435 my $w = new CFClient::UI::FancyFrame
384 title => "Bind Action"; 436 title => "Bind Action",
437 x => "center",
438 y => "center";
385 439
386 $w->add (my $vb = new CFClient::UI::VBox); 440 $w->add (my $vb = new CFClient::UI::VBox);
387 $vb->add (new CFClient::UI::Label 441 $vb->add (new CFClient::UI::Label
388 text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key." 442 text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
389 ."You can only bind 0-9 and F1-F15 without modifiers." 443 ."You can only bind 0-9 and F1-F15 without modifiers."
… …
412 return; 466 return;
413 } 467 }
414 468
415 $entry->focus_out; 469 $entry->focus_out;
416 470
417 $::CFG->{bindings}->{$mod}->{$sym} = $cmd; 471 $cb->($mod, $sym);
418 $::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
419 472
420 $w->destroy 473 $w->destroy
421 }); 474 });
422 475
423 $entry->focus_in; 476 $entry->focus_in;
424 $w->center;
425 $w->show; 477 $w->show;
426} 478}
427 479
428sub keycombo_to_name { 480sub keycombo_to_name {
429 my ($mod, $sym) = @_; 481 my ($mod, $sym) = @_;
430 482
431 my $mods = join '+', 483 my $mods = join '+',
432 map { $ALLOWED_MODIFIERS{$_} } 484 map { $ALLOWED_MODIFIERS{$_} }
433 grep { $_ & $mod } 485 grep { ($_ + 0) & ($mod + 0) }
434 keys %ALLOWED_MODIFIERS; 486 keys %ALLOWED_MODIFIERS;
435 $mods .= "+" if $mods ne ''; 487 $mods .= "+" if $mods ne '';
436 488
437 return $mods . CFClient::SDL_GetKeyName ($sym); 489 return $mods . CFClient::SDL_GetKeyName ($sym);
438} 490}
439 491
440sub clear_command_list { 492package CFClient::Pickup;
441 $CMDBOX->clear () if $CMDBOX; 493# some pickup constants
442} 494sub PU_NOTHING { 0x00000000 }
443 495
444sub set_command_list { 496sub PU_DEBUG { 0x10000000 }
445 my ($list) = @_; 497sub PU_INHIBIT { 0x20000000 }
498sub PU_STOP { 0x40000000 }
499sub PU_NEWMODE { 0x80000000 }
446 500
447 return unless $CMDBOX; 501sub PU_RATIO { 0x0000000F }
448 502
449 $CMDBOX->clear (); 503sub PU_FOOD { 0x00000010 }
450 $CURRENT_CMDS = $list; 504sub PU_DRINK { 0x00000020 }
505sub PU_VALUABLES { 0x00000040 }
506sub PU_BOW { 0x00000080 }
451 507
452 my $idx = 0; 508sub PU_ARROW { 0x00000100 }
509sub PU_HELMET { 0x00000200 }
510sub PU_SHIELD { 0x00000400 }
511sub PU_ARMOUR { 0x00000800 }
453 512
454 for (@$list) { 513sub PU_BOOTS { 0x00001000 }
455 $CMDBOX->add (my $hb = new CFClient::UI::HBox); 514sub PU_GLOVES { 0x00002000 }
515sub PU_CLOAK { 0x00004000 }
516sub PU_KEY { 0x00008000 }
456 517
457 my $i = $idx; 518sub PU_MISSILEWEAPON { 0x00010000 }
458 $hb->add (new CFClient::UI::Button 519sub PU_ALLWEAPON { 0x00020000 }
459 text => "delete", 520sub PU_MAGICAL { 0x00040000 }
460 tooltip => "Deletes the action from the record", 521sub PU_POTION { 0x00080000 }
461 on_activate => sub {
462 $CMDBOX->remove ($hb);
463 $list->[$i] = undef;
464 });
465 522
466 $hb->add (new CFClient::UI::Label text => $_); 523sub PU_SPELLBOOK { 0x00100000 }
524sub PU_SKILLSCROLL { 0x00200000 }
525sub PU_READABLES { 0x00400000 }
526sub PU_MAGIC_DEVICE { 0x00800000 }
467 527
468 $idx++ 528sub PU_NOT_CURSED { 0x01000000 }
469 }
470}
471 529
472# if $show is 1 the recorder will be shown 530sub PU_JEWELS { 0x02000000 }
473sub start {
474 my ($show) = @_;
475 531
476 $RECORD_WINDOW->show if $show;
477
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;
499 }
500}
501
502sub make_window {
503 $RECORD_WINDOW = new CFClient::UI::FancyFrame
504 req_y => 1,
505 req_x => -1,
506 title => "Action Recorder";
507
508 $RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
509 $vb->add ($REC_BTN = new CFClient::UI::Button
510 text => "start recording",
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) = @_;
518
519 unless ($btn->{recording}) {
520 start;
521 } else {
522 stop;
523 }
524 });
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 });
532
533 $RECORD_WINDOW
534}
535 532
5361; 5331;
537 534
538=back 535=back
539 536

Diff Legend

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