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.138 by elmex, Wed Dec 16 17:00:09 2009 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.25';
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;
… …
151 boat => MOVE_BOAT, 153 boat => MOVE_BOAT,
152 ship => MOVE_SHIP, 154 ship => MOVE_SHIP,
153 all => MOVE_ALL, 155 all => MOVE_ALL,
154); 156);
155 157
156our @MOVE_TYPE = keys %MOVE_TYPE; 158our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat ship);
157 159
158{ 160{
159 package Deliantra::MoveType; 161 package Deliantra::MoveType;
160 162
161 use overload 163 use overload
162 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 164 '=' => sub { bless [@{$_[0]}], ref $_[0] },
163 '""' => \&as_string, 165 '""' => \&as_string,
164 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 166 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
167 '<=' => sub {
168 ($_[0][0] & $MOVE_TYPE{$_[1]}) == $MOVE_TYPE{$_[1]}
169 ? $_[0][1] & $MOVE_TYPE{$_[1]}
170 : undef
171 },
165 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise }, 172 '+=' => 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 }, 173 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
167 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 174 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
168 'x=' => sub { 175 'x=' => sub { # toggle between off, + and -
169 my $cur = $_[0] >= $_[1]; 176 my $cur = $_[0] >= $_[1];
170 if (!defined $cur) { 177 if (!defined $cur) {
171 if ($_[0] >= "all") { 178 if ($_[0] >= "all") {
172 $_[0] -= $_[1]; 179 $_[0] -= $_[1];
173 } else { 180 } else {
… …
182 $_[0] 189 $_[0]
183 }, 190 },
184 'eq' => sub { "$_[0]" eq "$_[1]" }, 191 'eq' => sub { "$_[0]" eq "$_[1]" },
185 'ne' => sub { "$_[0]" ne "$_[1]" }, 192 'ne' => sub { "$_[0]" ne "$_[1]" },
186 ; 193 ;
194
195 sub TO_JSON {
196 $_[0][0]
197 }
187} 198}
188 199
189sub Deliantra::MoveType::new { 200sub Deliantra::MoveType::new {
190 my ($class, $string) = @_; 201 my ($class, $string) = @_;
191 202
… …
333 344
334# object as in "Object xxx", i.e. archetypes 345# object as in "Object xxx", i.e. archetypes
335sub normalize_object($) { 346sub normalize_object($) {
336 my ($ob) = @_; 347 my ($ob) = @_;
337 348
349 delete $ob->{editable}; # deprecated
350
338 # convert material bitset to materialname, if possible 351 # convert material bitset to materialname, if possible
339 if (exists $ob->{material}) { 352 if (exists $ob->{material}) {
340 if (!$ob->{material}) { 353 if (!$ob->{material}) {
341 delete $ob->{material}; 354 delete $ob->{material};
342 } elsif (exists $ob->{materialname}) { 355 } elsif (exists $ob->{materialname}) {
… …
385 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr}; 398 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
386 } 399 }
387 400
388 # convert outdated movement flags to new movement sets 401 # convert outdated movement flags to new movement sets
389 if (defined (my $v = delete $ob->{no_pass})) { 402 if (defined (my $v = delete $ob->{no_pass})) {
390 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : ""; 403 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "0";
391 } 404 }
392 if (defined (my $v = delete $ob->{slow_move})) { 405 if (defined (my $v = delete $ob->{slow_move})) {
393 $ob->{move_slow} += "walk"; 406 $ob->{move_slow} += "walk";
394 $ob->{move_slow_penalty} = $v; 407 $ob->{move_slow_penalty} = $v;
395 } 408 }
396 if (defined (my $v = delete $ob->{walk_on})) { 409 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" } 410 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
398 } 411 }
399 if (defined (my $v = delete $ob->{walk_off})) { 412 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" } 413 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
401 } 414 }
402 if (defined (my $v = delete $ob->{fly_on})) { 415 if (defined (my $v = delete $ob->{fly_on})) {
… …
802 $root = $Deliantra::Data::TYPE{Misc}; 815 $root = $Deliantra::Data::TYPE{Misc};
803 } 816 }
804 } 817 }
805 818
806 my @import = ($root); 819 my @import = ($root);
807 820
808 unshift @import, \%Deliantra::Data::DEFAULT_ATTR 821 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
809 unless $type == 116; 822 unless $type == 116;
810 823
811 my (%ignore); 824 my (%ignore);
812 my (@section_order, %section, @attr_order); 825 my (@section_order, %section, @attr_order);
… …
833 $section{$name}{$k} ||= $v; 846 $section{$name}{$k} ||= $v;
834 } 847 }
835 } 848 }
836 } 849 }
837 850
851 # remove ignores for "root" type
852 for (map @{$_->[1]}, # section attributes
853 [general => ($root->{attr} || [])],
854 @{$root->{section} || []})
855 {
856 my ($k, $v) = @$_;
857 # skip fixed attributes, if they are ignored thats fine
858 next if $v->{type} eq 'fixed';
859
860 delete $ignore{$k}; # if the attributes are defined explicitly they
861 # should NOT be ignored. ignore should mainly
862 # hit imported/inherited attributes.
863 }
864
838 $attr->{section} = [ 865 $attr->{section} = [
839 map !exists $section{$_} ? () : do { 866 map !exists $section{$_} ? () : do {
840 my $attr = delete $section{$_}; 867 my $attr = delete $section{$_};
841 868
842 [ 869 [
… …
844 map exists $attr->{$_} && !$ignore{$_} 871 map exists $attr->{$_} && !$ignore{$_}
845 ? [$_ => delete $attr->{$_}] : (), 872 ? [$_ => delete $attr->{$_}] : (),
846 @attr_order 873 @attr_order
847 ] 874 ]
848 }, 875 },
849
850 exists $section{$_} ? [$_ => delete $section{$_}] : (), 876 exists $section{$_} ? [$_ => delete $section{$_}] : (),
851 @section_order 877 @section_order
852 ]; 878 ];
853 879
854 $attr 880 $attr
… …
983 1009
984 \%cache 1010 \%cache
985 }; 1011 };
986} 1012}
987 1013
1014=back
1015
988=head1 AUTHOR 1016=head1 AUTHOR
989 1017
990 Marc Lehmann <schmorp@schmorp.de> 1018 Marc Lehmann <schmorp@schmorp.de>
991 http://home.schmorp.de/ 1019 http://home.schmorp.de/
992 1020

Diff Legend

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