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

#
# $Id: tkzincbbbike,v 1.5 2007/02/03 11:05:33 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2004 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
#

use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib",
	);
use Tk;
use Tk::Zinc;

use Strassen::Strasse;

use BBBikeUtil qw(pi);
use BBBikeTrans;
use BBBikeGlobalVars;
use BBBikeRouting;

use vars qw($scale);
$scale = DEFAULT_SCALE;
old_create_transpose_subs();

my $routing = BBBikeRouting->new->init_context;
my $s = $routing->init_str;

my $mw = tkinit;
my $zinc_width=600;
my $zinc_height=500;
my $z = $mw->Scrolled("Zinc",
		      #-render => 1,
		      -width => $zinc_width,
		      -height => $zinc_height,
		     )->pack(-fill => "both", -expand => 1);

{
    my $f = $mw->Frame->pack;
    my $minus = $f->Button(-width => 2, 
			   -height => 2,
			   -text => '-',
			   -command=>sub{
			       $z->translate(1,-$zinc_width/2,-$zinc_height/2);
			       $z->scale(1,0.8,0.8);
			       $z->translate(1, $zinc_width/2,$zinc_height/2);
			       $z->configure(-scrollregion => [ $z->bbox(1) ]);
			   })->pack(-side=>'left');

    my $plus = $f->Button(-width => 2, 
			  -height => 2,
			  -text => '+',
			  -command=>sub{
			      $z->translate(1, -$zinc_width/2,-$zinc_height/2);
			      $z->scale(1,1.2,1.2);
			      $z->translate(1,$zinc_width/2,$zinc_height/2);
			      $z->configure(-scrollregion => [ $z->bbox(1) ]);
			  })->pack(-side => 'right');
}

my    %category_color =
	('NN' => '#bdffbd',
	 'N'  => 'grey98',
	 'NH' => '#ffffc0',     # noch blasseres gelb
	 'H'  => '#ffffa0', 	# blassgelb
	 'HH' => '#fff800', 	# krftiges gelb
	 'BAB' => 'DarkBlue',
	 'B'  => 'red3',
	 'P'  => 'green',
	 'Forest' => 'green',
	 'Pabove'  => '#76c48b', 	# same, but for higher stacking
	 'Forest'  => '#66b47b', 	# Wlder
	 'Forestabove'  => '#66b47b', 	# same, but for higher stacking
	 'Cemetery'  => '#70c085', 	# Friedhfe
	 'Green' => '#76c48b', 	# sonstige Grnanlagen
	 'Orchard' => '#e8f8c8', 	# Kleingrten (was #80ca94)
	 'Sport' => '#c8d898', 	# Sportanlagen (was #86d49b)
	 'Industrial' => '#d7b8c8',	# Industriegebiete
	 'Mine' => 'white',	# Tagebau
	 'Ae' => 'white',	# Flughfen
	 'F'  => 'grey99',	# sonstige Flchen
	 'W'  => 'lightblue',
	 'W0'  => 'lightblue',
	 'W1'  => 'lightblue',
	 'W2'  => 'lightblue',
);
my    %category_priority =
    (NN => 10,
     N => 11,
     NH => 11,
     H => 12,
     HH => 13,
     B => 14,
     W => 0,
     W0 => 0,
     W1 => 0,
     W2 => 0,
     P => 5,
     Forest => 5,
    );

my    %line_width =
	('s-NN'     => [1, 1, 2, 2, 4, 7],
	 's-N'      => [1, 1, 2, 2, 4, 7],
	 's-NH'     => [1, 1, 2, 3, 5, 8],
	 's-H'      => [1, 2, 3, 4, 6, 10],
	 's-HH'     => [1, 2, 3, 4, 6, 10],
	 's-B'      => [1, 2, 3, 4, 6, 10],
	 's-BAB'    => [1, 2, 3, 4, 6, 10],
);

my $last_c;
my $last_name;

for my $s_def (['w', Strassen->new("wasserstrassen")],
	       ['f', Strassen->new("flaechen")],
	       ['s', $s]) {
    my($abbrev, $s) = @$s_def;
    $s->init;
    while (1) {
	my $r = $s->next;
	my $c = $r->[Strassen::COORDS];
	last if !@$c;
	$c = [map { transpose_ls_slow(split /,/) } @$c];
	my $cat = $r->[Strassen::CAT];
	my $is_area;
	if ($cat =~ m{^F:(.*)}) {
	    $is_area = 1;
	    $cat = $1;
	}
	my $color = $category_color{$cat} || "white";
	my $width = $line_width{"s-".$cat}[5] || 2;
	my $prio = $category_priority{$cat} || 0;
	$z->add("curve", 1, $c,
		($is_area ? () : (-linewidth => $width+2)),
		-linecolor => "grey30", # XXX should be different for w/f
		-priority => $prio+0,
		($is_area ? (-closed => 1) : ()),
	       );
	$z->add("curve", 1, $c,
		($is_area ? () : (-linewidth => $width,
				  -linecolor => $color,
				 )),
		-priority => $prio+10,
		-tags => [$abbrev, $cat, $s->pos],
		($is_area ? (-closed => 1, -filled => 1, -fillcolor => $color) : ()),
	       );

	$name = $r->[Strassen::NAME];
	if (defined $last_name && $name ne $last_name) {
	    # 	my $labelformat = "x142x12+0+0";
	    # 	my $wpt = $z->add("waypoint", 1, 1, -position => [@{$c}[0,1]],
	    # 			  -labelangle => 45,
	    # 			  -labelformat => $labelformat,
	    # 			  -priority => 20,
	    # 	       );
	    # 	$z->itemconfigure($wpt, 0,
	    # 			  -text => $r->[Strassen::NAME],
	    # 			 );
	    my $pos;
	    my $angle = atan2($last_c->[3]-$last_c->[1], $last_c->[2]-$last_c->[0]);
	    my $anchor = "w";
	    #warn "$r->[Strassen::NAME] $angle\n";
	    if ($angle < -pi()/2 || $angle > pi()/2) {
		$pos = [@{$last_c}[-2,-1]];
		$angle = atan2($last_c->[-3]-$last_c->[-1], $last_c->[-4]-$last_c->[-2]);
		$anchor = "w";
		#warn "*** $angle\n";
	    } else {
		$pos = [@{$last_c}[0,1]];
	    }
	    
	    my $item = $z->add("text", 1, -position => $pos,
			       -text => Strasse::strip_bezirk($last_name),
			       -priority => 30,
			       -anchor => $anchor,
			       -font => "helvetica 9 bold",
			       -sensitive => 0,
			      );
	    
	    $z->rotate($item, $angle);
	    undef $last_name;
	    $last_c = [];
	}

	if ($cat =~ /^H/) {
	    $last_name = $name;
	    push @$last_c, @$c;
	}
	#last if $s->pos > 300;
	if ($s->pos % 50 == 0) {
	    printf "% 2d%%\r", ($s->pos/@{$s->{Data}})*100;
	}
    }
}

$z->configure(-scrollregion => [ $z->bbox(1) ]);

my $state = "start";

$z->bind("s", "<1>", \&press);

MainLoop;

sub press {
    my $z = shift;
    my $e = $z->XEvent;
    my @tags = $z->gettags("current");
    pop @tags; # "current"
    my $pos = $tags[2];
    return if !defined $pos;
    my $r = $s->get($pos) or die;
    my @xy= $z->transform($z->group('current'), [$e->x,$e->y]);

    my $coord = join(",", anti_transpose_ls(@xy));
    if ($state eq 'start') {
	$state = 'goal';
	$routing->Start->Coord($coord);
	$routing->fix_position($routing->Start);

    } else {
	$state = 'start';
	$routing->Goal->Coord($coord);
	$routing->fix_position($routing->Goal);
	$routing->search();

	$z->remove("route");
	my $path = $routing->Path;
	my $c = [map { transpose_ls_slow(@$_) } @$path];

	$z->add("curve", 1, $c,
		-linecolor => "red",
		-linewidth => 2,
		-linestyle => "dashed",
		-priority => 100,
		-tags => ["route"]);
    }
}

__END__
