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.104 by root, Sun Jul 23 11:09:57 2006 UTC vs.
Revision 1.107 by root, Mon Jul 24 08:23:27 2006 UTC

… …
26use Carp (); 26use Carp ();
27use AnyEvent (); 27use AnyEvent ();
28use BerkeleyDB; 28use BerkeleyDB;
29use Pod::POM (); 29use Pod::POM ();
30use Scalar::Util (); 30use Scalar::Util ();
31use YAML ();
31use Storable (); # finally 32use Storable (); # finally
32 33
33our %STAT_TOOLTIP = ( 34our %STAT_TOOLTIP = (
34 Str => "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack", 35 Str => "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack",
35 Dex => "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed", 36 Dex => "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed",
… …
59 60
60sub CFClient::Guard::DESTROY { 61sub CFClient::Guard::DESTROY {
61 ${$_[0]}->() 62 ${$_[0]}->()
62} 63}
63 64
64package CFClient::PodToPango; 65sub asxml($) {
66 local $_ = $_[0];
65 67
66use base Pod::POM::View::Text; 68 s/&/&amp;/g;
69 s/>/&gt;/g;
70 s/</&lt;/g;
67 71
68our $VERSION = 1; # bump if resultant formatting changes 72 $_
69
70our $indent = 0;
71
72*view_seq_code =
73*view_seq_bold = sub { "<b>$_[1]</b>" };
74*view_seq_italic = sub { "<i>$_[1]</i>" };
75*view_seq_space =
76*view_seq_link =
77*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
78
79sub view_seq_text {
80 my $text = $_[1];
81 $text =~ s/\s+/ /g;
82 CFClient::UI::Label::escape ($text)
83}
84
85sub view_item {
86 ("\t" x ($indent / 4))
87 . $_[1]->title->present ($_[0])
88 . "\n\n"
89 . $_[1]->content->present ($_[0])
90}
91
92sub view_verbatim {
93 (join "",
94 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
95 split /\n/, CFClient::UI::Label::escape ($_[1]))
96 . "\n"
97}
98
99sub view_textblock {
100 ("\t" x ($indent / 2)) . "$_[1]\n\n"
101}
102
103sub view_head1 {
104 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
105 . $_[1]->content->present ($_[0])
106};
107
108sub view_head2 {
109 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
110 . $_[1]->content->present ($_[0])
111};
112
113sub view_head3 {
114 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
115 . $_[1]->content->present ($_[0])
116};
117
118sub view_over {
119 local $indent = $indent + $_[1]->indent;
120 $_[1]->content->present ($_[0])
121} 73}
122 74
123package CFClient::Database; 75package CFClient::Database;
124 76
125our @ISA = BerkeleyDB::Btree::; 77our @ISA = BerkeleyDB::Btree::;
… …
153 } 105 }
154 106
155 die "FATAL: can't find required file $_[0]\n"; 107 die "FATAL: can't find required file $_[0]\n";
156} 108}
157 109
110sub parse_yaml {
111 my $text = shift;
112
113 utf8::decode $text;
114
115 YAML::Load $text
116}
117
158sub read_cfg { 118sub read_cfg {
159 my ($file) = @_; 119 my ($file) = @_;
160 120
161 open CFG, $file 121 open my $fh, $file
162 or return; 122 or return;
163 123
164 my $CFG;
165
166 local $/; 124 local $/;
167 $CFG = eval <CFG>; 125 my $CFG = <$fh>;
168 126
127 if ($CFG =~ /^---/) {
128 $::CFG = parse_yaml $CFG;
129 } else {
169 $::CFG = $CFG; 130 $::CFG = eval $CFG;
170 131 }
171 close CFG;
172} 132}
173 133
174sub write_cfg { 134sub write_cfg {
175 my ($file) = @_; 135 my ($file) = @_;
176 136
177 open CFG, ">$file" 137 $::CFG->{VERSION} = $::VERSION;
138
139 open my $fh, ">:utf8", $file
178 or return; 140 or return;
179 141 print $fh YAML::Dump $::CFG;
180 {
181 require Data::Dumper;
182 local $Data::Dumper::Purity = 1;
183 $::CFG->{VERSION} = $::VERSION;
184 print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
185 }
186
187 close CFG;
188} 142}
189 143
190our $DB_ENV; 144our $DB_ENV;
191 145
192{ 146{
… …
219# -Filename => "database", 173# -Filename => "database",
220# -Subname => $table, 174# -Subname => $table,
221 -Property => DB_CHKSUM, 175 -Property => DB_CHKSUM,
222 -Flags => DB_CREATE | DB_UPGRADE, 176 -Flags => DB_CREATE | DB_UPGRADE,
223 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" 177 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
224}
225
226my $pod_cache = db_table "pod_cache";
227
228sub load_pod($$$$) {
229 my ($path, $filtertype, $filterversion, $filtercb) = @_;
230
231 stat $path
232 or die "$path: $!";
233
234 my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
235
236 my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
237
238 return $pom if $chash eq $phash;
239
240 my $pod = do {
241 local $/;
242 open my $pod, "<:utf8", $_[0]
243 or die "$_[0]: $!";
244 <$pod>
245 };
246
247 #utf8::downgrade $pod;
248
249 $pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
250
251 $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
252
253 $pom
254}
255
256sub pod_to_pango($) {
257 my ($pom) = @_;
258
259 $pom->present ("CFClient::PodToPango")
260}
261
262sub pod_to_pango_list($) {
263 my ($pom) = @_;
264
265 [
266 map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "],
267 split /\n/, $pom->present ("CFClient::PodToPango")
268 ]
269} 178}
270 179
271package CFClient::Layout; 180package CFClient::Layout;
272 181
273$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub { 182$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
… …
413 . "Middle click - apply\n" 322 . "Middle click - apply\n"
414 . "Shift-Middle click - lock/unlock\n" 323 . "Shift-Middle click - lock/unlock\n"
415 . "Right click - further options" 324 . "Right click - further options"
416 . "</small>\n"; 325 . "</small>\n";
417 326
327 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
328 : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
329 : undef;
330
418 $self->{face_widget} ||= new CFClient::UI::Face 331 $self->{face_widget} ||= new CFClient::UI::Face
419 can_events => 1, 332 can_events => 1,
420 can_hover => 1, 333 can_hover => 1,
421 anim => $self->{anim}, 334 anim => $self->{anim},
422 animspeed => $self->{animspeed}, # TODO# must be set at creation time 335 animspeed => $self->{animspeed}, # TODO# must be set at creation time
423 on_button_down => $button_cb, 336 on_button_down => $button_cb,
424 ; 337 ;
338 $self->{face_widget}{bg} = $bg;
425 $self->{face_widget}{face} = $self->{face}; 339 $self->{face_widget}{face} = $self->{face};
426 $self->{face_widget}{anim} = $self->{anim}; 340 $self->{face_widget}{anim} = $self->{anim};
427 $self->{face_widget}{animspeed} = $self->{animspeed}; 341 $self->{face_widget}{animspeed} = $self->{animspeed};
428 $self->{face_widget}->set_tooltip ( 342 $self->{face_widget}->set_tooltip (
429 "<b>Face/Animation.</b>\n" 343 "<b>Face/Animation.</b>\n"
… …
438 ellipsise => 2, 352 ellipsise => 2,
439 align => -1, 353 align => -1,
440 on_button_down => $button_cb, 354 on_button_down => $button_cb,
441 ; 355 ;
442 my $desc = CFClient::Item::desc_string $self; 356 my $desc = CFClient::Item::desc_string $self;
357 $self->{desc_widget}{bg} = $bg;
443 $self->{desc_widget}->set_text ($desc); 358 $self->{desc_widget}->set_text ($desc);
444 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std"); 359 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
445 360
446 $self->{weight_widget} ||= new CFClient::UI::Label 361 $self->{weight_widget} ||= new CFClient::UI::Label
447 can_events => 1, 362 can_events => 1,
448 can_hover => 1, 363 can_hover => 1,
449 ellipsise => 0, 364 ellipsise => 0,
450 align => 0, 365 align => 0,
451 on_button_down => $button_cb, 366 on_button_down => $button_cb,
452 ; 367 ;
368 $self->{weight_widget}{bg} = $bg;
453 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self); 369 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
454
455 $self->{weight_widget}->set_tooltip ( 370 $self->{weight_widget}->set_tooltip (
456 "<b>Weight</b>.\n" 371 "<b>Weight</b>.\n"
457 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ") 372 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
458 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") 373 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
459 . "\n\n$tooltip_std" 374 . "\n\n$tooltip_std"

Diff Legend

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