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.125 by root, Wed Oct 18 12:53:45 2006 UTC vs.
Revision 1.140 by root, Fri Apr 6 07:45:33 2007 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines