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

Diff Legend

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