ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.17 by root, Wed Feb 22 22:36:45 2006 UTC vs.
Revision 1.26 by root, Thu Feb 23 05:23:01 2006 UTC

… …
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use Storable; 16use Storable;
17use File::Spec;
17use List::Util qw(min max); 18use List::Util qw(min max);
18 19
19#XXX: The map_* procedures scream for a map-object 20#XXX: The map_* procedures scream for a map-object
20 21
21our @EXPORT = 22our @EXPORT =
… …
24our $LIB = $ENV{CROSSFIRE_LIBDIR} 25our $LIB = $ENV{CROSSFIRE_LIBDIR}
25 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n"; 26 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";
26 27
27sub TILESIZE (){ 32 } 28sub TILESIZE (){ 32 }
28 29
29our $CACHEDIR; 30our $VARDIR;
30our %ARCH; 31our %ARCH;
31our %FACE; 32our %FACE;
32our $TILE; 33our $TILE;
33 34
34our %FIELD_MULTILINE = ( 35our %FIELD_MULTILINE = (
… …
112sub read_pak($;$) { 113sub read_pak($;$) {
113 my ($path, $cache) = @_; 114 my ($path, $cache) = @_;
114 115
115 eval { 116 eval {
116 defined $cache 117 defined $cache
118 && -e $cache
117 && -M $cache < -M $path 119 && -M $cache < -M $path
118 && Storable::retrieve $cache 120 && Storable::retrieve ($cache)
119 } or do { 121 } or do {
120 my %pak; 122 my %pak;
121 123
122 open my $fh, "<:raw", $path 124 open my $fh, "<:raw", $path
123 or Carp::croak "$_[0]: $!"; 125 or Carp::croak "$_[0]: $!";
… …
125 my ($type, $id, $len, $path) = split; 127 my ($type, $id, $len, $path) = split;
126 $path =~ s/.*\///; 128 $path =~ s/.*\///;
127 read $fh, $pak{$path}, $len; 129 read $fh, $pak{$path}, $len;
128 } 130 }
129 131
130 Storable::nstore \%pak, $cache 132 Storable::nstore (\%pak, $cache)
131 if defined $cache; 133 if defined $cache;
132 134
133 \%pak 135 \%pak
134 } 136 }
135} 137}
… …
137sub read_arch($;$) { 139sub read_arch($;$) {
138 my ($path, $cache) = @_; 140 my ($path, $cache) = @_;
139 141
140 eval { 142 eval {
141 defined $cache 143 defined $cache
144 && -e $cache
142 && -M $cache < -M $path 145 && -M $cache < -M $path
143 && Storable::retrieve $cache 146 && Storable::retrieve ($cache)
144 } or do { 147 } or do {
145 my %arc; 148 my %arc;
146 my ($more, $prev); 149 my ($more, $prev);
147 150
148 open my $fh, "<:raw", $path 151 open my $fh, "<:raw", $path
… …
203 } 206 }
204 } 207 }
205 208
206 undef $parse_block; # work around bug in perl not freeing $fh etc. 209 undef $parse_block; # work around bug in perl not freeing $fh etc.
207 210
211 warn "hoi\n";#d#
208 Storable::nstore \%arc, $cache 212 Storable::nstore (\%arc, $cache)
209 if defined $cache; 213 if defined $cache;
214 warn "hox\n";#d#
210 215
211 \%arc 216 \%arc
212 } 217 }
213} 218}
214 219
… …
264 # single face 269 # single face
265 return (0, 0, 0, 0); 270 return (0, 0, 0, 0);
266 } 271 }
267} 272}
268 273
269sub init($) {
270 my ($cachedir) = @_;
271
272 return if %ARCH;
273
274 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
275}
276
277=item $data = arch_attr $arch 274=item $type = arch_attr $arch
278 275
279Returns a hashref describing the object and its attributes. It can contain 276Returns a hashref describing the object and its attributes. It can contain
280the following keys: 277the following keys:
281 278
282 name the name, suitable for display purposes 279 name the name, suitable for display purposes
283 ignore 280 ignore
284 attr 281 attr
285 desc 282 desc
286 use 283 use
287 section => [name => \%attr, name => \%attr] 284 section => [name => \%attr, name => \%attr]
285 import
288 286
289=cut 287=cut
290 288
291sub arch_attr($) { 289sub arch_attr($) {
292 my ($arch) = @_; 290 my ($arch) = @_;
293 291
294 require Crossfire::Data; 292 require Crossfire::Data;
295 293
296 my %attr; 294 my $attr;
297 295
298 if ($arch->{type} > 0) { 296 if ($arch->{type} > 0) {
299 %attr = %{ $Crossfire::Data::ATTR{$arch->{type}+0} || {} }; 297 $attr = $Crossfire::Data::ATTR{$arch->{type}+0};
300 } else { 298 } else {
301 die; 299 $attr = $Crossfire::Data::TYPE{Misc};
302 }
303 300
304 use PApp::Util; 301 type:
305 warn PApp::Util::dumpval \%attr; 302 for (@Crossfire::Data::ATTR0) {
303 my $req = $_->{required}
304 or die "internal error: ATTR0 without 'required'";
305
306 while (my ($k, $v) = each %$req) {
307 next type
308 unless $arch->{$k} == $v;
309 }
310
311 $attr = $_;
312 }
313 }
314
315 $attr || \%Crossfire::Data::DEFAULT_ATTR;
306} 316}
307 317
308sub arch_edit_sections { 318sub arch_edit_sections {
309# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 319# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
310# edit_type = 0; 320# edit_type = 0;
… …
364# return(edit_type); 374# return(edit_type);
365# 375#
366# 376#
367} 377}
368 378
369$CACHEDIR ||= "$ENV{HOME}/.crossfire"; 379sub init($) {
380 my ($cachedir) = @_;
370 381
382 return if %ARCH;
383
384 mkdir $cachedir, 0777;
385 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
386}
387
388$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/crossfire" : File::Spec->tmpdir;
389
371init $CACHEDIR; 390init $VARDIR;
372 391
373=head1 AUTHOR 392=head1 AUTHOR
374 393
375 Marc Lehmann <schmorp@schmorp.de> 394 Marc Lehmann <schmorp@schmorp.de>
376 http://home.schmorp.de/ 395 http://home.schmorp.de/

Diff Legend

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