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.128 by root, Sun Sep 28 05:58:01 2008 UTC vs.
Revision 1.142 by root, Sat May 15 00:30:53 2010 UTC

1=head1 NAME 1=head1 NAME
2 2
3Deliantra - Deliantra suppport module to read/write archetypes, maps etc. 3Deliantra - Deliantra suppport module to read/write archetypes, maps etc.
4 4
5=over 4
6
5=cut 7=cut
6 8
7package Deliantra; 9package Deliantra;
8 10
9our $VERSION = '1.222'; 11our $VERSION = '1.30';
10 12
11use strict; 13use common::sense;
12 14
13use base 'Exporter'; 15use base 'Exporter';
14 16
15use Carp (); 17use Carp ();
16use File::Spec; 18use File::Spec;
54 56
55# same as in server save routine, to (hopefully) be compatible 57# same as in server save routine, to (hopefully) be compatible
56# to the other editors. 58# to the other editors.
57our @FIELD_ORDER_MAP = (qw( 59our @FIELD_ORDER_MAP = (qw(
58 file_format_version 60 file_format_version
59 name attach swap_time reset_timeout fixed_resettime difficulty region 61 name attach swap_time reset_timeout fixed_resettime difficulty
62 region music
60 shopitems shopgreed shopmin shopmax shoprace 63 shopitems shopgreed shopmin shopmax shoprace
61 darkness width height enter_x enter_y msg maplore 64 darkness width height enter_x enter_y msg maplore
62 unique template 65 unique template
63 outdoor temp pressure humid windspeed winddir sky nosmooth 66 outdoor temp pressure humid windspeed winddir sky nosmooth
64 tile_path_1 tile_path_2 tile_path_3 tile_path_4 67 tile_path_1 tile_path_2 tile_path_3 tile_path_4
151 boat => MOVE_BOAT, 154 boat => MOVE_BOAT,
152 ship => MOVE_SHIP, 155 ship => MOVE_SHIP,
153 all => MOVE_ALL, 156 all => MOVE_ALL,
154); 157);
155 158
156our @MOVE_TYPE = keys %MOVE_TYPE; 159our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat ship);
157 160
158{ 161{
159 package Deliantra::MoveType; 162 package Deliantra::MoveType;
160 163
161 use overload 164 use overload
162 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 165 '=' => sub { bless [@{$_[0]}], ref $_[0] },
163 '""' => \&as_string, 166 '""' => \&as_string,
164 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 167 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
168 '<=' => sub {
169 ($_[0][0] & $MOVE_TYPE{$_[1]}) == $MOVE_TYPE{$_[1]}
170 ? $_[0][1] & $MOVE_TYPE{$_[1]}
171 : undef
172 },
165 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise }, 173 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise },
166 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 174 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
167 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 175 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
168 'x=' => sub { 176 'x=' => sub { # toggle between off, + and -
169 my $cur = $_[0] >= $_[1]; 177 my $cur = $_[0] >= $_[1];
170 if (!defined $cur) { 178 if (!defined $cur) {
171 if ($_[0] >= "all") { 179 if ($_[0] >= "all") {
172 $_[0] -= $_[1]; 180 $_[0] -= $_[1];
173 } else { 181 } else {
182 $_[0] 190 $_[0]
183 }, 191 },
184 'eq' => sub { "$_[0]" eq "$_[1]" }, 192 'eq' => sub { "$_[0]" eq "$_[1]" },
185 'ne' => sub { "$_[0]" ne "$_[1]" }, 193 'ne' => sub { "$_[0]" ne "$_[1]" },
186 ; 194 ;
195
196 sub TO_JSON {
197 $_[0][0]
198 }
187} 199}
188 200
189sub Deliantra::MoveType::new { 201sub Deliantra::MoveType::new {
190 my ($class, $string) = @_; 202 my ($class, $string) = @_;
191 203
333 345
334# object as in "Object xxx", i.e. archetypes 346# object as in "Object xxx", i.e. archetypes
335sub normalize_object($) { 347sub normalize_object($) {
336 my ($ob) = @_; 348 my ($ob) = @_;
337 349
350 delete $ob->{editable}; # deprecated
351
338 # convert material bitset to materialname, if possible 352 # convert material bitset to materialname, if possible
339 if (exists $ob->{material}) { 353 if (exists $ob->{material}) {
340 if (!$ob->{material}) { 354 if (!$ob->{material}) {
341 delete $ob->{material}; 355 delete $ob->{material};
342 } elsif (exists $ob->{materialname}) { 356 } elsif (exists $ob->{materialname}) {
385 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr}; 399 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
386 } 400 }
387 401
388 # convert outdated movement flags to new movement sets 402 # convert outdated movement flags to new movement sets
389 if (defined (my $v = delete $ob->{no_pass})) { 403 if (defined (my $v = delete $ob->{no_pass})) {
390 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : ""; 404 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "0";
391 } 405 }
392 if (defined (my $v = delete $ob->{slow_move})) { 406 if (defined (my $v = delete $ob->{slow_move})) {
393 $ob->{move_slow} += "walk"; 407 $ob->{move_slow} += "walk";
394 $ob->{move_slow_penalty} = $v; 408 $ob->{move_slow_penalty} = $v;
395 } 409 }
396 if (defined (my $v = delete $ob->{walk_on})) { 410 if (defined (my $v = delete $ob->{walk_on})) {
397 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } 411 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
398 } 412 }
399 if (defined (my $v = delete $ob->{walk_off})) { 413 if (defined (my $v = delete $ob->{walk_off})) {
400 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" } 414 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
401 } 415 }
402 if (defined (my $v = delete $ob->{fly_on})) { 416 if (defined (my $v = delete $ob->{fly_on})) {
801 } else { 815 } else {
802 $root = $Deliantra::Data::TYPE{Misc}; 816 $root = $Deliantra::Data::TYPE{Misc};
803 } 817 }
804 } 818 }
805 819
820 my (%ignore);
806 my @import = ($root); 821 my @import = ($root);
807
808 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
809 unless $type == 116;
810 822
811 my (%ignore); 823 my @new_import;
812 my (@section_order, %section, @attr_order);
813
814 while (my $type = shift @import) { 824 while (my $type = shift @import) {
825 # first import everything we will need:
815 push @import, 826 push @import,
816 grep $_, 827 grep $_,
817 map $Deliantra::Data::TYPE{$_}, 828 map $Deliantra::Data::TYPE{$_},
818 @{$type->{import} || []}; 829 @{$type->{import} || []};
819 830
831 # and compute the ignored attributes
832 for (@{$type->{ignore} || []}) {
833 $ignore{$_}++ for ref $_ ? @$_ : $_;
834 }
835
836 push @new_import, $type;
837 }
838 (@import) = @new_import;
839
840 # then add defaults to the back of the list, so they are added
841 # as last resort.
842 push @import, \%Deliantra::Data::DEFAULT_ATTR
843 unless $type == 116;
844
845 my (@section_order, %section, @attr_order);
846
847 # @import = root, imported, default
848 while (my $type = pop @import) {
820 $attr->{$_} ||= $type->{$_} 849 $attr->{$_} ||= $type->{$_}
821 for qw(name desc use); 850 for qw(name desc use);
822
823 for (@{$type->{ignore} || []}) {
824 $ignore{$_}++ for ref $_ ? @$_ : $_;
825 }
826 851
827 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) { 852 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) {
828 my ($name, $attr) = @$_; 853 my ($name, $attr) = @$_;
829 push @section_order, $name; 854 push @section_order, $name;
830 for (@$attr) { 855 for (@$attr) {
831 my ($k, $v) = @$_; 856 my ($k, $v) = @$_;
832 push @attr_order, $k; 857 push @attr_order, $k;
833 $section{$name}{$k} ||= $v; 858 $section{$name}{$k} = $v; # overwrite, so that the root decides
834 }
835 } 859 }
860 }
861 }
862
863 # remove ignores for "root" type
864 for (
865 map @{$_->[1]}, # section attributes
866 [general => ($root->{attr} || [])],
867 @{$root->{section} || []}
868 ) {
869 my ($k, $v) = @$_;
870 # skip fixed attributes, if they are ignored thats fine
871 next if $v->{type} eq 'fixed';
872
873 delete $ignore{$k}; # if the attributes are defined explicitly they
874 # should NOT be ignored. ignore should mainly
875 # hit imported/inherited attributes.
836 } 876 }
837 877
838 $attr->{section} = [ 878 $attr->{section} = [
839 map !exists $section{$_} ? () : do { 879 map !exists $section{$_} ? () : do {
840 my $attr = delete $section{$_}; 880 my $attr = delete $section{$_};
844 map exists $attr->{$_} && !$ignore{$_} 884 map exists $attr->{$_} && !$ignore{$_}
845 ? [$_ => delete $attr->{$_}] : (), 885 ? [$_ => delete $attr->{$_}] : (),
846 @attr_order 886 @attr_order
847 ] 887 ]
848 }, 888 },
849
850 exists $section{$_} ? [$_ => delete $section{$_}] : (), 889 exists $section{$_} ? [$_ => delete $section{$_}] : (),
851 @section_order 890 @section_order
852 ]; 891 ];
853 892
854 $attr 893 $attr
855} 894}
983 1022
984 \%cache 1023 \%cache
985 }; 1024 };
986} 1025}
987 1026
1027=back
1028
988=head1 AUTHOR 1029=head1 AUTHOR
989 1030
990 Marc Lehmann <schmorp@schmorp.de> 1031 Marc Lehmann <schmorp@schmorp.de>
991 http://home.schmorp.de/ 1032 http://home.schmorp.de/
992 1033

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines