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.71 by root, Fri May 26 20:36:32 2006 UTC vs.
Revision 1.100 by root, Sun Jul 16 20:04:07 2006 UTC

… …
24use utf8; 24use utf8;
25 25
26use Carp (); 26use Carp ();
27use AnyEvent (); 27use AnyEvent ();
28use BerkeleyDB; 28use BerkeleyDB;
29use Pod::POM ();
30use Scalar::Util ();
31use Storable (); # finally
32
33package CFClient::PodToPango;
34
35use base Pod::POM::View::Text;
36
37our $VERSION = 1; # bump if resultant formatting changes
38
39our $indent = 0;
40
41*view_seq_code =
42*view_seq_bold = sub { "<b>$_[1]</b>" };
43*view_seq_italic = sub { "<i>$_[1]</i>" };
44*view_seq_space =
45*view_seq_link =
46*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
47
48sub view_seq_text {
49 my $text = $_[1];
50 $text =~ s/\s+/ /g;
51 CFClient::UI::Label::escape ($text)
52}
53
54sub view_item {
55 ("\t" x ($indent / 4))
56 . $_[1]->title->present ($_[0])
57 . "\n\n"
58 . $_[1]->content->present ($_[0])
59}
60
61sub view_verbatim {
62 (join "",
63 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
64 split /\n/, CFClient::UI::Label::escape ($_[1]))
65 . "\n"
66}
67
68sub view_textblock {
69 ("\t" x ($indent / 2)) . "$_[1]\n\n"
70}
71
72sub view_head1 {
73 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
74 . $_[1]->content->present ($_[0])
75};
76
77sub view_head2 {
78 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
79 . $_[1]->content->present ($_[0])
80};
81
82sub view_head3 {
83 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
84 . $_[1]->content->present ($_[0])
85};
86
87sub view_over {
88 local $indent = $indent + $_[1]->indent;
89 $_[1]->content->present ($_[0])
90}
91
92package CFClient::Database;
93
94our @ISA = BerkeleyDB::Btree::;
95
96sub get($$) {
97 my $data;
98
99 $_[0]->db_get ($_[1], $data) == 0
100 ? $data
101 : ()
102}
103
104my %DB_SYNC;
105
106sub put($$$) {
107 my ($db, $key, $data) = @_;
108
109 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
110
111 $db->db_put ($key => $data)
112}
113
114package CFClient;
29 115
30sub find_rcfile($) { 116sub find_rcfile($) {
31 my $path; 117 my $path;
32 118
33 for (grep !ref, @INC) { 119 for (grep !ref, @INC) {
… …
68 } 154 }
69 155
70 close CFG; 156 close CFG;
71} 157}
72 158
159our $DB_ENV;
160
161{
162 use strict;
163
73mkdir "$Crossfire::VARDIR/pclient", 0777; 164 mkdir "$Crossfire::VARDIR/cfplus", 0777;
165 my $recover = $BerkeleyDB::db_version >= 4.4
166 ? eval "DB_REGISTER | DB_RECOVER"
167 : 0;
74 168
75our $DB_ENV = new BerkeleyDB::Env 169 $DB_ENV = new BerkeleyDB::Env
76 -Home => "$Crossfire::VARDIR/pclient", 170 -Home => "$Crossfire::VARDIR/cfplus",
77 -Cachesize => 1_000_000, 171 -Cachesize => 1_000_000,
78 -ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt", 172 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
79# -ErrPrefix => "DATABASE", 173# -ErrPrefix => "DATABASE",
80 -Verbose => 1, 174 -Verbose => 1,
81 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN, 175 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
176 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
82 or die "unable to create/open database home $Crossfire::VARDIR/pclient: $BerkeleyDB::Error"; 177 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
178}
83 179
84sub db_table($) { 180sub db_table($) {
85 my ($table) = @_; 181 my ($table) = @_;
86 182
87 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; 183 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
88 184
89 new CFClient::Database 185 new CFClient::Database
90 -Env => $DB_ENV, 186 -Env => $DB_ENV,
91 -Filename => $table, 187 -Filename => $table,
92# -Filename => "database", 188# -Filename => "database",
93# -Subname => $table, 189# -Subname => $table,
94 -Property => DB_CHKSUM, 190 -Property => DB_CHKSUM,
95 -Flags => DB_CREATE | DB_UPGRADE, 191 -Flags => DB_CREATE | DB_UPGRADE,
96 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"; 192 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
193}
194
195my $pod_cache = db_table "pod_cache";
196
197sub load_pod($$$$) {
198 my ($path, $filtertype, $filterversion, $filtercb) = @_;
199
200 stat $path
201 or die "$path: $!";
202
203 my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
204
205 my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
206
207 return $pom if $chash eq $phash;
208
209 my $pod = do {
210 local $/;
211 open my $pod, "<:utf8", $_[0]
212 or die "$_[0]: $!";
213 <$pod>
214 };
215
216 #utf8::downgrade $pod;
217
218 $pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
219
220 $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
221
222 $pom
97} 223}
98 224
99sub pod_to_pango($) { 225sub pod_to_pango($) {
100 my ($pom) = @_; 226 my ($pom) = @_;
101 227
… …
109 map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], 235 map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "],
110 split /\n/, $pom->present ("CFClient::PodToPango") 236 split /\n/, $pom->present ("CFClient::PodToPango")
111 ] 237 ]
112} 238}
113 239
114package CFClient::PodToPango; 240package CFClient::Layout;
115 241
116use base Pod::POM::View::Text; 242$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
117 243 reset_glyph_cache;
118our $indent = 0;
119
120*view_seq_code =
121*view_seq_bold = sub { "<b>$_[1]</b>" };
122*view_seq_italic = sub { "<i>$_[1]</i>" };
123*view_seq_space =
124*view_seq_link =
125*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
126
127sub view_seq_text {
128 my $text = $_[1];
129 $text =~ s/\s+/ /g;
130 CFClient::UI::Label::escape ($text)
131}
132
133sub view_item {
134 ("\t" x ($indent / 4))
135 . $_[1]->title->present ($_[0])
136 . "\n"
137 . $_[1]->content->present ($_[0])
138}
139
140sub view_verbatim {
141 (join "",
142 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
143 split /\n/, CFClient::UI::Label::escape ($_[1]))
144 . "\n"
145}
146
147sub view_textblock {
148 ("\t" x ($indent / 2)) . "$_[1]\n\n"
149}
150
151sub view_head1 {
152 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
153 . $_[1]->content->present ($_[0])
154}; 244};
155
156sub view_head2 {
157 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
158 . $_[1]->content->present ($_[0])
159};
160
161sub view_head3 {
162 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
163 . $_[1]->content->present ($_[0])
164};
165
166sub view_over {
167 local $indent = $indent + $_[1]->indent;
168 $_[1]->content->present ($_[0])
169}
170
171package CFClient::Database;
172
173our @ISA = BerkeleyDB::Btree::;
174
175sub get($$) {
176 my $data;
177
178 $_[0]->db_get ($_[1], $data) == 0
179 ? $data
180 : ()
181}
182
183my %DB_SYNC;
184
185sub put($$$) {
186 my ($db, $key, $data) = @_;
187
188 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
189
190 $db->db_put ($key => $data)
191}
192 245
193package CFClient::Item; 246package CFClient::Item;
194 247
195use strict; 248use strict;
196use Crossfire::Protocol::Constants; 249use Crossfire::Protocol::Constants;
250
251my $last_enter_count = 1;
197 252
198sub desc_string { 253sub desc_string {
199 my ($self) = @_; 254 my ($self) = @_;
200 255
201 my $desc = 256 my $desc =
… …
227 my $weight = ($self->{nrof} || 1) * $self->{weight}; 282 my $weight = ($self->{nrof} || 1) * $self->{weight};
228 283
229 $weight < 0 ? "?" : $weight * 0.001 284 $weight < 0 ? "?" : $weight * 0.001
230} 285}
231 286
287sub do_n_dialog {
288 my ($cb) = @_;
289
290 my $w = new CFClient::UI::FancyFrame
291 on_delete => sub { $_[0]->destroy; 1 },
292 has_close_button => 1,
293 ;
294
295 $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
296 $vb->add (new CFClient::UI::Label text => "Enter item count:");
297 $vb->add (my $entry = new CFClient::UI::Entry
298 text => $last_enter_count,
299 on_activate => sub {
300 my ($entry) = @_;
301 $last_enter_count = $entry->get_text;
302 $cb->($last_enter_count);
303 $w->hide;
304 $w->destroy;
305
306 0
307 },
308 on_escape => sub { $w->destroy; 1 },
309 );
310 $entry->grab_focus;
311 $w->show;
312}
313
232sub update_widgets { 314sub update_widgets {
233 my ($self) = @_; 315 my ($self) = @_;
234 316
317 # necessary to avoid cyclic references
318 Scalar::Util::weaken $self;
319
235 my $button_cb = sub { 320 my $button_cb = sub {
236 my (undef, $ev, $x, $y) = @_; 321 my (undef, $ev, $x, $y) = @_;
237 322
323 my $targ = $::CONN->{player}{tag};
324
325 if ($self->{container} == $::CONN->{player}{tag}) {
326 $targ = $::CONN->{open_container};
327 }
328
238 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { 329 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
239 my $targ = $::CONN->{player}{tag};
240
241 if ($self->{container} == $::CONN->{player}{tag}) {
242 $targ = $::CONN->{open_container};
243 }
244
245 $::CONN->send ("move $targ $self->{tag} 0"); 330 $::CONN->send ("move $targ $self->{tag} 0")
331 if $targ || !($self->{flags} & F_LOCKED);
332 } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
333 $self->{flags} & F_LOCKED
334 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
335 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
246 } elsif ($ev->{button} == 1) { 336 } elsif ($ev->{button} == 1) {
247 $::CONN->send ("examine $self->{tag}"); 337 $::CONN->send ("examine $self->{tag}");
248 } elsif ($ev->{button} == 2) { 338 } elsif ($ev->{button} == 2) {
249 $::CONN->send ("apply $self->{tag}"); 339 $::CONN->send ("apply $self->{tag}");
250 } elsif ($ev->{button} == 3) { 340 } elsif ($ev->{button} == 3) {
251 my @menu_items = ( 341 my @menu_items = (
252 ["examine", sub { $::CONN->send ("examine $self->{tag}") }], 342 ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
253 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }], 343 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
344 ["ignite/thaw", # first try of an easier use of flint&steel
345 sub {
346 $::CONN->send ("mark ". pack "N", $self->{tag});
347 $::CONN->send ("command apply flint and steel");
348 }
349 ],
254 ["apply", sub { $::CONN->send ("apply $self->{tag}") }], 350 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
255 ( 351 (
256 $self->{flags} & F_LOCKED 352 $self->{flags} & F_LOCKED
257 ? ( 353 ? (
258 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], 354 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
259 ) 355 )
260 : ( 356 : (
261 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], 357 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
262 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }], 358 ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],
359 ["move n",
360 sub {
361 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
362 }
363 ]
263 ) 364 )
264 ), 365 ),
265 ); 366 );
266 367
267 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 368 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
… …
272 373
273 my $tooltip_std = "<small>" 374 my $tooltip_std = "<small>"
274 . "Left click - examine item\n" 375 . "Left click - examine item\n"
275 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" 376 . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
276 . "Middle click - apply\n" 377 . "Middle click - apply\n"
378 . "Shift-Middle click - lock/unlock\n"
277 . "Right click - further options" 379 . "Right click - further options"
278 . "</small>\n"; 380 . "</small>\n";
279 381
280 $self->{face_widget} ||= new CFClient::UI::Face 382 $self->{face_widget} ||= new CFClient::UI::Face
281 can_events => 1, 383 can_events => 1,
282 can_hover => 1, 384 can_hover => 1,
283 anim => $self->{anim}, 385 anim => $self->{anim},
284 animspeed => $self->{animspeed}, # TODO# must be set at creation time 386 animspeed => $self->{animspeed}, # TODO# must be set at creation time
285 connect_button_down => $button_cb, 387 on_button_down => $button_cb,
286 ; 388 ;
287 $self->{face_widget}{face} = $self->{face}; 389 $self->{face_widget}{face} = $self->{face};
288 $self->{face_widget}{anim} = $self->{anim}; 390 $self->{face_widget}{anim} = $self->{anim};
289 $self->{face_widget}{animspeed} = $self->{animspeed}; 391 $self->{face_widget}{animspeed} = $self->{animspeed};
290 $self->{face_widget}->set_tooltip ( 392 $self->{face_widget}->set_tooltip (
… …
297 $self->{desc_widget} ||= new CFClient::UI::Label 399 $self->{desc_widget} ||= new CFClient::UI::Label
298 can_events => 1, 400 can_events => 1,
299 can_hover => 1, 401 can_hover => 1,
300 ellipsise => 2, 402 ellipsise => 2,
301 align => -1, 403 align => -1,
302 connect_button_down => $button_cb, 404 on_button_down => $button_cb,
303 ; 405 ;
304 my $desc = CFClient::Item::desc_string $self; 406 my $desc = CFClient::Item::desc_string $self;
305 $self->{desc_widget}->set_text ($desc); 407 $self->{desc_widget}->set_text ($desc);
306 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std"); 408 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
307 409
308 $self->{weight_widget} ||= new CFClient::UI::Label 410 $self->{weight_widget} ||= new CFClient::UI::Label
309 can_events => 1, 411 can_events => 1,
310 can_hover => 1, 412 can_hover => 1,
311 ellipsise => 0, 413 ellipsise => 0,
312 align => 0, 414 align => 0,
313 connect_button_down => $button_cb, 415 on_button_down => $button_cb,
314 ; 416 ;
315 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self); 417 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
316 418
317 $self->{weight_widget}->set_tooltip ( 419 $self->{weight_widget}->set_tooltip (
318 "<b>Weight</b>.\n" 420 "<b>Weight</b>.\n"

Diff Legend

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