#!/usr/bin/perl -w
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 1998,2001,2004,2005,2014,2019 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://bbbike.sf.net
#

use strict;
use File::Basename;
use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib",
	 "$FindBin::RealBin/../data");
use Tie::IxHash;
use Route;
use Getopt::Long;
use Karte;
use BBBikeUtil qw(schnittwinkel rad2deg pi min);
Karte::preload(':all');
# -w:
$Karte::Polar::obj = $Karte::Polar::obj;
$Karte::Berlinmap1996::obj = $Karte::Berlinmap1996::obj;
$Karte::GISmap::obj=$Karte::GISmap::obj;

sub add_error ($);

# XXX Verwendung von Karte::*

my($bx0,$bx1,$bx2,$by0,$by1,$by2);

for ($Karte::Berlinmap1996::obj) {
    $bx0 = $_->{X0};
    $bx1 = $_->{X1};
    $bx2 = $_->{X2};
    $by0 = $_->{Y0};
    $by1 = $_->{Y1};
    $by2 = $_->{Y2};
}

##XXX del:
# my $bx0 = -12836.9327939148;
# my $bx1 = 2.45136658405786;
# my $bx2 = 0.056379335402179;

# my $by0 = 30045.9720846232;
# my $by1 = 0.0545170183739305;
# my $by2 = -2.46551998888634;

## XXX Still relevant?
my $ax0 = -28.2216526290485;
my $ax1 = 8.16235406585393;
my $ax2 = -0.0109733165457586;

my $ay0 = -65.8047677518293;
my $ay1 = 0.0260694234625675;
my $ay2 = 8.10351573376008;

my($ebx0,$ebx1,$ebx2,$eby0,$eby1,$eby2);

##XXX del:
# my $ebx0 = -121386.178249258;
# my $ebx1 = 21.3506107238918;
# my $ebx2 = 0.0535889077211635;
# my $eby0 = 119836.098179657;
# my $eby1 = 0.0443840560242271;
# my $eby2 = -21.3256129065485;

($ebx0,$ebx1,$ebx2,$eby0,$eby1,$eby2) =
    @{$Karte::GISmap::obj}{qw(X0 X1 X2 Y0 Y1 Y2)};

my %file2map =
    ("satmap2hafas"    => "S",
     "berlinmap2hafas" => "B",
     "gismap2hafas"    => "E",
     "hafas2hafas"     => "H",
     "gdf2hafas"       => "g",
     "rectxy2hafas"    => "r", # GDF-Koordinaten mit polar2xy konvertiert
     # else: convert2hafas
    );

my $use_map;
my $to_map;
my $global_use_map;
while(my($k,$v) = each %file2map) {
    if (basename($0) eq $k) {
	$use_map = $v;
    }
}

my $koord;

my $doppeltATS = 0;
my $k_obj;
my $bahnhof;
my $specborder;
my($specsperre, @specsperre_files, $specsperre_str, $specsperre_cr_kp);
my $specsperre_net;
my $specsperre_cr;
my $specsperre_exceptions;
my $specsperre_exceptions_hash;
my $append;
my $append_once;
my $verbose = 0;
my $quiet = 0;
my $do_cropdouble = 0;
my $infile = 0;
my($do_ampelschaltung, $do_ampelschaltung2);
my $data_from_file;
my $data_from_bbd_file;
my $strict;
my $keep_comment;
my $keep_global_directives = 1;
my $keep_prefixed;
my $keep_point_attrib;
my $keep_everything;
my $auto_descent_from_mount = 1;
my $base_file;
my $cr;
my $do_nocross = 1;
my $errors = 0;
my $max_errors = 20; # maximum number of errors before giving up
my $un_utf8_ify = 0;
my $do_trim_accuracy;
if (!GetOptions("bahnhof=s"        => \$bahnhof,
		"specborder=s"     => \$specborder,
		"specsperre=s"     => \$specsperre,
		"specsperre-exceptions=s" => \$specsperre_exceptions,
		"v!"               => \$verbose,
		"q!"               => \$quiet,
		'map|frommap=s'    => \$use_map,
		"tomap=s"          => \$to_map,
		"trimaccuracy"     => \$do_trim_accuracy,
		'ampelschaltung!'  => \$do_ampelschaltung,
		'ampelschaltung2!' => \$do_ampelschaltung2,
		'cropdouble!'      => \$do_cropdouble,
		'infile!'          => \$infile,
		"datafromfile=s"   => \$data_from_file,
		"datafrombbd|datafrombbdfile=s"   => \$data_from_bbd_file,
		"strict!"          => \$strict,
		"keepcomment!"	   => \$keep_comment,
		"keepglobaldirectives!" => \$keep_global_directives,
		"keepprefixed!"    => \$keep_prefixed,
		"keeppointattrib!" => \$keep_point_attrib,
		"keepeverything!"  => \$keep_everything,
		"autodescent!"     => \$auto_descent_from_mount,
		"basefile=s"       => \$base_file,
		"nc!"              => \$do_nocross,
		"maxerrors=i"	   => \$max_errors,
		"unutf8ify"        => \$un_utf8_ify,
	       )) {
    usage("Wrong option");
}

if ($keep_everything) {
    $keep_comment = $keep_prefixed = $keep_point_attrib = 1;
    $auto_descent_from_mount = 0;
}

if (defined $data_from_file) {
    $k_obj = Karte::object_from_file($data_from_file);
} elsif (defined $data_from_bbd_file) {
    $k_obj = Karte::object_from_bbd_file($data_from_bbd_file);
}

my $f = shift || "-";
if ($f eq '-') {
    if (-t $f) {
	warn "Read from STDIN...\n";
    }
}

if (!defined $use_map) {
    $use_map = 'H'; # this is now the default
} elsif (!$k_obj) {
    my $karte_token_rx = join("|", keys %Karte::map);
    if ($use_map =~ /^($karte_token_rx)$/) {
	$k_obj = $Karte::map{$use_map};
    } elsif ($use_map eq 'g' || $use_map eq 'r') {
	$Karte::GDF::obj = $Karte::GDF::obj; # peacify -w
	$k_obj = $Karte::GDF::obj;
    }
    if ($use_map eq 'r') {
	unshift @INC, ("/home/rezic/routenplaner/ppsrc",
		       "$FindBin::RealBin/gdfconv/ppsrc",
		      );
	require Routenplaner;
    }
}

$global_use_map = $use_map;
if ($verbose) {
    print STDERR "Using map: $use_map\n";
}

if ($do_ampelschaltung) {
    do_ampelschaltung();
    exit 0;
} elsif ($do_ampelschaltung2) {
    do_ampelschaltung2();
    exit 0;
}

if (defined $bahnhof) {
    die "Bahnhof-Datei = Source" if $f eq $bahnhof;
    die "Bahnhof-Datei is orig?" if $bahnhof =~ /-orig/;
    open(SPEC, ">$bahnhof") or die "Can't write to file $bahnhof: $!";
}

if (defined $specborder) {
    die "Border-Datei = Source" if $f eq $specborder;
    die "Border-Datei is orig?" if $specborder =~ /-orig/;
    open(SPEC, ">$specborder") or die "Can't write to file $specborder: $!";
}

if ($specsperre) {
    require Strassen;
    @specsperre_files = split /,/, $specsperre;
    my $MultiStrassen = "MultiStrassen";
    if (eval { require Strassen::Lazy; 1 }) {
	$MultiStrassen = "MultiStrassen::Lazy";
    }
    $specsperre_str = $MultiStrassen->new(@specsperre_files);
    $specsperre_cr_kp = $specsperre_str->all_crossings(RetType => 'hashpos',
						       UseCache => 1,
						       Kurvenpunkte => 1);
}

my $no_coords = 0;

my $tmpfile;
if ($infile) {
    $tmpfile = "/tmp/convert2hafas.tmp";
    open(W, ">$tmpfile") or die "Can't write to $tmpfile: $!";
} else {
    open(W, ">&STDOUT");
}

if (defined $to_map) {
    die "-infile and -tomap are incompatible" if $infile;
    from_to_convert();
}

my @skip_directives = qw(temporary);
my $skip_directives = "^(?:" . join("|", map { quotemeta } @skip_directives) . ")\$";

my @str_buffer;
if ($f eq '-') {
    open(F, "<&STDIN") or die "Can't open stdin: $!";
} else {
    open(F, $f) or die "Can't open file $f: $!";
}
my $at_beginning = 1;
my $is_utf8 = 0;
LINES: while(defined($_ = nextline())) {
    chomp;

    if ($at_beginning && $un_utf8_ify) {
	if (/^#:\s*encoding:\s*utf-8/) {
	    $is_utf8 = 1;
	    binmode(F, ":utf8");
	    print W "#: encoding: iso-8859-1\n";
	    next;
	} elsif (/#:\s*#:?\s*-\*- coding: utf-8 -\*-/) {
	    print W "#:# -*- coding: iso-8859-1 -*-\n";
	    next;
	}
    }
    if ($un_utf8_ify && $is_utf8) {
	$_ = unidecode_any($_, "iso-8859-1");
    }

    if ($keep_global_directives && $at_beginning && /^#:/) {
	print W "$_\n";
	if (/^#:\s*\S/) { # the global/local directive separator
	    next;
	}
    }

    $at_beginning = 0;

    if ($keep_comment && /^#/) {
	print W "$_\n";
	next;
    }

    if (/^\#: (\S+)\s*(.*\S)\s+v+$/) {
	my($dir, $text) = ($1, $2);
	$dir =~ s{:$}{};
	if ($dir eq 'append_comment') {
	    $append = $text;
	} elsif ($dir =~ /$skip_directives/) {
	    #
	} else {
	    #die "Unknown directive: $dir";
	}
    } elsif (/^\#: (\S+)\s+\^+$/) {
	my($dir) = ($1);
	$dir =~ s{:$}{};
	if ($dir eq 'append_comment') {
	    undef $append;
	} elsif ($dir =~ /$skip_directives/) {
	    #
	} else {
	    #die "Unknown directive: $dir";
	}
    } elsif (/^\#: (\S+)\s*(.*)/) {
	my($dir, $text) = ($1, $2);
	$dir =~ s{:$}{};
	if ($dir eq 'append_comment') {
	    $append_once = $text;
	}
    }	

    next if /^\#/ or /^\s*$/;

    my @specborder_list;
    my $specborder_flag = 0;
    my($name, $rest) = split(/\t/, $_);
    if ($strict && (!defined $rest || $rest eq '')) {
	add_error "Incomplete line $_";
    }
    if (defined $append) {
	$name .= " ($append)";
    } elsif (defined $append_once) {
	$name .= " ($append_once)";
	undef $append_once;
    }
    if ($strict) {
	if ($rest =~ /^\s/) {
	    add_error "Leading space in coordinates, line $_";
	} elsif ($rest =~ /\s$/) {
	    add_error "Trailing space in coordinates, line $_";
	}
    }
    my(@coord) = split(/ /, $rest); # nur nach Space trennen (160 kein Trennzeichen)
    if (!@coord) {
	$no_coords++;
	if ($strict) {
	    add_error "Neither cat nor coords in line $_";
	}
    }
    my $cat = shift @coord;
    if (!@coord && $strict) {
	add_error "No coords in line $_";
    }

    if ($cat eq 'St;' && $auto_descent_from_mount) {
	# Steigungen: automatische Erzeugung der Gegenrichtung
	# "Steigung" durch "Geflle" ersetzen
	require Strassen::Core;
	my $r = Strassen::parse($_);
	$r->[Strassen::NAME()] =~ s/Steigung/Geflle/;
	$r->[Strassen::CAT()] = 'Gf;';
	@{ $r->[Strassen::COORDS()] } = reverse @{ $r->[Strassen::COORDS()] };
	push @str_buffer, Strassen::arr2line2($r);
    }

    my(@res);
#    print W "$name\t$cat";
    my $coords = "";
    my $last;
  LINE: foreach (@coord) {
	next if $_ eq 'X';
	last LINE if $_ =~ /^\#/;

	# berprft, ob es doppelte Koordinaten gibt
	if (defined $last and $_ eq $last) {
	    if ($do_cropdouble) {
		next LINE;
	    } else {
		warn "Doppelte Koordinaten in $name: $_\n"
		    unless $quiet;
		$doppeltATS = 1;
	    }
	} else {
	    $last = $_;
	}

	if (/^(\d+)$/) {
	    warn "Leave $1 unconverted\n";
	    $coords .= " " if $coords ne '';
	    $coords .= "$1";
	    next;
	}
	if ($_ eq '*') { # special case
	    $coords .= " " if $coords ne '';
	    $coords .= "*";
	    next;
	}
	add_error "Can't parse coordinate <$_> in coordinate list <$rest>"
#	  if (!/(:[^:]+:)?([HSBE])?\(([+-]?\d+),([+-]?\d+)\)/);
	  if (!/(:[^:]+:)?([HSBE])?([+-]?[\d.]+),([+-]?[\d.]+)/);
	my($spec, $type, $oldx, $oldy) = ($1, $2, $3, $4);
	if ($spec) { $spec = substr($spec, 1, length($spec)-2) }
	my $use_map = $use_map;
	if (defined $type) {
	    if ($type ne 'S' and $type ne 'B' and
		$type ne 'H' and $type ne 'E') {
		add_error "Parse error: Neither S nor B nor H nor E: $type";
	    }
	    if ($keep_prefixed) {
		if ($type eq $global_use_map) {
		    #warn "Unnecessary prefix found, therefore converting";
		} elsif ((!defined $to_map && $type eq 'H') ||
			 (defined $to_map && $type eq $to_map)) {
		    $coords .= " " if $coords ne '';
		    $coords .= "$oldx,$oldy";
		    next LINE;
		} else {
		    $coords .= " " if $coords ne '';
		    $coords .= $_;
		    next LINE;
		}
	    }
	    $use_map = $type;
	}
	my($newx, $newy);
	if ($k_obj) {
	    if ($use_map eq 'H') {
		($newx, $newy) = ($oldx, $oldy);
	    } elsif ($use_map eq 'r') {
		my($px, $py) = map { int } Routenplaner::xy2polar($oldx, $oldy);
		($newx, $newy) = $k_obj->map2standard($px, $py);
	    } elsif ($use_map eq 'g') {
		my($x,$y) = map { $_/100 } ($oldx, $oldy);
		($newx,$newy) = $Karte::Polar::obj->map2standard($x,$y);
	    } elsif ($use_map ne $global_use_map) {
		warn "Ignore $oldx,$oldy ($use_map ne $global_use_map)";
		next LINE;
	    } else {
		($newx, $newy) = map { int } $k_obj->map2standard($oldx, $oldy);
	    }
	} else {
	    ($newx, $newy) = ($use_map eq 'S'
			      ? satmap2hafas($oldx, $oldy)
			      : ($use_map eq 'B'
				 ? berlinmap2hafas($oldx, $oldy)
				 : ($use_map eq 'E'
				    ? gismap2hafas($oldx, $oldy)
				    : ($oldx, $oldy))));
	}
	$coords .= " " if $coords ne '';
	if ($keep_point_attrib && $spec) {
	    $coords .= ":$spec:";
	}
	$coords .= Route::_coord_as_string([$newx,$newy]);
	if ($bahnhof && $spec) {
	    $spec =~ s/_/ /g;
	    print SPEC
	      "$spec\t$cat " . Route::_coord_as_string([$newx,$newy]) . "\n";
	}
	if ($specborder) {
	    if ($spec) {
		if ($spec eq 'B_ON') {
		    if ($specborder_flag) {
			add_error "Multiple B_ON in $name";
		    }
		    $specborder_flag++;
		} elsif ($spec ne 'B_OFF') {
		    add_error "Unknown specifier $spec in $name";
		}
	    }
	    if ($specborder_flag) {
		push @specborder_list, Route::_coord_as_string([$newx,$newy]);
	    }
	    if ($spec) {
		if ($spec eq 'B_OFF') {
		    if (!$specborder_flag) {
			add_error "Multiple B_OFF or B_OFF without B_ON in $name";
		    }
		    print
		      SPEC "Berlin\tZ " . join(" ", @specborder_list) . "\n";
		    $specborder_flag = 0;
		    @specborder_list = ();
		} elsif ($spec ne 'B_ON') {
		    add_error "Unknown specifier $spec in $name";
		}
	    }
	}
## Test fr hafas2berlinmap
# 	if ($use_map eq 'B') {
# 	    my($oldx2, $oldy2) = hafas2berlinmap($newx, $newy);
# 	    if (abs($oldx2-$oldx) > 1 or abs($oldy2-$oldy) > 1) {
# 		die "$oldx=$oldx2 $oldy=$oldy2";
# 	    }
# 	}
    }

    if ($specsperre && $cat =~ /^(0|BNP)/) {
	my($_cat, @addinfo) = split /:/, $cat;
	if (exists $specsperre_cr_kp->{$coords} &&
	    (scalar @{$specsperre_cr_kp->{$coords}} == 1 ||
	     scalar @{$specsperre_cr_kp->{$coords}} == 2)) {

	    my $angle;

	    my @c = @{ $specsperre_str->get($specsperre_cr_kp->{$coords}->[0])->[&Strassen::COORDS] };
	    for my $i (0 .. $#c) {
		if ($c[$i] eq $coords) {
		    my $ii = ($i > 0 ? $i : 1);
		    my($x1,$y1,$x2,$y2) = (split(/,/,$c[$i-1]),
					   split(/,/,$c[$i]));
		    # calculate angle, swap to mathematical coordinate system
		    my $_angle = atan2(-($y2-$y1),$x2-$x1);
		    # 0 means straight forward => subtract 90
		    $angle = int(rad2deg($_angle)-90);
		    # XXX maybe range checking/adjusting should be done
		}
	    }

	    if (defined $angle) {
		$addinfo[1] = $angle;
		$cat = join(":", $_cat, @addinfo);
	    } else {
		# This seems to happen if there are more
		# than one street at this point. So no
		# angle will be calculated here.
	    }
	}
    }

    my $print_record = 1;

    # Special handling for things like
    #   3nocross
    #   3nocross::inwork
    # But not for
    #   3nocross::ignrte
    #
    # Idea is to create display & routing-only entries out of this:
    # * For routing, create "3" entries for the "wegfuehrung" feature.
    #   These entries will get the "igndisp" attribute as it should
    #   not be rendered.
    # * For display, keep the "3nocross" entry, but add a "ignrte"
    #   attrbute
    #
    # "3nocross::ignrte" entries in gesperrt-orig are already
    # manually splitted into a display & routing-only entry, so
    # handle_no_cross_record() does not have to be called here.
    if ($specsperre && $do_nocross && $cat =~ /^(.*)nocross(:.*)?$/) {
	my $out_cat = $1;
	my $out_attribs = $2;
	if (($out_attribs||'') !~ m{^::?ignrte$}) {
	    my $out_name = $name;
	    if ($name =~ /^.*?:\s*(.*)$/) {
		$out_name = $1;
	    }
	    my @res = handle_no_cross_record($out_name, $out_cat, $out_attribs, $coords);
	    for (@res) {
		my $name = shift @$_;
		my $cat  = shift @$_;
		print W "$name\t$cat ", join(" ", @$_), "\n";
	    }

	    $print_record = 0;
	}
    }

    if ($coords ne "" && $print_record) {
	print W "$name\t$cat $coords\n";
    }

    if (@specborder_list) {
	add_error "Missing B_OFF in $name";
    }
}
close F;
close W;

if ($errors) {
    die "Errors encountered, giving up.\n";
}

if ($infile) {
    require File::Copy;
    if ($f eq '-') {
	die "-infile option not valid with stdin";
    }
    File::Copy::cp($tmpfile, $f);
}

if ($no_coords) {
    warn "Found $no_coords references without coordinates.";
}

if (defined $bahnhof || defined $specborder) {
    close SPEC;
}

exit $doppeltATS;

######################################################################
# Subs

sub berlinmap2hafas {
    my($oldx, $oldy) = @_;
    (int($bx0+$oldx*$bx1+$oldy*$bx2),
     int($by0+$oldx*$by1+$oldy*$by2));
}

sub hafas2berlinmap {
    my($newx, $newy) = @_;
    (int((($newx-$bx0)*$by2-($newy-$by0)*$bx2)/($bx1*$by2-$by1*$bx2)),
     int((($newx-$bx0)*$by1-($newy-$by0)*$bx1)/($bx2*$by1-$bx1*$by2)));
}

sub satmap2hafas {
    my($oldx, $oldy) = @_;
    my($newx, $newy) = (int($ax0+$oldx*$ax1+$oldy*$ax2),
			int($ay0+$oldx*$ay1+$oldy*$ay2));
    (int($bx0+$newx*$bx1+$newy*$bx2),
     int($by0+$newx*$by1+$newy*$by2));
}

sub gismap2hafas {
    my($oldx, $oldy) = @_;
    (int($ebx0+$oldx*$ebx1+$oldy*$ebx2),
     int($eby0+$oldx*$eby1+$oldy*$eby2));
}

sub do_ampelschaltung {
    open(F, $f) or die "$f? $!";
    while(<F>) {
	chomp;
	if ($keep_comment && /^#/) {
	    print "$_\n";
	    next;
	}
	next if /^\#/;
	my($c, $r) = split(/\t/, $_, 2);
	my($x, $y) = split(/,/, $c);
	my($newx,$newy);
	if ($use_map eq 'H') {
	    ($newx, $newy) = ($x, $y);
	} else { # only support for "B" map!
	    ($newx, $newy) = berlinmap2hafas($x, $y);
	}
	print "$newx,$newy\t$r\n";
    }
    close F;
}

sub do_ampelschaltung2 {
    require Text::Tabs;
    open(F, $f) or die "$f? $!";
    while(<F>) {
	chomp;
	if ($keep_comment && /^#/) {
	    print "$_\n";
	    next;
	}
	next if /^\#/;
	if (/^(\d+),(\d+)/) {
	    my($x, $y) = ($1, $2);
	    my($newx,$newy);
	    if ($use_map eq 'H') {
		($newx, $newy) = ($x, $y);
	    } else { # only support for "B" map!
		($newx, $newy) = berlinmap2hafas($x, $y);
	    }
	    $_ = Text::Tabs::expand($_);
	    substr($_, 0, 13) = substr("$newx,$newy" . " "x13, 0, 13);
	}
	print "$_\n";
    }
    close F;
}

sub nextline {
    if (@str_buffer) {
	pop @str_buffer;
    } else {
	scalar <F>;
    }
}

sub from_to_convert {
    require Strassen;
    require Object::Iterate;
    require Karte;
    Karte::preload(":all");
    my $to_obj = $Karte::map{$to_map};

    my $s = Strassen->new($f);

    print "#:map: $to_map\n";
    Object::Iterate::iterate
	    (sub {
		 print $_->[Strassen::NAME()], "\t", $_->[Strassen::CAT()], " ";
		 print join(" ", map {
		     my @c = $k_obj->map2map($to_obj, split /,/, $_);
		     if ($do_trim_accuracy) {
			 @c = $to_obj->trim_accuracy(@c);
		     }
		     join(",", @c);
		 } @{ $_->[Strassen::COORDS()] }), "\n";
	     }, $s);
    exit 0;
}

sub get_crossings {
    return $specsperre_cr if $specsperre_cr;

    die "Can't handle stdin" if $f eq '-';

    if (!$specsperre_net) {
	$specsperre_net = StrassenNetz->new($specsperre_str);
	$specsperre_net->make_net(UseCache => 1);
	$specsperre_net->make_sperre($f,
				     Type => [StrassenNetz::BLOCKED_ONEWAY(),
					      StrassenNetz::BLOCKED_COMPLETE(),
					     ],
				    );
    }

    $specsperre_cr = $specsperre_str->all_crossings(RetType => "hashpos",
						    UseCache => 1);
    $specsperre_cr;
}

sub get_specsperre_exceptions {
    return $specsperre_exceptions_hash if $specsperre_exceptions_hash;

    $specsperre_exceptions_hash = {};
    my $s = Strassen->new($specsperre_exceptions);
    $s->init;
    while(1) {
	my $r = $s->next;
	my $c = $r->[Strassen::COORDS()];
	last if !@$c;
	for my $i (0 .. $#$c - 1) {
	    push @{ $specsperre_exceptions_hash->{$c->[$i]} }, [@{$c}[$i+1 .. $#$c]];
	}
    }
    $specsperre_exceptions_hash;
}

sub match_specsperre_exception {
    my($coords) = @_;
    my $first = $coords->[0];
    my $hash = get_specsperre_exceptions();
    my $exceptions = $hash->{$first};
    return if !$exceptions;
 EXCEPTION:
    for my $exception (@$exceptions) {
	for my $i (1 .. $#$coords) {
	    next EXCEPTION if $i-1 > $#$exception;
	    next EXCEPTION if $coords->[$i] ne $exception->[$i-1];
	}
	warn "(exception match <@$coords> <$first @$exception>)\n"
	    if $verbose;
	return 1;
    }
    0;
}

sub handle_no_cross_record {
    my($name, $cat, $attribs, $coords) = @_;
    my @coords = split /\s+/, $coords;
    if (@coords < 3) {
	warn "Need at least three coordinates for handling nocross records. <$name $cat $coords>\n";
	return;
    }
    $attribs = '' if !defined $attribs;

    my @res;

    push @res, [$name, $cat."nocross::ignrte$attribs", @coords];

    for my $i (2 .. $#coords) {
	my @blocked = @coords[$i-2 .. $i];
	my $middle = $blocked[1];
	my @surrounding = get_surrounding_points($middle);
	for my $p (@surrounding) {
	    if (!exists $specsperre_net->{Net}{$p}{$middle}) {
		warn "$p -> $middle already blocked, ignoring...\n" if $verbose;
		next;
	    }
	    my @angles;
	    push @angles, real_schnittwinkel($p, $middle, $blocked[0]) if $p ne $blocked[0];
	    push @angles, real_schnittwinkel($p, $middle, $blocked[2]) if $p ne $blocked[2];
	    my $angle = min(@angles);
	    for my $last (@surrounding) {
		next if $last eq $p;
		if (!exists $specsperre_net->{Net}{$middle}{$last}) {
		    warn "$middle -> $last already blocked, ignoring...\n" if $verbose;
		    next;
		}
		my $other_angle = real_schnittwinkel($p, $middle, $last);
		if ($other_angle > $angle) {
		    my $name = get_street_name_by_coords($p, $middle, "first") . " -> " .
			       get_street_name_by_coords($middle, $last, "last") . ": " . $name;
		    my @coords = ($p, $middle, $last);
		    if ($specsperre_exceptions && match_specsperre_exception(\@coords)) {
			warn "Ignore <@coords>, found entry in $specsperre_exceptions\n"
			    if $verbose;
		    } else {
			push @res, [$name, $cat."::igndisp$attribs", @coords];
		    }
		}
	    }
	}
    }

    @res;
}

sub get_street_name_by_coords {
    my($c1, $c2, $first_or_last) = @_;
    my $rec = $specsperre_net->get_street_record($c1, $c2);
    my $is_backward = 1;
    my $c = $rec->[Strassen::COORDS()];
    for my $i (1 .. $#$c) {
	if ($c1 eq $c->[$i-1] && $c2 eq $c->[$i]) {
	    $is_backward = 0;
	    last;
	}
    }
    my $name = Strasse::strip_bezirk($rec->[Strassen::NAME()]);
    if (($first_or_last eq 'first' && !$is_backward) ||
	($first_or_last eq 'last'  &&  $is_backward)) {
	$name = Strasse::get_first_part($name);
    } else {
	$name = Strasse::get_last_part($name);
    }    
    Strasse::short($name, 1);
}

sub get_surrounding_points {
    my($middle) = @_;
    my $cr = get_crossings();
    my $ss = $cr->{$middle};
    return if !$ss;
    tie my %res, 'Tie::IxHash';
    for my $s_pos (@$ss) {
	my $s_obj = $specsperre_str->get($s_pos);
	my $c = $s_obj->[Strassen::COORDS()];
	for my $i (0 .. $#$c) {
	    if ($c->[$i] eq $middle) {
		if ($i > 0) {
		    $res{$c->[$i-1]}++;
		}
		if ($i < $#$c) {
		    $res{$c->[$i+1]}++;
		}
	    }
	}
    }
    keys %res;
}

sub real_schnittwinkel {
    my(@x) = map { split /,/ } @_;
    my($winkel, $richtung) = schnittwinkel(@x);
    if ($richtung eq 'l') {
	$winkel += pi;
    } else {
	$winkel = pi - $winkel;
    }
    $winkel;
}

sub usage {
    die <<EOF;
This script only converts from a bbd file with any coord system to a
bbd file with a standard (hafas) coord system. For a converting tool
between all coord systems see the convert_coordsys script.

usage: $0 [-bahnhof file] [-specborder file] [-v] [-q] [-map map]
          [-ampelschaltung] [-ampelschaltung2] [-cropdouble] [-infile]
          [-keepcomment] [-keepprefixed] [ file ]
-v:  verbose
-q:  quiet
-map map: specify source coord system
-keepcomment:  keep comments and directives for output
-keepprefixed: do not convert coordinates which are prefixed
...
If file is not given, read input from stdin (some features are not available then).
EOF
}

sub add_error ($) {
    my($msg) = @_;
    require Carp;
    Carp::carp($msg);
    $errors++;
    if ($errors >= $max_errors) {
	if ($max_errors > 1) {
	    die "Too many errors - giving up.\n";
	} else {
	    exit 1;
	}
    }
}

# REPO BEGIN
# REPO NAME unidecode_any /home/e/eserte/work/srezic-repository 
# REPO MD5 bd47157f30dee711682b6a173fb1cb02

=head2 unidecode_any($text, $encoding)

Similar to Text::Unidecode::unidecode, but convert to the given
$encoding.

=cut

sub unidecode_any {
    my($text, $encoding) = @_;

    require Text::Unidecode;
    require Encode;

    my $res = "";

    for (split //, $text) {
	my $conv = eval { Encode::encode($encoding, $_, Encode::FB_CROAK()) };
	if ($@) {
	    $res .= Text::Unidecode::unidecode($_);
	} else {
	    $res .= $conv;
	}
    }

    $res;
}
# REPO END

