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

Diff Legend

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