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.76 by root, Mon May 29 21:20:15 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
73mkdir "$Crossfire::VARDIR/cfplus", 0777; 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;
74 90
75{ 91{
76 use strict; 92 use strict;
77 93
94 mkdir "$Crossfire::VARDIR/cfplus", 0777;
95 my $recover = $BerkeleyDB::db_version >= 4.4
96 ? eval "DB_REGISTER | DB_RECOVER"
97 : 0;
98
78 our $DB_ENV = new BerkeleyDB::Env 99 $DB_ENV = new BerkeleyDB::Env
79 -Home => "$Crossfire::VARDIR/cfplus", 100 -Home => "$Crossfire::VARDIR/cfplus",
80 -Cachesize => 1_000_000, 101 -Cachesize => 1_000_000,
81 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 102 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
82# -ErrPrefix => "DATABASE", 103# -ErrPrefix => "DATABASE",
83 -Verbose => 1, 104 -Verbose => 1,
84 -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,
85 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE | DB_TXN_WRITE_NOSYNC, 106 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
86 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";
87} 108}
88 109
89sub db_table($) { 110sub db_table($) {
90 my ($table) = @_; 111 my ($table) = @_;
… …
197 218
198package CFClient::Item; 219package CFClient::Item;
199 220
200use strict; 221use strict;
201use Crossfire::Protocol::Constants; 222use Crossfire::Protocol::Constants;
223
224my $last_enter_count = 1;
202 225
203sub desc_string { 226sub desc_string {
204 my ($self) = @_; 227 my ($self) = @_;
205 228
206 my $desc = 229 my $desc =
… …
232 my $weight = ($self->{nrof} || 1) * $self->{weight}; 255 my $weight = ($self->{nrof} || 1) * $self->{weight};
233 256
234 $weight < 0 ? "?" : $weight * 0.001 257 $weight < 0 ? "?" : $weight * 0.001
235} 258}
236 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
237sub update_widgets { 281sub update_widgets {
238 my ($self) = @_; 282 my ($self) = @_;
239 283
240 my $button_cb = sub { 284 my $button_cb = sub {
241 my (undef, $ev, $x, $y) = @_; 285 my (undef, $ev, $x, $y) = @_;
242 286
287 my $targ = $::CONN->{player}{tag};
288
289 if ($self->{container} == $::CONN->{player}{tag}) {
290 $targ = $::CONN->{open_container};
291 }
292
243 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { 293 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
244 my $targ = $::CONN->{player}{tag};
245
246 if ($self->{container} == $::CONN->{player}{tag}) {
247 $targ = $::CONN->{open_container};
248 }
249
250 $::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})
251 } elsif ($ev->{button} == 1) { 300 } elsif ($ev->{button} == 1) {
252 $::CONN->send ("examine $self->{tag}"); 301 $::CONN->send ("examine $self->{tag}");
253 } elsif ($ev->{button} == 2) { 302 } elsif ($ev->{button} == 2) {
254 $::CONN->send ("apply $self->{tag}"); 303 $::CONN->send ("apply $self->{tag}");
255 } elsif ($ev->{button} == 3) { 304 } elsif ($ev->{button} == 3) {
… …
263 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], 312 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
264 ) 313 )
265 : ( 314 : (
266 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], 315 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
267 ["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 ]
268 ) 322 )
269 ), 323 ),
270 ); 324 );
271 325
272 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 326 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
… …
277 331
278 my $tooltip_std = "<small>" 332 my $tooltip_std = "<small>"
279 . "Left click - examine item\n" 333 . "Left click - examine item\n"
280 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" 334 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
281 . "Middle click - apply\n" 335 . "Middle click - apply\n"
336 . "Shift-Middle click - lock/unlock\n"
282 . "Right click - further options" 337 . "Right click - further options"
283 . "</small>\n"; 338 . "</small>\n";
284 339
285 $self->{face_widget} ||= new CFClient::UI::Face 340 $self->{face_widget} ||= new CFClient::UI::Face
286 can_events => 1, 341 can_events => 1,
… …
325 . ($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. ")
326 . "\n\n$tooltip_std" 381 . "\n\n$tooltip_std"
327 ); 382 );
328} 383}
329 384
330package CFClient::Recorder; 385package CFClient::Binder;
331
332our $RECORD_WINDOW;
333
334my $CMDBOX;
335my $CURRENT_CMDS;
336my $REC_BTN;
337 386
338my @ALLOWED_MODIFIER_KEYS = ( 387my @ALLOWED_MODIFIER_KEYS = (
339 (CFClient::SDLK_LSHIFT) => "LSHIFT", 388 CFClient::SDLK_LSHIFT,
340 (CFClient::SDLK_LCTRL ) => "LCTRL", 389 CFClient::SDLK_LCTRL ,
341 (CFClient::SDLK_LALT ) => "LALT", 390 CFClient::SDLK_LALT ,
342 (CFClient::SDLK_LMETA ) => "LMETA", 391 CFClient::SDLK_LMETA ,
343 392
344 (CFClient::SDLK_RSHIFT) => "RSHIFT", 393 CFClient::SDLK_RSHIFT,
345 (CFClient::SDLK_RCTRL ) => "RCTRL", 394 CFClient::SDLK_RCTRL ,
346 (CFClient::SDLK_RALT ) => "RALT", 395 CFClient::SDLK_RALT ,
347 (CFClient::SDLK_RMETA ) => "RMETA", 396 CFClient::SDLK_RMETA ,
348); 397);
349 398
350my %ALLOWED_MODIFIERS = ( 399my %ALLOWED_MODIFIERS = (
351 (CFClient::KMOD_LSHIFT) => "LSHIFT", 400 CFClient::KMOD_LSHIFT => "LSHIFT",
352 (CFClient::KMOD_LCTRL ) => "LCTRL", 401 CFClient::KMOD_LCTRL => "LCTRL",
353 (CFClient::KMOD_LALT ) => "LALT", 402 CFClient::KMOD_LALT => "LALT",
354 (CFClient::KMOD_LMETA ) => "LMETA", 403 CFClient::KMOD_LMETA => "LMETA",
355 404
356 (CFClient::KMOD_RSHIFT) => "RSHIFT", 405 CFClient::KMOD_RSHIFT => "RSHIFT",
357 (CFClient::KMOD_RCTRL ) => "RCTRL", 406 CFClient::KMOD_RCTRL => "RCTRL",
358 (CFClient::KMOD_RALT ) => "RALT", 407 CFClient::KMOD_RALT => "RALT",
359 (CFClient::KMOD_RMETA ) => "RMETA", 408 CFClient::KMOD_RMETA => "RMETA",
360); 409);
361 410
362my %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/;
363my @DIRECT_BIND_KEYS = ( 412my @DIRECT_BIND_KEYS = (
364 CFClient::SDLK_F1, 413 CFClient::SDLK_F1,
… …
377 CFClient::SDLK_F14, 426 CFClient::SDLK_F14,
378 CFClient::SDLK_F15, 427 CFClient::SDLK_F15,
379); 428);
380 429
381# this binding dialog asks for a key-combo to be pressed 430# this binding dialog asks for a key-combo to be pressed
382# and if successful it binds the modifier+symbol to the 431# and if successful it calls the $cb with $mod and $sym as args.
383# supplied actions in $cmd.
384# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
385sub open_binding_dialog { 432sub open_binding_dialog {
386 my ($cmd) = @_; 433 my ($cb) = @_;
387 434
388 my $w = new CFClient::UI::FancyFrame 435 my $w = new CFClient::UI::FancyFrame
389 title => "Bind Action"; 436 title => "Bind Action",
437 x => "center",
438 y => "center";
390 439
391 $w->add (my $vb = new CFClient::UI::VBox); 440 $w->add (my $vb = new CFClient::UI::VBox);
392 $vb->add (new CFClient::UI::Label 441 $vb->add (new CFClient::UI::Label
393 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."
394 ."You can only bind 0-9 and F1-F15 without modifiers." 443 ."You can only bind 0-9 and F1-F15 without modifiers."
… …
417 return; 466 return;
418 } 467 }
419 468
420 $entry->focus_out; 469 $entry->focus_out;
421 470
422 $::CFG->{bindings}->{$mod}->{$sym} = $cmd; 471 $cb->($mod, $sym);
423 $::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
424 472
425 $w->destroy 473 $w->destroy
426 }); 474 });
427 475
428 $entry->focus_in; 476 $entry->focus_in;
429 $w->center;
430 $w->show; 477 $w->show;
431} 478}
432 479
433sub keycombo_to_name { 480sub keycombo_to_name {
434 my ($mod, $sym) = @_; 481 my ($mod, $sym) = @_;
435 482
436 my $mods = join '+', 483 my $mods = join '+',
437 map { $ALLOWED_MODIFIERS{$_} } 484 map { $ALLOWED_MODIFIERS{$_} }
438 grep { $_ & $mod } 485 grep { ($_ + 0) & ($mod + 0) }
439 keys %ALLOWED_MODIFIERS; 486 keys %ALLOWED_MODIFIERS;
440 $mods .= "+" if $mods ne ''; 487 $mods .= "+" if $mods ne '';
441 488
442 return $mods . CFClient::SDL_GetKeyName ($sym); 489 return $mods . CFClient::SDL_GetKeyName ($sym);
443} 490}
444 491
445sub clear_command_list { 492package CFClient::Pickup;
446 $CMDBOX->clear () if $CMDBOX; 493# some pickup constants
447} 494sub PU_NOTHING { 0x00000000 }
448 495
449sub set_command_list { 496sub PU_DEBUG { 0x10000000 }
450 my ($list) = @_; 497sub PU_INHIBIT { 0x20000000 }
498sub PU_STOP { 0x40000000 }
499sub PU_NEWMODE { 0x80000000 }
451 500
452 return unless $CMDBOX; 501sub PU_RATIO { 0x0000000F }
453 502
454 $CMDBOX->clear (); 503sub PU_FOOD { 0x00000010 }
455 $CURRENT_CMDS = $list; 504sub PU_DRINK { 0x00000020 }
505sub PU_VALUABLES { 0x00000040 }
506sub PU_BOW { 0x00000080 }
456 507
457 my $idx = 0; 508sub PU_ARROW { 0x00000100 }
509sub PU_HELMET { 0x00000200 }
510sub PU_SHIELD { 0x00000400 }
511sub PU_ARMOUR { 0x00000800 }
458 512
459 for (@$list) { 513sub PU_BOOTS { 0x00001000 }
460 $CMDBOX->add (my $hb = new CFClient::UI::HBox); 514sub PU_GLOVES { 0x00002000 }
515sub PU_CLOAK { 0x00004000 }
516sub PU_KEY { 0x00008000 }
461 517
462 my $i = $idx; 518sub PU_MISSILEWEAPON { 0x00010000 }
463 $hb->add (new CFClient::UI::Button 519sub PU_ALLWEAPON { 0x00020000 }
464 text => "delete", 520sub PU_MAGICAL { 0x00040000 }
465 tooltip => "Deletes the action from the record", 521sub PU_POTION { 0x00080000 }
466 on_activate => sub {
467 $CMDBOX->remove ($hb);
468 $list->[$i] = undef;
469 });
470 522
471 $hb->add (new CFClient::UI::Label text => $_); 523sub PU_SPELLBOOK { 0x00100000 }
524sub PU_SKILLSCROLL { 0x00200000 }
525sub PU_READABLES { 0x00400000 }
526sub PU_MAGIC_DEVICE { 0x00800000 }
472 527
473 $idx++ 528sub PU_NOT_CURSED { 0x01000000 }
474 }
475}
476 529
477# if $show is 1 the recorder will be shown 530sub PU_JEWELS { 0x02000000 }
478sub start {
479 my ($show) = @_;
480 531
481 $RECORD_WINDOW->show if $show;
482
483 $REC_BTN->set_text ("stop recording");
484 $REC_BTN->{recording} = 1;
485 clear_command_list;
486 $::CONN->start_record;
487}
488
489# if $autobind is 1 the recorder will be automatically
490# jump into the binding query and hide the recorder window
491sub stop {
492 my ($autobind) = @_;
493
494 $REC_BTN->set_text ("start recording");
495 $REC_BTN->{recording} = 0;
496
497 my $rec = $::CONN->stop_record;
498 return unless ref $rec eq 'ARRAY';
499 set_command_list ($rec);
500
501 if ($autobind) {
502 open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
503 $RECORD_WINDOW->hide;
504 }
505}
506
507sub make_window {
508 $RECORD_WINDOW = new CFClient::UI::FancyFrame
509 req_y => 1,
510 req_x => -1,
511 title => "Action Recorder";
512
513 $RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
514 $vb->add ($REC_BTN = new CFClient::UI::Button
515 text => "start recording",
516 tooltip => "Start/Stops recording of actions."
517 ."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)"
518 ."All subsequent actions after the recording started will be captured."
519 ."The actions are displayed after the record was stopped."
520 ."To bind the action you have to click on the 'Bind' button",
521 on_activate => sub {
522 my ($btn) = @_;
523
524 unless ($btn->{recording}) {
525 start;
526 } else {
527 stop;
528 }
529 });
530 $vb->add ($CMDBOX = new CFClient::UI::VBox);
531 $vb->add (new CFClient::UI::Button
532 text => "bind",
533 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
534 on_activate => sub {
535 open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
536 });
537
538 $RECORD_WINDOW
539}
540 532
5411; 5331;
542 534
543=back 535=back
544 536

Diff Legend

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