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

Diff Legend

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