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

Diff Legend

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