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.133 by root, Wed Dec 6 00:15:12 2006 UTC vs.
Revision 1.169 by root, Wed Dec 26 21:03:21 2007 UTC

1=head1 NAME 1=head1 NAME
2 2
3CFPlus - undocumented utility garbage for our crossfire client 3DC - undocumented utility garbage for our deliantra client
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use CFPlus; 7 use DC;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11=over 4 11=over 4
12 12
13=cut 13=cut
14 14
15package CFPlus; 15package DC;
16 16
17use Carp (); 17use Carp ();
18 18
19BEGIN { 19BEGIN {
20 $VERSION = '0.97'; 20 $VERSION = '0.9962';
21 21
22 use XSLoader; 22 use XSLoader;
23 XSLoader::load "CFPlus", $VERSION; 23 XSLoader::load "Deliantra::Client", $VERSION;
24} 24}
25 25
26use utf8; 26use utf8;
27 27
28use AnyEvent (); 28use AnyEvent ();
29use BerkeleyDB;
30use Pod::POM (); 29use Pod::POM ();
31use Scalar::Util (); 30use File::Path ();
32use Storable (); # finally 31use Storable (); # finally
33 32use Fcntl ();
34BEGIN { 33use JSON::XS qw(encode_json decode_json);
35 use Crossfire::Protocol::Base ();
36 *to_json = \&Crossfire::Protocol::Base::to_json;
37 *from_json = \&Crossfire::Protocol::Base::from_json;
38}
39 34
40=item guard { BLOCK } 35=item guard { BLOCK }
41 36
42Returns an object that executes the given block as soon as it is destroyed. 37Returns an object that executes the given block as soon as it is destroyed.
43 38
44=cut 39=cut
45 40
46sub guard(&) { 41sub guard(&) {
47 bless \(my $cb = $_[0]), "CFPlus::Guard" 42 bless \(my $cb = $_[0]), "DC::Guard"
48} 43}
49 44
50sub CFPlus::Guard::DESTROY { 45sub DC::Guard::DESTROY {
51 ${$_[0]}->() 46 ${$_[0]}->()
52} 47}
53 48
54=item shorten $string[, $maxlength] 49=item shorten $string[, $maxlength]
55 50
… …
71 $_ 66 $_
72} 67}
73 68
74sub socketpipe() { 69sub socketpipe() {
75 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC 70 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
76 or die "cannot establish bidiretcional pipe: $!\n"; 71 or die "cannot establish bidirectional pipe: $!\n";
77 72
78 ($fh1, $fh2) 73 ($fh1, $fh2)
79} 74}
80 75
81sub background(&;&) { 76sub background(&;&) {
82 my ($bg, $cb) = @_; 77 my ($bg, $cb) = @_;
83 78
84 my ($fh_r, $fh_w) = CFPlus::socketpipe; 79 my ($fh_r, $fh_w) = DC::socketpipe;
85 80
86 my $pid = fork; 81 my $pid = fork;
87 82
88 if (defined $pid && !$pid) { 83 if (defined $pid && !$pid) {
89 local $SIG{__DIE__}; 84 local $SIG{__DIE__};
… …
99 94
100 if ($@) { 95 if ($@) {
101 my $msg = $@; 96 my $msg = $@;
102 $msg =~ s/\n+/\n/; 97 $msg =~ s/\n+/\n/;
103 warn "FATAL: $msg"; 98 warn "FATAL: $msg";
104 CFPlus::_exit 1; 99 DC::_exit 1;
105 } 100 }
106 101
107 # win32 is fucked up, of course. exit will clean stuff up, 102 # win32 is fucked up, of course. exit will clean stuff up,
108 # which destroys our database etc. _exit will exit ALL 103 # which destroys our database etc. _exit will exit ALL
109 # forked processes, because of the dreaded fork emulation. 104 # forked processes, because of the dreaded fork emulation.
110 CFPlus::_exit 0; 105 DC::_exit 0;
111 } 106 }
112 107
113 close $fh_w; 108 close $fh_w;
114 109
115 my $buffer; 110 my $buffer;
… …
124 while ($buffer =~ s/^(.*)\n//) { 119 while ($buffer =~ s/^(.*)\n//) {
125 my $line = $1; 120 my $line = $1;
126 $line =~ s/\s+$//; 121 $line =~ s/\s+$//;
127 utf8::decode $line; 122 utf8::decode $line;
128 if ($line =~ /^\x{e877}json_msg (.*)$/s) { 123 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
129 $cb->(from_json $1); 124 $cb->(JSON::XS->new->allow_nonref->decode ($1));
130 } else { 125 } else {
131 ::message ({ 126 ::message ({
132 markup => "background($pid): " . CFPlus::asxml $line, 127 markup => "background($pid): " . DC::asxml $line,
133 }); 128 });
134 } 129 }
135 } 130 }
136 }); 131 });
137} 132}
138 133
139sub background_msg { 134sub background_msg {
140 my ($msg) = @_; 135 my ($msg) = @_;
141 136
142 $msg = "\x{e877}json_msg " . to_json $msg; 137 $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg);
143 $msg =~ s/\n//g; 138 $msg =~ s/\n//g;
144 utf8::encode $msg; 139 utf8::encode $msg;
145 print $msg, "\n"; 140 print $msg, "\n";
146} 141}
147 142
148package CFPlus::Database;
149
150our @ISA = BerkeleyDB::Btree::;
151
152sub get($$) {
153 my $data;
154
155 $_[0]->db_get ($_[1], $data) == 0
156 ? $data
157 : ()
158}
159
160my %DB_SYNC;
161
162sub put($$$) {
163 my ($db, $key, $data) = @_;
164
165 my $hkey = $db + 0;
166 Scalar::Util::weaken $db;
167 $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 5, cb => sub {
168 delete $DB_SYNC{$hkey};
169 $db->db_sync if $db;
170 });
171
172 $db->db_put ($key => $data)
173}
174
175package CFPlus; 143package DC;
176 144
177sub find_rcfile($) { 145sub find_rcfile($) {
178 my $path; 146 my $path;
179 147
180 for (grep !ref, @INC) { 148 for (grep !ref, @INC) {
181 $path = "$_/CFPlus/resources/$_[0]"; 149 $path = "$_/Deliantra/Client/private/resources/$_[0]";
182 return $path if -r $path; 150 return $path if -r $path;
183 } 151 }
184 152
185 die "FATAL: can't find required file $_[0]\n"; 153 die "FATAL: can't find required file $_[0]\n";
186} 154}
… …
192 or return; 160 or return;
193 161
194 local $/; 162 local $/;
195 my $CFG = <$fh>; 163 my $CFG = <$fh>;
196 164
197 if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
198 require YAML;
199 utf8::decode $CFG;
200 $::CFG = YAML::Load ($CFG);
201 } elsif ($CFG =~ /^\{/) {
202 $::CFG = from_json $CFG; 165 $::CFG = decode_json $CFG;
203 } else {
204 $::CFG = eval $CFG; ## todo comaptibility cruft
205 }
206} 166}
207 167
208sub write_cfg { 168sub write_cfg {
209 my ($file) = @_; 169 my ($file) = @_;
210 170
211 $::CFG->{VERSION} = $::VERSION; 171 $::CFG->{VERSION} = $::VERSION;
212 172
213 open my $fh, ">:utf8", $file 173 open my $fh, ">:utf8", $file
214 or return; 174 or return;
215 print $fh to_json $::CFG; 175 print $fh encode_json $::CFG;
216} 176}
217 177
218sub http_proxy { 178sub http_proxy {
219 my @proxy = win32_proxy_info; 179 my @proxy = win32_proxy_info;
220 180
… …
235} 195}
236 196
237sub lwp_useragent { 197sub lwp_useragent {
238 require LWP::UserAgent; 198 require LWP::UserAgent;
239 199
240 CFPlus::set_proxy; 200 DC::set_proxy;
241 201
242 my $ua = LWP::UserAgent->new ( 202 my $ua = LWP::UserAgent->new (
243 agent => "cfplus $VERSION", 203 agent => "cfplus $VERSION",
244 keep_alive => 1, 204 keep_alive => 1,
245 env_proxy => 1, 205 env_proxy => 1,
… …
254 and die $res->status_line; 214 and die $res->status_line;
255 215
256 $res 216 $res
257} 217}
258 218
259our $DB_ENV; 219sub fh_nonblocking($$) {
260our $DB_STATE;
261
262sub db_table($) {
263 my ($table) = @_; 220 my ($fh, $nb) = @_;
264 221
265 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; 222 if ($^O eq "MSWin32") {
223 $nb = (! ! $nb) + 0;
224 ioctl $fh, 0x8004667e, \$nb; # FIONBIO
225 } else {
226 fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
227 }
266 228
267 new CFPlus::Database
268 -Env => $DB_ENV,
269 -Filename => $table,
270# -Filename => "database",
271# -Subname => $table,
272 -Property => DB_CHKSUM,
273 -Flags => DB_CREATE | DB_UPGRADE,
274 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
275} 229}
276 230
277{
278 use strict;
279
280 my $HOME = "$Crossfire::VARDIR/cfplus-$BerkeleyDB::db_version";
281
282 mkdir $HOME, 0777;
283 my $recover = $BerkeleyDB::db_version >= 4.4
284 ? eval "DB_REGISTER | DB_RECOVER"
285 : 0;
286
287 $DB_ENV = new BerkeleyDB::Env
288 -Home => $HOME,
289 -Cachesize => 1_000_000,
290 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
291# -ErrPrefix => "DATABASE",
292 -Verbose => 1,
293 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
294 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
295 or die "unable to create/open database home $HOME: $BerkeleyDB::Error";
296
297 $DB_STATE = db_table "state";
298}
299
300package CFPlus::Layout; 231package DC::Layout;
301 232
302$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { 233$DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub {
303 reset_glyph_cache; 234 glyph_cache_restore;
304}; 235};
305 236
306package CFPlus::Item; 237$DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub {
307 238 glyph_cache_backup;
308use strict; 239};
309use Crossfire::Protocol::Constants;
310
311my $last_enter_count = 1;
312
313sub desc_string {
314 my ($self) = @_;
315
316 my $desc =
317 $self->{nrof} < 2
318 ? $self->{name}
319 : "$self->{nrof} × $self->{name_pl}";
320
321 $self->{flags} & F_OPEN
322 and $desc .= " (open)";
323 $self->{flags} & F_APPLIED
324 and $desc .= " (applied)";
325 $self->{flags} & F_UNPAID
326 and $desc .= " (unpaid)";
327 $self->{flags} & F_MAGIC
328 and $desc .= " (magic)";
329 $self->{flags} & F_CURSED
330 and $desc .= " (cursed)";
331 $self->{flags} & F_DAMNED
332 and $desc .= " (damned)";
333 $self->{flags} & F_LOCKED
334 and $desc .= " *";
335
336 $desc
337}
338
339sub weight_string {
340 my ($self) = @_;
341
342 my $weight = ($self->{nrof} || 1) * $self->{weight};
343
344 $weight < 0 ? "?" : $weight * 0.001
345}
346
347sub do_n_dialog {
348 my ($cb) = @_;
349
350 my $w = new CFPlus::UI::Toplevel
351 on_delete => sub { $_[0]->destroy; 1 },
352 has_close_button => 1,
353 ;
354
355 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
356 $vb->add (new CFPlus::UI::Label text => "Enter item count:");
357 $vb->add (my $entry = new CFPlus::UI::Entry
358 text => $last_enter_count,
359 on_activate => sub {
360 my ($entry) = @_;
361 $last_enter_count = $entry->get_text;
362 $cb->($last_enter_count);
363 $w->hide;
364 $w->destroy;
365
366 0
367 },
368 on_escape => sub { $w->destroy; 1 },
369 );
370 $entry->grab_focus;
371 $w->show;
372}
373
374sub update_widgets {
375 my ($self) = @_;
376
377 # necessary to avoid cyclic references
378 Scalar::Util::weaken $self;
379
380 my $button_cb = sub {
381 my (undef, $ev, $x, $y) = @_;
382
383 my $targ = $::CONN->{player}{tag};
384
385 if ($self->{container} == $::CONN->{player}{tag}) {
386 $targ = $::CONN->{open_container};
387 }
388
389 if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
390 $::CONN->send ("move $targ $self->{tag} 0")
391 if $targ || !($self->{flags} & F_LOCKED);
392 } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) {
393 $self->{flags} & F_LOCKED
394 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
395 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
396 } elsif ($ev->{button} == 1) {
397 $::CONN->send ("examine $self->{tag}");
398 } elsif ($ev->{button} == 2) {
399 $::CONN->send ("apply $self->{tag}");
400 } elsif ($ev->{button} == 3) {
401 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
402 if ($self->{container} == $::CONN->{open_container}) {
403 $move_prefix = "take";
404 }
405
406 my $shortname = CFPlus::shorten $self->{name}, 14;
407
408 my @menu_items = (
409 ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
410 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
411 ["ignite/thaw", # first try of an easier use of flint&steel
412 sub {
413 $::CONN->send ("mark ". pack "N", $self->{tag});
414 $::CONN->send ("command apply flint and steel");
415 }
416 ],
417 ["inscribe", # first try of an easier use of flint&steel
418 sub {
419 &::open_string_query ("Text to inscribe", sub {
420 my ($entry, $txt) = @_;
421 $::CONN->send ("mark ". pack "N", $self->{tag});
422 $::CONN->send ("command use_skill inscription $txt");
423 });
424 }
425 ],
426 ["rename", # first try of an easier use of flint&steel
427 sub {
428 &::open_string_query ("Rename item to:", sub {
429 my ($entry, $txt) = @_;
430 $::CONN->send ("mark ". pack "N", $self->{tag});
431 $::CONN->send ("command rename to <$txt>");
432 }, $self->{name},
433 "If you input no name or erase the current custom name, the custom name will be unset");
434 }
435 ],
436 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
437 (
438 $self->{flags} & F_LOCKED
439 ? (
440 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
441 )
442 : (
443 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
444 ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
445 ["$move_prefix &lt;n&gt;",
446 sub {
447 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
448 }
449 ]
450 )
451 ),
452 ["bind <i>apply $shortname</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["apply $self->{name}"]) }],
453 );
454
455 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
456 }
457
458 1
459 };
460
461 my $tooltip_std = "<small>"
462 . "Left click - examine item\n"
463 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
464 . "Middle click - apply\n"
465 . "Shift-Middle click - lock/unlock\n"
466 . "Right click - further options"
467 . "</small>\n";
468
469 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
470 : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
471 : undef;
472
473 $self->{face_widget} ||= new CFPlus::UI::Face
474 can_events => 1,
475 can_hover => 1,
476 anim => $self->{anim},
477 animspeed => $self->{animspeed}, # TODO# must be set at creation time
478 on_button_down => $button_cb,
479 ;
480 $self->{face_widget}{bg} = $bg;
481 $self->{face_widget}{face} = $self->{face};
482 $self->{face_widget}{anim} = $self->{anim};
483 $self->{face_widget}{animspeed} = $self->{animspeed};
484 $self->{face_widget}->set_tooltip (
485 "<b>Face/Animation.</b>\n"
486 . "Item uses face #$self->{face}. "
487 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
488 . "\n\n$tooltip_std"
489 );
490
491 $self->{desc_widget} ||= new CFPlus::UI::Label
492 can_events => 1,
493 can_hover => 1,
494 ellipsise => 2,
495 align => -1,
496 on_button_down => $button_cb,
497 ;
498 my $desc = CFPlus::Item::desc_string $self;
499 $self->{desc_widget}{bg} = $bg;
500 $self->{desc_widget}->set_text ($desc);
501 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
502
503 $self->{weight_widget} ||= new CFPlus::UI::Label
504 can_events => 1,
505 can_hover => 1,
506 ellipsise => 0,
507 align => 0,
508 on_button_down => $button_cb,
509 ;
510 $self->{weight_widget}{bg} = $bg;
511 $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self);
512 $self->{weight_widget}->set_tooltip (
513 "<b>Weight</b>.\n"
514 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
515 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
516 . "\n\n$tooltip_std"
517 );
518}
519 240
5201; 2411;
521 242
522=back 243=back
523 244

Diff Legend

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