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.91 by root, Sat Mar 3 19:06:03 2007 UTC vs.
Revision 1.100 by root, Thu Apr 5 17:33:31 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.96'; 9our $VERSION = '0.98';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
19 19
20our @EXPORT = qw( 20our @EXPORT = qw(
21 read_pak read_arch *ARCH TILESIZE $TILE *FACE editor_archs arch_extents 21 read_pak read_arch *ARCH TILESIZE $TILE *FACE editor_archs arch_extents
22); 22);
23 23
24use JSON::Syck (); #TODO#d# replace by JSON::PC when it becomes available == working 24use JSON::XS qw(from_json to_json);
25
26sub from_json($) {
27 $JSON::Syck::ImplicitUnicode = 1;
28 JSON::Syck::Load $_[0]
29}
30
31sub to_json($) {
32 $JSON::Syck::ImplicitUnicode = 0;
33 JSON::Syck::Dump $_[0]
34}
35 25
36our $LIB = $ENV{CROSSFIRE_LIBDIR}; 26our $LIB = $ENV{CROSSFIRE_LIBDIR};
37 27
38our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
39 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
… …
157 147
158{ 148{
159 package Crossfire::MoveType; 149 package Crossfire::MoveType;
160 150
161 use overload 151 use overload
152 '=' => sub { bless [@{$_[0]}], ref $_[0] },
162 '""' => \&as_string, 153 '""' => \&as_string,
163 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 154 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
164 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise }, 155 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise },
165 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 156 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
166 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 157 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
167 'x=' => sub { 158 'x=' => sub {
168 my $cur = $_[0] >= $_[1]; 159 my $cur = $_[0] >= $_[1];
169 if (!defined $cur) { 160 if (!defined $cur) {
161 if ($_[0] >= "all") {
162 $_[0] -= $_[1];
163 } else {
170 $_[0] += $_[1]; 164 $_[0] += $_[1];
165 }
171 } elsif ($cur) { 166 } elsif ($cur) {
172 $_[0] -= $_[1]; 167 $_[0] -= $_[1];
173 } else { 168 } else {
174 $_[0] /= $_[1]; 169 $_[0] /= $_[1];
175 } 170 }
… …
185 my ($class, $string) = @_; 180 my ($class, $string) = @_;
186 181
187 my $mask; 182 my $mask;
188 my $value; 183 my $value;
189 184
185 if ($string =~ /^\s*\d+\s*$/) {
186 $mask = MOVE_ALL;
187 $value = $string+0;
188 } else {
190 for (split /\s+/, lc $string) { 189 for (split /\s+/, lc $string) {
191 if (s/^-//) { 190 if (s/^-//) {
192 $mask |= $MOVE_TYPE{$_}; 191 $mask |= $MOVE_TYPE{$_};
193 $value &= ~$MOVE_TYPE{$_}; 192 $value &= ~$MOVE_TYPE{$_};
194 } else { 193 } else {
195 $mask |= $MOVE_TYPE{$_}; 194 $mask |= $MOVE_TYPE{$_};
196 $value |= $MOVE_TYPE{$_}; 195 $value |= $MOVE_TYPE{$_};
196 }
197 } 197 }
198 } 198 }
199 199
200 (bless [$mask, $value], $class)->normalise 200 (bless [$mask, $value], $class)->normalise
201} 201}
… …
342 } else { 342 } else {
343 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 343 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
344 } 344 }
345 } 345 }
346 346
347 # color_fg is used as default for magicmap if magicmap does not exist
348 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
349
347 # nuke outdated or never supported fields 350 # nuke outdated or never supported fields
348 delete @$ob{qw( 351 delete @$ob{qw(
349 can_knockback can_parry can_impale can_cut can_dam_armour 352 can_knockback can_parry can_impale can_cut can_dam_armour
350 can_apply pass_thru can_pass_thru 353 can_apply pass_thru can_pass_thru color_bg color_fg
351 )}; 354 )};
352 355
353 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; } 356 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
354 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; } 357 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
355 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; } 358 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }

Diff Legend

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