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";
    }
  }
}