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.30 by root, Thu Feb 23 14:54:44 2006 UTC vs.
Revision 1.38 by root, Sun Mar 12 23:22:48 2006 UTC

… …
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use File::Spec; 16use File::Spec;
17use List::Util qw(min max); 17use List::Util qw(min max);
18 18use Storable;
19#XXX: The map_* procedures scream for a map-object
20 19
21our @EXPORT = 20our @EXPORT =
22 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);
23 22
24our $LIB = $ENV{CROSSFIRE_LIBDIR} 23our $LIB = $ENV{CROSSFIRE_LIBDIR}
… …
44sub MOVE_FLY_HIGH (){ 0x4 } 43sub MOVE_FLY_HIGH (){ 0x4 }
45sub MOVE_FLYING (){ 0x6 } 44sub MOVE_FLYING (){ 0x6 }
46sub MOVE_SWIM (){ 0x8 } 45sub MOVE_SWIM (){ 0x8 }
47sub MOVE_ALL (){ 0xf } 46sub MOVE_ALL (){ 0xf }
48 47
49BEGIN {
50 if ($^O eq "MSWin32") {
51 eval "use FreezeThaw qw(freeze thaw)";
52 } else {
53 eval "use Storable qw(freeze thaw)";
54 }
55}
56
57sub load_ref($) { 48sub load_ref($) {
58 my ($path) = @_; 49 my ($path) = @_;
59 50
60 open my $fh, "<:raw", "$path~" 51 open my $fh, "<", $path
61 or die "$path~: $!"; 52 or die "$path: $!";
53 binmode $fh;
62 local $/; 54 local $/;
63 thaw <$fh> 55
56 Storable::thaw <$fh>
64} 57}
65 58
66sub save_ref($$) { 59sub save_ref($$) {
67 my ($ref, $path) = @_; 60 my ($ref, $path) = @_;
68 61
69 open my $fh, ">:raw", "$path~" 62 open my $fh, ">", "$path~"
70 or die "$path~: $!"; 63 or die "$path~: $!";
71 my $ref = freeze $ref; 64 binmode $fh;
72 print $fh $ref; 65 print $fh Storable::freeze $ref;
73 close $fh; 66 close $fh;
74 rename "$path~", $path 67 rename "$path~", $path
75 or die "$path: $!"; 68 or die "$path: $!";
76} 69}
77 70
… …
146 && -M $cache < -M $path 139 && -M $cache < -M $path
147 && load_ref $cache 140 && load_ref $cache
148 } or do { 141 } or do {
149 my %pak; 142 my %pak;
150 143
151 open my $fh, "<:raw", $path 144 open my $fh, "<", $path
152 or Carp::croak "$_[0]: $!"; 145 or Carp::croak "$_[0]: $!";
146 binmode $fh;
153 while (<$fh>) { 147 while (<$fh>) {
154 my ($type, $id, $len, $path) = split; 148 my ($type, $id, $len, $path) = split;
155 $path =~ s/.*\///; 149 $path =~ s/.*\///;
156 read $fh, $pak{$path}, $len; 150 read $fh, $pak{$path}, $len;
157 } 151 }
… …
172 && load_ref $cache 166 && load_ref $cache
173 } or do { 167 } or do {
174 my %arc; 168 my %arc;
175 my ($more, $prev); 169 my ($more, $prev);
176 170
177 open my $fh, "<:raw", $path 171 open my $fh, "<", $path
178 or Carp::croak "$path: $!"; 172 or Carp::croak "$path: $!";
173
174 binmode $fh;
179 175
180 my $parse_block; $parse_block = sub { 176 my $parse_block; $parse_block = sub {
181 my %arc = @_; 177 my %arc = @_;
182 178
183 while (<$fh>) { 179 while (<$fh>) {
… …
313sub arch_attr($) { 309sub arch_attr($) {
314 my ($arch) = @_; 310 my ($arch) = @_;
315 311
316 require Crossfire::Data; 312 require Crossfire::Data;
317 313
318 my $attr; 314 my $root;
319 315
320 if ($arch->{type} > 0) { 316 if ($arch->{type} > 0) {
321 $attr = $Crossfire::Data::ATTR{$arch->{type}+0}; 317 $root = $Crossfire::Data::ATTR{$arch->{type}+0};
322 } else { 318 } else {
323 $attr = $Crossfire::Data::TYPE{Misc}; 319 $root = $Crossfire::Data::TYPE{Misc};
324 320
325 type: 321 type:
326 for (@Crossfire::Data::ATTR0) { 322 for (@Crossfire::Data::ATTR0) {
327 my $req = $_->{required} 323 my $req = $_->{required}
328 or die "internal error: ATTR0 without 'required'"; 324 or die "internal error: ATTR0 without 'required'";
329 325
326 keys %$req;
330 while (my ($k, $v) = each %$req) { 327 while (my ($k, $v) = each %$req) {
331 next type 328 next type
332 unless $arch->{$k} == $v; 329 unless $arch->{$k} == $v;
333 } 330 }
334 331
335 $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;
336 } 359 }
360 }
337 } 361 }
338 362
339 $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
340} 383}
341 384
342sub arch_edit_sections { 385sub arch_edit_sections {
343# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 386# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
344# edit_type = 0; 387# edit_type = 0;

Diff Legend

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