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.80 by root, Tue Feb 6 22:08:14 2007 UTC vs.
Revision 1.85 by root, Wed Feb 7 00:44:18 2007 UTC

… …
199 while (my ($k, $v) = each %attack_mask) { 199 while (my ($k, $v) = each %attack_mask) {
200 $ob->{"resist_$k"} = min 100, max -100, $ob->{"resist_$k"} + $value if $mask & $v; 200 $ob->{"resist_$k"} = min 100, max -100, $ob->{"resist_$k"} + $value if $mask & $v;
201 } 201 }
202} 202}
203 203
204my %MATERIAL = reverse
205 paper => 1,
206 iron => 2,
207 glass => 4,
208 leather => 8,
209 wood => 16,
210 organic => 32,
211 stone => 64,
212 cloth => 128,
213 adamant => 256,
214 liquid => 512,
215 tin => 1024,
216 bone => 2048,
217 ice => 4096,
218
219 # guesses
220 runestone => 12,
221 bronze => 18,
222 "ancient wood" => 20,
223 glass => 36,
224 marble => 66,
225 ice => 68,
226 stone => 70,
227 stone => 80,
228 cloth => 136,
229 ironwood => 144,
230 adamantium => 258,
231 glacium => 260,
232 blood => 544,
233;
234
204# object as in "Object xxx", i.e. archetypes 235# object as in "Object xxx", i.e. archetypes
205sub normalize_object($) { 236sub normalize_object($) {
206 my ($ob) = @_; 237 my ($ob) = @_;
238
239 # convert material bitset to materialname, if possible
240 if (exists $ob->{material}) {
241 if (!$ob->{material}) {
242 delete $ob->{material};
243 } elsif (exists $ob->{materialname}) {
244 if ($MATERIAL{$ob->{material}} eq $ob->{materialname}) {
245 delete $ob->{material};
246 } else {
247 warn "object $ob->{_name} has both materialname ($ob->{materialname}) and material ($ob->{material}) set.\n";
248 delete $ob->{material}; # assume materilname is more specific and nuke material
249 }
250 } elsif (my $name = $MATERIAL{$ob->{material}}) {
251 delete $ob->{material};
252 $ob->{materialname} = $name;
253 } else {
254 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
255 }
256 }
207 257
208 # nuke outdated or never supported fields 258 # nuke outdated or never supported fields
209 delete @$ob{qw( 259 delete @$ob{qw(
210 can_knockback can_parry can_impale can_cut can_dam_armour 260 can_knockback can_parry can_impale can_cut can_dam_armour
211 can_apply pass_thru can_pass_thru 261 can_apply pass_thru can_pass_thru
… …
421 push @{ $arc{anim} }, $_; 471 push @{ $arc{anim} }, $_;
422 } 472 }
423 } elsif (/^(\S+)\s*(.*)$/) { 473 } elsif (/^(\S+)\s*(.*)$/) {
424 $arc{lc $1} = $2; 474 $arc{lc $1} = $2;
425 } elsif (/^\s*#/) { 475 } elsif (/^\s*#/) {
426 $arc{_comment} .= $_; 476 $arc{_comment} .= "$_\n";
427 477
428 } elsif (/^\s*$/) { 478 } elsif (/^\s*$/) {
429 # 479 #
430 } else { 480 } else {
431 warn "$path: unparsable line '$_' in arch $arc{_name}"; 481 warn "$path: unparsable line '$_' in arch $arc{_name}";
… …
437 487
438 while (<$fh>) { 488 while (<$fh>) {
439 s/\s+$//; 489 s/\s+$//;
440 if (/^more$/i) { 490 if (/^more$/i) {
441 $more = $prev; 491 $more = $prev;
442 } elsif (/^\s*#/) {
443 $comment .= $_;
444 } elsif (/^object (\S+)$/i) { 492 } elsif (/^object (\S+)$/i) {
445 my $name = $1; 493 my $name = $1;
446 my $arc = attr_thaw normalize_object $parse_block->(_name => $name, _comment => $comment); 494 my $arc = attr_thaw normalize_object $parse_block->(_name => $name, _comment => $comment);
495 undef $comment;
447 delete $arc{_comment} unless length $arc{_comment}; 496 delete $arc{_comment} unless length $arc{_comment};
448 $arc->{_atype} = 'object'; 497 $arc->{_atype} = 'object';
449 498
450 if ($more) { 499 if ($more) {
451 $more->{more} = $arc; 500 $more->{more} = $arc;
… …
455 $prev = $arc; 504 $prev = $arc;
456 $more = undef; 505 $more = undef;
457 } elsif (/^arch (\S+)$/i) { 506 } elsif (/^arch (\S+)$/i) {
458 my $name = $1; 507 my $name = $1;
459 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name, _comment => $comment); 508 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name, _comment => $comment);
509 undef $comment;
460 delete $arc{_comment} unless length $arc{_comment}; 510 delete $arc{_comment} unless length $arc{_comment};
461 $arc->{_atype} = 'arch'; 511 $arc->{_atype} = 'arch';
462 512
463 if ($more) { 513 if ($more) {
464 $more->{more} = $arc; 514 $more->{more} = $arc;
… …
474 push @{$toplevel->{lev_array}}, $_+0; 524 push @{$toplevel->{lev_array}}, $_+0;
475 } 525 }
476 } else { 526 } else {
477 $toplevel->{$1} = $2; 527 $toplevel->{$1} = $2;
478 } 528 }
529 } elsif (/^\s*#/) {
530 $comment .= "$_\n";
479 } elsif (/^\s*($|#)/) { 531 } elsif (/^\s*($|#)/) {
480 # 532 #
481 } else { 533 } else {
482 die "$path: unparseable top-level line '$_'"; 534 die "$path: unparseable top-level line '$_'";
483 } 535 }
… …
503 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 555 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) {
504 $a{attack_movement} = (delete $a{attack_movement_bits_0_3}) 556 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
505 | (delete $a{attack_movement_bits_4_7}); 557 | (delete $a{attack_movement_bits_4_7});
506 } 558 }
507 559
560 if (my $comment = delete $a{_comment}) {
561 if ($comment =~ /[^\n\s#]/) {
562 $str .= $comment;
563 }
564 }
565
508 $str .= ((exists $a{_atype}) ? $a{_atype} : 'arch'). " $a{_name}\n"; 566 $str .= ((exists $a{_atype}) ? $a{_atype} : 'arch'). " $a{_name}\n";
509 567
510 my $inv = delete $a{inventory}; 568 my $inv = delete $a{inventory};
511 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some 569 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
512 my $anim = delete $a{anim}; 570 my $anim = delete $a{anim};
513 571
514 my @kv; 572 my @kv;
515 573
… …
571 if $anim; 629 if $anim;
572 } 630 }
573 631
574 $str .= "end\n"; 632 $str .= "end\n";
575 633
576 if (($a{_atype} eq 'object') && $more) { 634 if ($a{_atype} eq 'object') {
635 if ($more) {
577 $str .= "\nmore\n"; 636 $str .= "more\n";
578 $append->($more) if $more; 637 $append->($more) if $more;
638 } else {
639 $str .= "\n";
640 }
579 } 641 }
580 }; 642 };
581 643
582 for (@$arch) { 644 for (@$arch) {
583 $append->($_); 645 $append->($_);

Diff Legend

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