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.102 by root, Sat Jul 22 13:20:33 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",
… …
45 Arm => "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value. This is the same as the physical resistance.", 46 Arm => "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value. This is the same as the physical resistance.",
46 Spd => "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed.", 47 Spd => "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed.",
47 WSp => "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed.", 48 WSp => "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed.",
48); 49);
49 50
50package CFClient::PodToPango; 51=item guard { BLOCK }
51 52
52use base Pod::POM::View::Text; 53Returns an object that executes the given block as soon as it is destroyed.
53 54
54our $VERSION = 1; # bump if resultant formatting changes 55=cut
55 56
56our $indent = 0; 57sub guard(&) {
57 58 bless \(my $cb = $_[0]), "CFClient::Guard"
58*view_seq_code =
59*view_seq_bold = sub { "<b>$_[1]</b>" };
60*view_seq_italic = sub { "<i>$_[1]</i>" };
61*view_seq_space =
62*view_seq_link =
63*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
64
65sub view_seq_text {
66 my $text = $_[1];
67 $text =~ s/\s+/ /g;
68 CFClient::UI::Label::escape ($text)
69} 59}
70 60
71sub view_item { 61sub CFClient::Guard::DESTROY {
72 ("\t" x ($indent / 4)) 62 ${$_[0]}->()
73 . $_[1]->title->present ($_[0])
74 . "\n\n"
75 . $_[1]->content->present ($_[0])
76} 63}
77 64
78sub view_verbatim { 65sub asxml($) {
79 (join "", 66 local $_ = $_[0];
80 map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
81 split /\n/, CFClient::UI::Label::escape ($_[1]))
82 . "\n"
83}
84 67
85sub view_textblock { 68 s/&/&amp;/g;
86 ("\t" x ($indent / 2)) . "$_[1]\n\n" 69 s/>/&gt;/g;
87} 70 s/</&lt;/g;
88 71
89sub view_head1 { 72 $_
90 "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
91 . $_[1]->content->present ($_[0])
92};
93
94sub view_head2 {
95 "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
96 . $_[1]->content->present ($_[0])
97};
98
99sub view_head3 {
100 "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
101 . $_[1]->content->present ($_[0])
102};
103
104sub view_over {
105 local $indent = $indent + $_[1]->indent;
106 $_[1]->content->present ($_[0])
107} 73}
108 74
109package CFClient::Database; 75package CFClient::Database;
110 76
111our @ISA = BerkeleyDB::Btree::; 77our @ISA = BerkeleyDB::Btree::;
… …
139 } 105 }
140 106
141 die "FATAL: can't find required file $_[0]\n"; 107 die "FATAL: can't find required file $_[0]\n";
142} 108}
143 109
110sub parse_yaml {
111 my $text = shift;
112
113 utf8::decode $text;
114
115 YAML::Load $text
116}
117
144sub read_cfg { 118sub read_cfg {
145 my ($file) = @_; 119 my ($file) = @_;
146 120
147 open CFG, $file 121 open my $fh, $file
148 or return; 122 or return;
149 123
150 my $CFG;
151
152 local $/; 124 local $/;
153 $CFG = eval <CFG>; 125 my $CFG = <$fh>;
154 126
127 if ($CFG =~ /^---/) {
128 $::CFG = parse_yaml $CFG;
129 } else {
155 $::CFG = $CFG; 130 $::CFG = eval $CFG;
156 131 }
157 close CFG;
158} 132}
159 133
160sub write_cfg { 134sub write_cfg {
161 my ($file) = @_; 135 my ($file) = @_;
162 136
163 open CFG, ">$file" 137 $::CFG->{VERSION} = $::VERSION;
138
139 open my $fh, ">:utf8", $file
164 or return; 140 or return;
165 141 print $fh YAML::Dump $::CFG;
166 {
167 require Data::Dumper;
168 local $Data::Dumper::Purity = 1;
169 $::CFG->{VERSION} = $::VERSION;
170 print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
171 }
172
173 close CFG;
174} 142}
175 143
176our $DB_ENV; 144our $DB_ENV;
177 145
178{ 146{
… …
205# -Filename => "database", 173# -Filename => "database",
206# -Subname => $table, 174# -Subname => $table,
207 -Property => DB_CHKSUM, 175 -Property => DB_CHKSUM,
208 -Flags => DB_CREATE | DB_UPGRADE, 176 -Flags => DB_CREATE | DB_UPGRADE,
209 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" 177 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
210}
211
212my $pod_cache = db_table "pod_cache";
213
214sub load_pod($$$$) {
215 my ($path, $filtertype, $filterversion, $filtercb) = @_;
216
217 stat $path
218 or die "$path: $!";
219
220 my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
221
222 my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
223
224 return $pom if $chash eq $phash;
225
226 my $pod = do {
227 local $/;
228 open my $pod, "<:utf8", $_[0]
229 or die "$_[0]: $!";
230 <$pod>
231 };
232
233 #utf8::downgrade $pod;
234
235 $pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
236
237 $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
238
239 $pom
240}
241
242sub pod_to_pango($) {
243 my ($pom) = @_;
244
245 $pom->present ("CFClient::PodToPango")
246}
247
248sub pod_to_pango_list($) {
249 my ($pom) = @_;
250
251 [
252 map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "],
253 split /\n/, $pom->present ("CFClient::PodToPango")
254 ]
255} 178}
256 179
257package CFClient::Layout; 180package CFClient::Layout;
258 181
259$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub { 182$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
… …
376 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], 299 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
377 ) 300 )
378 : ( 301 : (
379 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], 302 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
380 ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }], 303 ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
381 ["$move_prefix n", 304 ["$move_prefix &lt;n&gt;",
382 sub { 305 sub {
383 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") }) 306 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
384 } 307 }
385 ] 308 ]
386 ) 309 )
… …
399 . "Middle click - apply\n" 322 . "Middle click - apply\n"
400 . "Shift-Middle click - lock/unlock\n" 323 . "Shift-Middle click - lock/unlock\n"
401 . "Right click - further options" 324 . "Right click - further options"
402 . "</small>\n"; 325 . "</small>\n";
403 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
404 $self->{face_widget} ||= new CFClient::UI::Face 331 $self->{face_widget} ||= new CFClient::UI::Face
405 can_events => 1, 332 can_events => 1,
406 can_hover => 1, 333 can_hover => 1,
407 anim => $self->{anim}, 334 anim => $self->{anim},
408 animspeed => $self->{animspeed}, # TODO# must be set at creation time 335 animspeed => $self->{animspeed}, # TODO# must be set at creation time
409 on_button_down => $button_cb, 336 on_button_down => $button_cb,
410 ; 337 ;
338 $self->{face_widget}{bg} = $bg;
411 $self->{face_widget}{face} = $self->{face}; 339 $self->{face_widget}{face} = $self->{face};
412 $self->{face_widget}{anim} = $self->{anim}; 340 $self->{face_widget}{anim} = $self->{anim};
413 $self->{face_widget}{animspeed} = $self->{animspeed}; 341 $self->{face_widget}{animspeed} = $self->{animspeed};
414 $self->{face_widget}->set_tooltip ( 342 $self->{face_widget}->set_tooltip (
415 "<b>Face/Animation.</b>\n" 343 "<b>Face/Animation.</b>\n"
… …
424 ellipsise => 2, 352 ellipsise => 2,
425 align => -1, 353 align => -1,
426 on_button_down => $button_cb, 354 on_button_down => $button_cb,
427 ; 355 ;
428 my $desc = CFClient::Item::desc_string $self; 356 my $desc = CFClient::Item::desc_string $self;
357 $self->{desc_widget}{bg} = $bg;
429 $self->{desc_widget}->set_text ($desc); 358 $self->{desc_widget}->set_text ($desc);
430 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std"); 359 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
431 360
432 $self->{weight_widget} ||= new CFClient::UI::Label 361 $self->{weight_widget} ||= new CFClient::UI::Label
433 can_events => 1, 362 can_events => 1,
434 can_hover => 1, 363 can_hover => 1,
435 ellipsise => 0, 364 ellipsise => 0,
436 align => 0, 365 align => 0,
437 on_button_down => $button_cb, 366 on_button_down => $button_cb,
438 ; 367 ;
368 $self->{weight_widget}{bg} = $bg;
439 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self); 369 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
440
441 $self->{weight_widget}->set_tooltip ( 370 $self->{weight_widget}->set_tooltip (
442 "<b>Weight</b>.\n" 371 "<b>Weight</b>.\n"
443 . ($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. ")
444 . ($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. ")
445 . "\n\n$tooltip_std" 374 . "\n\n$tooltip_std"

Diff Legend

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