Mercurial > hg > batmud > maputils
view old/mapref.pl @ 2833:d0e186348cb2 default tip
Add mention of soft level limitation to 'Eightleg woods'.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Sun, 26 May 2024 20:33:53 +0300 |
parents | a869b5b6ce2a |
children |
line wrap: on
line source
#!/usr/bin/perl -w use strict; use warnings; use utf8; # Settings and defaults my $prog_name = "mapref"; my $prog_version = "0.1"; my $prog_file = $0; my $opt_verbosity = 1; my %opt_locfiles = (); ### ### Print out help if no arguments given ### my $opt_reffile = shift or die( "${prog_name} v${prog_version} - Generate complete LOC file from references Developed by Matti Hamalainen (Ggr \@ bat), <ccr\@tnsp.org> (C) Copyright 2010 Tecnic Software productions (TNSP) Usage: ${prog_file} <reffile> [locfile #1 ...] [options] -v Be more verbose "); while (my $arg = shift) { if ($arg eq "-v") { $opt_verbosity++; } else { die("Loc file '".$arg."' already given.\n") if defined($opt_locfiles{$arg}); $opt_locfiles{$arg} = 1; } } die("No loc files given.\n") unless (scalar(keys %opt_locfiles) > 0); ### ### Read loc files ### my %locfiles = (); foreach my $filename (keys %opt_locfiles) { open(INFILE, "<:encoding(utf8)", $filename) or die("Could not open loc-file '".$filename."': ".$!."\n"); while (defined(my $line = <INFILE>)) { $line =~ s/\s+$//; $line =~ s/^\s+//; if ($line =~ /^(#|$)/) { # Ignore empty lines and comments } elsif ($line =~ /^(\d+)\s*;\s*(\d+)\s*;\s*(\d\S*)\s*;\s*([^;]+);(.*)/) { my ($flags, $namestr, $rest) = ($3,$4,$5); my @names = split(/\s*\|\s*/, $namestr); my $key = lc($names[0]); if (substr($key, 0, 1) eq "\@") { $key = substr($key, 1); } if ($flags !~ /C/) { $locfiles{$key}{"flags"} = $flags; $locfiles{$key}{"name"} = $namestr; $locfiles{$key}{"rest"} = $rest; } } } } ### ### Process reference file ### open(INFILE, "<:encoding(utf8)", $opt_reffile) or die("Could not open loc file '".$opt_reffile."': ".$!."\n"); binmode(STDOUT, ":utf8"); my $nline = 0; while (defined(my $line = <INFILE>)) { $nline++; $line =~ s/^\s*//; $line =~ s/\s*$//; if ($line =~ /^(#|$)/) { print $line."\n"; } elsif ($line =~ /^(\d+)\s*;\s*(\d+)\s*;\s*(\d\S*)\s*;([^;]+);(.*)/) { my ($xc, $yc, $flags, $namestr, $rest) = ($1,$2,$3,$4,$5); if (substr($namestr, 0, 1) eq "\@") { my $key = lc(substr($namestr, 1)); if (defined($locfiles{$key})) { print $xc."\t; ".$yc."\t; ".$flags."\t;". $locfiles{$key}{"name"}.";". $locfiles{$key}{"rest"}."\n"; } else { print "# Location key '".$key."' on line #".$nline." not defined!\n"; print STDERR "# Location key '".$key."' on line #".$nline." not defined!\n"; } } else { print $line."\n"; } } }