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.33 by root, Thu Feb 23 15:47:50 2006 UTC vs.
Revision 1.48 by root, Thu Mar 16 21:06:37 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 Data::Dumper";
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, "<", $path 51 open my $fh, "<", $path
61 or die "$path: $!"; 52 or die "$path: $!";
62 binmode $fh; 53 binmode $fh;
63 local $/; 54 local $/;
64 55
65 $^O eq "MSWin32" ? eval <$fh> : thaw (<$fh>) 56 Storable::thaw <$fh>
66} 57}
67 58
68sub save_ref($$) { 59sub save_ref($$) {
69 my ($ref, $path) = @_; 60 my ($ref, $path) = @_;
70 61
71 open my $fh, ">", "$path~" 62 open my $fh, ">", "$path~"
72 or die "$path~: $!"; 63 or die "$path~: $!";
73 binmode $fh; 64 binmode $fh;
74 print $fh $^O eq "MSWin32" 65 print $fh Storable::freeze $ref;
75 ? Data::Dumper->new ([$ref])->Deepcopy (1)->Purity (1)->Terse (1)->Indent (0)->Dump
76 : freeze ($ref);
77 close $fh; 66 close $fh;
78 rename "$path~", $path 67 rename "$path~", $path
79 or die "$path: $!"; 68 or die "$path: $!";
80} 69}
81 70
… …
274 my ($a) = @_; 263 my ($a) = @_;
275 264
276 my $o = $ARCH{$a->{_name}} 265 my $o = $ARCH{$a->{_name}}
277 or return; 266 or return;
278 267
279 my $face = $FACE{$a->{face} || $o->{face}} 268 my $face = $FACE{$a->{face} || $o->{face} || "blank.111"}
280 or (warn "no face data found for arch '$a->{_name}'"), return; 269 or (warn "no face data found for arch '$a->{_name}'"), return;
281 270
282 if ($face->{w} > 1 || $face->{h} > 1) { 271 if ($face->{w} > 1 || $face->{h} > 1) {
283 # bigface 272 # bigface
284 return (0, 0, $face->{w} - 1, $face->{h} - 1); 273 return (0, 0, $face->{w} - 1, $face->{h} - 1);
… …
316 import 305 import
317 306
318=cut 307=cut
319 308
320sub arch_attr($) { 309sub arch_attr($) {
321 my ($arch) = @_; 310 my ($obj) = @_;
322 311
323 require Crossfire::Data; 312 require Crossfire::Data;
324 313
325 my $attr; 314 my $root;
315
316 my $arch = $ARCH{ $obj->{_name} };
317 my $type = $obj->{type} || $arch->{type};
326 318
327 if ($arch->{type} > 0) { 319 if ($type > 0) {
328 $attr = $Crossfire::Data::ATTR{$arch->{type}+0}; 320 $root = $Crossfire::Data::ATTR{$type};
329 } else { 321 } else {
330 $attr = $Crossfire::Data::TYPE{Misc}; 322 $root = $Crossfire::Data::TYPE{Misc};
331 323
332 type: 324 type:
333 for (@Crossfire::Data::ATTR0) { 325 for (@Crossfire::Data::ATTR0) {
334 my $req = $_->{required} 326 my $req = $_->{required}
335 or die "internal error: ATTR0 without 'required'"; 327 or die "internal error: ATTR0 without 'required'";
336 328
329 keys %$req;
337 while (my ($k, $v) = each %$req) { 330 while (my ($k, $v) = each %$req) {
338 next type 331 next type
339 unless $arch->{$k} == $v; 332 unless $obj->{$k} == $v || $arch->{$k} == $v;
340 } 333 }
341 334
342 $attr = $_; 335 $root = $_;
343 } 336 }
337 }
338
339 my $attr = { };
340
341 my @import = ($root);
344 } 342
345
346 $attr || \%Crossfire::Data::DEFAULT_ATTR; 343 unshift @import, \%Crossfire::Data::DEFAULT_ATTR
344 unless $type == 116;
345
346 my (%ignore);
347 my (@section_order, %section, @attr_order);
348
349 while (my $type = shift @import) {
350 push @import, @{$type->{import} || []};
351
352 $attr->{$_} ||= $type->{$_}
353 for qw(name desc use);
354
355 for (@{$type->{ignore} || []}) {
356 $ignore{$_}++ for ref $_ ? @$_ : $_;
357 }
358
359 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) {
360 my ($name, $attr) = @$_;
361 push @section_order, $name;
362 for (@$attr) {
363 my ($k, $v) = @$_;
364 push @attr_order, $k;
365 $section{$name}{$k} ||= $v;
366 }
367 }
368 }
369
370 $attr->{section} = [
371 map !exists $section{$_} ? () : do {
372 my $attr = delete $section{$_};
373
374 [
375 $_,
376 map exists $attr->{$_} && !$ignore{$_}
377 ? [$_ => delete $attr->{$_}] : (),
378 @attr_order
379 ]
380 },
381
382 exists $section{$_} ? [$_ => delete $section{$_}] : (),
383 @section_order
384 ];
385
386 $attr
347} 387}
348 388
349sub arch_edit_sections { 389sub arch_edit_sections {
350# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 390# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
351# edit_type = 0; 391# edit_type = 0;

Diff Legend

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