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

#
# Author: Slaven Rezic
#
# Copyright (C) 2003,2004,2009,2013,2020 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://www.rezic.de/eserte/
#

# Checks, whether all crossings are marked as crossings or brunnels.

use strict;
use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib",
	);
use VectorUtil;
use Strassen::Core;
use Object::Iterate qw(iterate);
use Getopt::Long;

my $outfile;
my $encoding;
my $against;
my $v;
my $v_if_interactive;
my @ignore_rx;
my $autoflush;
my $included_brunnels;
if (!GetOptions("o=s" => \$outfile,
		"encoding=s" => \$encoding,
		"against=s" => \$against,
		"included-brunnels!" => \$included_brunnels,
		"v" => \$v,
		"v-if-interactive" => \$v_if_interactive,
		"ignore=s" => sub {
		    my @s = split /,/, $_[1];
		    push @ignore_rx, map { '^' . quotemeta($_) . '$' } @s;
		},
		"ignorerx=s" => sub {
		    push @ignore_rx, $_[1];
		},
		"autoflush" => \$autoflush,
	       )) {
    die <<EOF;
usage: $0 [-v | -v-if-interactive] [-autoflush] [-o outfile]
        [-encoding encoding]
	[-ignore name,name,...] [-ignorerx namerx]
	[-against file | -included-brunnels] strassen ...
EOF
}

if ($v_if_interactive) {
    if (is_interactive() && !running_in_script()) {
	$v = 1;
    }
}

my $ignore_rx;
if (@ignore_rx) {
    $ignore_rx = "(?:" . join("|", @ignore_rx) . ")";
    $ignore_rx = qr{$ignore_rx};
}

my $ignore_cat = qr{(?::_?Tu_?(?::|$))}; # ignore if feature itself is in an tunnel

my @files = @ARGV;
@files = "strassen" if !@files;
my $s;
if (@files == 1) {
    $s = Strassen->new($files[0]);
} else {
    require Strassen::MultiStrassen;
    $s = MultiStrassen->new(@files);
}
$s->make_grid(Exact => 1, UseCache => 1);

my $brunnel;
my $brunnel_use_cache;
if ($included_brunnels) {
    $brunnel = Strassen->new;
    $s->init;
    while() {
	my $r = $s->next;
	last if !@{ $r->[Strassen::COORDS] };
	if ($r->[Strassen::CAT] =~ m{::(Br|Tu)}) {
	    $brunnel->push([$r->[Strassen::NAME], $r->[Strassen::COORDS], $1]);
	}
    }
    $brunnel_use_cache = 0;
} else {
    my $brunnelfile = $against || "brunnels";
    $brunnel = Strassen->new($brunnelfile);
    $brunnel_use_cache = 1;
}
my $brunnelcr = $brunnel->all_crossings(RetType => "hashpos",
					UseCache => $brunnel_use_cache,
					Kurvenpunkte => 1,
				       );

my %seen;

my $outfh;
if ($outfile) {
    open($outfh, ">$outfile") or die "Can't write to $outfile: $!";
    if ($autoflush) {
	select $outfh; $| = 1; select STDOUT;
    }
    if ($encoding) {
	print $outfh "#: #: -*- coding: $encoding -*-\n";
	print $outfh "#:encoding: $encoding\n";
	print $outfh "#:\n";
	binmode $outfh, ":encoding($encoding)";
    }
}

my $errfh;
if ($autoflush) {
    $errfh = \*STDERR;
} else {
    $errfh = \*STDOUT;
}

iterate {
    my $line = "  "x80;
    my $word = $_->[Strassen::NAME] . "...";
    substr($line,0,length $word) = $word;
    substr($line,79,1) = "\r";
    print $errfh substr($line, 0, 80) if $v;
    return if $ignore_rx && $_->[Strassen::NAME] =~ $ignore_rx;
    return if $ignore_cat && $_->[Strassen::CAT] =~ $ignore_cat;
    for my $i (1 .. $#{ $_->[Strassen::COORDS] }) {
	my($p1,$p2) = @{$_->[Strassen::COORDS]}[$i-1,$i];
	my(@grids) = $s->get_new_grids((split /,/, $p1), (split /,/, $p2));
	for my $grid (@grids) {
	    next if !exists $s->{Grid}{$grid};
	    for my $n (@{ $s->{Grid}{$grid} }) {
		my $r = $s->get($n);
		next if $ignore_rx && $r->[Strassen::NAME] =~ $ignore_rx;
		next if $ignore_cat && $r->[Strassen::CAT] =~ $ignore_cat;
		for my $r_i (1 .. $#{ $r->[Strassen::COORDS] }) {
		    my($r1,$r2) = @{$r->[Strassen::COORDS]}[$r_i-1,$r_i];
		    if ($r1 eq $p1 || $r1 eq $p2 || $r2 eq $p1 || $r2 eq $p2) {
			next;
		    }
		    if (exists $brunnelcr->{$r1} ||
			exists $brunnelcr->{$r2} ||
			exists $brunnelcr->{$p1} ||
			exists $brunnelcr->{$p2}) {
			next;
		    }
		    my @sorted_p = sort ($p1, $p2);
		    my @sorted_r = sort ($r1, $r2);
		    if ($seen{"@sorted_p"} &&
			$seen{"@sorted_r"}) {
			next;
		    }
		    if (VectorUtil::intersect_lines(split(/,/, $p1),
						    split(/,/, $p2),
						    split(/,/, $r1),
						    split(/,/, $r2),
						   )) {
			if ($v) {
			    print $errfh "Found: $_->[Strassen::NAME] <=> $r->[Strassen::NAME] $p1 $p2 $r1 $r2\n";
			}
			if ($outfh) {
			    # XXX find exact crossing point!
			    print $outfh "$_->[Strassen::NAME]/$r->[Strassen::NAME]\tX $p1 $p2\n";
			    print $outfh "$_->[Strassen::NAME]/$r->[Strassen::NAME]\tX $r1 $r2\n";
			}

			$seen{"@sorted_p"}++;
			$seen{"@sorted_r"}++;
		    }
		}
	    }
	}
    }
} $s;

# Determine if command is running within 'script', which should be
# treated as non-interactive.
sub running_in_script {
    return 0 if !eval { require Proc::ProcessTable };
    my $pto = Proc::ProcessTable->new;
    my $pt = $pto->table;
    my %pt;
    for my $p (@$pt) {
	$pt{$p->pid} = $p;
    }
    my $recursion_breaker = 0;
    my $pid = $$;
    while ($pid && $pid != 1) {
	my $p = $pt{$pid};
	if ($p->fname eq 'script') {
	    return 1;
	}
	$pid = $p->ppid;
	die if $recursion_breaker++>100;
    }
    0;
}

# REPO BEGIN
# REPO NAME is_interactive /home/e/eserte/work/srezic-repository 
# REPO MD5 87e9e2500fbe4a3ffe5f977de8513d47
sub is_interactive {
    if ($^O eq 'MSWin32' || !eval { require POSIX; 1 }) {
	# fallback
	return -t STDIN && -t STDOUT;
    }

    # from perlfaq8
    open(TTY, "/dev/tty") or return 0;
    my $tpgrp = POSIX::tcgetpgrp(fileno(*TTY));
    my $pgrp = getpgrp();
    if ($tpgrp == $pgrp) {
	1;
    } else {
	0;
    }
}
# REPO END

__END__
