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.28 by root, Thu Feb 23 13:15:22 2006 UTC vs.
Revision 1.38 by root, Sun Mar 12 23:22:48 2006 UTC

… …
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use Storable;
17use File::Spec; 16use File::Spec;
18use List::Util qw(min max); 17use List::Util qw(min max);
19 18use Storable;
20#XXX: The map_* procedures scream for a map-object
21 19
22our @EXPORT = 20our @EXPORT =
23 qw(read_pak read_arch %ARCH TILESIZE $TILE %FACE editor_archs arch_extents); 21 qw(read_pak read_arch %ARCH TILESIZE $TILE %FACE editor_archs arch_extents);
24 22
25our $LIB = $ENV{CROSSFIRE_LIBDIR} 23our $LIB = $ENV{CROSSFIRE_LIBDIR}
… …
48sub MOVE_ALL (){ 0xf } 46sub MOVE_ALL (){ 0xf }
49 47
50sub load_ref($) { 48sub load_ref($) {
51 my ($path) = @_; 49 my ($path) = @_;
52 50
53 open my $fh, ">:raw", "$path~" 51 open my $fh, "<", $path
54 or die "$path~: $!"; 52 or die "$path: $!";
53 binmode $fh;
55 local $/; 54 local $/;
55
56 Storable::thaw <$fh> 56 Storable::thaw <$fh>
57} 57}
58 58
59sub save_ref($$) { 59sub save_ref($$) {
60 my ($ref, $path) = @_; 60 my ($ref, $path) = @_;
61 61
62 open my $fh, ">:raw", "$path~" 62 open my $fh, ">", "$path~"
63 or die "$path~: $!"; 63 or die "$path~: $!";
64 binmode $fh;
64 print $fh Storable::nfreeze $ref; 65 print $fh Storable::freeze $ref;
65 close $fh; 66 close $fh;
66 rename "$path~", $path 67 rename "$path~", $path
67 or die "$path: $!"; 68 or die "$path: $!";
68} 69}
69 70
… …
138 && -M $cache < -M $path 139 && -M $cache < -M $path
139 && load_ref $cache 140 && load_ref $cache
140 } or do { 141 } or do {
141 my %pak; 142 my %pak;
142 143
143 open my $fh, "<:raw", $path 144 open my $fh, "<", $path
144 or Carp::croak "$_[0]: $!"; 145 or Carp::croak "$_[0]: $!";
146 binmode $fh;
145 while (<$fh>) { 147 while (<$fh>) {
146 my ($type, $id, $len, $path) = split; 148 my ($type, $id, $len, $path) = split;
147 $path =~ s/.*\///; 149 $path =~ s/.*\///;
148 read $fh, $pak{$path}, $len; 150 read $fh, $pak{$path}, $len;
149 } 151 }
… …
164 && load_ref $cache 166 && load_ref $cache
165 } or do { 167 } or do {
166 my %arc; 168 my %arc;
167 my ($more, $prev); 169 my ($more, $prev);
168 170
169 open my $fh, "<:raw", $path 171 open my $fh, "<", $path
170 or Carp::croak "$path: $!"; 172 or Carp::croak "$path: $!";
173
174 binmode $fh;
171 175
172 my $parse_block; $parse_block = sub { 176 my $parse_block; $parse_block = sub {
173 my %arc = @_; 177 my %arc = @_;
174 178
175 while (<$fh>) { 179 while (<$fh>) {
… …
305sub arch_attr($) { 309sub arch_attr($) {
306 my ($arch) = @_; 310 my ($arch) = @_;
307 311
308 require Crossfire::Data; 312 require Crossfire::Data;
309 313
310 my $attr; 314 my $root;
311 315
312 if ($arch->{type} > 0) { 316 if ($arch->{type} > 0) {
313 $attr = $Crossfire::Data::ATTR{$arch->{type}+0}; 317 $root = $Crossfire::Data::ATTR{$arch->{type}+0};
314 } else { 318 } else {
315 $attr = $Crossfire::Data::TYPE{Misc}; 319 $root = $Crossfire::Data::TYPE{Misc};
316 320
317 type: 321 type:
318 for (@Crossfire::Data::ATTR0) { 322 for (@Crossfire::Data::ATTR0) {
319 my $req = $_->{required} 323 my $req = $_->{required}
320 or die "internal error: ATTR0 without 'required'"; 324 or die "internal error: ATTR0 without 'required'";
321 325
326 keys %$req;
322 while (my ($k, $v) = each %$req) { 327 while (my ($k, $v) = each %$req) {
323 next type 328 next type
324 unless $arch->{$k} == $v; 329 unless $arch->{$k} == $v;
325 } 330 }
326 331
327 $attr = $_; 332 $root = $_;
333 }
334 }
335
336 my $attr = { };
337
338 my @import = $root || \%Crossfire::Data::DEFAULT_ATTR;
339 my (%ignore);
340 my (@section_order, %section, @attr_order);
341
342 while (my $type = shift @import) {
343 push @import, @{$type->{import} || []};
344
345 $attr->{$_} ||= $type->{$_}
346 for qw(name desc use);
347
348 for (@{$type->{ignore} || []}) {
349 $ignore{$_}++ for ref $_ ? @$_ : $_;
350 }
351
352 for ([general => ($type->{attr} || {})], @{$type->{section} || []}) {
353 my ($name, $attr) = @$_;
354 push @section_order, $name;
355 for (@$attr) {
356 my ($k, $v) = @$_;
357 push @attr_order, $k;
358 $section{$name}{$k} ||= $v;
328 } 359 }
360 }
329 } 361 }
330 362
331 $attr || \%Crossfire::Data::DEFAULT_ATTR; 363 $attr->{section} = [
364 map !exists $section{$_} ? () : do {
365 my $attr = delete $section{$_};
366
367 [
368 $_,
369 map exists $attr->{$_} && !$ignore{$_}
370 ? [$_ => delete $attr->{$_}] : (),
371 @attr_order
372 ]
373 },
374
375 exists $section{$_} ? [$_ => delete $section{$_}] : (),
376 @section_order
377 ];
378
379 use PApp::Util;
380 warn PApp::Util::dumpval $attr;
381
382 $attr
332} 383}
333 384
334sub arch_edit_sections { 385sub arch_edit_sections {
335# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 386# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
336# edit_type = 0; 387# edit_type = 0;
… …
399 450
400 mkdir $cachedir, 0777; 451 mkdir $cachedir, 0777;
401 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst"; 452 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
402} 453}
403 454
404$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/crossfire" : File::Spec->tmpdir; 455$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";
405 456
406init $VARDIR; 457init $VARDIR;
407 458
408=head1 AUTHOR 459=head1 AUTHOR
409 460

Diff Legend

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