ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC.pm
Revision: 1.112
Committed: Sun Aug 13 03:20:53 2006 UTC (17 years, 9 months ago) by root
Branch: MAIN
Changes since 1.111: +0 -17 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3 root 1.108 CFPlus - undocumented utility garbage for our crossfire client
4 root 1.1
5     =head1 SYNOPSIS
6    
7 root 1.108 use CFPlus;
8 root 1.1
9     =head1 DESCRIPTION
10    
11     =over 4
12    
13     =cut
14    
15 root 1.108 package CFPlus;
16 root 1.1
17     BEGIN {
18 root 1.111 $VERSION = '0.2';
19 root 1.1
20 root 1.2 use XSLoader;
21 root 1.108 XSLoader::load "CFPlus", $VERSION;
22 root 1.1 }
23    
24 root 1.62 use utf8;
25    
26 root 1.43 use Carp ();
27 root 1.52 use AnyEvent ();
28 root 1.34 use BerkeleyDB;
29 root 1.89 use Pod::POM ();
30 root 1.92 use Scalar::Util ();
31 root 1.89 use Storable (); # finally
32    
33 root 1.103 =item guard { BLOCK }
34    
35     Returns an object that executes the given block as soon as it is destroyed.
36    
37     =cut
38    
39     sub guard(&) {
40 root 1.108 bless \(my $cb = $_[0]), "CFPlus::Guard"
41 root 1.103 }
42    
43 root 1.108 sub CFPlus::Guard::DESTROY {
44 root 1.103 ${$_[0]}->()
45     }
46    
47 root 1.105 sub asxml($) {
48     local $_ = $_[0];
49 root 1.89
50 root 1.105 s/&/&/g;
51     s/>/>/g;
52     s/</&lt;/g;
53 root 1.89
54 root 1.105 $_
55 root 1.89 }
56    
57 root 1.108 package CFPlus::Database;
58 root 1.89
59     our @ISA = BerkeleyDB::Btree::;
60    
61     sub get($$) {
62     my $data;
63    
64     $_[0]->db_get ($_[1], $data) == 0
65     ? $data
66     : ()
67     }
68    
69     my %DB_SYNC;
70    
71     sub put($$$) {
72     my ($db, $key, $data) = @_;
73    
74     $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
75    
76     $db->db_put ($key => $data)
77     }
78    
79 root 1.108 package CFPlus;
80 root 1.52
81 root 1.5 sub find_rcfile($) {
82     my $path;
83    
84 root 1.46 for (grep !ref, @INC) {
85 root 1.108 $path = "$_/CFPlus/resources/$_[0]";
86 root 1.5 return $path if -r $path;
87     }
88    
89     die "FATAL: can't find required file $_[0]\n";
90     }
91    
92 root 1.110 BEGIN {
93     use Crossfire::Protocol::Base ();
94     *to_json = \&Crossfire::Protocol::Base::to_json;
95     *from_json = \&Crossfire::Protocol::Base::from_json;
96 root 1.107 }
97    
98 root 1.5 sub read_cfg {
99     my ($file) = @_;
100    
101 root 1.107 open my $fh, $file
102 root 1.5 or return;
103    
104     local $/;
105 root 1.107 my $CFG = <$fh>;
106 root 1.5
107 root 1.108 if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
108     require YAML;
109     utf8::decode $CFG;
110     $::CFG = YAML::Load ($CFG);
111     } elsif ($CFG =~ /^\{/) {
112     $::CFG = from_json $CFG;
113 root 1.107 } else {
114 root 1.108 $::CFG = eval $CFG; ## todo comaptibility cruft
115 root 1.107 }
116 root 1.5 }
117    
118     sub write_cfg {
119     my ($file) = @_;
120    
121 root 1.107 $::CFG->{VERSION} = $::VERSION;
122    
123     open my $fh, ">:utf8", $file
124 root 1.5 or return;
125 root 1.108 print $fh to_json $::CFG;
126 root 1.5 }
127    
128 root 1.77 our $DB_ENV;
129    
130 root 1.76 {
131     use strict;
132    
133 root 1.87 mkdir "$Crossfire::VARDIR/cfplus", 0777;
134 root 1.77 my $recover = $BerkeleyDB::db_version >= 4.4
135     ? eval "DB_REGISTER | DB_RECOVER"
136     : 0;
137    
138     $DB_ENV = new BerkeleyDB::Env
139 root 1.76 -Home => "$Crossfire::VARDIR/cfplus",
140     -Cachesize => 1_000_000,
141     -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
142 root 1.39 # -ErrPrefix => "DATABASE",
143 root 1.76 -Verbose => 1,
144 root 1.77 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
145 root 1.78 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
146 root 1.76 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
147     }
148 root 1.34
149     sub db_table($) {
150 root 1.38 my ($table) = @_;
151    
152     $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
153 root 1.76
154 root 1.108 new CFPlus::Database
155 root 1.34 -Env => $DB_ENV,
156 root 1.38 -Filename => $table,
157     # -Filename => "database",
158     # -Subname => $table,
159 root 1.51 -Property => DB_CHKSUM,
160 root 1.34 -Flags => DB_CREATE | DB_UPGRADE,
161 root 1.76 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
162 root 1.34 }
163    
164 root 1.108 package CFPlus::Layout;
165 root 1.97
166 root 1.108 $CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
167 root 1.98 reset_glyph_cache;
168 root 1.97 };
169    
170 root 1.108 package CFPlus::Item;
171 root 1.62
172 root 1.71 use strict;
173     use Crossfire::Protocol::Constants;
174    
175 elmex 1.84 my $last_enter_count = 1;
176    
177 root 1.62 sub desc_string {
178     my ($self) = @_;
179    
180     my $desc =
181     $self->{nrof} < 2
182     ? $self->{name}
183     : "$self->{nrof} × $self->{name_pl}";
184    
185 root 1.71 $self->{flags} & F_OPEN
186 root 1.62 and $desc .= " (open)";
187 root 1.71 $self->{flags} & F_APPLIED
188 root 1.62 and $desc .= " (applied)";
189 root 1.71 $self->{flags} & F_UNPAID
190 root 1.62 and $desc .= " (unpaid)";
191 root 1.71 $self->{flags} & F_MAGIC
192 root 1.62 and $desc .= " (magic)";
193 root 1.71 $self->{flags} & F_CURSED
194 root 1.62 and $desc .= " (cursed)";
195 root 1.71 $self->{flags} & F_DAMNED
196 root 1.62 and $desc .= " (damned)";
197 root 1.71 $self->{flags} & F_LOCKED
198 root 1.62 and $desc .= " *";
199    
200     $desc
201     }
202    
203     sub weight_string {
204     my ($self) = @_;
205    
206     my $weight = ($self->{nrof} || 1) * $self->{weight};
207    
208     $weight < 0 ? "?" : $weight * 0.001
209     }
210    
211 elmex 1.84 sub do_n_dialog {
212     my ($cb) = @_;
213    
214 root 1.108 my $w = new CFPlus::UI::FancyFrame
215 root 1.100 on_delete => sub { $_[0]->destroy; 1 },
216     has_close_button => 1,
217     ;
218    
219 root 1.108 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
220     $vb->add (new CFPlus::UI::Label text => "Enter item count:");
221     $vb->add (my $entry = new CFPlus::UI::Entry
222 elmex 1.84 text => $last_enter_count,
223     on_activate => sub {
224     my ($entry) = @_;
225     $last_enter_count = $entry->get_text;
226     $cb->($last_enter_count);
227     $w->hide;
228 root 1.100 $w->destroy;
229    
230     0
231     },
232     on_escape => sub { $w->destroy; 1 },
233 elmex 1.84 );
234 root 1.93 $entry->grab_focus;
235 elmex 1.84 $w->show;
236     }
237    
238 root 1.62 sub update_widgets {
239     my ($self) = @_;
240    
241 root 1.92 # necessary to avoid cyclic references
242     Scalar::Util::weaken $self;
243    
244 root 1.63 my $button_cb = sub {
245     my (undef, $ev, $x, $y) = @_;
246    
247 elmex 1.84 my $targ = $::CONN->{player}{tag};
248 root 1.63
249 elmex 1.84 if ($self->{container} == $::CONN->{player}{tag}) {
250     $targ = $::CONN->{open_container};
251     }
252 root 1.63
253 root 1.108 if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
254 root 1.79 $::CONN->send ("move $targ $self->{tag} 0")
255     if $targ || !($self->{flags} & F_LOCKED);
256 root 1.108 } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) {
257 elmex 1.86 $self->{flags} & F_LOCKED
258     ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
259     : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
260 root 1.63 } elsif ($ev->{button} == 1) {
261     $::CONN->send ("examine $self->{tag}");
262     } elsif ($ev->{button} == 2) {
263     $::CONN->send ("apply $self->{tag}");
264     } elsif ($ev->{button} == 3) {
265 elmex 1.101 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
266     if ($self->{container} == $::CONN->{open_container}) {
267     $move_prefix = "take";
268     }
269    
270 root 1.63 my @menu_items = (
271     ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
272     ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
273 elmex 1.99 ["ignite/thaw", # first try of an easier use of flint&steel
274     sub {
275     $::CONN->send ("mark ". pack "N", $self->{tag});
276     $::CONN->send ("command apply flint and steel");
277     }
278     ],
279 elmex 1.109 ["inscribe", # first try of an easier use of flint&steel
280     sub {
281     &::open_string_query ("Text to inscribe", sub {
282     my ($entry, $txt) = @_;
283     $::CONN->send ("mark ". pack "N", $self->{tag});
284     $::CONN->send ("command use_skill inscription $txt");
285     });
286     }
287     ],
288 root 1.63 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
289     (
290 root 1.71 $self->{flags} & F_LOCKED
291 root 1.63 ? (
292     ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
293     )
294     : (
295     ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
296 elmex 1.101 ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
297 root 1.104 ["$move_prefix &lt;n&gt;",
298 elmex 1.84 sub {
299     do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
300     }
301     ]
302 root 1.63 )
303     ),
304     );
305    
306 root 1.108 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
307 root 1.63 }
308    
309     1
310     };
311    
312 root 1.62 my $tooltip_std = "<small>"
313     . "Left click - examine item\n"
314     . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
315     . "Middle click - apply\n"
316 elmex 1.86 . "Shift-Middle click - lock/unlock\n"
317 root 1.62 . "Right click - further options"
318     . "</small>\n";
319    
320 root 1.106 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
321     : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
322     : undef;
323    
324 root 1.108 $self->{face_widget} ||= new CFPlus::UI::Face
325 root 1.63 can_events => 1,
326     can_hover => 1,
327 root 1.67 anim => $self->{anim},
328 root 1.66 animspeed => $self->{animspeed}, # TODO# must be set at creation time
329 root 1.72 on_button_down => $button_cb,
330 root 1.63 ;
331 root 1.106 $self->{face_widget}{bg} = $bg;
332 root 1.62 $self->{face_widget}{face} = $self->{face};
333     $self->{face_widget}{anim} = $self->{anim};
334 root 1.65 $self->{face_widget}{animspeed} = $self->{animspeed};
335 root 1.62 $self->{face_widget}->set_tooltip (
336     "<b>Face/Animation.</b>\n"
337     . "Item uses face #$self->{face}. "
338     . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
339     . "\n\n$tooltip_std"
340     );
341    
342 root 1.108 $self->{desc_widget} ||= new CFPlus::UI::Label
343 root 1.63 can_events => 1,
344     can_hover => 1,
345     ellipsise => 2,
346 root 1.68 align => -1,
347 root 1.72 on_button_down => $button_cb,
348 root 1.63 ;
349 root 1.108 my $desc = CFPlus::Item::desc_string $self;
350 root 1.106 $self->{desc_widget}{bg} = $bg;
351 root 1.63 $self->{desc_widget}->set_text ($desc);
352     $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
353    
354 root 1.108 $self->{weight_widget} ||= new CFPlus::UI::Label
355 root 1.63 can_events => 1,
356     can_hover => 1,
357     ellipsise => 0,
358 root 1.68 align => 0,
359 root 1.72 on_button_down => $button_cb,
360 root 1.63 ;
361 root 1.106 $self->{weight_widget}{bg} = $bg;
362 root 1.108 $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self);
363 root 1.62 $self->{weight_widget}->set_tooltip (
364     "<b>Weight</b>.\n"
365     . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
366     . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
367     . "\n\n$tooltip_std"
368     );
369     }
370    
371 root 1.1 1;
372    
373     =back
374    
375     =head1 AUTHOR
376    
377     Marc Lehmann <schmorp@schmorp.de>
378     http://home.schmorp.de/
379    
380     =cut
381