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.105 by root, Sun Jul 23 16:11:12 2006 UTC vs.
Revision 1.108 by root, Sun Jul 30 13:16:44 2006 UTC

1=head1 NAME 1=head1 NAME
2 2
3CFClient - undocumented utility garbage for our crossfire client 3CFPlus - undocumented utility garbage for our crossfire client
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use CFClient; 7 use CFPlus;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11=over 4 11=over 4
12 12
13=cut 13=cut
14 14
15package CFClient; 15package CFPlus;
16 16
17BEGIN { 17BEGIN {
18 $VERSION = '0.1'; 18 $VERSION = '0.1';
19 19
20 use XSLoader; 20 use XSLoader;
21 XSLoader::load "CFClient", $VERSION; 21 XSLoader::load "CFPlus", $VERSION;
22} 22}
23 23
24use utf8; 24use utf8;
25 25
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 JSON::Syck ();
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",
52Returns an object that executes the given block as soon as it is destroyed. 53Returns an object that executes the given block as soon as it is destroyed.
53 54
54=cut 55=cut
55 56
56sub guard(&) { 57sub guard(&) {
57 bless \(my $cb = $_[0]), "CFClient::Guard" 58 bless \(my $cb = $_[0]), "CFPlus::Guard"
58} 59}
59 60
60sub CFClient::Guard::DESTROY { 61sub CFPlus::Guard::DESTROY {
61 ${$_[0]}->() 62 ${$_[0]}->()
62} 63}
63 64
64sub asxml($) { 65sub asxml($) {
65 local $_ = $_[0]; 66 local $_ = $_[0];
69 s/</&lt;/g; 70 s/</&lt;/g;
70 71
71 $_ 72 $_
72} 73}
73 74
74package CFClient::Database; 75package CFPlus::Database;
75 76
76our @ISA = BerkeleyDB::Btree::; 77our @ISA = BerkeleyDB::Btree::;
77 78
78sub get($$) { 79sub get($$) {
79 my $data; 80 my $data;
91 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 92 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
92 93
93 $db->db_put ($key => $data) 94 $db->db_put ($key => $data)
94} 95}
95 96
96package CFClient; 97package CFPlus;
97 98
98sub find_rcfile($) { 99sub find_rcfile($) {
99 my $path; 100 my $path;
100 101
101 for (grep !ref, @INC) { 102 for (grep !ref, @INC) {
102 $path = "$_/CFClient/resources/$_[0]"; 103 $path = "$_/CFPlus/resources/$_[0]";
103 return $path if -r $path; 104 return $path if -r $path;
104 } 105 }
105 106
106 die "FATAL: can't find required file $_[0]\n"; 107 die "FATAL: can't find required file $_[0]\n";
107} 108}
108 109
110$JSON::Syck::ImplicitUnicode = 1;
111
112sub from_json {
113 JSON::Syck::Load $_[0]
114}
115
116sub to_json {
117 JSON::Syck::Dump $_[0]
118}
119
109sub read_cfg { 120sub read_cfg {
110 my ($file) = @_; 121 my ($file) = @_;
111 122
112 open CFG, $file 123 open my $fh, $file
113 or return; 124 or return;
114 125
115 my $CFG;
116
117 local $/; 126 local $/;
118 $CFG = eval <CFG>; 127 my $CFG = <$fh>;
119 128
120 $::CFG = $CFG; 129 if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
121 130 require YAML;
122 close CFG; 131 utf8::decode $CFG;
132 $::CFG = YAML::Load ($CFG);
133 } elsif ($CFG =~ /^\{/) {
134 $::CFG = from_json $CFG;
135 } else {
136 $::CFG = eval $CFG; ## todo comaptibility cruft
137 }
123} 138}
124 139
125sub write_cfg { 140sub write_cfg {
126 my ($file) = @_; 141 my ($file) = @_;
127 142
128 open CFG, ">$file" 143 $::CFG->{VERSION} = $::VERSION;
144
145 open my $fh, ">:utf8", $file
129 or return; 146 or return;
130 147 print $fh to_json $::CFG;
131 {
132 require Data::Dumper;
133 local $Data::Dumper::Purity = 1;
134 $::CFG->{VERSION} = $::VERSION;
135 print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
136 }
137
138 close CFG;
139} 148}
140 149
141our $DB_ENV; 150our $DB_ENV;
142 151
143{ 152{
162sub db_table($) { 171sub db_table($) {
163 my ($table) = @_; 172 my ($table) = @_;
164 173
165 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; 174 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
166 175
167 new CFClient::Database 176 new CFPlus::Database
168 -Env => $DB_ENV, 177 -Env => $DB_ENV,
169 -Filename => $table, 178 -Filename => $table,
170# -Filename => "database", 179# -Filename => "database",
171# -Subname => $table, 180# -Subname => $table,
172 -Property => DB_CHKSUM, 181 -Property => DB_CHKSUM,
173 -Flags => DB_CREATE | DB_UPGRADE, 182 -Flags => DB_CREATE | DB_UPGRADE,
174 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" 183 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
175} 184}
176 185
177package CFClient::Layout; 186package CFPlus::Layout;
178 187
179$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub { 188$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
180 reset_glyph_cache; 189 reset_glyph_cache;
181}; 190};
182 191
183package CFClient::Item; 192package CFPlus::Item;
184 193
185use strict; 194use strict;
186use Crossfire::Protocol::Constants; 195use Crossfire::Protocol::Constants;
187 196
188my $last_enter_count = 1; 197my $last_enter_count = 1;
222} 231}
223 232
224sub do_n_dialog { 233sub do_n_dialog {
225 my ($cb) = @_; 234 my ($cb) = @_;
226 235
227 my $w = new CFClient::UI::FancyFrame 236 my $w = new CFPlus::UI::FancyFrame
228 on_delete => sub { $_[0]->destroy; 1 }, 237 on_delete => sub { $_[0]->destroy; 1 },
229 has_close_button => 1, 238 has_close_button => 1,
230 ; 239 ;
231 240
232 $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center"); 241 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
233 $vb->add (new CFClient::UI::Label text => "Enter item count:"); 242 $vb->add (new CFPlus::UI::Label text => "Enter item count:");
234 $vb->add (my $entry = new CFClient::UI::Entry 243 $vb->add (my $entry = new CFPlus::UI::Entry
235 text => $last_enter_count, 244 text => $last_enter_count,
236 on_activate => sub { 245 on_activate => sub {
237 my ($entry) = @_; 246 my ($entry) = @_;
238 $last_enter_count = $entry->get_text; 247 $last_enter_count = $entry->get_text;
239 $cb->($last_enter_count); 248 $cb->($last_enter_count);
261 270
262 if ($self->{container} == $::CONN->{player}{tag}) { 271 if ($self->{container} == $::CONN->{player}{tag}) {
263 $targ = $::CONN->{open_container}; 272 $targ = $::CONN->{open_container};
264 } 273 }
265 274
266 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { 275 if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
267 $::CONN->send ("move $targ $self->{tag} 0") 276 $::CONN->send ("move $targ $self->{tag} 0")
268 if $targ || !($self->{flags} & F_LOCKED); 277 if $targ || !($self->{flags} & F_LOCKED);
269 } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) { 278 } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) {
270 $self->{flags} & F_LOCKED 279 $self->{flags} & F_LOCKED
271 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) 280 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
272 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) 281 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
273 } elsif ($ev->{button} == 1) { 282 } elsif ($ev->{button} == 1) {
274 $::CONN->send ("examine $self->{tag}"); 283 $::CONN->send ("examine $self->{tag}");
305 ] 314 ]
306 ) 315 )
307 ), 316 ),
308 ); 317 );
309 318
310 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 319 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
311 } 320 }
312 321
313 1 322 1
314 }; 323 };
315 324
319 . "Middle click - apply\n" 328 . "Middle click - apply\n"
320 . "Shift-Middle click - lock/unlock\n" 329 . "Shift-Middle click - lock/unlock\n"
321 . "Right click - further options" 330 . "Right click - further options"
322 . "</small>\n"; 331 . "</small>\n";
323 332
333 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
334 : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
335 : undef;
336
324 $self->{face_widget} ||= new CFClient::UI::Face 337 $self->{face_widget} ||= new CFPlus::UI::Face
325 can_events => 1, 338 can_events => 1,
326 can_hover => 1, 339 can_hover => 1,
327 anim => $self->{anim}, 340 anim => $self->{anim},
328 animspeed => $self->{animspeed}, # TODO# must be set at creation time 341 animspeed => $self->{animspeed}, # TODO# must be set at creation time
329 on_button_down => $button_cb, 342 on_button_down => $button_cb,
330 ; 343 ;
344 $self->{face_widget}{bg} = $bg;
331 $self->{face_widget}{face} = $self->{face}; 345 $self->{face_widget}{face} = $self->{face};
332 $self->{face_widget}{anim} = $self->{anim}; 346 $self->{face_widget}{anim} = $self->{anim};
333 $self->{face_widget}{animspeed} = $self->{animspeed}; 347 $self->{face_widget}{animspeed} = $self->{animspeed};
334 $self->{face_widget}->set_tooltip ( 348 $self->{face_widget}->set_tooltip (
335 "<b>Face/Animation.</b>\n" 349 "<b>Face/Animation.</b>\n"
336 . "Item uses face #$self->{face}. " 350 . "Item uses face #$self->{face}. "
337 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ") 351 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
338 . "\n\n$tooltip_std" 352 . "\n\n$tooltip_std"
339 ); 353 );
340 354
341 $self->{desc_widget} ||= new CFClient::UI::Label 355 $self->{desc_widget} ||= new CFPlus::UI::Label
342 can_events => 1, 356 can_events => 1,
343 can_hover => 1, 357 can_hover => 1,
344 ellipsise => 2, 358 ellipsise => 2,
345 align => -1, 359 align => -1,
346 on_button_down => $button_cb, 360 on_button_down => $button_cb,
347 ; 361 ;
348 my $desc = CFClient::Item::desc_string $self; 362 my $desc = CFPlus::Item::desc_string $self;
363 $self->{desc_widget}{bg} = $bg;
349 $self->{desc_widget}->set_text ($desc); 364 $self->{desc_widget}->set_text ($desc);
350 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std"); 365 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
351 366
352 $self->{weight_widget} ||= new CFClient::UI::Label 367 $self->{weight_widget} ||= new CFPlus::UI::Label
353 can_events => 1, 368 can_events => 1,
354 can_hover => 1, 369 can_hover => 1,
355 ellipsise => 0, 370 ellipsise => 0,
356 align => 0, 371 align => 0,
357 on_button_down => $button_cb, 372 on_button_down => $button_cb,
358 ; 373 ;
374 $self->{weight_widget}{bg} = $bg;
359 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self); 375 $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self);
360
361 $self->{weight_widget}->set_tooltip ( 376 $self->{weight_widget}->set_tooltip (
362 "<b>Weight</b>.\n" 377 "<b>Weight</b>.\n"
363 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ") 378 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
364 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") 379 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
365 . "\n\n$tooltip_std" 380 . "\n\n$tooltip_std"

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines