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.79 by root, Tue May 30 02:55:45 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
… …
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")
257 if $targ || !($self->{flags} & F_LOCKED); 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})
258 } elsif ($ev->{button} == 1) { 300 } elsif ($ev->{button} == 1) {
259 $::CONN->send ("examine $self->{tag}"); 301 $::CONN->send ("examine $self->{tag}");
260 } elsif ($ev->{button} == 2) { 302 } elsif ($ev->{button} == 2) {
261 $::CONN->send ("apply $self->{tag}"); 303 $::CONN->send ("apply $self->{tag}");
262 } elsif ($ev->{button} == 3) { 304 } elsif ($ev->{button} == 3) {
… …
270 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], 312 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
271 ) 313 )
272 : ( 314 : (
273 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], 315 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
274 ["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 ]
275 ) 322 )
276 ), 323 ),
277 ); 324 );
278 325
279 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 326 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
… …
284 331
285 my $tooltip_std = "<small>" 332 my $tooltip_std = "<small>"
286 . "Left click - examine item\n" 333 . "Left click - examine item\n"
287 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" 334 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
288 . "Middle click - apply\n" 335 . "Middle click - apply\n"
336 . "Shift-Middle click - lock/unlock\n"
289 . "Right click - further options" 337 . "Right click - further options"
290 . "</small>\n"; 338 . "</small>\n";
291 339
292 $self->{face_widget} ||= new CFClient::UI::Face 340 $self->{face_widget} ||= new CFClient::UI::Face
293 can_events => 1, 341 can_events => 1,
… …
332 . ($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. ")
333 . "\n\n$tooltip_std" 381 . "\n\n$tooltip_std"
334 ); 382 );
335} 383}
336 384
337package CFClient::Recorder; 385package CFClient::Binder;
338
339our $RECORD_WINDOW;
340
341my $CMDBOX;
342my $CURRENT_CMDS;
343my $REC_BTN;
344 386
345my @ALLOWED_MODIFIER_KEYS = ( 387my @ALLOWED_MODIFIER_KEYS = (
346 (CFClient::SDLK_LSHIFT) => "LSHIFT", 388 CFClient::SDLK_LSHIFT,
347 (CFClient::SDLK_LCTRL ) => "LCTRL", 389 CFClient::SDLK_LCTRL ,
348 (CFClient::SDLK_LALT ) => "LALT", 390 CFClient::SDLK_LALT ,
349 (CFClient::SDLK_LMETA ) => "LMETA", 391 CFClient::SDLK_LMETA ,
350 392
351 (CFClient::SDLK_RSHIFT) => "RSHIFT", 393 CFClient::SDLK_RSHIFT,
352 (CFClient::SDLK_RCTRL ) => "RCTRL", 394 CFClient::SDLK_RCTRL ,
353 (CFClient::SDLK_RALT ) => "RALT", 395 CFClient::SDLK_RALT ,
354 (CFClient::SDLK_RMETA ) => "RMETA", 396 CFClient::SDLK_RMETA ,
355); 397);
356 398
357my %ALLOWED_MODIFIERS = ( 399my %ALLOWED_MODIFIERS = (
358 (CFClient::KMOD_LSHIFT) => "LSHIFT", 400 CFClient::KMOD_LSHIFT => "LSHIFT",
359 (CFClient::KMOD_LCTRL ) => "LCTRL", 401 CFClient::KMOD_LCTRL => "LCTRL",
360 (CFClient::KMOD_LALT ) => "LALT", 402 CFClient::KMOD_LALT => "LALT",
361 (CFClient::KMOD_LMETA ) => "LMETA", 403 CFClient::KMOD_LMETA => "LMETA",
362 404
363 (CFClient::KMOD_RSHIFT) => "RSHIFT", 405 CFClient::KMOD_RSHIFT => "RSHIFT",
364 (CFClient::KMOD_RCTRL ) => "RCTRL", 406 CFClient::KMOD_RCTRL => "RCTRL",
365 (CFClient::KMOD_RALT ) => "RALT", 407 CFClient::KMOD_RALT => "RALT",
366 (CFClient::KMOD_RMETA ) => "RMETA", 408 CFClient::KMOD_RMETA => "RMETA",
367); 409);
368 410
369my %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/;
370my @DIRECT_BIND_KEYS = ( 412my @DIRECT_BIND_KEYS = (
371 CFClient::SDLK_F1, 413 CFClient::SDLK_F1,
… …
384 CFClient::SDLK_F14, 426 CFClient::SDLK_F14,
385 CFClient::SDLK_F15, 427 CFClient::SDLK_F15,
386); 428);
387 429
388# this binding dialog asks for a key-combo to be pressed 430# this binding dialog asks for a key-combo to be pressed
389# and if successful it binds the modifier+symbol to the 431# and if successful it calls the $cb with $mod and $sym as args.
390# supplied actions in $cmd.
391# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
392sub open_binding_dialog { 432sub open_binding_dialog {
393 my ($cmd) = @_; 433 my ($cb) = @_;
394 434
395 my $w = new CFClient::UI::FancyFrame 435 my $w = new CFClient::UI::FancyFrame
396 title => "Bind Action"; 436 title => "Bind Action",
437 x => "center",
438 y => "center";
397 439
398 $w->add (my $vb = new CFClient::UI::VBox); 440 $w->add (my $vb = new CFClient::UI::VBox);
399 $vb->add (new CFClient::UI::Label 441 $vb->add (new CFClient::UI::Label
400 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."
401 ."You can only bind 0-9 and F1-F15 without modifiers." 443 ."You can only bind 0-9 and F1-F15 without modifiers."
… …
424 return; 466 return;
425 } 467 }
426 468
427 $entry->focus_out; 469 $entry->focus_out;
428 470
429 $::CFG->{bindings}->{$mod}->{$sym} = $cmd; 471 $cb->($mod, $sym);
430 $::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
431 472
432 $w->destroy 473 $w->destroy
433 }); 474 });
434 475
435 $entry->focus_in; 476 $entry->focus_in;
436 $w->center;
437 $w->show; 477 $w->show;
438} 478}
439 479
440sub keycombo_to_name { 480sub keycombo_to_name {
441 my ($mod, $sym) = @_; 481 my ($mod, $sym) = @_;
442 482
443 my $mods = join '+', 483 my $mods = join '+',
444 map { $ALLOWED_MODIFIERS{$_} } 484 map { $ALLOWED_MODIFIERS{$_} }
445 grep { $_ & $mod } 485 grep { ($_ + 0) & ($mod + 0) }
446 keys %ALLOWED_MODIFIERS; 486 keys %ALLOWED_MODIFIERS;
447 $mods .= "+" if $mods ne ''; 487 $mods .= "+" if $mods ne '';
448 488
449 return $mods . CFClient::SDL_GetKeyName ($sym); 489 return $mods . CFClient::SDL_GetKeyName ($sym);
450} 490}
451 491
452sub clear_command_list { 492package CFClient::Pickup;
453 $CMDBOX->clear () if $CMDBOX; 493# some pickup constants
454} 494sub PU_NOTHING { 0x00000000 }
455 495
456sub set_command_list { 496sub PU_DEBUG { 0x10000000 }
457 my ($list) = @_; 497sub PU_INHIBIT { 0x20000000 }
498sub PU_STOP { 0x40000000 }
499sub PU_NEWMODE { 0x80000000 }
458 500
459 return unless $CMDBOX; 501sub PU_RATIO { 0x0000000F }
460 502
461 $CMDBOX->clear (); 503sub PU_FOOD { 0x00000010 }
462 $CURRENT_CMDS = $list; 504sub PU_DRINK { 0x00000020 }
505sub PU_VALUABLES { 0x00000040 }
506sub PU_BOW { 0x00000080 }
463 507
464 my $idx = 0; 508sub PU_ARROW { 0x00000100 }
509sub PU_HELMET { 0x00000200 }
510sub PU_SHIELD { 0x00000400 }
511sub PU_ARMOUR { 0x00000800 }
465 512
466 for (@$list) { 513sub PU_BOOTS { 0x00001000 }
467 $CMDBOX->add (my $hb = new CFClient::UI::HBox); 514sub PU_GLOVES { 0x00002000 }
515sub PU_CLOAK { 0x00004000 }
516sub PU_KEY { 0x00008000 }
468 517
469 my $i = $idx; 518sub PU_MISSILEWEAPON { 0x00010000 }
470 $hb->add (new CFClient::UI::Button 519sub PU_ALLWEAPON { 0x00020000 }
471 text => "delete", 520sub PU_MAGICAL { 0x00040000 }
472 tooltip => "Deletes the action from the record", 521sub PU_POTION { 0x00080000 }
473 on_activate => sub {
474 $CMDBOX->remove ($hb);
475 $list->[$i] = undef;
476 });
477 522
478 $hb->add (new CFClient::UI::Label text => $_); 523sub PU_SPELLBOOK { 0x00100000 }
524sub PU_SKILLSCROLL { 0x00200000 }
525sub PU_READABLES { 0x00400000 }
526sub PU_MAGIC_DEVICE { 0x00800000 }
479 527
480 $idx++ 528sub PU_NOT_CURSED { 0x01000000 }
481 }
482}
483 529
484# if $show is 1 the recorder will be shown 530sub PU_JEWELS { 0x02000000 }
485sub start {
486 my ($show) = @_;
487 531
488 $RECORD_WINDOW->show if $show;
489
490 $REC_BTN->set_text ("stop recording");
491 $REC_BTN->{recording} = 1;
492 clear_command_list;
493 $::CONN->start_record;
494}
495
496# if $autobind is 1 the recorder will be automatically
497# jump into the binding query and hide the recorder window
498sub stop {
499 my ($autobind) = @_;
500
501 $REC_BTN->set_text ("start recording");
502 $REC_BTN->{recording} = 0;
503
504 my $rec = $::CONN->stop_record;
505 return unless ref $rec eq 'ARRAY';
506 set_command_list ($rec);
507
508 if ($autobind) {
509 open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
510 $RECORD_WINDOW->hide;
511 }
512}
513
514sub make_window {
515 $RECORD_WINDOW = new CFClient::UI::FancyFrame
516 req_y => 1,
517 req_x => -1,
518 title => "Action Recorder";
519
520 $RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
521 $vb->add ($REC_BTN = new CFClient::UI::Button
522 text => "start recording",
523 tooltip => "Start/Stops recording of actions."
524 ."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)"
525 ."All subsequent actions after the recording started will be captured."
526 ."The actions are displayed after the record was stopped."
527 ."To bind the action you have to click on the 'Bind' button",
528 on_activate => sub {
529 my ($btn) = @_;
530
531 unless ($btn->{recording}) {
532 start;
533 } else {
534 stop;
535 }
536 });
537 $vb->add ($CMDBOX = new CFClient::UI::VBox);
538 $vb->add (new CFClient::UI::Button
539 text => "bind",
540 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
541 on_activate => sub {
542 open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
543 });
544
545 $RECORD_WINDOW
546}
547 532
5481; 5331;
549 534
550=back 535=back
551 536

Diff Legend

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