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

Diff Legend

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