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

#
# Author: Slaven Rezic
#
# Copyright (C) 2001,2003,2004,2015,2017 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.de
#

# This script will create a .bbd file of all inaccessible points for
# a given street net (in combination with gesperrt)

use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib",
	 "$FindBin::RealBin/../data",
	);
use Strassen;
use Strassen::Check;
use Getopt::Long;
use strict;

my $s;
my $blocked;
my $refpoint;
my $usecache;
my $v;
my $debug;
my $shorter;
my $encoding;
my $map;
my $stats;
my $max_loops = 10;

my @s_files;
my @blocked_files;
my @blocked_type;

my @allowed_blocked_type = qw(einbahn sperre tragen wegfuehrung);

if (!GetOptions("street=s@"  => sub { push @s_files, split /,/, $_[1] },
		"blocked=s@" => sub { push @blocked_files, split /,/, $_[1] },
		"blockedtype=s@" => \@blocked_type,
		"refpoint=s" => \$refpoint,
		"q" => sub { warn "-q option is obsolete" },
		"cache" => \$usecache,
		"v" => \$v,
		"debug" => \$debug,
		"shorter" => \$shorter,
		"encoding=s" => \$encoding,
		"stats!" => \$stats,
		"maxloops=i" => \$max_loops,
	       )) {
    die <<EOF;
usage: $0 [-street file] [-blocked file]
       [-blockedtype type] [-refpoint x,y] [-v] [-cache] [-shorter] [-stats]
       [-encoding encoding]
-street and -blocked may be given multiple times or separated with commas
-blockedtype may be given multiple times and should be one of
             @allowed_blocked_type
-shorter: just output the first street name for a blocking series
EOF
}

if (!$usecache) {
    eval 'use BBBikeXS';
    if ($@) {
	warn "Can't load BBBikeXS, expect slower operation or specify -cache.\n";
	if ($v) { warn $@ }
    }
}

if ($v) {
    Strassen::set_verbose($v);
}

if (!@s_files) { push @s_files, "strassen" }
if (!@blocked_files) { push @blocked_files, "gesperrt" }

# blocked types
if (!@blocked_type) { push @blocked_type, qw/einbahn sperre tragen/ }
my %blocked_type;
my $allowed_blocked_rx = join("|", @allowed_blocked_type);
foreach (@blocked_type) {
    if (/^($allowed_blocked_rx)$/) {
	$blocked_type{$_} = 1;
    } else {
	die "Only @allowed_blocked_type is allowed, not $_";
    }
}

$s = MultiStrassen->new(@s_files);
$blocked = MultiStrassen->new(@blocked_files);

{
    my $_encoding = $s->get_global_directive('encoding');
    $encoding = $_encoding if defined $_encoding;
}

{
    my $_map = $s->get_global_directive('map');
    $map = $_map if defined $_map;
}

new_search();

sub new_search {
    my $net = StrassenNetz->new($s);
    $net->make_net(UseCache => $usecache);
    $net->make_sperre($blocked, %blocked_type);

    my $s = $net->{Strassen};

    my $number_of_unique_points = Strassen::Check::number_of_unique_points($s);

    my @islands;
    if ($refpoint) {
	push @islands, Strassen::Check::get_island($net, $refpoint);
    } else {
	push @islands, @{ Strassen::Check::get_islands($net, shortcut => 1, debug => $debug, number_of_unique_points => $number_of_unique_points, max_loops => $max_loops) };
    }

    @islands = sort { scalar(keys %$b) <=> scalar(keys %$a) } @islands;

    if ($encoding) {
	print "#: #: -*- coding: $encoding -*-\n";
	print "#:encoding: $encoding\n";
	binmode STDOUT, ":encoding($encoding)";
    }
    if ($map) {
	print "#:map: $map\n";
    }
    print "#:title: inaccessible points\n";
    print "#:\n";
    print "# generated by $0\n";
    print "#\n";

    if (@islands >= 1) {
	my $continent = $islands[0];
	my %seen_point;
	$s->init;
	while() {
	    my $r = $s->next;
	    my @c = @{ $r->[Strassen::COORDS] };
	    last if !@c;

	    my $name_output = 0;
	    for my $c (@c) {
		if (!exists $continent->{$c} && !$seen_point{$c}) {
		    if (!$shorter || !$name_output || length $r->[Strassen::NAME] <= 3) {
			print $r->[Strassen::NAME];
			$name_output = 1;
		    } else {
			print q{-"-};
		    }
		    print "\tX $c\n";
		    $seen_point{$c} = 1;
		}
	    }
	}
    }

    if ($stats) {
	print STDERR "search_inaccessible_points stats\n";
	if (@islands == 0) {
	    print STDERR "no data records?!\n";
	} else {
	    my $percentage = sub {
		my $index = 0;;
		sprintf "%.1f", 100*scalar(keys %{$islands[$index]})/$number_of_unique_points;
	    };
	    my $get_refpoint = sub {
		my $index = 0;
		(keys %{$islands[$index]})[0];
	    };
	    my $count_inaccessible_points = sub {
		$number_of_unique_points - scalar(keys %{$islands[0]});
	    };
	    print STDERR <<EOF;
largest continent:     @{[ $percentage->() ]}%
  ref point:           @{[ $get_refpoint->() ]}
  inaccessible points: @{[ $count_inaccessible_points->() ]}
EOF
	}
    }
}

__END__
