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.75 by root, Sat Oct 14 20:33:47 2006 UTC vs.
Revision 1.81 by root, Tue Feb 6 22:27:44 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.91'; 9our $VERSION = '0.96';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
384sub read_arch($;$) { 384sub read_arch($;$) {
385 my ($path, $toplevel) = @_; 385 my ($path, $toplevel) = @_;
386 386
387 my %arc; 387 my %arc;
388 my ($more, $prev); 388 my ($more, $prev);
389 my $comment;
389 390
390 open my $fh, "<:raw:perlio:utf8", $path 391 open my $fh, "<:raw:perlio:utf8", $path
391 or Carp::croak "$path: $!"; 392 or Carp::croak "$path: $!";
392 393
393# binmode $fh; 394# binmode $fh;
… …
397 398
398 while (<$fh>) { 399 while (<$fh>) {
399 s/\s+$//; 400 s/\s+$//;
400 if (/^end$/i) { 401 if (/^end$/i) {
401 last; 402 last;
403
402 } elsif (/^arch (\S+)$/i) { 404 } elsif (/^arch (\S+)$/i) {
403 push @{ $arc{inventory} }, attr_thaw normalize_arch $parse_block->(_name => $1); 405 push @{ $arc{inventory} }, attr_thaw normalize_arch $parse_block->(_name => $1);
406
404 } elsif (/^lore$/i) { 407 } elsif (/^lore$/i) {
405 while (<$fh>) { 408 while (<$fh>) {
406 last if /^endlore\s*$/i; 409 last if /^endlore\s*$/i;
407 $arc{lore} .= $_; 410 $arc{lore} .= $_;
408 } 411 }
… …
417 chomp; 420 chomp;
418 push @{ $arc{anim} }, $_; 421 push @{ $arc{anim} }, $_;
419 } 422 }
420 } elsif (/^(\S+)\s*(.*)$/) { 423 } elsif (/^(\S+)\s*(.*)$/) {
421 $arc{lc $1} = $2; 424 $arc{lc $1} = $2;
422 } elsif (/^\s*($|#)/) { 425 } elsif (/^\s*#/) {
426 $arc{_comment} .= "$_\n";
427
428 } elsif (/^\s*$/) {
423 # 429 #
424 } else { 430 } else {
425 warn "$path: unparsable line '$_' in arch $arc{_name}"; 431 warn "$path: unparsable line '$_' in arch $arc{_name}";
426 } 432 }
427 } 433 }
… …
433 s/\s+$//; 439 s/\s+$//;
434 if (/^more$/i) { 440 if (/^more$/i) {
435 $more = $prev; 441 $more = $prev;
436 } elsif (/^object (\S+)$/i) { 442 } elsif (/^object (\S+)$/i) {
437 my $name = $1; 443 my $name = $1;
438 my $arc = attr_thaw normalize_object $parse_block->(_name => $name); 444 my $arc = attr_thaw normalize_object $parse_block->(_name => $name, _comment => $comment);
445 undef $comment;
446 delete $arc{_comment} unless length $arc{_comment};
439 $arc->{_atype} = 'object'; 447 $arc->{_atype} = 'object';
440 448
441 if ($more) { 449 if ($more) {
442 $more->{more} = $arc; 450 $more->{more} = $arc;
443 } else { 451 } else {
… …
445 } 453 }
446 $prev = $arc; 454 $prev = $arc;
447 $more = undef; 455 $more = undef;
448 } elsif (/^arch (\S+)$/i) { 456 } elsif (/^arch (\S+)$/i) {
449 my $name = $1; 457 my $name = $1;
450 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name); 458 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name, _comment => $comment);
459 undef $comment;
460 delete $arc{_comment} unless length $arc{_comment};
451 $arc->{_atype} = 'arch'; 461 $arc->{_atype} = 'arch';
452 462
453 if ($more) { 463 if ($more) {
454 $more->{more} = $arc; 464 $more->{more} = $arc;
455 } else { 465 } else {
… …
464 push @{$toplevel->{lev_array}}, $_+0; 474 push @{$toplevel->{lev_array}}, $_+0;
465 } 475 }
466 } else { 476 } else {
467 $toplevel->{$1} = $2; 477 $toplevel->{$1} = $2;
468 } 478 }
479 } elsif (/^\s*#/) {
480 $comment .= "$_\n";
469 } elsif (/^\s*($|#)/) { 481 } elsif (/^\s*($|#)/) {
470 # 482 #
471 } else { 483 } else {
472 die "$path: unparseable top-level line '$_'"; 484 die "$path: unparseable top-level line '$_'";
473 } 485 }
… …
493 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 505 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}) 506 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
495 | (delete $a{attack_movement_bits_4_7}); 507 | (delete $a{attack_movement_bits_4_7});
496 } 508 }
497 509
510 if (my $comment = delete $a{_comment}) {
511 if ($comment =~ /[^\n\s#]/) {
512 $str .= $comment;
513 }
514 }
515
498 $str .= ((exists $a{_atype}) ? $a{_atype} : 'arch'). " $a{_name}\n"; 516 $str .= ((exists $a{_atype}) ? $a{_atype} : 'arch'). " $a{_name}\n";
499 517
500 my $inv = delete $a{inventory}; 518 my $inv = delete $a{inventory};
501 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some 519 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
502 my $anim = delete $a{anim}; 520 my $anim = delete $a{anim};
503 521
504 my @kv; 522 my @kv;
505 523
… …
561 if $anim; 579 if $anim;
562 } 580 }
563 581
564 $str .= "end\n"; 582 $str .= "end\n";
565 583
566 if (($a{_atype} eq 'object') && $more) { 584 if ($a{_atype} eq 'object') {
585 if ($more) {
567 $str .= "\nmore\n"; 586 $str .= "more\n";
568 $append->($more) if $more; 587 $append->($more) if $more;
588 } else {
589 $str .= "\n";
590 }
569 } 591 }
570 }; 592 };
571 593
572 for (@$arch) { 594 for (@$arch) {
573 $append->($_); 595 $append->($_);
… …
602 my ($a) = @_; 624 my ($a) = @_;
603 625
604 my $o = $ARCH{$a->{_name}} 626 my $o = $ARCH{$a->{_name}}
605 or return; 627 or return;
606 628
607 my $face = $FACE{$a->{face} || $o->{face} || "blank.111"} 629 my $face = $FACE{$a->{face} || $o->{face} || "blank.111"};
630 unless ($face) {
631 $face = $FACE{"blank.x11"}
608 or (warn "no face data found for arch '$a->{_name}'"), return; 632 or (warn "no face data found for arch '$a->{_name}'"), return;
633 }
609 634
610 if ($face->{w} > 1 || $face->{h} > 1) { 635 if ($face->{w} > 1 || $face->{h} > 1) {
611 # bigface 636 # bigface
612 return (0, 0, $face->{w} - 1, $face->{h} - 1); 637 return (0, 0, $face->{w} - 1, $face->{h} - 1);
613 638

Diff Legend

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