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.106 by root, Mon Jul 24 04:24:42 2006 UTC vs.
Revision 1.110 by root, Sun Jul 30 17:43:26 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 ();
… …
52Returns an object that executes the given block as soon as it is destroyed. 52Returns an object that executes the given block as soon as it is destroyed.
53 53
54=cut 54=cut
55 55
56sub guard(&) { 56sub guard(&) {
57 bless \(my $cb = $_[0]), "CFClient::Guard" 57 bless \(my $cb = $_[0]), "CFPlus::Guard"
58} 58}
59 59
60sub CFClient::Guard::DESTROY { 60sub CFPlus::Guard::DESTROY {
61 ${$_[0]}->() 61 ${$_[0]}->()
62} 62}
63 63
64sub asxml($) { 64sub asxml($) {
65 local $_ = $_[0]; 65 local $_ = $_[0];
… …
69 s/</&lt;/g; 69 s/</&lt;/g;
70 70
71 $_ 71 $_
72} 72}
73 73
74package CFClient::Database; 74package CFPlus::Database;
75 75
76our @ISA = BerkeleyDB::Btree::; 76our @ISA = BerkeleyDB::Btree::;
77 77
78sub get($$) { 78sub get($$) {
79 my $data; 79 my $data;
… …
91 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 91 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
92 92
93 $db->db_put ($key => $data) 93 $db->db_put ($key => $data)
94} 94}
95 95
96package CFClient; 96package CFPlus;
97 97
98sub find_rcfile($) { 98sub find_rcfile($) {
99 my $path; 99 my $path;
100 100
101 for (grep !ref, @INC) { 101 for (grep !ref, @INC) {
102 $path = "$_/CFClient/resources/$_[0]"; 102 $path = "$_/CFPlus/resources/$_[0]";
103 return $path if -r $path; 103 return $path if -r $path;
104 } 104 }
105 105
106 die "FATAL: can't find required file $_[0]\n"; 106 die "FATAL: can't find required file $_[0]\n";
107} 107}
108 108
109BEGIN {
110 use Crossfire::Protocol::Base ();
111 *to_json = \&Crossfire::Protocol::Base::to_json;
112 *from_json = \&Crossfire::Protocol::Base::from_json;
113}
114
109sub read_cfg { 115sub read_cfg {
110 my ($file) = @_; 116 my ($file) = @_;
111 117
112 open CFG, $file 118 open my $fh, $file
113 or return; 119 or return;
114 120
115 my $CFG;
116
117 local $/; 121 local $/;
118 $CFG = eval <CFG>; 122 my $CFG = <$fh>;
119 123
120 $::CFG = $CFG; 124 if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
121 125 require YAML;
122 close CFG; 126 utf8::decode $CFG;
127 $::CFG = YAML::Load ($CFG);
128 } elsif ($CFG =~ /^\{/) {
129 $::CFG = from_json $CFG;
130 } else {
131 $::CFG = eval $CFG; ## todo comaptibility cruft
132 }
123} 133}
124 134
125sub write_cfg { 135sub write_cfg {
126 my ($file) = @_; 136 my ($file) = @_;
127 137
128 open CFG, ">$file" 138 $::CFG->{VERSION} = $::VERSION;
139
140 open my $fh, ">:utf8", $file
129 or return; 141 or return;
130 142 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} 143}
140 144
141our $DB_ENV; 145our $DB_ENV;
142 146
143{ 147{
… …
162sub db_table($) { 166sub db_table($) {
163 my ($table) = @_; 167 my ($table) = @_;
164 168
165 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; 169 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
166 170
167 new CFClient::Database 171 new CFPlus::Database
168 -Env => $DB_ENV, 172 -Env => $DB_ENV,
169 -Filename => $table, 173 -Filename => $table,
170# -Filename => "database", 174# -Filename => "database",
171# -Subname => $table, 175# -Subname => $table,
172 -Property => DB_CHKSUM, 176 -Property => DB_CHKSUM,
173 -Flags => DB_CREATE | DB_UPGRADE, 177 -Flags => DB_CREATE | DB_UPGRADE,
174 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" 178 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
175} 179}
176 180
177package CFClient::Layout; 181package CFPlus::Layout;
178 182
179$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub { 183$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
180 reset_glyph_cache; 184 reset_glyph_cache;
181}; 185};
182 186
183package CFClient::Item; 187package CFPlus::Item;
184 188
185use strict; 189use strict;
186use Crossfire::Protocol::Constants; 190use Crossfire::Protocol::Constants;
187 191
188my $last_enter_count = 1; 192my $last_enter_count = 1;
… …
222} 226}
223 227
224sub do_n_dialog { 228sub do_n_dialog {
225 my ($cb) = @_; 229 my ($cb) = @_;
226 230
227 my $w = new CFClient::UI::FancyFrame 231 my $w = new CFPlus::UI::FancyFrame
228 on_delete => sub { $_[0]->destroy; 1 }, 232 on_delete => sub { $_[0]->destroy; 1 },
229 has_close_button => 1, 233 has_close_button => 1,
230 ; 234 ;
231 235
232 $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center"); 236 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
233 $vb->add (new CFClient::UI::Label text => "Enter item count:"); 237 $vb->add (new CFPlus::UI::Label text => "Enter item count:");
234 $vb->add (my $entry = new CFClient::UI::Entry 238 $vb->add (my $entry = new CFPlus::UI::Entry
235 text => $last_enter_count, 239 text => $last_enter_count,
236 on_activate => sub { 240 on_activate => sub {
237 my ($entry) = @_; 241 my ($entry) = @_;
238 $last_enter_count = $entry->get_text; 242 $last_enter_count = $entry->get_text;
239 $cb->($last_enter_count); 243 $cb->($last_enter_count);
… …
261 265
262 if ($self->{container} == $::CONN->{player}{tag}) { 266 if ($self->{container} == $::CONN->{player}{tag}) {
263 $targ = $::CONN->{open_container}; 267 $targ = $::CONN->{open_container};
264 } 268 }
265 269
266 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { 270 if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
267 $::CONN->send ("move $targ $self->{tag} 0") 271 $::CONN->send ("move $targ $self->{tag} 0")
268 if $targ || !($self->{flags} & F_LOCKED); 272 if $targ || !($self->{flags} & F_LOCKED);
269 } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) { 273 } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) {
270 $self->{flags} & F_LOCKED 274 $self->{flags} & F_LOCKED
271 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) 275 ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
272 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) 276 : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
273 } elsif ($ev->{button} == 1) { 277 } elsif ($ev->{button} == 1) {
274 $::CONN->send ("examine $self->{tag}"); 278 $::CONN->send ("examine $self->{tag}");
… …
285 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }], 289 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
286 ["ignite/thaw", # first try of an easier use of flint&steel 290 ["ignite/thaw", # first try of an easier use of flint&steel
287 sub { 291 sub {
288 $::CONN->send ("mark ". pack "N", $self->{tag}); 292 $::CONN->send ("mark ". pack "N", $self->{tag});
289 $::CONN->send ("command apply flint and steel"); 293 $::CONN->send ("command apply flint and steel");
294 }
295 ],
296 ["inscribe", # first try of an easier use of flint&steel
297 sub {
298 &::open_string_query ("Text to inscribe", sub {
299 my ($entry, $txt) = @_;
300 $::CONN->send ("mark ". pack "N", $self->{tag});
301 $::CONN->send ("command use_skill inscription $txt");
302 });
290 } 303 }
291 ], 304 ],
292 ["apply", sub { $::CONN->send ("apply $self->{tag}") }], 305 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
293 ( 306 (
294 $self->{flags} & F_LOCKED 307 $self->{flags} & F_LOCKED
… …
305 ] 318 ]
306 ) 319 )
307 ), 320 ),
308 ); 321 );
309 322
310 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 323 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
311 } 324 }
312 325
313 1 326 1
314 }; 327 };
315 328
… …
323 336
324 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5] 337 my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
325 : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5] 338 : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
326 : undef; 339 : undef;
327 340
328 $self->{face_widget} ||= new CFClient::UI::Face 341 $self->{face_widget} ||= new CFPlus::UI::Face
329 can_events => 1, 342 can_events => 1,
330 can_hover => 1, 343 can_hover => 1,
331 anim => $self->{anim}, 344 anim => $self->{anim},
332 animspeed => $self->{animspeed}, # TODO# must be set at creation time 345 animspeed => $self->{animspeed}, # TODO# must be set at creation time
333 on_button_down => $button_cb, 346 on_button_down => $button_cb,
… …
341 . "Item uses face #$self->{face}. " 354 . "Item uses face #$self->{face}. "
342 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ") 355 . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
343 . "\n\n$tooltip_std" 356 . "\n\n$tooltip_std"
344 ); 357 );
345 358
346 $self->{desc_widget} ||= new CFClient::UI::Label 359 $self->{desc_widget} ||= new CFPlus::UI::Label
347 can_events => 1, 360 can_events => 1,
348 can_hover => 1, 361 can_hover => 1,
349 ellipsise => 2, 362 ellipsise => 2,
350 align => -1, 363 align => -1,
351 on_button_down => $button_cb, 364 on_button_down => $button_cb,
352 ; 365 ;
353 my $desc = CFClient::Item::desc_string $self; 366 my $desc = CFPlus::Item::desc_string $self;
354 $self->{desc_widget}{bg} = $bg; 367 $self->{desc_widget}{bg} = $bg;
355 $self->{desc_widget}->set_text ($desc); 368 $self->{desc_widget}->set_text ($desc);
356 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std"); 369 $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
357 370
358 $self->{weight_widget} ||= new CFClient::UI::Label 371 $self->{weight_widget} ||= new CFPlus::UI::Label
359 can_events => 1, 372 can_events => 1,
360 can_hover => 1, 373 can_hover => 1,
361 ellipsise => 0, 374 ellipsise => 0,
362 align => 0, 375 align => 0,
363 on_button_down => $button_cb, 376 on_button_down => $button_cb,
364 ; 377 ;
365 $self->{weight_widget}{bg} = $bg; 378 $self->{weight_widget}{bg} = $bg;
366 $self->{weight_widget}->set_text (CFClient::Item::weight_string $self); 379 $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self);
367 $self->{weight_widget}->set_tooltip ( 380 $self->{weight_widget}->set_tooltip (
368 "<b>Weight</b>.\n" 381 "<b>Weight</b>.\n"
369 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ") 382 . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
370 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") 383 . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
371 . "\n\n$tooltip_std" 384 . "\n\n$tooltip_std"

Diff Legend

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