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.90 by root, Sat Mar 3 18:58:25 2007 UTC vs.
Revision 1.101 by root, Tue Apr 10 09:37:03 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"
… …
71 61
72our @FIELD_ORDER = (qw( 62our @FIELD_ORDER = (qw(
73 elevation 63 elevation
74 64
75 name name_pl custom_name attach title race 65 name name_pl custom_name attach title race
76 slaying skill msg lore other_arch face 66 slaying skill msg lore other_arch
77 #todo-events 67 is_animated animation face
78 animation is_animated 68 magicmap smoothlevel smoothface
79 str dex con wis pow cha int 69 str dex con wis pow cha int
80 hp maxhp sp maxsp grace maxgrace 70 hp maxhp sp maxsp grace maxgrace
81 exp perm_exp expmul 71 exp perm_exp expmul
82 food dam luck wc ac x y speed speed_left move_state attack_movement 72 food dam luck wc ac x y speed speed_left move_state attack_movement
83 nrof level direction type subtype attacktype 73 nrof level direction type subtype attacktype
… …
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 }
176 171
177 $_[0] 172 $_[0]
178 }, 173 },
174 'eq' => sub { "$_[0]" eq "$_[1]" },
175 'ne' => sub { "$_[0]" ne "$_[1]" },
179 ; 176 ;
180} 177}
181 178
182sub Crossfire::MoveType::new { 179sub Crossfire::MoveType::new {
183 my ($class, $string) = @_; 180 my ($class, $string) = @_;
184 181
185 my $mask; 182 my $mask;
186 my $value; 183 my $value;
187 184
185 if ($string =~ /^\s*\d+\s*$/) {
186 $mask = MOVE_ALL;
187 $value = $string+0;
188 } else {
188 for (split /\s+/, lc $string) { 189 for (split /\s+/, lc $string) {
189 if (s/^-//) { 190 if (s/^-//) {
190 $mask |= $MOVE_TYPE{$_}; 191 $mask |= $MOVE_TYPE{$_};
191 $value &= ~$MOVE_TYPE{$_}; 192 $value &= ~$MOVE_TYPE{$_};
192 } else { 193 } else {
193 $mask |= $MOVE_TYPE{$_}; 194 $mask |= $MOVE_TYPE{$_};
194 $value |= $MOVE_TYPE{$_}; 195 $value |= $MOVE_TYPE{$_};
196 }
195 } 197 }
196 } 198 }
197 199
198 (bless [$mask, $value], $class)->normalise 200 (bless [$mask, $value], $class)->normalise
199} 201}
… …
340 } else { 342 } else {
341 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 343 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
342 } 344 }
343 } 345 }
344 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
345 # nuke outdated or never supported fields 350 # nuke outdated or never supported fields
346 delete @$ob{qw( 351 delete @$ob{qw(
347 can_knockback can_parry can_impale can_cut can_dam_armour 352 can_knockback can_parry can_impale can_cut can_dam_armour
348 can_apply pass_thru can_pass_thru 353 can_apply pass_thru can_pass_thru color_bg color_fg
349 )}; 354 )};
350 355
351 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; } 356 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
352 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; } 357 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
353 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