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

Diff Legend

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