Mercurial > hg > batmud > maputils
changeset 2404:7bc30009ed14
Remove locref.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Wed, 10 Nov 2021 09:51:10 +0200 |
parents | 3049aafc269d |
children | 188e519afae8 |
files | world/locref.pl |
diffstat | 1 files changed, 0 insertions(+), 122 deletions(-) [+] |
line wrap: on
line diff
--- a/world/locref.pl Wed Nov 10 09:40:45 2021 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,122 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use warnings; - -# Settings and defaults -my $prog_name = "locref"; -my $prog_version = "0.1"; -my $prog_file = $0; - -my $opt_reffile = shift or - die("Usage: ".$prog_file." <reffile> <locfile.loc> [continent]\n"); - -my $opt_locfile = shift or - die("No location file given!\n"); - -my $opt_continent = shift; -$opt_continent = "" unless defined($opt_continent); -$opt_continent = lc($opt_continent); - -print STDERR "Continent = '$opt_continent'\n"; - - -### -### Process reference file -### -open(INFILE, "<:encoding(utf8)", $opt_reffile) or - die("Could not open loc-file '".$opt_reffile."'.\n"); - -my %areas = (); -my $nline = 0; -while (defined(my $line = <INFILE>)) -{ - $nline++; - $line =~ s/^\s*//; - $line =~ s/\s*$//; - - if ($line =~ /^(#|$)/) - { - # Ignore comments and empty lines - } - elsif ($line =~ /^(\d+),(\d+),(\d+),([a-z]+),(regions: )?(.+)$/) - { - $areas{$1}{"x"} = $2; - $areas{$1}{"y"} = $3; - $areas{$1}{"continent"} = $4; - $areas{$1}{"name"} = $6; - } - else - { - print STDERR "ERR(".$opt_reffile.") #".$nline.": ".$line."\n"; - } -} - - -### -### Process loc file -### -my %locations = (); -open(INFILE, "<:encoding(utf8)", $opt_locfile) or - die("Could not open loc-file '$opt_locfile'.\n"); - -$nline = 0; -while (defined(my $line = <INFILE>)) -{ - $nline++; - $line =~ s/^\s*//; - $line =~ s/\s*$//; - - if ($line =~ /^(#|$)/) - { - print "$line\n"; - } - elsif ($line =~ /^\s*(\d+)\s*;\s*(\d+)\s*;\s*(\d\S*)\s*;\s*([^;]+);(.*)/) - { - my ($xc, $yc, $flags, $namestr, $rest) = ($1,$2,$3,$4,$5); - - my $found = 0; - my $qname = undef; - foreach my $id (keys %areas) - { - if ($areas{$id}{"x"} == $xc && - $areas{$id}{"y"} == $yc && - lc($areas{$id}{"continent"}) eq $opt_continent) - { - $qname = $areas{$id}{"name"}; - my @ar = (); - foreach my $name (split(/\s*\|\s*/, $namestr)) - { - my $s = (substr($name, 0, 1) eq "\@") ? substr($name, 1) : $name; - if (lc($s) eq lc($qname)) - { - $found = 1; - push(@ar, "\@".$s); - } else { - push(@ar, $name); - } - } - $namestr = join('|', @ar); - } - last if ($found); - } - - if ($found) - { - printf "%d\t; %d\t; %s\t;%s;%s\n", $xc, $yc, $flags, $namestr, $rest; - } - else - { - printf "%d\t; %d\t; %s\t;%s", $xc, $yc, $flags, $namestr; - if (defined($qname)) - { - my $sname = uc(substr($qname, 0, 1)).substr($qname, 1); - print "|\@".$sname; - } - print ";$rest\n"; - } - } - else - { - print STDERR "ERR(".$opt_locfile.") #".$nline.": ".$line."\n"; - } -}