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.73 by root, Tue Sep 12 02:18:06 2006 UTC vs.
Revision 1.80 by root, Tue Feb 6 22:08:14 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.9'; 9our $VERSION = '0.96';
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
… …
382sub read_arch($;$) { 384sub read_arch($;$) {
383 my ($path, $toplevel) = @_; 385 my ($path, $toplevel) = @_;
384 386
385 my %arc; 387 my %arc;
386 my ($more, $prev); 388 my ($more, $prev);
389 my $comment;
387 390
388 open my $fh, "<:raw:perlio:utf8", $path 391 open my $fh, "<:raw:perlio:utf8", $path
389 or Carp::croak "$path: $!"; 392 or Carp::croak "$path: $!";
390 393
391# binmode $fh; 394# binmode $fh;
… …
395 398
396 while (<$fh>) { 399 while (<$fh>) {
397 s/\s+$//; 400 s/\s+$//;
398 if (/^end$/i) { 401 if (/^end$/i) {
399 last; 402 last;
403
400 } elsif (/^arch (\S+)$/i) { 404 } elsif (/^arch (\S+)$/i) {
401 push @{ $arc{inventory} }, attr_thaw normalize_arch $parse_block->(_name => $1); 405 push @{ $arc{inventory} }, attr_thaw normalize_arch $parse_block->(_name => $1);
406
402 } elsif (/^lore$/i) { 407 } elsif (/^lore$/i) {
403 while (<$fh>) { 408 while (<$fh>) {
404 last if /^endlore\s*$/i; 409 last if /^endlore\s*$/i;
405 $arc{lore} .= $_; 410 $arc{lore} .= $_;
406 } 411 }
… …
415 chomp; 420 chomp;
416 push @{ $arc{anim} }, $_; 421 push @{ $arc{anim} }, $_;
417 } 422 }
418 } elsif (/^(\S+)\s*(.*)$/) { 423 } elsif (/^(\S+)\s*(.*)$/) {
419 $arc{lc $1} = $2; 424 $arc{lc $1} = $2;
420 } elsif (/^\s*($|#)/) { 425 } elsif (/^\s*#/) {
426 $arc{_comment} .= $_;
427
428 } elsif (/^\s*$/) {
421 # 429 #
422 } else { 430 } else {
423 warn "$path: unparsable line '$_' in arch $arc{_name}"; 431 warn "$path: unparsable line '$_' in arch $arc{_name}";
424 } 432 }
425 } 433 }
… …
429 437
430 while (<$fh>) { 438 while (<$fh>) {
431 s/\s+$//; 439 s/\s+$//;
432 if (/^more$/i) { 440 if (/^more$/i) {
433 $more = $prev; 441 $more = $prev;
442 } elsif (/^\s*#/) {
443 $comment .= $_;
434 } elsif (/^object (\S+)$/i) { 444 } elsif (/^object (\S+)$/i) {
435 my $name = $1; 445 my $name = $1;
436 my $arc = attr_thaw normalize_object $parse_block->(_name => $name); 446 my $arc = attr_thaw normalize_object $parse_block->(_name => $name, _comment => $comment);
447 delete $arc{_comment} unless length $arc{_comment};
437 $arc->{_atype} = 'object'; 448 $arc->{_atype} = 'object';
438 449
439 if ($more) { 450 if ($more) {
440 $more->{more} = $arc; 451 $more->{more} = $arc;
441 } else { 452 } else {
… …
443 } 454 }
444 $prev = $arc; 455 $prev = $arc;
445 $more = undef; 456 $more = undef;
446 } elsif (/^arch (\S+)$/i) { 457 } elsif (/^arch (\S+)$/i) {
447 my $name = $1; 458 my $name = $1;
448 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name); 459 my $arc = attr_thaw normalize_arch $parse_block->(_name => $name, _comment => $comment);
460 delete $arc{_comment} unless length $arc{_comment};
449 $arc->{_atype} = 'arch'; 461 $arc->{_atype} = 'arch';
450 462
451 if ($more) { 463 if ($more) {
452 $more->{more} = $arc; 464 $more->{more} = $arc;
453 } else { 465 } else {
… …
600 my ($a) = @_; 612 my ($a) = @_;
601 613
602 my $o = $ARCH{$a->{_name}} 614 my $o = $ARCH{$a->{_name}}
603 or return; 615 or return;
604 616
605 my $face = $FACE{$a->{face} || $o->{face} || "blank.111"} 617 my $face = $FACE{$a->{face} || $o->{face} || "blank.111"};
618 unless ($face) {
619 $face = $FACE{"blank.x11"}
606 or (warn "no face data found for arch '$a->{_name}'"), return; 620 or (warn "no face data found for arch '$a->{_name}'"), return;
621 }
607 622
608 if ($face->{w} > 1 || $face->{h} > 1) { 623 if ($face->{w} > 1 || $face->{h} > 1) {
609 # bigface 624 # bigface
610 return (0, 0, $face->{w} - 1, $face->{h} - 1); 625 return (0, 0, $face->{w} - 1, $face->{h} - 1);
611 626

Diff Legend

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