| version 1.1 | | version 1.2 |
|---|
| | |
| #!/usr/local/bin/perl | | #!/usr/bin/perl |
| # | | # |
| # This program is meant to use check crossfire (version 0.90.?) maps. | | # This program is meant to use check crossfire (version 0.90.?) maps. |
| # Program wanderers through mapfiles and reports all objects that | | # Program wanderers through mapfiles and reports all objects that |
| | |
| # are not connected. This can be annoying at times, since many maps use | | # are not connected. This can be annoying at times, since many maps use |
| # these objects for decorations. | | # these objects for decorations. |
| $CONNECTED = 0; | | $CONNECTED = 0; |
| $LIB = "/home/hugin/a/crossfire/crossfire/lib"; | | $LIB = "/home/hugin/a/crossfire/cf-installroot/share/crossfire"; |
| $ARCH = "$LIB/archetypes"; | | $ARCH = "$LIB/archetypes"; |
| $FACES = "$LIB/faces"; | | $FACES = "$LIB/faces"; |
| $ANIM = "$LIB/animations"; | | $ANIM = "$LIB/animations"; |
| $MAPS = "$LIB/maps"; | | $MAPS = "$LIB/maps"; |
| | | # Set VERBOSE=1 if you want more output |
| | | $VERBOSE=0; |
| | | |
| if (! $ARGV[0]) { | | if (! $ARGV[0]) { |
| print "Usage: wanderer.pl map-directory ... > output.log\n"; | | print "Usage: wanderer.pl map-directory ... > output.log\n"; |
| | |
| print "Error: file $file isn't mapfile.\n"; | | print "Error: file $file isn't mapfile.\n"; |
| return; | | return; |
| } | | } |
| | | if ($VERBOSE) { |
| print "Testing $file, "; | | print "Testing $file, "; |
| print /^name (.+)$/ ? $1 : "No mapname"; | | print /^name (.+)$/ ? $1 : "No mapname"; |
| print ", size [", /^x (\d+)$/ ? $1 : 16; | | print ", size [", /^x (\d+)$/ ? $1 : 16; |
| | |
| } else { | | } else { |
| print ", Unknown\n"; | | print ", Unknown\n"; |
| } | | } |
| | | $printmap=0; |
| | | } |
| | | else { |
| | | $name= /^name (.+)$/ ? $1 : "No mapname"; |
| | | $x= /^x (\d+)$/ ? $1 : 16; |
| | | $y= /^y (\d+)/ ? $1 : 16; |
| | | $mapname="Map $file, $name, size [$x, $y]\n" ; |
| | | $printmap=1; |
| | | } |
| | | |
| | | |
| while (<IN>) { | | while (<IN>) { |
| if (($m = (@_ = /^arch \S+\s*$/g)) > 1) { | | if (($m = (@_ = /^arch \S+\s*$/g)) > 1) { |
| | |
| } elsif (/^end$/) { | | } elsif (/^end$/) { |
| &check_obj ("$inv$_"); | | &check_obj ("$inv$_"); |
| } else { | | } else { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n"; | | print " Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n"; |
| } | | } |
| } | | } |
| | |
| } elsif (/^More$/ || $m == 1) { | | } elsif (/^More$/ || $m == 1) { |
| &check_obj ($_); | | &check_obj ($_); |
| } else { | | } else { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n"; | | print " Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n"; |
| } | | } |
| } | | } |
| | |
| | | |
| if (! $arches{$1} && $last ne $1) { | | if (! $arches{$1} && $last ne $1) { |
| $last = $1; | | $last = $1; |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Error: Object $last is not defined in archetypes file ($x,$y), arch=$arch\n"; | | print " Error: Object $last is not defined in archetypes file ($x,$y), arch=$arch\n"; |
| $missing{$last}++; | | $missing{$last}++; |
| } elsif ($ex{$1}) { | | } elsif ($ex{$1}) { |
| &examine_exit ($_); | | &examine_exit ($_); |
| } elsif ($tele{$1}) { | | } elsif ($tele{$1}) { |
| if (/^food -?\d+$/) { | | if (/^food -?\d+$/) { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Error: Teleport $1 has food field.\n"; | | print " Error: Teleport $1 has food field.\n"; |
| } | | } |
| else { | | else { |
| | |
| } | | } |
| } elsif ($conn{$1} && ! /^connected -?\d+$/) { | | } elsif ($conn{$1} && ! /^connected -?\d+$/) { |
| $last = $1; | | $last = $1; |
| print " Warning: Object $last has not been connected, $x,$y\n" if ($CONNECTED); | | if ($CONNECTED) { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| | | print " Warning: Object $last has not been connected, $x,$y\n" |
| | | } |
| } elsif ($players{$1} && $last ne $1 && ! /^type / ) { | | } elsif ($players{$1} && $last ne $1 && ! /^type / ) { |
| $last = $1; | | $last = $1; |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Error: Player $last found in the map.\n"; | | print " Error: Player $last found in the map.\n"; |
| } elsif ($1 eq "scroll" && ! /^msg$/) { | | } elsif ($1 eq "scroll" && ! /^msg$/) { |
| $last = $1; | | $last = $1; |
| | |
| $objects{$1}++; | | $objects{$1}++; |
| if (/^color_fg (\S+)$/ || /^color_bg (\S+)$/) { | | if (/^color_fg (\S+)$/ || /^color_bg (\S+)$/) { |
| $last = $arch; | | $last = $arch; |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Warning: Object ".$arch." is setting color ($1), $x,$y\n"; | | print " Warning: Object ".$arch." is setting color ($1), $x,$y\n"; |
| } | | } |
| if (/^animation (\S+)$/) { | | if (/^animation (\S+)$/) { |
| print "Error: Object $arch is using an unknown animation $1\n" if (! $anim{$1}); | | if (! $anim{$1}) { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| | | print "Error: Object $arch is using an unknown animation $1\n" |
| | | } |
| } | | } |
| if (/^face (\S+)$/) { | | if (/^face (\S+)$/) { |
| print "Error: Object $arch is using an unknown face $1\n" if (! $faces{$1}); | | if (! $faces{$1}) { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| | | print "Error: Object $arch is using an unknown face $1\n" |
| | | } |
| } | | } |
| } | | } |
| | | |
| | |
| | | |
| if (/^food (-?\d+)$/) { | | if (/^food (-?\d+)$/) { |
| # old style exits, doesn't work with crossfire 0.90-1 | | # old style exits, doesn't work with crossfire 0.90-1 |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Error: ", &obj_name($_), " ($x1,$y1) -> ", | | print " Error: ", &obj_name($_), " ($x1,$y1) -> ", |
| "Old style level [$1] ($x,$y)\n"; | | "Old style level [$1] ($x,$y)\n"; |
| } elsif (! defined ($to)) { | | } elsif (! defined ($to)) { |
| # print " Closed: ", &obj_name($_), " ($x1,$y1)\n"; | | # print " Closed: ", &obj_name($_), " ($x1,$y1)\n"; |
| } else { | | } else { |
| # These are currently used be crossfire | | # These are currently used be crossfire |
| | | return if ($to eq "/!"); |
| if ($to =~ m!^/!) { | | if ($to =~ m!^/!) { |
| $cdir = "$MAPS"; | | $cdir = "$MAPS"; |
| } else { | | } else { |
| ($cdir) = $file =~ m!(.*/)!; | | ($cdir) = $file =~ m!(.*/)!; |
| } | | } |
| if (! -f "$cdir$to") { | | if (! -f "$cdir$to") { |
| | | if ($printmap) { print "$mapname"; $printmap=0;} |
| print " Missing: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n"; | | print " Missing: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n"; |
| } else { | | } else { |
| # print " OK: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n"; | | # print " OK: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n"; |
| | |
| | | |
| opendir (DIR , $dir) || die "Can't open directory : $dir\n"; | | opendir (DIR , $dir) || die "Can't open directory : $dir\n"; |
| while ($file = readdir (DIR)) { | | while ($file = readdir (DIR)) { |
| next if ($file eq "." || $file eq ".."); | | next if ($file eq "." || $file eq ".." || $file eq "CVS"); |
| $file = "$dir/$file"; | | $file = "$dir/$file"; |
| push (@dirs, $file) if (-d $file); | | push (@dirs, $file) if (-d $file); |
| push (@maps, $file) if (-f $file); | | push (@maps, $file) if (-f $file); |