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.70 by root, Sun Aug 27 16:33:19 2006 UTC vs.
Revision 1.77 by root, Tue Nov 7 22:40:26 2006 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.9'; 9our $VERSION = '0.95';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
33 JSON::Syck::Dump $_[0] 33 JSON::Syck::Dump $_[0]
34} 34}
35 35
36our $LIB = $ENV{CROSSFIRE_LIBDIR}; 36our $LIB = $ENV{CROSSFIRE_LIBDIR};
37 37
38our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire"; 38our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
39 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
40 : File::Spec->tmpdir . "/crossfire";
39 41
40mkdir $VARDIR, 0777; 42mkdir $VARDIR, 0777;
41 43
42sub TILESIZE (){ 32 } 44sub TILESIZE (){ 32 }
43 45
… …
160 close $fh; 162 close $fh;
161 rename "$path~", $path 163 rename "$path~", $path
162 or die "$path: $!"; 164 or die "$path: $!";
163} 165}
164 166
167my %attack_mask = (
168 physical => 0x00000001,
169 magic => 0x00000002,
170 fire => 0x00000004,
171 electricity => 0x00000008,
172 cold => 0x00000010,
173 confusion => 0x00000020,
174 acid => 0x00000040,
175 drain => 0x00000080,
176 weaponmagic => 0x00000100,
177 ghosthit => 0x00000200,
178 poison => 0x00000400,
179 slow => 0x00000800,
180 paralyze => 0x00001000,
181 turn_undead => 0x00002000,
182 fear => 0x00004000,
183 cancellation => 0x00008000,
184 deplete => 0x00010000,
185 death => 0x00020000,
186 chaos => 0x00040000,
187 counterspell => 0x00080000,
188 godpower => 0x00100000,
189 holyword => 0x00200000,
190 blind => 0x00400000,
191 internal => 0x00800000,
192 life_stealing => 0x01000000,
193 disease => 0x02000000,
194);
195
196sub _add_resist($$$) {
197 my ($ob, $mask, $value) = @_;
198
199 while (my ($k, $v) = each %attack_mask) {
200 $ob->{"resist_$k"} = min 100, max -100, $ob->{"resist_$k"} + $value if $mask & $v;
201 }
202}
203
165# object as in "Object xxx", i.e. archetypes 204# object as in "Object xxx", i.e. archetypes
166sub normalize_object($) { 205sub normalize_object($) {
167 my ($ob) = @_; 206 my ($ob) = @_;
168 207
169 # nuke outdated or never supported fields 208 # nuke outdated or never supported fields
170 delete $ob->{$_} for qw( 209 delete @$ob{qw(
171 can_knockback can_parry can_impale can_cut can_dam_armour 210 can_knockback can_parry can_impale can_cut can_dam_armour
172 can_apply pass_thru can_pass_thru 211 can_apply pass_thru can_pass_thru
173 ); 212 )};
213
214 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
215 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
216 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
174 217
175 # convert movement strings to bitsets 218 # convert movement strings to bitsets
176 for my $attr (keys %FIELD_MOVEMENT) { 219 for my $attr (keys %FIELD_MOVEMENT) {
177 next unless exists $ob->{$attr}; 220 next unless exists $ob->{$attr};
178 221
… …
247 slaying => delete $ob->{"event_${event}"}, 290 slaying => delete $ob->{"event_${event}"},
248 name => delete $ob->{"event_${event}_options"}, 291 name => delete $ob->{"event_${event}_options"},
249 }; 292 };
250 } 293 }
251 } 294 }
295
296 # some archetypes had "+3" instead of the canonical "3", so fix
297 $ob->{dam} *= 1 if exists $ob->{dam};
252 298
253 $ob 299 $ob
254} 300}
255 301
256# arch as in "arch xxx", ie.. objects 302# arch as in "arch xxx", ie.. objects
… …
388 if (/^more$/i) { 434 if (/^more$/i) {
389 $more = $prev; 435 $more = $prev;
390 } elsif (/^object (\S+)$/i) { 436 } elsif (/^object (\S+)$/i) {
391 my $name = $1; 437 my $name = $1;
392 my $arc = attr_thaw normalize_object $parse_block->(_name => $name); 438 my $arc = attr_thaw normalize_object $parse_block->(_name => $name);
439 $arc->{_atype} = 'object';
393 440
394 if ($more) { 441 if ($more) {
395 $more->{more} = $arc; 442 $more->{more} = $arc;
396 } else { 443 } else {
397 $arc{$name} = $arc; 444 $arc{$name} = $arc;
… …
399 $prev = $arc; 446 $prev = $arc;
400 $more = undef; 447 $more = undef;
401 } elsif (/^arch (\S+)$/i) { 448 } elsif (/^arch (\S+)$/i) {
402 my $name = $1; 449 my $name = $1;
403 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name); 450 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name);
451 $arc->{_atype} = 'arch';
404 452
405 if ($more) { 453 if ($more) {
406 $more->{more} = $arc; 454 $more->{more} = $arc;
407 } else { 455 } else {
408 push @{ $arc{arch} }, $arc; 456 push @{ $arc{arch} }, $arc;
… …
426 } 474 }
427 475
428 undef $parse_block; # work around bug in perl not freeing $fh etc. 476 undef $parse_block; # work around bug in perl not freeing $fh etc.
429 477
430 \%arc 478 \%arc
479}
480
481sub archlist_to_string {
482 my ($arch) = @_;
483
484 my $str;
485
486 my $append; $append = sub {
487 my %a = %{$_[0]};
488
489 Crossfire::attr_freeze \%a;
490 Crossfire::normalize_arch \%a;
491
492 # undo the bit-split we did before
493 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) {
494 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
495 | (delete $a{attack_movement_bits_4_7});
496 }
497
498 $str .= ((exists $a{_atype}) ? $a{_atype} : 'arch'). " $a{_name}\n";
499
500 my $inv = delete $a{inventory};
501 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
502 my $anim = delete $a{anim};
503
504 my @kv;
505
506 for ($a{_name} eq "map"
507 ? @Crossfire::FIELD_ORDER_MAP
508 : @Crossfire::FIELD_ORDER) {
509 push @kv, [$_, delete $a{$_}]
510 if exists $a{$_};
511 }
512
513 for (sort keys %a) {
514 next if /^_/; # ignore our _-keys
515 push @kv, [$_, delete $a{$_}];
516 }
517
518 for (@kv) {
519 my ($k, $v) = @$_;
520
521 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {
522 $v =~ s/\n$//;
523 $str .= "$k\n$v\n$end\n";
524 } elsif (exists $Crossfire::FIELD_MOVEMENT{$k}) {
525 if ($v & ~Crossfire::MOVE_ALL or !$v) {
526 $str .= "$k $v\n";
527
528 } elsif ($v & Crossfire::MOVE_ALLBIT) {
529 $str .= "$k all";
530
531 $str .= " -walk" unless $v & Crossfire::MOVE_WALK;
532 $str .= " -fly_low" unless $v & Crossfire::MOVE_FLY_LOW;
533 $str .= " -fly_high" unless $v & Crossfire::MOVE_FLY_HIGH;
534 $str .= " -swim" unless $v & Crossfire::MOVE_SWIM;
535 $str .= " -boat" unless $v & Crossfire::MOVE_BOAT;
536
537 $str .= "\n";
538
539 } else {
540 $str .= $k;
541
542 $str .= " walk" if $v & Crossfire::MOVE_WALK;
543 $str .= " fly_low" if $v & Crossfire::MOVE_FLY_LOW;
544 $str .= " fly_high" if $v & Crossfire::MOVE_FLY_HIGH;
545 $str .= " swim" if $v & Crossfire::MOVE_SWIM;
546 $str .= " boat" if $v & Crossfire::MOVE_BOAT;
547
548 $str .= "\n";
549 }
550 } else {
551 $str .= "$k $v\n";
552 }
553 }
554
555 if ($inv) {
556 $append->($_) for @$inv;
557 }
558
559 if ($a{_atype} eq 'object') {
560 $str .= join "\n", "anim", @$anim, "mina\n"
561 if $anim;
562 }
563
564 $str .= "end\n";
565
566 if (($a{_atype} eq 'object') && $more) {
567 $str .= "\nmore\n";
568 $append->($more) if $more;
569 }
570 };
571
572 for (@$arch) {
573 $append->($_);
574 }
575
576 $str
431} 577}
432 578
433# put all archs into a hash with editor_face as it's key 579# put all archs into a hash with editor_face as it's key
434# NOTE: the arrays in the hash values are references to 580# NOTE: the arrays in the hash values are references to
435# the archs from $ARCH 581# the archs from $ARCH

Diff Legend

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