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

#
# $Id: Generated_src.pm,v 1.18 2004/09/28 21:27:46 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2001 Slaven Rezic. All rights reserved.
# This package 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.sourceforge.net
#

# This is only needed because perl5.6.1 dumps core if Text::ScriptTemplate
# is used.

use strict;
use FindBin;
use lib "$FindBin::RealBin/..";

use Strassen;

package StrassenNetz;

use Text::ScriptTemplate;
my $tmpl = new Text::ScriptTemplate;

my %code_tmpl =
    ($FMT_HASH =>
     {'exist' => sub { 'exists $self->{Net}{' . $_[0] . '}' },
      #XXX 'get_dest' => sub { 'keys %{$self->{Net}{' . $_[0] . '}' },
     },
     $FMT_ARRAY =>
     {'exist' => sub { 'defined $self->{Net}[$self->{Coord2Index}{' . $_[0] . '}]' },
      #XXX 'get_dest' => sub { 'keys %{$self->{Net}{' . $_[0] . '}' },
     },
    );

my $dest = "$FindBin::RealBin/Generated.pm";
warn "Create $dest...\n";
open(DEST, ">$dest") or die "Can't write to $dest: $!";

sub l { "# line " . ($_[0]+1) . " Generated_src.pm\n" }

print DEST l(__LINE__) . <<EOF;
# DO NOT EDIT! Generated by $0!

package Strassen::Generated;

package StrassenNetz;

require Strassen::Util; # XXX move to subs

EOF

$tmpl->pack(l(__LINE__) . <<'EOF');
sub make_net_slow_<%=$type%> {
    my($self, %args) = @_;

    my $cacheable = defined $args{UseCache} ? $args{UseCache} : $Strassen::Util::cacheable;
    if ($cacheable) {
        return if $self->net_read_cache_<%=$type%>;
    }

    if ($VERBOSE) {
	warn "Using slow (type <%=$type%>) version of make_net\n";
    }
<% if ($type == $FMT_ARRAY) { %>
    $self->{Index2Pos}   = []; # Zuordnung Index-Paar => Pos im Straßenfile
    $self->{Coord2Index} = {}; # Zuordnung Koordinate => Index
    $self->{Index2Coord} = []; # Zuordnung Index => Koordinate
    $self->{Net}         = []; # Verbindungsnetz
    my $index2pos   = $self->{Index2Pos};
    my $coord2index = $self->{Coord2Index};
    my $index2coord = $self->{Index2Coord};
    my $pos = 0;
<% } else { %>
    $self->{Net2Name}    = {}; # Zuordnung Strecke => Straßenname
    $self->{Net}         = {}; # Verbindungsnetz
    my $net2name = $self->{Net2Name};
<% } %>
    $self->{Wegfuehrung} = {}; # unerlaubte Wegführung
    $self->{Penalty}     = {}; # zusätzliche Penalties
    my $net      = $self->{Net};
    my $strassen = $self->{Strassen};
    $strassen->init;
    while(1) {
	my $ret = $strassen->next;
	my @kreuzungen = @{$ret->[Strassen::COORDS()]};
	last if @kreuzungen == 0;
	my @kreuz_coord = @{Strassen::to_koord(\@kreuzungen)};

<% if ($type == $FMT_ARRAY) { %>
	my @k_i;
	foreach my $cp (@kreuz_coord) {
	    my $c = pack("l2", @$cp);
	    if (!exists $coord2index->{$c}) {
		$coord2index->{$c} = pack("l", $pos);
		$index2coord->[$pos] = $c;
		$pos++;
	    }
	    push @k_i, $coord2index->{$c};
	}

	for (my $i = 0; $i < $#k_i; $i++) {
	    my $entf = pack("l",
			    int(Strassen::Util::strecke($kreuz_coord[$i],
							$kreuz_coord[$i+1])));
	    my $k_i_u  = unpack("l", $k_i[$i]);
	    my $k_i1_u = unpack("l", $k_i[$i+1]);
	    $net->[$k_i_u]  .= $k_i[$i+1] . $entf;
	    $net->[$k_i1_u] .= $k_i[$i]   . $entf;
	    $index2pos->[$k_i_u]  .= $k_i[$i+1] . pack("l", $strassen->pos);
	    $index2pos->[$k_i1_u] .= $k_i[$i]   . pack("l", $strassen->pos);
	}
<% } else { %>
	for(my $i = 0; $i < $#kreuzungen; $i++) {
	    # Integer reicht vollkommen aus, da die Angaben sowieso in m sind
	    my $entf = int(Strassen::Util::strecke($kreuz_coord[$i],
						   $kreuz_coord[$i+1]));
 	    $net->{$kreuzungen[$i]}{$kreuzungen[$i+1]} = $entf;
 	    $net->{$kreuzungen[$i+1]}{$kreuzungen[$i]} = $entf;
# XXX not yet, but maybe someday necessary:
#  	    if (exists $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]}) {
#  		if (ref $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} ne 'ARRAY') {
#  		    $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} = [ $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} ];
#  		}
#  		push @{ $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} }, $strassen->pos;
#  	    } else {
		$net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} = $strassen->pos;
#	    }
	}
<% } %>
    }

    if ($cacheable) {
	$self->net_write_cache_<%=$type%>;
    }

    $self->{UseMLDBM} = 0;
}

sub net_read_cache_<%=$type%> {
    my($self) = @_;
    my @src = $self->dependent_files;
    if (!@src || grep { !defined $_ } @src) {
	return 0;
    }
    my $cachefile = $self->get_cachefile;
<% if ($type == $FMT_ARRAY) { %>
    my $coord2index = Strassen::Util::get_from_cache("coord2index_<%=$type%>_$cachefile", \@src);
    my $index2coord = Strassen::Util::get_from_cache("index2coord_<%=$type%>_$cachefile", \@src);
    my $index2pos   = Strassen::Util::get_from_cache("index2pos_<%=$type%>_$cachefile", \@src);
<% } else { %>
    my $net2name = Strassen::Util::get_from_cache("net2name_<%=$type%>_$cachefile", \@src);
<% } %>
    my $net = Strassen::Util::get_from_cache("net_<%=$type%>_$cachefile", \@src);
    if (
<% if ($type == $FMT_ARRAY) { %>
	defined $coord2index &&
	defined $index2coord &&
	defined $index2pos &&
<% } else { %>
	defined $net2name &&
<% } %>
	defined $net
       ) {
<% if ($type == $FMT_ARRAY) { %>
	$self->{Coord2Index} = $coord2index;
	$self->{Index2Coord} = $index2coord;
	$self->{Index2Pos}   = $index2pos;
<% } else { %>
	$self->{Net2Name} = $net2name;
<% } %>
	$self->{Net} = $net;
	if ($VERBOSE) {
	    warn "Using cache for $cachefile\n";
	}
	return 1;
    } else {
	return 0;
    }
}

sub net_write_cache_<%=$type%> {
    my($self) = @_;
    my @src = $self->dependent_files;
    if (!@src || grep { !defined $_ } @src) {
	return;
    }
    my $cachefile = $self->get_cachefile;
<% if ($type == $FMT_ARRAY) { %>
    Strassen::Util::write_cache($self->{Coord2Index}, "coord2index_<%=$type%>_$cachefile");
    Strassen::Util::write_cache($self->{Index2Coord}, "index2coord_<%=$type%>_$cachefile");
    Strassen::Util::write_cache($self->{Index2Pos}, "index2pos_<%=$type%>_$cachefile");
<% } else { %>
    Strassen::Util::write_cache($self->{Net2Name}, "net2name_<%=$type%>_$cachefile", -modifiable => 1);
<% } %>
    Strassen::Util::write_cache($self->{Net}, "net_<%=$type%>_$cachefile", -modifiable => 1);
    if ($VERBOSE) {
        warn "Wrote cache ($cachefile)\n";
    }
}

EOF

 for my $type ($FMT_HASH, $FMT_ARRAY) {
    $tmpl->setq(type => $type, %{ $code_tmpl{$type} });
    my $code = $tmpl->fill;
    #my $i=1; warn join("", map { sprintf "%3d %s\n", $i++, $_ } split /\n/, $code);
    print DEST $code;
 } # Achtung, Einrückung für make_autoload!

# Erzeugt aus einer Route eine Liste mit den zugehörigen Straßennamen.
# Die Elemente der Liste bestehen aus:
#    [Straßenname, Entfernung (m), Winkel, Richtung, [FromStr, ToStr]]
# FromStr und ToStr sind Indices auf das übergebene Routen-Array
# Arguments:
#  -startindex: if specified, add this number to each FromStr/ToStr index
#  -combinestreet: if set to 0, do not combine same streets. Default is 1
# XXX
$tmpl->pack(l(__LINE__) . <<'EOF');
sub route_to_name_<%=$type%> {
    my($self, $route_ref, %args) = @_;
    my @strname;
    my $start_i = defined $args{'-startindex'} ? $args{'-startindex'} : 0;
    my $combinestreet = defined $args{'-combinestreet'} ? $args{'-combinestreet'} : 1;
    require Route;
    require Strassen::Util;
    require Strassen::Strasse;
    my $i;
    for($i = 0; $i < $#{$route_ref}; $i++) {
<% if ($type == $FMT_HASH) { %>
	my $xy1 = Route::_coord_as_string([$route_ref->[$i][0],
					   $route_ref->[$i][1]]);
	my $xy2 = Route::_coord_as_string([$route_ref->[$i+1][0],
					   $route_ref->[$i+1][1]]);
	my($str_i, $rueckwaerts) = $self->net2name($xy1, $xy2);
	my $entf = $self->{Net}{$xy1}{$xy2};
<% } else { %>
	my $xy1 = $self->{Coord2Index}->
	  {pack("l2", $route_ref->[$i][0], $route_ref->[$i][1])};
	my $xy1_u = unpack("l", $xy1);
	my $xy2 = $self->{Coord2Index}->
	  {pack("l2", $route_ref->[$i+1][0], $route_ref->[$i+1][1])};
	my $str_i;
	my $rueckwaerts = 0; # XXX
	my $entf;
	{
	    # first find pos of neighbor
	    my $net_s = $self->{Index2Pos}[$xy1_u];
	    my $net_s_len = length($net_s);
	    for(my $i = 0; $i < $net_s_len; $i+=8) {
		if (substr($net_s, $i, 4) eq $xy2) {
		    $str_i = unpack("l", substr($net_s, $i+4, 4));
		    last;
		}
	    }
	    # then find distance to neighbor
	    $net_s = $self->{Net}[$xy1_u];
	    $net_s_len = length($net_s);
	    for(my $i = 0; $i < $net_s_len; $i+=8) {
		if (substr($net_s, $i, 4) eq $xy2) {
		    $entf = unpack("l", substr($net_s, $i+4, 4));
		    last;
		}
	    }
	}
<% } %>
	my $str;
	if (!defined $str_i) {
	    ($str_i, $rueckwaerts) = $self->nearest_street($xy1, $xy2);
	}
	if (defined $str_i) {
	    if ($str_i =~ /^\d/) {
		$str = $self->{Strassen}->get($str_i)->[0];
		$str = Strasse::beautify_landstrasse($str, $rueckwaerts);
	    } else {
		$str = $str_i;
	    }
	} else {
	    # Aha. Wir haben hier wahrscheinlich einen angeklickten
	    # Punkt zwischen zwei Kurvenpunkten, der nicht mehr durch
	    # add_net abgedeckt ist. Also wird einfach geraten, ob der
	    # Punkt zur vorherigen Strecke gehört, indem der Schnittwinkel
	    # überprüft wird.
	    # Der Algorithmus ist nicht perfekt, weil einige Schnittwinkel
	    # im 90°-Bereich liegen, wo es sich trotzdem um die gleiche
	    # Straße handelt. Naja.
	    if ($i+1 < $#{$route_ref}) {
		my($w) = schnittwinkel
		  (split(/,/,$xy1),
		   split(/,/,$xy2),
		   split(/,/,Route::_coord_as_string
			 ([$route_ref->[$i+2][0],
			   $route_ref->[$i+2][1]])));
		if ($w < 0.15 || $w > 3.00) {
		    # ca. 10° Abweichung von der Geraden werden toleriert
		    $str = ($#strname >= 0 ? $strname[$#strname]->[0] : '???');
		}
	    }
	    # (Garantiert) unbekannte Straße.
	    if (!defined $str) {
		$str = "...";
	    }
	}
	if (!defined $entf && $i+1 <= $#{$route_ref}) {
	    $entf = Strassen::Util::strecke($route_ref->[$i],
					    $route_ref->[$i+1]);
	}
	my($winkel, $richtung);
	if ($i+1 < $#{$route_ref}) {
	    ($richtung, $winkel) = Strassen::Util::abbiegen(@{$route_ref}[$i .. $i+2]);
	}
	if (@strname &&
	    ($combinestreet && $str eq $strname[$#strname]->[ROUTE_NAME])) {
	    $strname[$#strname][ROUTE_DIST] += $entf;
	    $strname[$#strname][ROUTE_ANGLE] = $winkel;
	    $strname[$#strname][ROUTE_DIR] = $richtung;
	    $strname[$#strname][ROUTE_ARRAYINX][1] = $i+$start_i;
	    my $extra = $strname[$#strname][ROUTE_EXTRA];
	    if ($extra) {
		if ($args{-wanttrafficlights}) {
		    $extra->{Trafficlights} = +0;
		    $extra->{TrafficlightAtPoint} = 0;
		}
	    }
	} else {
	    my $val = [];
	    $val->[ROUTE_NAME]	 = $str;
	    $val->[ROUTE_DIST]	 = $entf;
	    $val->[ROUTE_ANGLE]	 = $winkel;
	    $val->[ROUTE_DIR]	 = $richtung;
	    $val->[ROUTE_ARRAYINX] = [$i+$start_i, $i+$start_i];
	    my $extra = $val->[ROUTE_EXTRA] = {};
	    if ($args{-wanttrafficlights}) {
		$extra->{Trafficlights} = 0;
		$extra->{TrafficlightAtPoint} = 0;
	    }
	    push @strname, $val;
	}

    }

    @strname;
}
EOF

 for my $type ($FMT_HASH, $FMT_ARRAY) {
    $tmpl->setq(type => $type, %{ $code_tmpl{$type} });
    my $code = $tmpl->fill;
    #my $i=1; warn join("", map { sprintf "%3d %s\n", $i++, $_ } split /\n/, $code);
    print DEST $code;
 } # Achtung, Einrückung für make_autoload!

$tmpl->pack(l(__LINE__) . <<'EOF');
sub reachable_<%=$type%> {
    my($self, $coord) = @_;
    if (!<%=$exist->('$coord')%>) {
	warn "Die Koordinate $coord kann im Netz nicht erreicht werden\n"
	  if $VERBOSE;
	0;
    } else {
	1;
    }
}
EOF

 foreach my $type ($FMT_HASH, $FMT_ARRAY) {
    $tmpl->setq(type => $type, %{ $code_tmpl{$type} });
    my $code = $tmpl->fill;
    #my $i=1; warn join("", map { sprintf "%3d %s\n", $i++, $_ } split /\n/, $code);
    print DEST $code;
 } # Achtung, Einrückung für make_autoload!

print DEST <<EOF;

1;
EOF

close DEST;

system($^X, "-I$FindBin::RealBin/..", "-I$FindBin::RealBin/../lib", "-MStrassen", "-c", $dest);

__END__