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.93 by root, Sun Jun 18 17:13:10 2006 UTC

… …
24use utf8; 24use utf8;
25 25
26use Carp (); 26use Carp ();
27use AnyEvent (); 27use AnyEvent ();
28use BerkeleyDB; 28use BerkeleyDB;
29use Pod::POM ();
30use Scalar::Util ();
31use Storable (); # finally
32
33package CFClient::PodToPango;
34
35use base Pod::POM::View::Text;
36
37our $VERSION = 1; # bump if resultant formatting changes
38
39our $indent = 0;
40
41*view_seq_code =
42*view_seq_bold = sub { "<b>$_[1]</b>" };
43*view_seq_italic = sub { "<i>$_[1]</i>" };
44*view_seq_space =
45*view_seq_link =
46*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
47
48sub view_seq_text {
49 my $text = $_[1];
50 $text =~ s/\s+/ /g;
51 CFClient::UI::Label::escape ($text)
52}
53
54sub view_item {
55 ("\t" x ($indent / 4))
56 . $_[1]->title->present ($_[0])
57 . "\n\n"
58 . $_[1]->content->present ($_[0])
59}
60
61sub view_verbatim {
62 (join "",
63 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
64 split /\n/, CFClient::UI::Label::escape ($_[1]))
65 . "\n"
66}
67
68sub view_textblock {
69 ("\t" x ($indent / 2)) . "$_[1]\n\n"
70}
71
72sub view_head1 {
73 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
74 . $_[1]->content->present ($_[0])
75};
76
77sub view_head2 {
78 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
79 . $_[1]->content->present ($_[0])
80};
81
82sub view_head3 {
83 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
84 . $_[1]->content->present ($_[0])
85};
86
87sub view_over {
88 local $indent = $indent + $_[1]->indent;
89 $_[1]->content->present ($_[0])
90}
91
92package CFClient::Database;
93
94our @ISA = BerkeleyDB::Btree::;
95
96sub get($$) {
97 my $data;
98
99 $_[0]->db_get ($_[1], $data) == 0
100 ? $data
101 : ()
102}
103
104my %DB_SYNC;
105
106sub put($$$) {
107 my ($db, $key, $data) = @_;
108
109 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
110
111 $db->db_put ($key => $data)
112}
113
114package CFClient;
29 115
30sub find_rcfile($) { 116sub find_rcfile($) {
31 my $path; 117 my $path;
32 118
33 for (grep !ref, @INC) { 119 for (grep !ref, @INC) {
… …
68 } 154 }
69 155
70 close CFG; 156 close CFG;
71} 157}
72 158
73mkdir "$Crossfire::VARDIR/cfplus", 0777;
74
75our $DB_ENV; 159our $DB_ENV;
76 160
77{ 161{
78 use strict; 162 use strict;
79 163
164 mkdir "$Crossfire::VARDIR/cfplus", 0777;
80 my $recover = $BerkeleyDB::db_version >= 4.4 165 my $recover = $BerkeleyDB::db_version >= 4.4
81 ? eval "DB_REGISTER | DB_RECOVER" 166 ? eval "DB_REGISTER | DB_RECOVER"
82 : 0; 167 : 0;
83 168
84 $DB_ENV = new BerkeleyDB::Env 169 $DB_ENV = new BerkeleyDB::Env
… …
105 -Property => DB_CHKSUM, 190 -Property => DB_CHKSUM,
106 -Flags => DB_CREATE | DB_UPGRADE, 191 -Flags => DB_CREATE | DB_UPGRADE,
107 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" 192 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
108} 193}
109 194
195my $pod_cache = db_table "pod_cache";
196
197sub load_pod($$$$) {
198 my ($path, $filtertype, $filterversion, $filtercb) = @_;
199
200 stat $path
201 or die "$path: $!";
202
203 my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
204
205 my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
206
207 return $pom if $chash eq $phash;
208
209 my $pod = do {
210 local $/;
211 open my $pod, "<:utf8", $_[0]
212 or die "$_[0]: $!";
213 <$pod>
214 };
215
216 #utf8::downgrade $pod;
217
218 $pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
219
220 $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
221
222 $pom
223}
224
110sub pod_to_pango($) { 225sub pod_to_pango($) {
111 my ($pom) = @_; 226 my ($pom) = @_;
112 227
113 $pom->present ("CFClient::PodToPango") 228 $pom->present ("CFClient::PodToPango")
114} 229}
… …
120 map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], 235 map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "],
121 split /\n/, $pom->present ("CFClient::PodToPango") 236 split /\n/, $pom->present ("CFClient::PodToPango")
122 ] 237 ]
123} 238}
124 239
125package CFClient::PodToPango;
126
127use base Pod::POM::View::Text;
128
129our $indent = 0;
130
131*view_seq_code =
132*view_seq_bold = sub { "<b>$_[1]</b>" };
133*view_seq_italic = sub { "<i>$_[1]</i>" };
134*view_seq_space =
135*view_seq_link =
136*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
137
138sub view_seq_text {
139 my $text = $_[1];
140 $text =~ s/\s+/ /g;
141 CFClient::UI::Label::escape ($text)
142}
143
144sub view_item {
145 ("\t" x ($indent / 4))
146 . $_[1]->title->present ($_[0])
147 . "\n"
148 . $_[1]->content->present ($_[0])
149}
150
151sub view_verbatim {
152 (join "",
153 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
154 split /\n/, CFClient::UI::Label::escape ($_[1]))
155 . "\n"
156}
157
158sub view_textblock {
159 ("\t" x ($indent / 2)) . "$_[1]\n\n"
160}
161
162sub view_head1 {
163 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
164 . $_[1]->content->present ($_[0])
165};
166
167sub view_head2 {
168 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
169 . $_[1]->content->present ($_[0])
170};
171
172sub view_head3 {
173 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
174 . $_[1]->content->present ($_[0])
175};
176
177sub view_over {
178 local $indent = $indent + $_[1]->indent;
179 $_[1]->content->present ($_[0])
180}
181
182package CFClient::Database;
183
184our @ISA = BerkeleyDB::Btree::;
185
186sub get($$) {
187 my $data;
188
189 $_[0]->db_get ($_[1], $data) == 0
190 ? $data
191 : ()
192}
193
194my %DB_SYNC;
195
196sub put($$$) {
197 my ($db, $key, $data) = @_;
198
199 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
200
201 $db->db_put ($key => $data)
202}
203
204package CFClient::Item; 240package CFClient::Item;
205 241
206use strict; 242use strict;
207use Crossfire::Protocol::Constants; 243use Crossfire::Protocol::Constants;
244
245my $last_enter_count = 1;
208 246
209sub desc_string { 247sub desc_string {
210 my ($self) = @_; 248 my ($self) = @_;
211 249
212 my $desc = 250 my $desc =
… …
238 my $weight = ($self->{nrof} || 1) * $self->{weight}; 276 my $weight = ($self->{nrof} || 1) * $self->{weight};
239 277
240 $weight < 0 ? "?" : $weight * 0.001 278 $weight < 0 ? "?" : $weight * 0.001
241} 279}
242 280
281sub do_n_dialog {
282 my ($cb) = @_;
283
284 my $w = new CFClient::UI::FancyFrame;
285 $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
286 $vb->add (new CFClient::UI::Label text => "Enter item count:");
287 $vb->add (my $entry = new CFClient::UI::Entry
288 text => $last_enter_count,
289 on_activate => sub {
290 my ($entry) = @_;
291 $last_enter_count = $entry->get_text;
292 $cb->($last_enter_count);
293 $w->hide;
294 $w = undef;
295 }
296 );
297 $entry->grab_focus;
298 $w->show;
299
300}
301
243sub update_widgets { 302sub update_widgets {
244 my ($self) = @_; 303 my ($self) = @_;
245 304
305 # necessary to avoid cyclic references
306 Scalar::Util::weaken $self;
307
246 my $button_cb = sub { 308 my $button_cb = sub {
247 my (undef, $ev, $x, $y) = @_; 309 my (undef, $ev, $x, $y) = @_;
248 310
311 my $targ = $::CONN->{player}{tag};
312
313 if ($self->{container} == $::CONN->{player}{tag}) {
314 $targ = $::CONN->{open_container};
315 }
316
249 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { 317 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") 318 $::CONN->send ("move $targ $self->{tag} 0")
257 if $targ || !($self->{flags} & F_LOCKED); 319 if $targ || !($self->{flags} & F_LOCKED);
320 } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
321 $self->{flags} & F_LOCKED
322 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
323 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
258 } elsif ($ev->{button} == 1) { 324 } elsif ($ev->{button} == 1) {
259 $::CONN->send ("examine $self->{tag}"); 325 $::CONN->send ("examine $self->{tag}");
260 } elsif ($ev->{button} == 2) { 326 } elsif ($ev->{button} == 2) {
261 $::CONN->send ("apply $self->{tag}"); 327 $::CONN->send ("apply $self->{tag}");
262 } elsif ($ev->{button} == 3) { 328 } elsif ($ev->{button} == 3) {
… …
270 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], 336 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
271 ) 337 )
272 : ( 338 : (
273 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], 339 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
274 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }], 340 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],
341 ["move n",
342 sub {
343 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
344 }
345 ]
275 ) 346 )
276 ), 347 ),
277 ); 348 );
278 349
279 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 350 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
… …
284 355
285 my $tooltip_std = "<small>" 356 my $tooltip_std = "<small>"
286 . "Left click - examine item\n" 357 . "Left click - examine item\n"
287 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" 358 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
288 . "Middle click - apply\n" 359 . "Middle click - apply\n"
360 . "Shift-Middle click - lock/unlock\n"
289 . "Right click - further options" 361 . "Right click - further options"
290 . "</small>\n"; 362 . "</small>\n";
291 363
292 $self->{face_widget} ||= new CFClient::UI::Face 364 $self->{face_widget} ||= new CFClient::UI::Face
293 can_events => 1, 365 can_events => 1,
… …
332 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") 404 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
333 . "\n\n$tooltip_std" 405 . "\n\n$tooltip_std"
334 ); 406 );
335} 407}
336 408
337package CFClient::Recorder; 409package CFClient::Binder;
338
339our $RECORD_WINDOW;
340
341my $CMDBOX;
342my $CURRENT_CMDS;
343my $REC_BTN;
344 410
345my @ALLOWED_MODIFIER_KEYS = ( 411my @ALLOWED_MODIFIER_KEYS = (
346 (CFClient::SDLK_LSHIFT) => "LSHIFT", 412 CFClient::SDLK_LSHIFT,
347 (CFClient::SDLK_LCTRL ) => "LCTRL", 413 CFClient::SDLK_LCTRL ,
348 (CFClient::SDLK_LALT ) => "LALT", 414 CFClient::SDLK_LALT ,
349 (CFClient::SDLK_LMETA ) => "LMETA", 415 CFClient::SDLK_LMETA ,
350 416
351 (CFClient::SDLK_RSHIFT) => "RSHIFT", 417 CFClient::SDLK_RSHIFT,
352 (CFClient::SDLK_RCTRL ) => "RCTRL", 418 CFClient::SDLK_RCTRL ,
353 (CFClient::SDLK_RALT ) => "RALT", 419 CFClient::SDLK_RALT ,
354 (CFClient::SDLK_RMETA ) => "RMETA", 420 CFClient::SDLK_RMETA ,
355); 421);
356 422
357my %ALLOWED_MODIFIERS = ( 423my %ALLOWED_MODIFIERS = (
358 (CFClient::KMOD_LSHIFT) => "LSHIFT", 424 CFClient::KMOD_LSHIFT => "LSHIFT",
359 (CFClient::KMOD_LCTRL ) => "LCTRL", 425 CFClient::KMOD_LCTRL => "LCTRL",
360 (CFClient::KMOD_LALT ) => "LALT", 426 CFClient::KMOD_LALT => "LALT",
361 (CFClient::KMOD_LMETA ) => "LMETA", 427 CFClient::KMOD_LMETA => "LMETA",
362 428
363 (CFClient::KMOD_RSHIFT) => "RSHIFT", 429 CFClient::KMOD_RSHIFT => "RSHIFT",
364 (CFClient::KMOD_RCTRL ) => "RCTRL", 430 CFClient::KMOD_RCTRL => "RCTRL",
365 (CFClient::KMOD_RALT ) => "RALT", 431 CFClient::KMOD_RALT => "RALT",
366 (CFClient::KMOD_RMETA ) => "RMETA", 432 CFClient::KMOD_RMETA => "RMETA",
367); 433);
368 434
369my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/; 435my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
370my @DIRECT_BIND_KEYS = ( 436my @DIRECT_BIND_KEYS = (
371 CFClient::SDLK_F1, 437 CFClient::SDLK_F1,
… …
384 CFClient::SDLK_F14, 450 CFClient::SDLK_F14,
385 CFClient::SDLK_F15, 451 CFClient::SDLK_F15,
386); 452);
387 453
388# this binding dialog asks for a key-combo to be pressed 454# this binding dialog asks for a key-combo to be pressed
389# and if successful it binds the modifier+symbol to the 455# 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 { 456sub open_binding_dialog {
393 my ($cmd) = @_; 457 my ($cb) = @_;
394 458
395 my $w = new CFClient::UI::FancyFrame 459 my $w = new CFClient::UI::FancyFrame
396 title => "Bind Action"; 460 title => "Bind Action",
461 x => "center",
462 y => "center";
397 463
398 $w->add (my $vb = new CFClient::UI::VBox); 464 $w->add (my $vb = new CFClient::UI::VBox);
399 $vb->add (new CFClient::UI::Label 465 $vb->add (new CFClient::UI::Label
400 text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key." 466 text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
401 ."You can only bind 0-9 and F1-F15 without modifiers." 467 ."You can only bind 0-9 and F1-F15 without modifiers."
… …
422 ." directly without modifier! It would damage the completer handling." 488 ." directly without modifier! It would damage the completer handling."
423 ); 489 );
424 return; 490 return;
425 } 491 }
426 492
427 $entry->focus_out; 493 $entry->grab_focus;
428 494
429 $::CFG->{bindings}->{$mod}->{$sym} = $cmd; 495 $cb->($mod, $sym);
430 $::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
431 496
432 $w->destroy 497 $w->destroy
433 }); 498 });
434 499
435 $entry->focus_in; 500 $entry->grab_focus;
436 $w->center;
437 $w->show; 501 $w->show;
438} 502}
439 503
440sub keycombo_to_name { 504sub keycombo_to_name {
441 my ($mod, $sym) = @_; 505 my ($mod, $sym) = @_;
442 506
443 my $mods = join '+', 507 my $mods = join '+',
444 map { $ALLOWED_MODIFIERS{$_} } 508 map { $ALLOWED_MODIFIERS{$_} }
445 grep { $_ & $mod } 509 grep { ($_ + 0) & ($mod + 0) }
446 keys %ALLOWED_MODIFIERS; 510 keys %ALLOWED_MODIFIERS;
447 $mods .= "+" if $mods ne ''; 511 $mods .= "+" if $mods ne '';
448 512
449 return $mods . CFClient::SDL_GetKeyName ($sym); 513 return $mods . CFClient::SDL_GetKeyName ($sym);
450} 514}
451 515
452sub clear_command_list {
453 $CMDBOX->clear () if $CMDBOX;
454}
455
456sub set_command_list {
457 my ($list) = @_;
458
459 return unless $CMDBOX;
460
461 $CMDBOX->clear ();
462 $CURRENT_CMDS = $list;
463
464 my $idx = 0;
465
466 for (@$list) {
467 $CMDBOX->add (my $hb = new CFClient::UI::HBox);
468
469 my $i = $idx;
470 $hb->add (new CFClient::UI::Button
471 text => "delete",
472 tooltip => "Deletes the action from the record",
473 on_activate => sub {
474 $CMDBOX->remove ($hb);
475 $list->[$i] = undef;
476 });
477
478 $hb->add (new CFClient::UI::Label text => $_);
479
480 $idx++
481 }
482}
483
484# if $show is 1 the recorder will be shown
485sub start {
486 my ($show) = @_;
487
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
5481; 5161;
549 517
550=back 518=back
551 519
552=head1 AUTHOR 520=head1 AUTHOR

Diff Legend

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