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.122 by root, Sun Oct 1 14:48:50 2006 UTC vs.
Revision 1.136 by root, Sat Dec 9 02:21:24 2006 UTC

15package CFPlus; 15package CFPlus;
16 16
17use Carp (); 17use Carp ();
18 18
19BEGIN { 19BEGIN {
20 $VERSION = '0.52'; 20 $VERSION = '0.97';
21 21
22 use XSLoader; 22 use XSLoader;
23 XSLoader::load "CFPlus", $VERSION; 23 XSLoader::load "CFPlus", $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} 24}
34 25
35use utf8; 26use utf8;
36 27
37use AnyEvent (); 28use AnyEvent ();
38use BerkeleyDB; 29use BerkeleyDB;
39use Pod::POM (); 30use Pod::POM ();
40use Scalar::Util (); 31use Scalar::Util ();
32use File::Path ();
41use Storable (); # finally 33use Storable (); # finally
34
35BEGIN {
36 use Crossfire::Protocol::Base ();
37 *to_json = \&Crossfire::Protocol::Base::to_json;
38 *from_json = \&Crossfire::Protocol::Base::from_json;
39}
42 40
43=item guard { BLOCK } 41=item guard { BLOCK }
44 42
45Returns an object that executes the given block as soon as it is destroyed. 43Returns an object that executes the given block as soon as it is destroyed.
46 44
50 bless \(my $cb = $_[0]), "CFPlus::Guard" 48 bless \(my $cb = $_[0]), "CFPlus::Guard"
51} 49}
52 50
53sub CFPlus::Guard::DESTROY { 51sub CFPlus::Guard::DESTROY {
54 ${$_[0]}->() 52 ${$_[0]}->()
53}
54
55=item shorten $string[, $maxlength]
56
57=cut
58
59sub shorten($;$) {
60 my ($str, $len) = @_;
61 substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
62 $str
55} 63}
56 64
57sub asxml($) { 65sub asxml($) {
58 local $_ = $_[0]; 66 local $_ = $_[0];
59 67
60 s/&/&amp;/g; 68 s/&/&amp;/g;
61 s/>/&gt;/g; 69 s/>/&gt;/g;
62 s/</&lt;/g; 70 s/</&lt;/g;
63 71
64 $_ 72 $_
73}
74
75sub socketpipe() {
76 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
77 or die "cannot establish bidiretcional pipe: $!\n";
78
79 ($fh1, $fh2)
80}
81
82sub background(&;&) {
83 my ($bg, $cb) = @_;
84
85 my ($fh_r, $fh_w) = CFPlus::socketpipe;
86
87 my $pid = fork;
88
89 if (defined $pid && !$pid) {
90 local $SIG{__DIE__};
91
92 open STDOUT, ">&", $fh_w;
93 open STDERR, ">&", $fh_w;
94 close $fh_r;
95 close $fh_w;
96
97 $| = 1;
98
99 eval { $bg->() };
100
101 if ($@) {
102 my $msg = $@;
103 $msg =~ s/\n+/\n/;
104 warn "FATAL: $msg";
105 CFPlus::_exit 1;
106 }
107
108 # win32 is fucked up, of course. exit will clean stuff up,
109 # which destroys our database etc. _exit will exit ALL
110 # forked processes, because of the dreaded fork emulation.
111 CFPlus::_exit 0;
112 }
113
114 close $fh_w;
115
116 my $buffer;
117
118 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
119 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
120 undef $w;
121 $cb->();
122 return;
123 }
124
125 while ($buffer =~ s/^(.*)\n//) {
126 my $line = $1;
127 $line =~ s/\s+$//;
128 utf8::decode $line;
129 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
130 $cb->(from_json $1);
131 } else {
132 ::message ({
133 markup => "background($pid): " . CFPlus::asxml $line,
134 });
135 }
136 }
137 });
138}
139
140sub background_msg {
141 my ($msg) = @_;
142
143 $msg = "\x{e877}json_msg " . to_json $msg;
144 $msg =~ s/\n//g;
145 utf8::encode $msg;
146 print $msg, "\n";
65} 147}
66 148
67package CFPlus::Database; 149package CFPlus::Database;
68 150
69our @ISA = BerkeleyDB::Btree::; 151our @ISA = BerkeleyDB::Btree::;
100 $path = "$_/CFPlus/resources/$_[0]"; 182 $path = "$_/CFPlus/resources/$_[0]";
101 return $path if -r $path; 183 return $path if -r $path;
102 } 184 }
103 185
104 die "FATAL: can't find required file $_[0]\n"; 186 die "FATAL: can't find required file $_[0]\n";
105}
106
107BEGIN {
108 use Crossfire::Protocol::Base ();
109 *to_json = \&Crossfire::Protocol::Base::to_json;
110 *from_json = \&Crossfire::Protocol::Base::from_json;
111} 187}
112 188
113sub read_cfg { 189sub read_cfg {
114 my ($file) = @_; 190 my ($file) = @_;
115 191
157 or return; 233 or return;
158 234
159 $ENV{http_proxy} = $proxy; 235 $ENV{http_proxy} = $proxy;
160} 236}
161 237
238sub lwp_useragent {
239 require LWP::UserAgent;
240
241 CFPlus::set_proxy;
242
243 my $ua = LWP::UserAgent->new (
244 agent => "cfplus $VERSION",
245 keep_alive => 1,
246 env_proxy => 1,
247 timeout => 30,
248 );
249}
250
251sub lwp_check($) {
252 my ($res) = @_;
253
254 $res->is_error
255 and die $res->status_line;
256
257 $res
258}
259
162our $DB_ENV; 260our $DB_ENV;
163our $DB_STATE; 261our $DB_STATE;
164 262
165sub db_table($) { 263sub db_table($) {
166 my ($table) = @_; 264 my ($table) = @_;
175 -Property => DB_CHKSUM, 273 -Property => DB_CHKSUM,
176 -Flags => DB_CREATE | DB_UPGRADE, 274 -Flags => DB_CREATE | DB_UPGRADE,
177 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" 275 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
178} 276}
179 277
180{ 278our $DB_HOME = "$Crossfire::VARDIR/cfplus";
279
280sub open_db {
181 use strict; 281 use strict;
182 282
183 mkdir "$Crossfire::VARDIR/cfplus", 0777; 283 mkdir $DB_HOME, 0777;
184 my $recover = $BerkeleyDB::db_version >= 4.4 284 my $recover = $BerkeleyDB::db_version >= 4.4
185 ? eval "DB_REGISTER | DB_RECOVER" 285 ? eval "DB_REGISTER | DB_RECOVER"
186 : 0; 286 : 0;
187 287
188 $DB_ENV = new BerkeleyDB::Env 288 $DB_ENV = new BerkeleyDB::Env
189 -Home => "$Crossfire::VARDIR/cfplus", 289 -Home => $DB_HOME,
190 -Cachesize => 1_000_000, 290 -Cachesize => 1_000_000,
191 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 291 -ErrFile => "$DB_HOME/errorlog.txt",
192# -ErrPrefix => "DATABASE", 292# -ErrPrefix => "DATABASE",
193 -Verbose => 1, 293 -Verbose => 1,
194 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 294 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
195 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 295 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
196 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 296 or die "unable to create/open database home $DB_HOME: $BerkeleyDB::Error";
197 297
198 $DB_STATE = db_table "state"; 298 $DB_STATE = db_table "state";
299
300 1
301}
302
303unless (eval { open_db }) {
304 File::Path::rmtree $DB_HOME;
305 open_db;
199} 306}
200 307
201package CFPlus::Layout; 308package CFPlus::Layout;
202 309
203$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { 310$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
204 reset_glyph_cache; 311 reset_glyph_cache;
205}; 312};
206 313
207package CFPlus::Item;
208
209use strict;
210use Crossfire::Protocol::Constants;
211
212my $last_enter_count = 1;
213
214sub desc_string {
215 my ($self) = @_;
216
217 my $desc =
218 $self->{nrof} < 2
219 ? $self->{name}
220 : "$self->{nrof} × $self->{name_pl}";
221
222 $self->{flags} & F_OPEN
223 and $desc .= " (open)";
224 $self->{flags} & F_APPLIED
225 and $desc .= " (applied)";
226 $self->{flags} & F_UNPAID
227 and $desc .= " (unpaid)";
228 $self->{flags} & F_MAGIC
229 and $desc .= " (magic)";
230 $self->{flags} & F_CURSED
231 and $desc .= " (cursed)";
232 $self->{flags} & F_DAMNED
233 and $desc .= " (damned)";
234 $self->{flags} & F_LOCKED
235 and $desc .= " *";
236
237 $desc
238}
239
240sub weight_string {
241 my ($self) = @_;
242
243 my $weight = ($self->{nrof} || 1) * $self->{weight};
244
245 $weight < 0 ? "?" : $weight * 0.001
246}
247
248sub do_n_dialog {
249 my ($cb) = @_;
250
251 my $w = new CFPlus::UI::Toplevel
252 on_delete => sub { $_[0]->destroy; 1 },
253 has_close_button => 1,
254 ;
255
256 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
257 $vb->add (new CFPlus::UI::Label text => "Enter item count:");
258 $vb->add (my $entry = new CFPlus::UI::Entry
259 text => $last_enter_count,
260 on_activate => sub {
261 my ($entry) = @_;
262 $last_enter_count = $entry->get_text;
263 $cb->($last_enter_count);
264 $w->hide;
265 $w->destroy;
266
267 0
268 },
269 on_escape => sub { $w->destroy; 1 },
270 );
271 $entry->grab_focus;
272 $w->show;
273}
274
275sub update_widgets {
276 my ($self) = @_;
277
278 # necessary to avoid cyclic references
279 Scalar::Util::weaken $self;
280
281 my $button_cb = sub {
282 my (undef, $ev, $x, $y) = @_;
283
284 my $targ = $::CONN->{player}{tag};
285
286 if ($self->{container} == $::CONN->{player}{tag}) {
287 $targ = $::CONN->{open_container};
288 }
289
290 if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
291 $::CONN->send ("move $targ $self->{tag} 0")
292 if $targ || !($self->{flags} & F_LOCKED);
293 } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) {
294 $self->{flags} & F_LOCKED
295 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
296 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
297 } elsif ($ev->{button} == 1) {
298 $::CONN->send ("examine $self->{tag}");
299 } elsif ($ev->{button} == 2) {
300 $::CONN->send ("apply $self->{tag}");
301 } elsif ($ev->{button} == 3) {
302 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
303 if ($self->{container} == $::CONN->{open_container}) {
304 $move_prefix = "take";
305 }
306
307 my @menu_items = (
308 ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
309 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
310 ["ignite/thaw", # first try of an easier use of flint&steel
311 sub {
312 $::CONN->send ("mark ". pack "N", $self->{tag});
313 $::CONN->send ("command apply flint and steel");
314 }
315 ],
316 ["inscribe", # first try of an easier use of flint&steel
317 sub {
318 &::open_string_query ("Text to inscribe", sub {
319 my ($entry, $txt) = @_;
320 $::CONN->send ("mark ". pack "N", $self->{tag});
321 $::CONN->send ("command use_skill inscription $txt");
322 });
323 }
324 ],
325 ["rename", # first try of an easier use of flint&steel
326 sub {
327 &::open_string_query ("Rename item to:", sub {
328 my ($entry, $txt) = @_;
329 $::CONN->send ("mark ". pack "N", $self->{tag});
330 $::CONN->send ("command rename to <$txt>");
331 }, $self->{name},
332 "If you input no name or erase the current custom name, the custom name will be unset");
333 }
334 ],
335 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
336 (
337 $self->{flags} & F_LOCKED
338 ? (
339 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
340 )
341 : (
342 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
343 ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
344 ["$move_prefix &lt;n&gt;",
345 sub {
346 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
347 }
348 ]
349 )
350 ),
351 );
352
353 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
354 }
355
356 1
357 };
358
359 my $tooltip_std = "<small>"
360 . "Left click - examine item\n"
361 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
362 . "Middle click - apply\n"
363 . "Shift-Middle click - lock/unlock\n"
364 . "Right click - further options"
365 . "</small>\n";
366
367 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
368 : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
369 : undef;
370
371 $self->{face_widget} ||= new CFPlus::UI::Face
372 can_events => 1,
373 can_hover => 1,
374 anim => $self->{anim},
375 animspeed => $self->{animspeed}, # TODO# must be set at creation time
376 on_button_down => $button_cb,
377 ;
378 $self->{face_widget}{bg} = $bg;
379 $self->{face_widget}{face} = $self->{face};
380 $self->{face_widget}{anim} = $self->{anim};
381 $self->{face_widget}{animspeed} = $self->{animspeed};
382 $self->{face_widget}->set_tooltip (
383 "<b>Face/Animation.</b>\n"
384 . "Item uses face #$self->{face}. "
385 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
386 . "\n\n$tooltip_std"
387 );
388
389 $self->{desc_widget} ||= new CFPlus::UI::Label
390 can_events => 1,
391 can_hover => 1,
392 ellipsise => 2,
393 align => -1,
394 on_button_down => $button_cb,
395 ;
396 my $desc = CFPlus::Item::desc_string $self;
397 $self->{desc_widget}{bg} = $bg;
398 $self->{desc_widget}->set_text ($desc);
399 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
400
401 $self->{weight_widget} ||= new CFPlus::UI::Label
402 can_events => 1,
403 can_hover => 1,
404 ellipsise => 0,
405 align => 0,
406 on_button_down => $button_cb,
407 ;
408 $self->{weight_widget}{bg} = $bg;
409 $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self);
410 $self->{weight_widget}->set_tooltip (
411 "<b>Weight</b>.\n"
412 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
413 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
414 . "\n\n$tooltip_std"
415 );
416}
417
4181; 3141;
419 315
420=back 316=back
421 317
422=head1 AUTHOR 318=head1 AUTHOR

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines