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

#
# $Id: bbbike,v 3.214 2005/12/09 21:48:14 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (c) 1995-2005 Slaven Rezic. All rights reserved.
# This is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License, see the file COPYING.
#
# Mail: slaven@rezic.de
# WWW:  http://bbbike.sourceforge.net
#

package main;

## This is list is not maintained anymore:
#perl2exe_include Tk/Checkbutton.pm

#BEGIN { $Devel::Trace::TRACE = 0 }

use FindBin;
use lib ("$FindBin::RealBin",
	 "$FindBin::RealBin/images",
	 "$FindBin::RealBin/lib",
	);
# To create the Devel::Size output, start bbbike with:
#     env BBBIKE_DEBUG=Devel::Size ./bbbike | & grep size
BEGIN {
    if ($ENV{BBBIKE_DEBUG}) {
	eval 'use BBBikeDebug';
	die $@ if $@;
    }
}

BEGIN {
    my $nosplash = grep { $_ eq '-nosplash' } @ARGV;
    if ($] >= 5.005 && !$^C && !$^P && !$nosplash) {
	# XXX don't know whether this is a Tk400 or an old perl problem
	eval {
	    require Tk::ProgressSplash;
	    my $splashtype = 'fast';
	    if ($^O eq 'MSWin32') {
		$splashtype = 'normal';
	    }
	    $splash_screen = Tk::ProgressSplash->Show
		(-splashtype => $splashtype,
		 "$FindBin::RealBin/images/bbbike_splash.xpm",
		 240, 90, "BBBike", 1);
	}; warn $@ if $@;
    }
    if ($nosplash) { $use_logo = 0 }

    eval 'use sigtrap qw(stack-trace USR1)'; warn $@ if $@;
    $booting = 1;
}

use Config;

## DEBUG_BEGIN
#BEGIN{mymstat("before autouse BBBikeMail, Text::Wrap, File::Copy");}
## DEBUG_END

# Call "autouse" as early as possible. Otherwise there will be errors,
# if any other module requires theses modules.
# "autouse" cannot be used on modules with non-standard import functions
use autouse 'BBBikeMail'	=> qw(enter_send_mail enter_send_fax);
use autouse 'Text::Wrap'	=> qw(wrap);
use autouse 'File::Copy'	=> qw(copy mv);
use autouse 'BBBikeGPS'
    => qw(gps_interface draw_gpsman_data do_draw_gpsman_data);
use autouse 'BBBikeWeather'
    => qw(wetter_dir_exists ignore_weather reset_wind update_weather
	  show_weather_db parse_wetterline analyze_wind);
use autouse 'BBBikeHeavy'
    => qw(start_followmouse stop_followmouse
	  string_eval_die load_plugin layer_editor
	  getmap get_file_or_url get_user_agent delete_map
	  pdf_export svg_export perlmod_install_advice
	  show_register save_register_routes load_register_routes
	  show_calories check_available_memory
	  reload_all);
#XXX problems with autouse! -> what problems?
use autouse 'BBBikeEdit'
    => qw(insert_point_from_canvas create_relation_from_canvas
	  ampeln_on_route radweg_open radweg_draw_canvas
	 );
use autouse 'BBBikeLazy'
    => qw(bbbikelazy_setup bbbikelazy_init bbbikelazy_clear
	  bbbikelazy_reload bbbikelazy_reload_all bbbikelazy_redraw_current_view
	  bbbikelazy_add_data bbbikelazy_remove_data plotstr_on_demand);
use autouse 'BBBikePrint'
    => qw(create_postscript print_postscript toggle_legend
	  print_text_postscript print_text_pdflatex print_route_pdf view_pdf);

## This is only for the Autoloader-Hack (see "make autoload")
#use AutoLoader 'AUTOLOAD';

## DEBUG_BEGIN
#BEGIN{mymstat("before Tk");}
## DEBUG_END

use Tk;
#XXX for now disabled ... still too many bugs floating around -> what bugs?
#use Tk::ErrorDialog; # XXX is this OK?
use Tk::Canvas;
use Tk::CanvasUtil;
use File::Basename;
## DEBUG_BEGIN
#BEGIN{mymstat("before BBBikeUtil");}
## DEBUG_END
use BBBikeUtil;
use BBBikeUtil qw(min max);
use BBBikeVar;
use BBBikeCalc;
use BBBikeTrans;
## DEBUG_BEGIN
#BEGIN{mymstat("before Strassen");}
## DEBUG_END
use Strassen;
use Strassen::Dataset;
## DEBUG_BEGIN
#BEGIN{mymstat("before Route");}
## DEBUG_END
use Route;
## DEBUG_BEGIN
#BEGIN{mymstat("before Karte");}
## DEBUG_END
use Karte;
use Hooks;
use VectorUtil qw(get_polygon_center point_in_polygon point_in_grid);
## DEBUG_BEGIN
#BEGIN{mymstat("before locale");}
## DEBUG_END

use strict;
## DEBUG_BEGIN
#BEGIN{mymstat("before use vars");}
## DEBUG_END

# i18n functions M and Mfmt
BEGIN {
    if (!eval '
use Msg; # This call has to be in bbbike!
1;
') {
	warn $@ if $@;
	eval 'sub M ($) { $_[0] }';
	eval 'sub Mfmt { sprintf(shift, @_) }';
    }
}

use BBBikeGlobalVars 1.012;

## DEBUG_BEGIN
#BEGIN{mymstat("before use your");}
## DEBUG_END

use your qw($Karte::Standard::obj $Karte::Standard::init_scrollregion
	    $Karte::GISmap::obj $Karte::Polar::obj
	    $Tk::Getopt::x11_pass_through
	    $wettermeldung2::proxy $wettermeldung2::module
	    $wettermeldung2::FIELD_TEMP $wettermeldung2::tk_widget
	    $Http::tk_widget
	    %GfxConvert::tmpfiles
	    $BikePower::has_xs
	    $Radwege::bez @Radwege::bbbike_category_order
	    %Radwege::category_plural
	    $FURadar::use_map $FURadar::progress
	    $PLZ::VERBOSE $Devel::Trace::TRACE
	   );

*transpose_ls          = \&transpose_ls_slow;
# If you don't have a FPU, maybe \&old_create_transpose_subs should be
# used instead.
*create_transpose_subs = \&old_create_transpose_subs_no_int;

## DEBUG_BEGIN
#BEGIN{mymstat("before use BBBikeXS");}
## DEBUG_END

eval 'use BBBikeXS 0.09';

## DEBUG_BEGIN
#BEGIN{mymstat("after use BBBikeXS");}
## DEBUG_END

$^W = 1;

# $VERSION is the version of the BBBike distribution
# $PROG_REVISION is the version of the main program
$VERSION = $BBBike::VERSION;
$PROG_REVISION = sprintf("%d.%03d", q$Revision: 3.214 $ =~ /(\d+)\.(\d+)/);
# since version 3.40 => 3.040

# OS related
$progname = basename($0);
$devel_host = ($ENV{HOST} && $ENV{HOST} =~ /^(vran|cabulja|cvrsnica|spiff|devpc01)/i);
$os =   $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos' ? 'win'
      : $^O eq 'MacOS'				    	 ? 'mac'
      : 						   'unix';
$os_bsd = $^O =~ /bsd/i;

if (!defined $is_handheld) {
    $is_handheld = $Config{"archname"} =~ /^arm-linux$/i;
}
$use_clipboard = 1 if $os eq 'win';

# include after setting $os!
require TkChange;

# compatibility includes
if ($Tk::VERSION < 402) {
    warn Mfmt("Die Tk-Version ist veraltet (%s). Mglicherweise ist
BBBike trotzdem benutzbar. Empfohlen wird ein Upgrade auf Version 800.012 oder
besser.\n", $Tk::VERSION);
}

if ($Tk::VERSION <= 402.004) {
    require TkCompat;
}

if ($os eq 'win') {
    require WinCompat;
}

# enable DnD
use Tk::DropSite;

$tmpdir = $ENV{TMPDIR} || $ENV{TEMP} || "/tmp";
if (! -d $tmpdir) {
    $tmpdir = "/temp";
    if (! -d $tmpdir) {
	$tmpdir = catfile($FindBin::RealBin, "tmp");
	warn Mfmt("Verwende Unterverzeichnis 'tmp' des Programmverzeichnisses (%s) als temporres Verzeichnis", $tmpdir);
    }
}

# Var section: map scales and orientation
set_landscape();
$scale_coeff = 1;
$small_scale  = 0.0625;    # map scale for overview window (region mode)
$medium_scale = 0.13;      # map scale for overview window (city/Berlin mode)
$small_scale_edit  = 0.01;         # dasselbe fr den Edit-Mode XXX remove?
$medium_scale_edit = 0.02;
set_canvas_scale(DEFAULT_SCALE);
Karte::preload('Standard');
my $init_scale_massstab; # in 1:x form
$init_scrollregion = $Karte::Standard::init_scrollregion;
$normal_scrollregion = $init_scrollregion*$scale;
@scrollregion = ((-$normal_scrollregion) x 2,
		 ($normal_scrollregion)  x 2);
$bbbike_route_ext = 'bbr';
$map_bg = 'grey85';

# Var section: street and point attributes
@comments_types = @Strassen::Dataset::comments_types;
$str_draw{'s'} = 1;      # draw streets by default
$p_draw{'pp'}  = 0;      # do not draw crossings by default
$p_draw{"pp-all"} = 0;   # pp drawing only for the tag types below:
for (qw(s l r b u w f v e z fz)) { $p_draw{"pp-$_"} = 1} # this list should cover most keys of %str_file (but not the dependent ones like "comm" or "qs")
$p_draw{'lsa'} = 1;
$p_far_away{'o'} = 0;
$str_restrict{'s'}  = {qw(BAB 0 B 1 HH 1 H 1 N 1 NN 1 Pl 0 Br 0)}; # Pl = places, Br = bridges
$str_restrict{'r'}  = {qw(RA 1 RB 1 RC 1 R 1 R0 0)};
$str_restrict{'b'}  = {qw(S 1 SA 1 SB 1 SC 1 S0 0)};
$str_restrict{'u'}  = {qw(U 1 UA 1 UB 1 U0 0)};
$str_restrict{'qs'} = {qw(Q0 0 Q1 1 Q2 1 Q3 1)};
$str_restrict{'ql'} = {qw(Q0 0 Q1 1 Q2 1 Q3 1)};
$str_restrict{'hs'} = {qw(q0 0 q1 1 q2 1 q3 1 q4 1)};
$str_restrict{'hl'} = {qw(q0 0 q1 1 q2 1 q3 1 q4 1)};
$str_ignore{'temp_sperre_s'} = {0 => 1, 1 => 1, 2 => 1, 3 => 1}; # XXX BNP auch?
# do not draw Steigung and Geflle at the same time:
$str_ignore{'comm'} = {'Gf' => 1}; # XXX with ";"???
require Radwege;
foreach (@Radwege::category_order) {
    $str_restrict{'rw'}->{$Radwege::category_code{$_}} = 1
        if defined $Radwege::category_code{$_};
}
$str_nr_draw{'comm-route'} = 1;

%tag_group = # group related tags (for stacking)
  ('str_s' => ['s-out', 'gr', 'rw',
	       's-NN', 's-N', 's-H', 's-HH', 's-B', 's-BAB', 'sBAB-BAB',
	       'comm', (map { "comm-$_" } @comments_types),
	       'nl', 'qs', 'hs', 'mount',
	       's-label-bg', 's-label', 'hoehe', 'vf-bg',
	       'sperre', 'temp_sperre_s', 'temp_sperre',
	       'delnet', 'pl-fg', 'lsa-bg', 'vf-fg', 'lsa-fg'],
   'str_l' => ['l-out', 'l', 'comm',
	       (map { "comm-$_" } @comments_types),
	       'ql', 'hl', 'l-label-bg', 'l-label'], # XXX mount?
   'p_o'   => ['o', 'O'],
   'p_p'   => ['p'],
   'str_u' => ['u', 'sperre_u', 'u-bg', 'u-fg', 'u_bg-img', 'u-label'],
   'str_b' => ['b', 'sperre_b', 'b-bg', 'b-fg', 'b_bg-img', 'b-label'],
   'str_r' => ['r', 'sperre_r', 'r-bg', 'r-fg', 'r_bg-img', 'r-label'],
   'str_w' => ['w-out', 'w', 'i-out', 'i', 'w-label-bg', 'w-label'],
   'str_f' => ['f', 'f-label-bg', 'f-label', 'f-Pabove'],
   'str_g' => ['z', 'g', 'gP', 'gD'],
   'p_kn'  => ['kn', 'ki', 'rest'],
   'map'   => ['map'],
   'route' => ['route'],
   'v'     => ['v', 'v-fg'],
   'e'     => ['e', 'e-img'],
  );
$do_iconframe = 1;
$do_route_strnames          = 0 if !defined $do_route_strnames;
$do_route_strnames_km       = 0 if !defined $do_route_strnames_km;
$do_route_strnames_compact  = 0 if !defined $do_route_strnames_compact;
$do_route_strnames_comments = 1 if !defined $do_route_strnames_comments;
$net_type = "s";
$no_make_net = 0;
$str_far_away{'w'} = 0;
$orte_label_size = 1;
use constant MIN_ORT_CAT => 0;
use constant MAX_ORT_CAT => 6;
$str_far_away{'l'} = 0;
$show_overview_mode = "b";
$show_overview = $show_strlist = 0;
$show_calories = 0;
$use_hoehe = 1; # XXX kann im Programm nicht gesetzt werden
$steigung_optimierung = 0;
$green_optimization = 0;
$grade_minimum_short_length = 100; # 100m gilt als kurz fr grademinimumshort
$use_legend = $use_legend_right = 0;
$use_faehre = 0;
$sperre{'einbahn'} = 1;
$sperre{'einbahn-strict'} = 0;
$sperre{'sperre'} = 1;
$sperre{'wegfuehrung'} = 1;
$sperre{'Q3'} = 0;
$p_draw{'sperre'} = 0;
$sperre_file = "gesperrt";
# immediate_replot: 0 = none, 1 = immediate, 2 = deferred
my($immediate_replot, $immediate_recalc) = (1, 1);
$auto_visible = 1;
%tag_visibility =
  ('p-hoehe'  => 1,
   'str-s-NN' => 0.5,
   'str-s-N'  => 0.5,
   'p-lsa'    => 0.5,
   'p-o-0'    => 0.375,
   'p-o-1'    => 0.25,
   'str-s-H'  => 0.125,
   'p-o-2'    => 0.125,
  );
$map_draw = 0;
$map_default_type = 'berlinmap';
$use_map_fallback = 1;
$map_surround = 0;
$dont_delete_map = 1;
$use_current_coord_prefix = 0;
$coord_prefix = undef;
$coordlist_lbox_nl = "";
$min_cache_decider_time = 0.500; # 500ms, dann wird gecached
$steady_mark = 0;
$lowmem = 0;
$use_logo = 1 if !defined $use_logo;
$center_loaded_route = 0;
$zoom_loaded_route = 1;
$zoom_new_route = 0;
$zoom_new_route_chooseort = 1;
$special_edit = '';
$map_mode = MM_SEARCH;
%b2_mode_desc = (B2M_NONE,	 M"Nichts",
		 B2M_SCAN,	 M"Scanning",
		 B2M_FASTSCAN,	 M"Fast Scanning",
		 B2M_AUTOSCROLL, M"Autoscrolling",
		 B2M_DELLAST,	 M"Letzten Punkt lschen",
		);
# Default ist rot, weil das Orange von power oder wind schlecht zu erkennen ist
$mark_color    = 'red'; # Farbe der Markierung in mark_street et al.
$gps_waypoints = 50;

define_item_attribs();

generate_plot_functions();

###################################################################
$really_no_www = $os eq 'win'; # Trumpet und Win32Sock hngen zu lange, wenn es keine Verbindung gibt
$no_map = !$devel_host && (!defined $ENV{USER} || $ENV{USER} !~ /^(eserte|rezic|srezic)$/);
$abbiege_optimierung = 0;
# Verlust in Metern beim Linksabbiegen ohne Ampel
# XXXXX und beim Geradeausfahren??????
$abbiege_penalty = { 'H'   => 70, # entspricht ca. 10s bei 25km/h
		     'HH'  => 140, # entspricht ca. 20s bei 25km/h
		     'BAB' => 140, # hh? fr Radfahrer?
		     'B'   => 140,
		   };
$lost_strecke_per_ampel = 50; # verlorene Strecke pro Ampel in m # XXX F ...?
%lost_time_per_ampel = ('X' => 15,
			'F' => 5,
		       ); # verlorene Zeit pro Ampel in s
$average_v = 0;

$radwege_optimierung = 0;
for(0..$#Radwege::category_order, "") {
    $radwege_speed{"RW$_"} = 100;
}

%strcat_bez =
  (
   B  => M"Bundesstraen",
   HH => M"wichtige Hauptstraen",
   H  => M"Hauptstraen",
   N  => M"Nebenstraen",
   NN => M"fr Kfz gesperrte Straen",
  );
@strcat_order = qw(B HH H N NN);

if (0) { # not enabled by default
    unshift @strcat_order, "BAB";
    $strcat_bez{BAB} = M"Autobahnen";
}

$steigung_penalty = {};
$strecke = 0;
$dim_color = '#999999';
$unit_km = 'km';
$next_is_undo = 0;
# kontrolliert das Zeichnen der Start/Zielflagge:
@do_flag{qw(start via ziel)} = (1, 1, 1);
# $in_search: wahr, wenn gerade gesucht wird

use enum qw(:SRP_ COORD TYPE);

$aufschlag = 1; # XXX ???

# Weather variables section
$wetter_force_update = 1 if !defined $wetter_force_update;
$wetter_route_update = 0 if !defined $wetter_route_update;
$wetter_station = 'uptodate' if !defined $wetter_station;
@wetter_dir = ("$ENV{HOME}/doc/met", "/home/e/eserte/doc/met");
%wetter_zuordnung =
  ('dahlem1'   => 'wetter-full',
   'dahlem2'   => 'wetter',
   #'tempelhof' => 'wetter-tempelhof',
  );
%wetter_name =
  ('dahlem1'   => M"Dahlem (FU, lang)",
   'dahlem2'   => M"Dahlem (FU, kurz)",
   #'tempelhof' => M"Tempelhof (DWD)",
  );
%wetter_full = ('dahlem1' => 1);
$temperature = 20; # degrees Celsius
BBBikeCalc::init_wind();

use enum qw(:WIND_COLOR_ RED GREEN BLUE NAME);

%wind_colors = (-2 => [qw(255   0   0  red)],
		-1 => [qw(255 165   0  orange)],
		 0 => [qw(255 215   0  gold)],
		 1 => [qw(154 205  50  YellowGreen)],
		 2 => [qw(105 139 105  DarkSeaGreen4)],
	       );

### Fonts
$standard_height = 12;

## DEBUG_BEGIN
#BEGIN{mymstat("use vars fr postscript...");}
## DEBUG_END
### Postscript
$ps_color    = 'color';
$ps_rotate   = 1;
$ps_scale_a4 = 1;
$ps_fixed_font = "Courier7";

$nr = -1; # number of points in route (XXX correct???)
{
    my $cachedir = catfile($FindBin::RealBin, "cache");
    $cache_root = (-d $cachedir && -w $cachedir
		   ? catfile($FindBin::RealBin, "cache")
		   : $tmpdir);
    $Karte::cache_root = $cache_root;
}

Karte::preload('Berlinmap2000');
$do_wwwmap = (! $Karte::Berlinmap2000::obj ||
	      ! -e $Karte::Berlinmap2000::obj->fs_dir);
if ($devel_host) {
    $Karte::cache_root = "/usr/www/berlin";
}

if (!$ENV{HOME} || !-d $ENV{HOME}) { # z.B. unter Win32
    $ENV{HOME} = $FindBin::RealBin;
}
if ($os eq 'win') {
    require Win32Util;
    my $home = Win32Util::get_user_folder();
    if (-d $home) {
        $bbbike_configdir = catfile($home, "BBBike");
    }
}
if (!defined $bbbike_configdir) {
    $bbbike_configdir = defined $ENV{HOME} ? catfile($ENV{HOME}, ".bbbike")
    		        		   : "/bbbike.cfg";
}
if (!-d $bbbike_configdir) {
    mkdir $bbbike_configdir, 0700;
}
if (-d $bbbike_configdir) {
    $bbbike_routedir = catfile($bbbike_configdir, "route");
    if (!-d $bbbike_routedir) {
	mkdir $bbbike_routedir, 0700;
    }
}
$oldpath = $bbbike_routedir;
$save2_path = $ENV{HOME};

# Hook init
foreach (qw(before_plot after_plot new_route del_route after_resize
	    after_new_layer after_delete_layer
	    after_change_visibility after_change_stacking)) {
    new Hooks $_;
}

eval { local $SIG{'__DIE__'};
       do "$FindBin::RealBin/$progname" . "_0.config" };

## DEBUG_BEGIN
#BEGIN{mymstat("before getopt BEGIN");} mymstat("before getopt");
## DEBUG_END

handle_options();

## DEBUG_BEGIN
#mymstat("after getopt processing");
## DEBUG_END

my $city_obj;
if (!defined $city) {
    $city = "Berlin";
    $country = "DE";
}
if (defined $city) {
    require Geography;
    $city_obj = Geography->new($city, $country);
    if ($city_obj) {
	set_datadir($city_obj->datadir, -clearold => 1);
	%global_search_args = $city_obj->search_args
	    if $city_obj->can("search_args");
	$no_original_datadir = $city ne "Berlin"; # XXX Was bedeutet das genau?
    } else {
	die Mfmt("Kann keine passende Datei fr Stadt=%s und Land=%s finden",
		 $city, (defined $country ? $country : M("(unbestimmt)")));
    }
} elsif ($datadir) {
    set_datadir($datadir, -clearold => 1);
    $no_original_datadir = 1;
} else {
    warn "XXX Should never happen anymore";
    # default (Berlin)
    set_datadir("$FindBin::RealBin/data");
}

if ($environment ne "normal") {
    eval { local $SIG{'__DIE__'};
	   require $progname . "_" . $environment . ".config" };
}

## DEBUG_BEGIN
#mymstat("before advanced");
## DEBUG_END
if ($advanced) {
    Karte::preload(':all');
    require BBBikeAdvanced;
}

$coord_system_obj = $Karte::Standard::obj;
$coord_system     = $coord_system_obj->token;

if ($verbose) {
    set_verbose();
}

if ($proxy) {
    $wettermeldung2::proxy = $proxy;
}

if ($do_www) {
    $wetter_source{'www'}   = 1;
}
if (wetter_dir_exists() and !$public) {
    $wetter_source{'db'}    = 1;
}
if ($devel_host and !$public) {
    $wetter_source{'local'} = 1;
}
# XXX ja?
# berprfen ... auf win32 wird trotz do_www=0 trotzdem geladen?!
if (!grep($_, values %wetter_source) and $do_www and !$really_no_www) {
    $wetter_source{'www'} = 1;
}

if ($net_type ne 's' && $coloring eq 'wind') {
    $coloring = 'black';
}
reset_wind();
## DEBUG_BEGIN
#mymstat("before update_weather");
## DEBUG_END
update_weather(1) if $want_wind;
$wetter_route_update = 1;

if ($bikepwr) {
    eval {
	require BikePower;
    };
    if ($@) {
 	status_message(Mfmt("Kann BikePower nicht laden: %s", $@), 'err');
 	$bikepwr = 0;
    } else {
	if ($verbose && $BikePower::has_xs) {
	    warn M"Verwende die XS version von BikePower\n";
	}
 	$bp_obj = new BikePower;
	$bp_obj->given('P');
	$bp_obj->temperature($temperature);

	set_corresponding_power();
    }
}
if (!@power) {
    @power = (50, 100);
}

TRY_SPEED_POWER_REFERENCE_STRING: {
    $active_speed_power{Type} = 'speed';
    $active_speed_power{Index} = 0;
    if (defined $speed_power_reference_string) {
	my($type, $val) = split /:/, $speed_power_reference_string;
	if ($type =~ /^(speed|power)$/) {
	    my $i = 0;
	    for ($type eq 'speed' ? @speed : @power) {
		if ($val eq $_) {
		    $active_speed_power{Index} = $i;
		    $active_speed_power{Type} = $type;
		    last TRY_SPEED_POWER_REFERENCE_STRING;
		}
		$i++;
	    }
	    warn "Ignore reference $type $val"; # XXX german
	} else {
	    warn "-reference should be in the form type:value, where type is either speed or power"; # XXX german
	}
    }
}

mk_speed_txt();
for(my $i = 0; $i <= $#speed; $i++) {
    $ampel_count->{"speed"}[$i] = 1;
    $kopfstein_count->{"speed"}[$i] = 1;
}
for(my $i = 0; $i <= $#power; $i++) {
    $ampel_count->{"power"}[$i] = 1;
    $kopfstein_count->{"power"}[$i] = 1;
}

eval {
    set_coord_output_sub();
}; warn __LINE__ . ": $@" if $@;

change_net_type();

if ($do_wwwmap && $devel_host) {
    $map_default_type = 'b2004';
}

if ($all_outline) {
    $str_outline{'s'} =
    $str_outline{'l'} =
    $str_outline{'w'} =
    $str_outline{'i'} = 1;
}

if (defined $init_scope) {
    if    ($init_scope eq 'city')   { city_settings()   }
    elsif ($init_scope eq 'region') { region_settings() }
    elsif ($init_scope eq 'jwd')    { jwd_settings()    }
}

if ($visual) {
    push(@extra_args, -visual => $visual);
}
if (defined $Plugin::brinfo{'xwindow_id'}) {
    push(@extra_args, "-use" => $Plugin::brinfo{'xwindow_id'});
}

if ($Tk::VERSION < 803 || $Tk::VERSION >= 804.025) {
    eval { require Tk::UnderlineAll };
    warn __LINE__ . ": $@" if $@ && $verbose;
}

eval { local $SIG{'__DIE__'};
       do "FindBin::RealBin/$progname" . "_1.config" };

## DEBUG_BEGIN
#BEGIN{mymstat("irgendwo in der mitte BEGIN");} mymstat("irgendwo in der mitte");
## DEBUG_END

if (!defined $top) {
    $top = MainWindow->new(@extra_args);
    $top->{initial_iconic} = $top->state eq 'iconic';

    $top->scaling($scaling) if defined $scaling && $scaling ne "";

    # Es gibt gute Grnde, fr CloseMainWin kein Escape zu nehmen
    # (damit knnen Vorgnge abgebrochen werden). Verwendung von C-q,
    # weil das mittlerweile quasi-Standard ist.
    $top->eventAdd(qw[<<CloseMainWin>> <Control-c> <Control-q>]);
    $top->eventAdd(qw[<<CloseWin>>     <Control-c> <Escape>]);

    if ($os eq 'win') { # vorerst, Windows kann keine tearoffs
	$top->optionAdd("*tearOff", "false", "startupFile");
    }
    if ($os ne 'win') { # use standard bg color on Windows
	for (qw(background highlightBackground)) {
	    $top->optionAdd("*$_", 'grey80', 'startupFile');
	}
	# Workaround for a KDE 3.x problem: KDE sets background, but not
	# highlightBackground options which looks quite ugly.
	my $bg = $top->optionGet("background", "Background");
	if ($top->optionGet("highlightBackground", "HighlightBackground") ne $bg) {
	    $top->optionAdd("*highlightBackground", $bg, 'interactive');
	}
	# Unter Windows sollten Balloons eigentlich -bg => white sein XXX
	for (qw(Balloon CanvasBalloon)) {
	    $top->optionAdd("*$_.background", '#C0C080', 'startupFile');
	}
	for (qw(Scale Scrollbar)) {
	    $top->optionAdd("*$_.troughcolor", "grey95", "startupFile");
	}
    }
    # Browse is for Tk::HistEntry::Browse
    for (qw(Browse Entry NumEntry Date*NumEntryPlain PathEntry
	    Listbox KListbox K2Listbox
	    TixHList HList Text ROText BrowseEntry.Entry SimpleHistEntry
	    ListboxSearchAnything
	   )) {
	if ($os eq 'win') {
	    $top->optionAdd("*$_.background", "SystemWindow", "startupFile");
	} else {
	    $top->optionAdd("*$_.background", "grey95", "startupFile");
	}
    }
    for (qw(Button Checkbutton Radiobutton Menubutton
	    FlatCheckbox FlatRadiobutton FireButton)) {
	$top->optionAdd("*$_.cursor", "hand2", "startupFile");
    }

    if (0) { # ... naja, msste ein Designer ran ... auerdem with -tile nicht mehr untersttzt (?)
	my $bg = $top->Photo(-file => Tk::findINC("images/bg.gif"));
	for (qw(Toplevel Label Button Checkbutton Radiobutton FlatBut
		FlatCheckbox FlatRadiobutton FireButton Menubutton Frame Pane),
	     "Bbbike Chooser", "Bbbike Copyright", "Bbbike Window",
	     "Bbbike Extended Chooser", "Bbbike Overview",
	     "Bbbike Routeinfo") {
	    $top->optionAdd("*$_.tile" => $bg) if $bg;
	}
	$top->optionAdd("*highlightBackground" => "white");
    }
}

# KDE initialisation
if ($run_under_kde) {
    eval {
	require KDEUtil;
	if ($kde = new KDEUtil -top => $top, -checkrunning => 1) {
	    my $kde_focus_policy =
		KDEUtil::WM::get_config($kde, 'General', 'FocusPolicy');
	    local $^W = 0;
	    $focus_policy = ($kde_focus_policy eq 'ClickToFocus'
			     ? 'click'
			     : 'follow');
	    $kde->kde_config_for_tk;
	}
    };
    warn __LINE__ . ": $@" if $@; # XXX and $verbose
}

# Are we running exceed?
$exceed = ($top->server =~ /Hummingbird/);

$focus_policy = 'click' if $exceed;

if (!defined $focus_policy) {
    if ($os eq 'unix') {
	## XXX Problem: Fenster erscheinen manchmal abgeschnitten wegen
	## XXX still in 804?
	## -popover => 'cursor'
	#XXX $focus_policy = 'follow';
	$focus_policy = 'click';
    } else {
	$focus_policy = 'click';
    }
}

if ($focus_policy eq 'follow') {
    @popup_style = ('-popover', 'cursor');
} else {
    @popup_style = ();
}

# erst *nach* new MainWindow aufrufen (wegen Tk::CmdLine)
if (@ARGV) {
    $preload_file = $ARGV[0];
}

# Die folgende Reihenfolge ist wichtig einzuhalten:
# * Geometry ermitteln und in @want_extends ablegen, aber noch nicht setzen
#   (set_default_geometry, geometry_dependent_settings)
# * Zeichenstze ermitteln und Default einstellen (set_fonts)
# * EmptyMenubar zeichnen
# * Geometry setzen

use enum qw(:GEOMETRY_ X Y WIDTH HEIGHT);

# Geometry
set_default_geometry();
geometry_dependent_settings();

# Zeichenstze
set_fonts();

## DEBUG_BEGIN
#BEGIN{mymstat("after setfonts BEGIN");} mymstat("after setfonts");
## DEBUG_END

if ($Tk::VERSION < 800) {
    $standard_menubar = 0;
}
if ($standard_menubar && !$top->cget(-menu)) {
    require BBBikeMenubar;
    BBBike::Menubar::EmptyMenubar(); # Platz reservieren ...
    # Tk feature: menu bar is not counted to geometry
    my $menu_height;
    if ($os eq 'unix') {
	$top->withdraw;
	$top->update;
	$menu_height = ($top->wrapper)[1];
    } else {
	# wrapper[1] is not implemented on Windows ... guess menu height
	$menu_height = 20;
    }
    if ($want_extends[GEOMETRY_HEIGHT] =~ /^-/) {
	$want_extends[GEOMETRY_HEIGHT] += $menu_height;
    } else {
	$want_extends[GEOMETRY_HEIGHT] -= $menu_height;
    }
}

if (@want_extends) {
    if (($want_extends[GEOMETRY_WIDTH]  < 30 && $want_extends[GEOMETRY_WIDTH] !~ /^-/) ||
	($want_extends[GEOMETRY_HEIGHT] < 20 && $want_extends[GEOMETRY_HEIGHT] !~ /^-/) ||
	$want_extends[GEOMETRY_X] < 0 ||
	$want_extends[GEOMETRY_Y] < 0) {
	warn M("Die Fenstergre wird wegen ungltiger Werte nicht gesetzt: ")
	    . join(", ", @want_extends), "\n";
    } else {
	geometry($top, @want_extends);
	@want_extends = ();
    }
}

# dots per inch und mm
$top_dpmm = $top->screenwidth/$top->screenmmwidth;
$top_dpi  = $top_dpmm*25.4;
$ps_image_res = int($top_dpi) . "x" . int($top_dpi);

if (defined $init_scale_massstab) {
    if ($init_scale_massstab =~ m{^1:(\d+)$}) {
	my $nenner = $1;
	my $nenner_now = calc_mapscale_nenner();
	# to the old $scale form:
	$init_scale_massstab = ($scale*$nenner_now)/$nenner;
    }

    if ($init_scale_massstab > 0) {
	my $oldscale = $scale;
	set_canvas_scale($init_scale_massstab);
	my $change_scale_factor = $scale/$oldscale;
	foreach (@scrollregion) {
	    $_ *= $change_scale_factor;
	}
    } else {
	warn "Ungltiger Skalierungswert <$init_scale_massstab> wird ignoriert\n";
    }
}

$srtbike_photo = load_photo($top, 'srtbike_solid.' . $default_img_fmt);
if ($os eq 'win' || $^O eq 'cygwin') {
    # XXX should I use 16 too?
    $srtbike_icon = load_photo($top, 'srtbike32.' . $default_img_fmt);
    if ($srtbike_icon) {
#XXX Produces funny colors --- Tk problem?!
#	$top->iconmask('@' . $FindBin::RealBin . '/images/srtbike32_mask.xbm');
    }
} else {
    # 16x16 is the preferred size for mini-icons in KDE
    # works also for twm (however, a little bit tiny)
    $srtbike_icon = load_photo($top, 'srtbike16.' . $default_img_fmt);
    if ($srtbike_icon) {
	$top->iconmask('@' . $FindBin::RealBin . '/images/srtbike16_mask.xbm');
    }
}

$top->title("$progname $VERSION");

# In ->Icon wird auch ein ->update durchgefhrt:
# XXX Unter Unix vielleicht darauf verzichten und iconimage stattdessen verwenden?
$top->Icon(-image => $srtbike_icon) if defined $srtbike_icon;
if ($splash_screen) {
    $splash_screen->Raise; # raise after the first ->update on $top, otherwise on Windows the splash screen will stay obscured by the main window
    $splash_screen->Update(0.0);
}

# Exceed-Bug
$capstyle_round = ($exceed ? "projecting" : "round");

#XXX
# for(my $i=0; $i <= $#speed; $++) {
#     $bikepwr_cal_spd[$i] = 0;
# }
# erst hier ist die @power-Zuweisung abgeschlossen
for(my $i=0; $i <= $#power; $i++) {
    $bikepwr_time[$i] = 0;
    $bikepwr_cal[$i] = 0;
}
mk_power_txt();

## DEBUG_BEGIN
#BEGIN{mymstat("after mk_power_txt BEGIN");} mymstat("after mk_power_txt");
## DEBUG_END

# Zeichenstze fr Straennamen
# Normal
if (defined $font_family && $font_family =~ /nimbus/) {
    # XXX nimbus is a rather obscure font found in
    # /usr/ports/x11-fonts/freefonts --- maybe use another?
    #
    # somewhere called "nimbus sans" without "l"
    $rot_font_sub  = sub { "-*-nimbus sans l-medium-r-condensed--0-" . $_[0]
			       . "-0-0-p-0-iso8859-1"};
} elsif (defined $font_family && $font_family =~ /luxi/) {
    # a Type 1 font --- slower and nicer
    $rot_font_sub = sub { '-b&h-Luxi Sans-medium-r-normal--0-' . $_[0] . '-0-0-p-0-iso8859-1'};
}
if (defined $rot_font_sub && !check_font($rot_font_sub->(120))) {
    warn "Cannot get normal font in $font_family, use fallback...\n";
    undef $rot_font_sub;
}
# Fallback to helvetica
if (!$rot_font_sub) {
    my $font_family = "helvetica";
    $rot_font_sub  = sub { "-*-$font_family-medium-r-normal--0-" . $_[0]
			     . "-0-0-p-0-iso8859-1"};
}
# Bold
if (defined $font_family && $font_family =~ /nimbus/) {
    $rot_bold_font_sub  = sub { "-*-nimbus sans l-bold-r-condensed--0-" . $_[0]
				  . "-0-0-p-0-iso8859-1"};
} elsif (defined $font_family && $font_family =~ /luxi/) {
    $rot_bold_font_sub = sub { '-b&h-Luxi Sans-bold-r-normal--0-' . $_[0] . '-0-0-p-0-iso8859-1'};
}
if (defined $rot_bold_font_sub && !check_font($rot_bold_font_sub->(120))) {
    warn "Cannot get bold font in $font_family, use fallback...\n";
    undef $rot_bold_font_sub;
}
# Fallback to helvetica bold
if (!$rot_bold_font_sub) {
    my $font_family = "helvetica";
    $rot_bold_font_sub  = sub { "-*-$font_family-bold-r-normal--0-" . $_[0]
				  . "-0-0-p-0-iso8859-1"};
}
%category_rot_font =
  ('N'   => $rot_font_sub,
   'NN'  => $rot_font_sub,
   'H'   => $rot_bold_font_sub,
   'HH'  => $rot_bold_font_sub,
   'B'   => $rot_bold_font_sub,
   'BAB' => $rot_bold_font_sub,
   'W'   => $rot_bold_font_sub);

# According to
# http://web.archive.org/web/20020124125029/www.iarchitect.com/color.htm
# using colors for dialog buttons is not advised. Well, anyway...
$top->optionAdd("*ok*foreground"      => 'green4');
$top->optionAdd("*ok*text"            => M"OK");
if ($Tk::VERSION >= 800) {
    $top->optionAdd("*ok*default"         => 'active');
}
$top->optionAdd("*apply*foreground"   => 'yellow4');
$top->optionAdd("*apply*text"         => M"bernehmen");
$top->optionAdd("*search*foreground"  => 'yellow4');
$top->optionAdd("*search*text"        => M"Suchen");
$top->optionAdd("*show*foreground"    => 'yellow4');
$top->optionAdd("*show*text"          => M"Zeigen");
$top->optionAdd("*default*foreground" => 'yellow4');
$top->optionAdd("*default*text"       => M"Voreinstellung");
$top->optionAdd("*cancel*foreground"  => 'red');
$top->optionAdd("*cancel*text"        => M"Abbrechen");
#XXX Experiment for Tk804: {my $p=load_photo($top, "cross.".$default_img_fmt, -name => "cross");for(qw(close cancel)) { $top->optionAdd("*$_*compound","left"); $top->optionAdd("*$_*image","cross")}}
$top->optionAdd("*close*foreground"   => 'red');
$top->optionAdd("*close*text"         => M"Schlieen");
$top->optionAdd("*end*foreground"     => 'green4');
$top->optionAdd("*end*text"           => M"Schlieen");

if ($small_icons) {
    $top->optionAdd("*Button*borderWidth" => 1);
    $top->optionAdd("*Checkbutton*borderWidth" => 1);
}

$top->optionAdd("*FlatBut*borderWidth" => 0);
$top->optionAdd("*FlatBut*padX" => 1);
$top->optionAdd("*FlatBut*padY" => 0);

if ($use_logo and (!$splash_screen or !$splash_screen->{Exists})) {
    show_logo();
}

if ($use_balloon) {
    eval {
	require Tk::Balloon;
	# -balloonposition: Ansonsten kann es bei Buttons vorkommen, dass
	# der Balloon Teile der Klickflche berdeckt.
	$balloon = $top->Balloon(-balloonposition => "mouse");
    };
}
if (!defined $balloon) {
    eval '
	package Tk::Balloon; # AUTOLOAD: ignore
	sub attach {}
	sub configure {}
	package main;
	$balloon = bless {}, "Tk::Balloon";
    '; # '
}

## DEBUG_BEGIN
#BEGIN{mymstat("after balloon BEGIN");} mymstat("after balloon");
## DEBUG_END

# XXX if !perl2exe
if (!$lowmem) {
    if (eval { require Tk::CanvasBalloon; 1 }) {
	$c_balloon = $top->CanvasBalloon(-initwait => $c_balloon_wait,
					 -show => $use_c_balloon);
    }
}

## DEBUG_BEGIN
#BEGIN{mymstat("after canvasballoon BEGIN");} mymstat("after canvasballoon");
## DEBUG_END

TRY: {
    last TRY unless $use_contexthelp;
    if (!eval {
	require Tk::ContextHelp;
	Tk::ContextHelp->VERSION(0.05); # Win32 check
    }) {
	$use_contexthelp = 0;
	last TRY;
    }
    $ch = $top->ContextHelp('-podfile' => "$FindBin::RealBin/$FindBin::Script" . ".pod");
}
if (!defined $ch) {
    eval q{
	package Tk::ContextHelp; # AUTOLOAD: ignore
	sub attach {}
	sub activate {}
	sub HelpButton { shift; shift->Label(-padx => 0, -pady => 0) }
	package main;
	$ch = bless {}, "Tk::ContextHelp";
    };
}

## DEBUG_BEGIN
#BEGIN{mymstat("after contexthelp BEGIN");} mymstat("after contexthelp");
## DEBUG_END

$frame = $top->Frame;
$frame->pack(-side => "top", -expand => "yes", -fill => "both");
$ctrl_frame = $frame->Frame->pack(-anchor => 'w', -fill => 'x');

## DEBUG_BEGIN
#BEGIN{mymstat("before topframe BEGIN");} mymstat("before topframe");
## DEBUG_END

##### Topframe #######################################################

$splash_screen->Update(0.1) if $splash_screen;

$menuarrow_photo = load_photo($top, 'menupfeil.' . $default_img_fmt);

my $col = 0;
my $top_frame = $ctrl_frame->Frame->pack(-side => 'top', -anchor => 'w',
					 -fill => 'x');

my($hslabel_frame, $km_frame, @speed_frame, $wind_frame,
   @power_frame, $percent_frame, $temp_frame);

$top_frame->gridColumnconfigure(0, -weight => 1, -minsize => 50);
for(1..10) {
    $top_frame->gridColumnconfigure($_, -weight => 0);
}

$hslabel_frame  = $top_frame->Frame
  (-relief => 'raised', -bd => 1);

if (!$small_icons) {
    $hslabel_frame->Button
	(-text => M('Ort/Bahnhof').':',
	 -class => 'FlatBut',
	 -highlightthickness => 0, -takefocus => 0,
	 -command => sub { choose_ort(qw(p o)) },
	)->grid(-row => 0,
		-column => 0,
		-sticky => 'w');
    $hslabel_frame->Button
	(-text => M('Strae/Strecke').':',
	 -class => 'FlatBut',
	 -highlightthickness => 0, -takefocus => 0,
	 -command => \&choose_streets,
	)->grid(-column => 0,
		-row => 1,
		-sticky => 'w');
}

#XXXXXXXXXXXXXXXXX Ab hier POD attaches Msg-tauglich machen
$hslabel_frame->gridColumnconfigure(1, -weight => 1, -minsize => 10);
$hs_label = $hslabel_frame->Label
  (-textvariable => \$act_value{Haltestelle},
   -fg => $dim_color,
   -font => $font{'bold'},
   -anchor => 'w',
  )->grid(-column => 1, -row => 0, -sticky => 'w');
$ch->attach($hs_label, -pod => "^\\s*Ort/Haltestelle");

$str_label = $hslabel_frame->Label
  (-textvariable => \$act_value{Strasse},
   -fg => $dim_color,
   -font => $font{'bold'},
   -anchor => 'nw',
  )->grid(-column => 1, -row => 1, -sticky => 'w');
$ch->attach($str_label, -pod => "^Strae/Strecke");

$km_frame = $top_frame->Frame(-relief => 'raised',
			      -bd => 1);
my $kmcb = $km_frame->Button
    (-textvariable => \$unit_km,
     -class => 'FlatBut',
     -command => \&change_unit,
    )->pack;
if ($km_frame->can('UnderlineAll')) { $km_frame->UnderlineAll }

$km_frame->Label(-width => 5,
		 -textvariable => \$act_value{Km},
		 -font => $font{'bold'})->pack;
$balloon->attach($km_frame, -msg => M"Streckenlnge");
$ch->attach($km_frame, -pod => "^\\s*km");

$percent_frame = $top_frame->Frame
  (-relief => 'raised', -bd => 1);
$percent_frame->Label(-text => "%")->pack;
$percent_frame->Label(-width => 4,
		      -textvariable => \$act_value{Percent},
		      -font => $font{'bold'})->pack;
$balloon->attach($percent_frame, -msg => M"% ber Luftlinie");
$ch->attach($percent_frame, -pod => "^\\s*%");

$ampel_klein_photo      = load_photo($top, 'ampel_klein.' . $default_img_fmt);
$ampel_klein_grey_photo = load_photo($top, 'ampel_klein_grey.' . $default_img_fmt);
$kopfstein_klein_photo      = load_photo($top, 'kopfstein_klein.' . $default_img_fmt);
$kopfstein_klein_grey_photo = load_photo($top, 'kopfstein_klein_grey.' . $default_img_fmt);
$star_photo             = load_photo($top, 'star.' . $default_img_fmt);
$newlayer_photo		= load_photo($top, 'newlayer.' . $default_img_fmt);

for(my $i = 0; $i <= $#speed; $i++) {
    my $ii = $i; # fr das sub
    $speed_frame[$i] = $top_frame->Frame
      (-relief => 'raised', -bd => 1);
    $ch->attach($speed_frame[$i], -pod => "^\\s*km/h");
    my $b = $speed_frame[$i]->Button
      (-textvariable => \$speed_txt[$i],
       -class => 'FlatBut',
       -command => sub { enter_speed($ii) },
      )->grid(-row => 0, -column => 0);
    {
	my $f = $speed_frame[$i]->Frame->grid(-row => 0, -column => 1);;
	$ampel_count_button->{"speed"}[$i] =
	    $f->Button
		(-image => ($ampel_count->{"speed"}[$i]
			    ? $ampel_klein_photo
			    : $ampel_klein_grey_photo),
		 -class => 'FlatBut',
		 -padx => 1,
		 -command => sub { change_ampel_count("speed", $ii) },
		)->pack;
	$balloon->attach($ampel_count_button->{"speed"}[$i],
			 -msg => M"Ampeln in Zeitberechnung aufnehmen");

	$kopfstein_count_button->{"speed"}[$i] =
	    $f->Button
		(-image => ($kopfstein_count->{"speed"}[$i]
			    ? $kopfstein_klein_photo
			    : $kopfstein_klein_grey_photo),
		 -class => 'FlatBut',
		 -padx => 1,
		 -command => sub { change_kopfstein_count("speed", $ii) },
		)->pack;
	$balloon->attach($kopfstein_count_button->{"speed"}[$i],
			 -msg => M"Langsamfahrstrecken in Zeitberechnung aufnehmen");
    }
    my $l = $speed_frame[$i]->Button
      (-width => 7,
       -class => 'FlatBut',
       -command => sub {
	   require BBBikeAlarm;
	   BBBikeAlarm::enter_alarm($top, \$act_value{Time}->[$ii],
				    -location => get_polar_location_of_route_end());
       },
       -textvariable => \$act_value{Time}->[$i],
       -font => $font{'bold'},
      )->grid(-row => 1, -column => 0, -columnspan => 2, -sticky => "ew");
    foreach (qw(2 3)) {
	$speed_frame[$i]->bind
	  ("<ButtonPress-$_>" =>
	   sub { change_active_speed_power("speed", $ii) });
	$b->bind("<ButtonPress-$_>" =>
		 sub { change_active_speed_power("speed", $ii) });
	$l->bind("<ButtonPress-$_>" =>
		 sub { change_active_speed_power("speed", $ii) });
    }
    enter_leave_bind_for_help($speed_frame[$i],
			      [M"Geschwindigkeit eingeben",
			       M"Geschwindigkeit als Voreinstellung festlegen",
			       M"Geschwindigkeit als Voreinstellung festlegen",
			      ]);
    enter_leave_bind_for_help($l,
			      [M"Alarm setzen", undef, undef]);
    enter_leave_bind_for_help($ampel_count_button->{"speed"}[$i],
			      [M"Ampeln in Zeitberechnung aufnehmen", "", ""]);
    enter_leave_bind_for_help($kopfstein_count_button->{"speed"}[$i],
			      [M"Langsamfahrstrecken in Zeitberechnung aufnehmen", "", ""]);
}

if ($bikepwr) {
    for(my $i = 0; $i <= $#power; $i++) {
	my $ii = $i;
	$power_frame[$i] = $top_frame->Frame
	  (-relief => 'raised', -bd => 1);
	$ch->attach($power_frame[$i], -pod => "^\\s*W\$");
	my $b = $power_frame[$i]->Button
	  (-textvariable => \$power_txt[$i],
	   -class => 'FlatBut',
	   -command => sub { enter_power($ii) },
	  )->grid(-row => 0, -column => 0);
	{
	    my $f = $power_frame[$i]->Frame->grid(-row => 0, -column => 1);;
	    $ampel_count_button->{"power"}[$i] =
		$f->Button
		    (-image => ($ampel_count->{"power"}[$i]
				? $ampel_klein_photo
				: $ampel_klein_grey_photo),
		     -class => 'FlatBut',
		     -padx => 1,
		     -command => sub { change_ampel_count("power", $ii) },
		    )->pack;
	    $balloon->attach($ampel_count_button->{"power"}[$i],
			     -msg => M"Ampeln in Zeitberechnung aufnehmen");

if (0) { # XXX activate if implemented in updatekm()
	    $kopfstein_count_button->{"power"}[$i] =
		$f->Button
		    (-image => ($kopfstein_count->{"power"}[$i]
				? $kopfstein_klein_photo
				: $kopfstein_klein_grey_photo),
		     -class => 'FlatBut',
		     -padx => 1,
		     -command => sub { change_kopfstein_count("power", $ii) },
		    )->pack;
	    $balloon->attach($kopfstein_count_button->{"power"}[$i],
			     -msg => M"Langsamfahrstrecken in Zeitberechnung aufnehmen");
}
	}
	my $l = $power_frame[$i]->Button
	  (-width => 7,
	   -class => 'FlatBut',
	   -command => sub {
	       require BBBikeAlarm;
	       BBBikeAlarm::enter_alarm($top, \$act_value{PowerTime}->[$ii],
					-location => get_polar_location_of_route_end());
	   },
	   -textvariable => \$act_value{PowerTime}->[$i],
	   -font => $font{'bold'},
	  )->grid(-row => 1, -column => 0, -columnspan => 2, -sticky => "ew");
	foreach (qw(2 3)) {
	    $power_frame[$i]->bind
	      ("<ButtonPress-$_>" =>
	       sub { change_active_speed_power("power", $ii) });
	    $b->bind("<ButtonPress-$_>" =>
		     sub { change_active_speed_power("power", $ii) });
	    $l->bind("<ButtonPress-$_>" =>
		     sub { change_active_speed_power("power", $ii) });
	}
	enter_leave_bind_for_help($power_frame[$i],
				  [M"Leistung eingeben",
				   M"Leistung als Voreinstellung festlegen",
				   M"Leistung als Voreinstellung festlegen",
				  ]);
	enter_leave_bind_for_help($l,
				  [M"Alarm setzen", undef, undef]);
	# XXX not yet activated
	#enter_leave_bind_for_help($ampel_count_button->{"speed"}[$i],
	#[M"Ampeln in Zeitberechnung aufnehmen", "", ""]);
	#enter_leave_bind_for_help($kopfstein_count_button->{"speed"}[$i],
	#[M"Langsamfahrstrecken in Zeitberechnung aufnehmen", "", ""]);
    }
}

change_active_speed_power($active_speed_power{Type}, $active_speed_power{Index});

##### Wind & Wetter #####
$wind_frame = $top_frame->Frame
  (-relief => 'raised', -bd => 1);
my $wb = $wind_frame->Button
    (-textvariable => \$act_value{Windlabel},
     -class => 'FlatBut',
     -command => sub { update_weather(1) },
     -width => 22)->pack;
$ch->attach($wb, -pod => "^\\s*Datum der Winddaten");

my $wff = $wind_frame->Frame->pack(-fill => 'x');
my $wfewb = $wff->Button
  (-font => $font{'bold'},
   -textvariable => \$act_value{Wind},
   -class => 'FlatBut',
   -command => \&enter_wind,
  )->pack(-fill => 'x', -expand => 1, -side => 'left');
$ch->attach($wfewb, -pod => "^\\s*Winddaten");

my $wfemb = $wff->Menubutton;
# Hack: Verwendung von -disabledforeground, weil es kein "label"-Kommando gibt.
my $wbm = $wfemb->Menu(-title => M("Wetterdaten"),
		       -disabledforeground => $wb->cget(-foreground));
$wbm->command(-label => M("Wetterstation").":",
	      -state => 'disabled',
	      -font => $font{'bold'},
	     );
foreach (['uptodate' => M"aktuellste"],
	 ['dahlem2'],
	 ['dahlem1'],
	 #['tempelhof'],
	 ($advanced
	  ? map { ["synop_$_" => "$_ (Synop)"] }
	  qw(potsdam berlin_dahlem berlin_tegel
	     berlin_tempelhof berlin_schoenefeld berlin_alexanderplatz)
	  : ()
	 ),
	 ($devel_host && $advanced
	  ? (['wetterkarte' => 'Wetterkarte Berlin-Dahlem'])
	  : ()
	 ),
	) {
    my $name = $_->[1];
    if (!defined $name) {
	$name = $wetter_name{$_->[0]}
    }
    $wbm->radiobutton
      (-label    => $name,
       -variable => \$wetter_station,
       -value    => $_->[0],
       -command  => sub { update_weather($wetter_force_update) },
      );
}
$wbm->separator;

$wbm->command(-label => M('Quelle').':',
	      -state => 'disabled',
	      -font => $font{'bold'},
	     );
foreach ([M"WWW",           'www'],
	 [M"lokaler Cache", 'local'],
	 [M"Datenbank",     'db'],
	) {
    next if $_->[1] eq 'db'    && !wetter_dir_exists();
    next if $_->[1] eq 'local' && !$devel_host;
    $wbm->checkbutton
      (-label    => $_->[0],
       -variable => \$wetter_source{$_->[1]},
       -command  => sub { update_weather($wetter_force_update) },
      );
}
if (wetter_dir_exists()) {
    $wbm->separator;
    $wbm->command(-label => M('Auswahl aus Datenbank').':',
		  -state => 'disabled',
		  -font => $font{'bold'},
		 );
    $wbm->command(-label => M"Dahlem (kurz)",
		  -command => sub { show_weather_db('dahlem2') });
    $wbm->command(-label => M"Dahlem (lang)",
		  -command => sub { show_weather_db('dahlem1') });
#      $wbm->command(-label => M"Tempelhof",
#  		  -command => sub { show_weather_db('tempelhof') });
}
$wbm->separator;
$wbm->command(-label => M"Wind ignorieren",
	      -command => sub { ignore_weather() },
	     );
{
    my $index = $wbm->index('last');
    push @edit_mode_cmd, sub { $wbm->invoke($index) };
}

$wbm->command(-label => M"Aktualisierung",
	      -command => sub { update_weather(1) },
	     );
$wbm->checkbutton(-label => M"automatische Aktualisierung",
		  -variable => \$wetter_force_update,
		  -command => sub { update_weather($wetter_force_update) },
		 );
$wbm->checkbutton(-label => M"automatische Routenaktualisierung",
		  -variable => \$wetter_route_update,
		 );

menuright($wb, $wbm);
menuright($wfewb, $wbm);
menuarrow($wfemb, $wbm, undef, '-pack' => [-side => 'bottom']);

if ($wind_frame->can('UnderlineAll')) { $wind_frame->UnderlineAll }

$temp_frame = $top_frame->Frame
  (-relief => 'raised', -bd => 1);
$ch->attach($temp_frame, -pod => "^\\s*Temp\$");
$temp_frame->Button
    (-text => 'Temp',
     -width => 7,
     -class => 'FlatBut',
     -command => sub {
	 require WWWBrowser;
	 WWWBrowser::start_browser('http://www.met.fu-berlin.de/deutsch/Wetter/beobachtung.html');
     }
    )->pack;
$temp_frame->Label(-textvariable => \$act_value{Temp},
		  )->pack;

arrange_topframe();

##### Iconframe #######################################################

$check_sub{'s'} = sub {
    plot("str",'s');
};
$check_sub{'l'} = sub {
    plot("str",'l');
};
$check_sub{'u'} = sub {
    $p_draw{'u'} = $p_draw{'sperre_u'} = $str_draw{'u'};
    $progress->InitGroup;
    plot("str",'u');
    plot("p",'u');
    plot_sperre($p_file{"sperre_u"}, -abk => "sperre_u");
    $progress->FinishGroup;
};
$check_sub{'b'} = sub {
    $p_draw{'b'} = $p_draw{'sperre_b'} = $str_draw{'b'};
    $progress->InitGroup;
    plot('str','b');
    plot('p','b');
    plot_sperre($p_file{"sperre_b"}, -abk => "sperre_b");
    $progress->FinishGroup;
};
$check_sub{'r'} = sub {
    $p_draw{'r'} = $str_draw{'r'};
    $progress->InitGroup;
    plot('str','r');
    plot('p','r');
    $progress->FinishGroup;
};
$check_sub{'w'} = sub {
    plot('str','w');
};
$check_sub{'f'} = sub {
    plot('str','f');
};
$check_sub{'o'} = sub { plot('p','o',Shortname => 1) };
$check_sub{'p'} = sub { plot('p','p') };

## DEBUG_BEGIN
#BEGIN{mymstat("before do_iconframe BEGIN");} mymstat("before do_iconframe");
## DEBUG_END
$DockFrame = 'Frame';

# use FlatCheckbox or not?
# flat relief relies on Tie::Watch installed
if ($flat_relief and !eval 'require Tie::Watch; 1') {
    $flat_relief = 0;
}
$Checkbutton = 'Checkbutton';
$Radiobutton = 'Radiobutton';
if ($flat_relief) {
    eval { require Tk::FlatCheckbox };
    if (!$@) {
	$Checkbutton = 'FlatCheckbox';
	if ($os ne 'win') {
	    $top->optionAdd('*FlatCheckbox*background' => 'grey80',
			    "startupFile");
	}
    }
    eval { require Tk::FlatRadiobutton };
    if (!$@) {
	$Radiobutton = 'FlatRadiobutton';
	if ($os ne 'win') {
	    $top->optionAdd('*FlatRadiobutton*background' => 'grey80',
			    "startupFile");
	}
    }
}

$splash_screen->Update(0.2) if $splash_screen;

do_iconframe() if $do_iconframe;
if ($standard_menubar) {
## DEBUG_BEGIN
#mymstat("set menubar");
## DEBUG_END
    BBBike::Menubar::Set();
}
## DEBUG_BEGIN
#BEGIN{mymstat("after do_iconframe BEGIN");}
## DEBUG_END

# Erzeugt das Frame mit den Icons und den dazugehrigen Mens
sub do_iconframe {
    my $sym_frame = $ctrl_frame->Frame
      (Name => 'symframe')->pack(-side => 'top', -anchor => 'w');

    my $def_selectcolor;
    {
	# get default selectcolor
	my $cb = $top->Checkbutton;
	$def_selectcolor = $cb->cget(-selectcolor);
	$cb->destroy;
    }

    $top->optionAdd('*symframe*padX' => 0, 'startupFile');
    $top->optionAdd('*symframe*padY' => 0, 'startupFile');
    # XXX ja?
    $top->optionAdd('*symframe*indicatorOn' => $flat_relief, 'startupFile');
    $top->optionAdd('*symframe*selectColor' => 'white', 'startupFile')
      unless $flat_relief;
    $top->optionAdd('*symframe*Menu*selectColor' => $def_selectcolor,
		    'startupFile');
    if ($flat_relief) {
	$top->optionAdd('*symframe*relief' => 'flat');
	$top->optionAdd('*symframe*Menu*relief' => 'raised');
    }

    if ($small_icons) {
	foreach (qw(Button Checkbutton Radiobutton Menubutton
		    FlatCheckbox FlatRadiobutton FireButton)) {
	    $top->optionAdd('*symframe*$_*padY' => 0, 'startupFile');
	}
    }

    my($dock_port, $dock_port2);
    eval {
	die; # XXX not ready....
	require Tk::DockFrame;
	$DockFrame = 'DockFrame';
	$dock_port = $sym_frame->DockPort->grid(-row => 0,
						-column => 0,
						-sticky => 'nw');
	$dock_port2 = $sym_frame->DockPort->grid(-row => 0,
						 -column => 1,
						 -sticky => 'nw');
    };

    use vars qw($curr_row);
    local $curr_row = 0;
    $misc_frame = $sym_frame->$DockFrame
      (-bd => 1, -relief => 'raised',
       ($DockFrame eq 'DockFrame' ? ('-dock' => $dock_port) : ()));
    if ($DockFrame ne 'DockFrame') {
	$misc_frame->grid(-row => 0,
			  -column => 0,
			  -sticky => 'nsew');
    }
    $misc_frame->gridColumnconfigure(999, -weight => 1); # force buttons to the left
    $col = 0;
##### Straen #####
    $strasse_photo = load_photo($misc_frame, 'strasse.' . $default_img_fmt);
    my $strasse_check = $misc_frame->$Checkbutton
      (image_or_text($strasse_photo, 'Str'),
       -variable => \$str_draw{'s'},
       -command => $check_sub{'s'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($strasse_check, -msg => M"Straen");
    $ch->attach($strasse_check, -pod => "^\\s*Straen-Symbol");

    my $strcmb = $misc_frame->Menubutton;
    $strcmb->focus;
    my $strcm = $strcmb->Menu(-title => M("Straen"));
    menu_entry_choose_ort
	($strcm, 's',
	 -accelerator => 'S',
	 -strchooseortargs =>
	 {'-markstartifactive' => 1,
	  -completelistbutton => sub { choose_from_plz(-interactive => 1) },
	  -completelistbuttonlabel => M"Alle Straen",
	 },
	 -strextrachoosemenuaction =>
	 sub {
	     $strcm->cascade(-label => M('Erweiterte Auswahl').' ...');
	     my $ausm = $strcm->Menu(-title => M("Erweiterte Auswahl").' ...');
	     $strcm->entryconfigure('last', -menu => $ausm);
	     $plzmcmd = $ausm->command
		 (-label => M"Komplette Straenliste",
		  -command => sub { choose_from_plz(-interactive => 1) });
	     $ausm->command
		 (-label => M"Telefonbuch-Datenbank (Strae)",
		  -command => sub {
		      telefonbuch_dialog("str");
		  });
	     $ausm->command
		 (-label => M"Telefonbuch-Datenbank (Name)",
		  -command => sub {
		      telefonbuch_dialog("tel");
		  });
	     if ($advanced) {
		 $ausm->command(-label => M"MySQL-DB",
				-command => sub {
				    push @INC, "$FindBin::RealBin/miscsrc";
				    eval {
					require TelbuchDBApprox;
					TelbuchDBApprox::tk_choose($top);
				    };
				    if ($@) {
					status_message($@, "die");
				    }
				});
	     }
	     $ausm->command(-label => M"Volltextsuche",
			    -accelerator => "Ctrl-F",
			    -command => sub {
				require BBBikeAdvanced;
				search_anything();
			    });
	 },
	);
    $strcm->separator;
    $strcm->cascade(-label => M"Straenkategorien");
    {
	my $skm = $strcm->Menu(-title => M"Straenkategorien");
	$strcm->entryconfigure('last', -menu => $skm);
	my @l = ([M"wichtige Hauptstraen", 'HH'],
		 [M"Hauptstraen", 'H'],
		 [M"Nebenstraen", 'N'],
		 [M"fr Kfz gesperrte Straen", 'NN']);
	foreach (@l) {
	    $skm->checkbutton
	      (-label => $_->[0],
	       -variable => \$str_restrict{'s'}->{$_->[1]},
	       -command => sub {
		   pending(1, 'replot-str-s');
	       },
	      );
	}
	if ($advanced) {
	    $skm->separator;
	    $skm->checkbutton
		(-label => M"Autobahnen/Kfz-Straen",
		 -variable => \$str_draw{'sBAB'},
		 -command => sub {
		     plot("str", "sBAB",
			  -filename => get_strassen_file("strassen_bab"));
		 },
		);
	}

    }
    $strcm->checkbutton(-label => M"Hhenangaben",
			-variable => \$p_draw{'hoehe'},
			-command => sub { plot('p','hoehe') });

    $strcm->checkbutton(-label => M"Radwege",
			-variable => \$str_draw{'rw'},
			-command => sub { plot('str','rw')},
			-accelerator => 'Shift-R',
		       );
    my $radwege_check_index = $strcm->index('last');
    $strcm->cascade(-label => M"Radwegekategorien");
    {
	my $rkm = $strcm->Menu(-title => M"Radwegekategorien");
	$strcm->entryconfigure('last', -menu => $rkm);
	foreach my $t (@Radwege::category_order) {
	    my $cat_code = $Radwege::category_code{$t} || '';
	    next if $cat_code eq 'RW0';
	    $rkm->checkbutton
	      (-label => $Radwege::category_name{$t},
	       -variable => \$str_restrict{'rw'}->{$cat_code},
	       -command => sub {
		   pending(1, 'replot-str-rw');
	       },
	      );
	}
    }

    $strcm->checkbutton(-label => M"Einbahn-/gesperrte Straen",
			-variable => \$p_draw{'sperre'},
			-command => sub { plot_sperre() },
			-accelerator => 'G',
		       );
    my $sperre_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Fhren",
			-variable => \$str_draw{'e'},
			-command => sub { plot('str','e') });
    $strcm->checkbutton(-label => M"Ampeln",
			-variable => \$p_draw{'lsa'},
			-command => sub { plot('p','lsa') },
			-accelerator => 'A',
		       );
    my $ampeln_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Outline zeichnen",
			-variable => \$str_outline{'s'},
			-command => sub {
			    pending(1, 'replot-str-s');
			},
		       );
    if ($os ne 'win' || $advanced) {
	# No rotation on win possible.
	$strcm->checkbutton(-label => M"Straennamen",
			    -variable => \$str_name_draw{'s'},
			    -command => sub {
				pending(1, 'replot-str-s');
			    },
			   );
    }
    $strcm->checkbutton(-label => M"Straenqualitt",
			-variable => \$str_draw{'qs'},
			-command => sub { plot('str','qs') },
			-accelerator => 'Shift-Q',
		       );
    my $qualitaet_check_index = $strcm->index('last');
    $strcm->cascade(-label => M"Qualittskategorien");
    {
	my $qm = $strcm->Menu(-title => M"Qualittskategorien");
	$strcm->entryconfigure('last', -menu => $qm);
	foreach (0 .. 3) {
	    my $cat = "Q$_";
	    my $label = $category_attrib{$cat}->[ATTRIB_SINGULAR];
	    $qm->checkbutton
	      (-label => $label,
	       -variable => \$str_restrict{'qs'}->{$cat},
	       -command => sub {
		   $str_restrict{'ql'}->{$cat} =
		       $str_restrict{'qs'}->{$cat};
		   pending(1, 'replot-str-qs');
		   pending(1, 'replot-str-ql');
	       },
	      );
	}
    }
    $strcm->checkbutton(-label => M"Sonstige Beeintrchtigungen",
			-variable => \$str_draw{'hs'},
			-command => sub { plot('str','hs') },
		       );
    my $handicap_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Unbeleuchtete Straen",
			-variable => \$str_draw{'nl'},
			-command => sub { plot('str','nl') },
		       );
    $strcm->checkbutton(-label => M"Grne Wege",
			-variable => \$str_draw{'gr'},
			-command => sub { plot('str','gr') },
		       );
    $strcm->checkbutton(-label => M"Vorfahrt",
			-variable => \$p_draw{'vf'},
			-command => sub { plot('p','vf') },
		       );
    my $fragezeichen_check_index;
    if ($advanced) {
	$strcm->checkbutton(-label => M"Fragezeichen",
			    -variable => \$str_draw{'fz'},
			    -command => sub { plot('str','fz') },
			    -accelerator => '?',
			   );
	$fragezeichen_check_index = $strcm->index('last');
    }
    if ($advanced) {
#XXXXXXXXXXXXXXXXX del?
	if (0) {
	    $strcm->checkbutton(-label => M"Kommentare",
				-variable => \$str_draw{'comm'},
				-command => sub { plot('str','comm') },
			       );
	}
#XXXXXXXXXXXXXXXXX do it nicer, maybe using an "all" category?
	$strcm->cascade(-label => M"Kommentarkategorien");
	{
	    my $c_bpcm = $strcm->Menu(-title => M"Kommentarkategorien");
	    $strcm->entryconfigure("last", -menu => $c_bpcm);
	    foreach my $_type (@comments_types) {
		next if $_type =~ /^(cyclepath|mount)$/; # handled elsewhere
		my $type = my $label = $_type;
		my $def = 'comm-' . $type;
		$c_bpcm->checkbutton
		    (-label => $label,
		     -variable => \$str_draw{$def},
		     -command => sub {
			 my $file  = get_strassen_file("comments_" . $type);
			 plot('str', $def, Filename => $file);
		     },
		    );
	    }
	}
    }

    $strcm->command(-label => M"Radroute auswhlen",
		    -command => sub {
			choose_ort(qw(s comm-route),
				   -markstartifactive => 1);
		    });

    if ($advanced) {
	$strcm->checkbutton
	    (-label => M"Steigungen",
	     -variable => \$str_draw{'mount'},
	     -command => \&plot_mount,
	    );
    }
    menu_entry_up_down($strcm, $tag_group{'str_s'});
    menuright($strasse_check, $strcm);
    menuarrow($strcmb, $strcm, $col++, -special => 'LAYER');

##### Landstraen #####
    $landstrasse_photo =
      load_photo($misc_frame, 'landstrasse.' . $default_img_fmt);
    my $landstrasse_check = $misc_frame->$Checkbutton
      (image_or_text($landstrasse_photo, 'LStr'),
       -variable => \$str_draw{'l'},
       -command => $check_sub{'l'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($landstrasse_check, -msg => M"Landstraen");
    $ch->attach($landstrasse_check, -pod => "^\\s*Landstraen-Symbol");

    my $lstrcmb = $misc_frame->Menubutton;
    my $lstrcm = $lstrcmb->Menu(-title => M"Landstraen");
    menu_entry_choose_ort($lstrcm, 'l',
			  -accelerator => 'L',
			  -strchooseortargs => {'-markstartifactive' => 1});
    $lstrcm->separator;
    $lstrcm->checkbutton(-label => M"Outline zeichnen",
			 -variable => \$str_outline{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
			);
    $lstrcm->checkbutton(-label => M"Landstraen jwd zeichnen",
			 -variable => \$str_far_away{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
			 -accelerator => 'Shift-L',
			);
    my $land_jwd_check_index = $lstrcm->index('last');
    $lstrcm->checkbutton(-label => M"Straennamen",
			 -variable => \$str_name_draw{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
		       );
    $lstrcm->checkbutton(-label => M"Straennummern",
			 -variable => \$str_nr_draw{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
		       );
    $lstrcm->checkbutton(-label => M"Straenqualitt",
			 -variable => \$str_draw{'ql'},
			 -command => sub { plot('str','ql') },
			 -accelerator => 'Shift-Q',
			);
    my $qualitaet_l_check_index = $lstrcm->index('last');
    $lstrcm->checkbutton(-label => M"Sonstige Beeintrchtigungen",
			 -variable => \$str_draw{'hl'},
			 -command => sub { plot('str','hl') },
			);
    my $handicap_l_check_index = $lstrcm->index('last');
    $lstrcm->checkbutton(-label => M"Radwege im Umland",
			-variable => \$str_draw{'comm-cyclepath'},
			 -command => sub {
			     my $file = get_strassen_file("comments_cyclepath");
			     plot('str', 'comm-cyclepath', Filename => $file);
			 },
			 -accelerator => 'Shift-R',
			);
    my $radwege_l_check_index = $strcm->index('last');
    menu_entry_up_down($lstrcm, $tag_group{'str_l'});
    menuright($landstrasse_check, $lstrcm);
    menuarrow($lstrcmb, $lstrcm, $col++, -special => 'LAYER');

##### Orte #####
    $ort_photo = load_photo($misc_frame, 'ort.' . $default_img_fmt);
    my $ort_check = $misc_frame->$Checkbutton
      (image_or_text($ort_photo, 'Ort'),
       -variable => \$p_draw{'o'},
       -command => $check_sub{'o'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($ort_check, -msg => M"Orte im Umland");
    $ch->attach($ort_check, -pod => "^\\s*Ort-Symbol");

    my $ocmb = $misc_frame->Menubutton;
    my $ocm = $ocmb->Menu(-title => M"Orte");
    menu_entry_choose_ort($ocm, 'o', -accelerator_p => 'O',
			  -pchooseortargs => {'-markstartifactive' => 1});
    $ocm->separator;
    $ocm->checkbutton(-label => M"Ortsnamen",
		      -variable => \$p_name_draw{'o'},
		      -command => sub {
			  pending(1, 'replot-p-o');
		      },
		     );
    $ocm->cascade(-label => M"Kategorie");
    {
	my $m = $ocm->Menu(-title => M"Ortkategorie");
	$ocm->entryconfigure('last', -menu => $m);
	for my $cat ('auto', 0 .. 5) {
	    $m->radiobutton(-label => ($cat eq 'auto' ? M"Auto" :
				       $cat == 0 ? M"Alle" : $cat),
			    -variable => \$place_category,
			    -value => $cat,
			    -command => sub {
				pending(1, 'replot-p-o');
			    },
			   );
	}
    }
    $ocm->checkbutton(-label => M"Orte jwd zeichnen",
		      -variable => \$p_far_away{'o'},
		      -command => sub {
			  pending(1, 'replot-p-o');
		      },
		      -accelerator => 'Shift-O',
		     );
    my $ort_jwd_check_index = $ocm->index('last');
    $ocm->separator;
    $ocm->cascade(-label => M"Schriftgre");
    {
	my $m = $ocm->Menu(-title => M"Ort-Schriftgre");
	$ocm->entryconfigure('last', -menu => $m);
	foreach my $fontsize ([M"klein",       0],
			      [M"normal",      1],
			      [M"gro",        2],
			      [M"sehr gro",   3],
			     ) {
	    $m->radiobutton(-label    => $fontsize->[0],
			    -variable => \$orte_label_size,
			    -value    => $fontsize->[1],
			    -command => sub {
				pending(1, 'replot-p-o');
			    },
			   );
	}
    }
    $ocm->checkbutton(-label => M"berlappungen vermeiden",
		      -variable => \$no_overlap_label{'o'},
		      -command => sub {
			  pending(1, 'replot-p-o');
		      },
		     );
    if ($advanced) { # XXX funktioniert noch nicht mit no_verlap zusammen
	$ocm->checkbutton(-label => M"Umrandung um Labels",
			  -variable => \$do_outline_text{'o'},
			  -command => sub {
			      pending(1, 'replot-p-o');
			  },
			 );
    }
    menu_entry_up_down($ocm, $tag_group{'p_o'});
    menuright($ort_check, $ocm);
    menuarrow($ocmb, $ocm, $col++, -special => 'LAYER');

##### U-Bahn #####
    $ubahn_photo = load_photo($misc_frame, 'ubahn.' . $default_img_fmt);
    my $ubahn_check = $misc_frame->$Checkbutton
      (image_or_text($ubahn_photo, 'U'),
       -variable => \$str_draw{'u'},
       -command => $check_sub{'u'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($ubahn_check, -msg => M"U-Bahn");
    $ch->attach($ubahn_check, -pod => "^\\s*U-Bahn-Symbol");

    my $ubcmb = $misc_frame->Menubutton;
    my $ubcm = $ubcmb->Menu(-title => M"U-Bahn");
    menu_entry_choose_ort($ubcm, 'u', -accelerator => 'U',
			  -pchooseortargs => {'-markstartifactive' => 1},
			  -strblockings => 1,
			 );
    $ubcm->checkbutton(-label => M"U-Bhf-Namen",
		       -variable => \$p_name_draw{'u'},
		       -command => sub {
			   pending(1, 'replot-p-u');
		       },
		      );
    $ubcm->checkbutton(-label => M"berlappungen vermeiden",
		       -variable => \$no_overlap_label{'u'},
		       -command => sub {
			   pending(1, 'replot-p-u');
		       },
		      );
    $ubcm->checkbutton(-label => M"Fahrradfreundliche Zugnge",
		       -variable => \$p_draw{'u_bg'},
		       -command => sub {
			   plot('p', 'u_bg');
		       },
		      );
    $ubcm->separator;
    foreach ([M"VBB-Zone Berlin A", 'UA'],
	     [M"VBB-Zone Berlin B", 'UB'],
	     [M"in Bau", 'U0'],
	    ) {
	$ubcm->checkbutton(-label => $_->[0],
			   -variable => \$str_restrict{'u'}->{$_->[ATTRIB_PLURAL]},
			   -command => sub {
			       $progress->InitGroup;
			       pending(1, 'replot-str-u');
			       pending(1, 'replot-p-u');
			       $progress->FinishGroup;
			   },
			  );
    }
    menu_entry_up_down($ubcm, $tag_group{'str_u'});
    menuright($ubahn_check, $ubcm);
    menuarrow($ubcmb, $ubcm, $col++,
	      -menulabel => M"U-Bahn", -special => 'LAYER');

##### S-Bahn #####
    $sbahn_photo = load_photo($misc_frame, 'sbahn.' . $default_img_fmt);
    my $sbahn_check = $misc_frame->$Checkbutton
      (image_or_text($sbahn_photo, 'S'),
       -variable => \$str_draw{'b'},
       -command => $check_sub{'b'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($sbahn_check, -msg => M"S-Bahn");
    $ch->attach($sbahn_check, -pod => "^\\s*S-Bahn-Symbol");
    my $sbcmb = $misc_frame->Menubutton;
    my $sbcm = $sbcmb->Menu(-title => M"S-Bahn");
    menu_entry_choose_ort($sbcm, 'b', -accelerator => 'B',
			  -pchooseortargs => {'-markstartifactive' => 1},
			  -strblockings => 1,
			 );
    $sbcm->checkbutton(-label => M"S-Bhf-Namen",
		       -variable => \$p_name_draw{'b'},
		       -command => sub {
			   pending(1, 'replot-p-b');
		       },
		      );
    $sbcm->checkbutton(-label => M"berlappungen vermeiden",
		       -variable => \$no_overlap_label{'b'},
		       -command => sub {
			   pending(1, 'replot-p-b');
		       },
		      );
    $sbcm->checkbutton(-label => M"Fahrradfreundliche Zugnge",
		       -variable => \$p_draw{'b_bg'},
		       -command => sub {
			   plot('p', 'b_bg');
		       },
		      );
    $sbcm->separator;
    foreach ([M"VBB-Zone Berlin A", 'SA'],
	     [M"VBB-Zone Berlin B", 'SB'],
	     [M"VBB-Zone Berlin C", 'SC'],
	     [M"in Bau/stillgelegt", 'S0'],
	    ) {
	$sbcm->checkbutton(-label => $_->[0],
			   -variable => \$str_restrict{'b'}->{$_->[ATTRIB_PLURAL]},
			   -command => sub {
			       $progress->InitGroup;
			       pending(1, 'replot-str-b');
			       pending(1, 'replot-p-b');
			       $progress->FinishGroup;
			   },
			  );
    }
    menu_entry_up_down($sbcm, $tag_group{'str_b'});
    menuright($sbahn_check, $sbcm);
    menuarrow($sbcmb, $sbcm, $col++,
	      -menulabel => M"S-Bahn", -special => 'LAYER');

##### RB #####
    $rbahn_photo = load_photo($misc_frame, 'rbahn.' . $default_img_fmt);
    my $rbahn_check = $misc_frame->$Checkbutton
      (image_or_text($rbahn_photo, 'RB'),
       -variable => \$str_draw{'r'},
       -command => $check_sub{'r'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($rbahn_check, -msg => M"Regionalbahn");
    $ch->attach($rbahn_check, -pod => "^\\s*RB-Symbol");
    my $rbcmb = $misc_frame->Menubutton;
    my $rbcm = $rbcmb->Menu(-title => M"Regionalbahn");
    menu_entry_choose_ort($rbcm, 'r', -accelerator => 'R',
			  -pchooseortargs => {'-markstartifactive' => 1},
			  -strblockings => 1,
			 );
    $rbcm->checkbutton(-label => M"R-Bhf-Namen",
		       -variable => \$p_name_draw{'r'},
		       -command => sub {
			   pending(1, 'replot-p-r');
		       },
		      );
    $rbcm->checkbutton(-label => M"berlappungen vermeiden",
		       -variable => \$no_overlap_label{'r'},
		       -command => sub {
			   pending(1, 'replot-p-r');
		       },
		      );
    $rbcm->separator;
    foreach ([M"VBB-Zonen Berlin A und B", 'RB'],
	     [M"VBB-Zone Berlin C", 'RC'],
	     [M"auerhalb Berlin ABC", 'R'],
	     [M"in Bau/stillgelegt", 'R0'],
	    ) {
	$rbcm->checkbutton(-label => $_->[0],
			   -variable => \$str_restrict{'r'}->{$_->[ATTRIB_PLURAL]},
			   -command => sub {
			       $progress->InitGroup;
			       pending(1, 'replot-str-r');
			       pending(1, 'replot-p-r');
			       $progress->FinishGroup;
			   },
			  );
    }
    menu_entry_up_down($rbcm, $tag_group{'str_r'});
    menuright($rbahn_check, $rbcm);
    menuarrow($rbcmb, $rbcm, $col++,
	      -menulabel => M"R-Bahn", -special => 'LAYER');

##### Gewsser #####
    $wasser_photo = load_photo($misc_frame, 'wasser.' . $default_img_fmt);
    my $wasser_check = $misc_frame->$Checkbutton
      (image_or_text($wasser_photo, 'H20'),
       -variable => \$str_draw{'w'},
       -command => $check_sub{'w'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($wasser_check, -msg => M"Gewsser");
    $ch->attach($wasser_check, -pod => "^\\s*Gewsser-Symbol");
    my $wcmb = $misc_frame->Menubutton;
    my $wcm = $wcmb->Menu(-title => M"Gewsser");
    menu_entry_choose_ort($wcm, 'w', -accelerator => 'W');
    $wcm->separator;
    $wcm->checkbutton(-label => M"Outline zeichnen",
		      -variable => \$str_outline{'w'},
		      -command => sub {
			  $str_outline{'i'} = $str_outline{'w'};
			  pending(1, 'replot-str-w');
		      },
		     );
    $wcm->checkbutton(-label => M"Namen der Gewsser",
		      -variable => \$str_name_draw{'w'},
		      -command => sub {
			  pending(1, 'replot-str-w');
		      },
		     );
    $wcm->checkbutton(-label => M"Gewsser in der Stadt zeichnen",
		      -variable => \$wasserstadt,
		      -command => sub {
			  pending(1, 'replot-str-w');
		      },
		     );
    $wcm->checkbutton(-label => M"Gewsser im Umland zeichnen",
		      -variable => \$wasserumland,
		      -command => sub {
			  pending(1, 'replot-str-w');
		      },
		      -accelerator => 'Shift-W',
		     );
    my $wasserumland_check_index = $wcm->index('last');
    $wcm->checkbutton(-label => M"Gewsser jwd zeichnen",
		      -variable => \$str_far_away{'w'},
		      -command => sub {
			  pending(1, 'replot-str-w');
		      },
		     );
    menu_entry_up_down($wcm, $tag_group{'str_w'});
    menuright($wasser_check, $wcm);
    menuarrow($wcmb, $wcm, $col++, -special => 'LAYER');

##### Flchen #####
    $flaechen_photo = load_photo($misc_frame, 'flaechen.' . $default_img_fmt);
    my $flaechen_check = $misc_frame->$Checkbutton
      (image_or_text($flaechen_photo, 'Fl'),
       -variable => \$str_draw{'f'},
       -command => $check_sub{'f'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($flaechen_check, -msg => M"sonstige Flchen");
    $ch->attach($flaechen_check, -pod => "^\\s*Flchen-Symbol");
    my $fcmb = $misc_frame->Menubutton;
    my $fcm = $fcmb->Menu(-title => M"sonstige Flchen");
    menu_entry_choose_ort($fcm, 'f', -accelerator => 'F');
    $fcm->checkbutton(-label => M"Namen der Flchen",
		      -variable => \$str_name_draw{'f'},
		      -command => sub {
			  pending(1, 'replot-str-f');
		      },
		     );
    $fcm->separator;

    if ($advanced) {
	menu_entry_choose_ort($fcm, 'z');
	$fcm->separator;
    }
    $fcm->checkbutton(-label => M"Grenzen von Berlin",
		      -variable => \$str_draw{'g'},
		      -command => sub { plot('str','g') });
    $fcm->checkbutton(-label => M"Grenzen von Potsdam",
		      -variable => \$str_draw{'gP'},
		      -command => sub { plot('str','gP') });
    $fcm->checkbutton(-label => M"Staatsgrenzen", # Deutschland
		      -variable => \$str_draw{'gD'},
		      -command => sub { plot('str','gD') });

    menu_entry_up_down($fcm, $tag_group{'str_f'});
    menuright($flaechen_check, $fcm);
    menuarrow($fcmb, $fcm, $col++, -special => 'LAYER');

##### Sehenswrdigkeiten, Kneipen etc. #####
    my $sehenswuerdigkeiten_check = $misc_frame->$Checkbutton
      (image_or_text($star_photo, '*'),
       -variable => \$str_draw{'v'},
       -command => sub { plot('str','v') },
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($sehenswuerdigkeiten_check, -msg => M"Sehenswrdigkeiten etc.");
    $ch->attach($sehenswuerdigkeiten_check, -pod => "^\\s*Sehenswrdigkeiten-Symbol");
    my $knmb = $misc_frame->Menubutton;
    my $knm = $knmb->Menu(-title => M"Sehenswrdigkeiten etc.");

    $knm->checkbutton(-label => M"Sehenswrdigkeiten",
		      -variable => \$str_draw{'v'},
		      -command => sub { plot('str','v') });
    $knm->command(-label => M"Sehenswrdigkeit auswhlen",
		  -command => sub { choose_ort(qw(s v),
					       -markstartifactive => 1) });
    $knm->checkbutton(-label => M"Namen der Sehenswrdigkeiten",
		      -variable => \$str_name_draw{'v'},
		      -command => sub {
			  pending(1, 'replot-str-v');
		      },
		     );
    $knm->checkbutton(-label => M"berlappungen vermeiden",
		      -variable => \$no_overlap_label{'v'},
		      -command => sub {
			  pending(1, 'replot-str-v');
		      },
		     );
    $knm->separator;

    my @kneipen_list = ('kn');
    if ($advanced) {
	push @kneipen_list, qw(rest ki);
    }
    foreach my $f (@kneipen_list) {
	if (-f "$FindBin::RealBin/data/$p_file{$f}") {
	    $knm->checkbutton(-label => $p_attrib{$f}->[ATTRIB_PLURAL],
			      -variable => \$p_draw{$f},
			      -command => sub { plot('p',$f) });
	    $knm->command(-label => Mfmt("%s auswhlen", $p_attrib{$f}->[ATTRIB_SINGULAR]),
			  -command => sub { choose_ort('p', $f) });
	}
    }
    if (0 && $advanced) { # XXX Wird nicht mehr gepflegt...
	$knm->command(-label => M"Film auswhlen",
		      -command => sub {
			  require BBBikeAdvanced;
			  search_movie();
		      });
    }
    $knm->command(-label => M"Persnliche Orte",
		  -command => sub {
		      require BBBikePersonal;
		      BBBikePersonal::dialog();
		  });

    $knm->separator;
    $knm->checkbutton(-label => M"Obst",
		      -variable => \$p_draw{'obst'},
		      -command => sub { plot('p','obst') });

    #XXXX menu_entry_up_down($knm, $tag_group{'str_f'});
    menuright($sehenswuerdigkeiten_check, $knm);
    menuarrow($knmb, $knm, $col++, -special => 'LAYER');

##### Zustzliche Kartenebenen #####
    my $newlayer_label = $misc_frame->Label
      (image_or_text($newlayer_photo, '*'),
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($newlayer_label, -msg => M"Zustzliche Kartenebenen");
    $ch->attach($newlayer_label, -pod => "^\\s*Zustzliche Kartenebenen");
    my $nlmb = $misc_frame->Menubutton;
    my $nlm = $nlmb->Menu(-title => M"Zustzliche Kartenebenen");
    {
	# XXX this used to be LazyMenu to postpone loading of layers
	# XXX maybe re-enable this one day if I find a possibility to
	# update the cascade menu without showing the menu first.
	my $cusm = $nlm;
#XXX del:
# 	$BBBike::Menubar::additional_layer_menu = $cusm;
# 	$BBBike::Menubar::additional_layer_menu = $BBBike::Menubar::additional_layer_menu; # peacify -w
 	$cusm->{BBBike_Menulabel} = M"Zustzliche Kartenebenen";
#	$opbm->entryconfigure('last', -menu => $cusm);
# 	$cusm->command(-label => M"Zustzliche Layer",
# 		       -state => 'disabled',
# 		       -font => $font{'bold'});
	$cusm->command(-label => M"Straen-Layer zeichnen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_plot_additional_layer('str') });
	if ($advanced) {
	    $cusm->command(-label => M"Sperrungen-Layer zeichnen", # XXX label? in advanced mode because there is no way to delete the blockings from net!
			   -command => sub {
			       require BBBikeAdvanced;
			       plot_additional_sperre_layer() });
	}
	$cusm->command(-label => M"Punkte-Layer zeichnen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_plot_additional_layer('p') });
	$cusm->command(-label => M"Straen/Punkte auswhlen",
		       -command => sub {
			   require BBBikeAdvanced;
			   choose_from_additional_layer() });
	$cusm->cascade(-label => M("Letzte geffnete Layer")."...");
	{
	    my $m = $cusm->Menu(-title => M("Letzte geffnete Layer")."...");
	    $cusm->entryconfigure("last", -menu => $m);
	    $main::last_loaded_layers_obj =
		{
		 List => [],
		 File => "$main::bbbike_configdir/last_layers",
		 Menu => $m,
		 Title => M("Letzte Layer").":",
		 Cb => sub {
		     my($file, %args) = @_;
		     my $linetype = delete $args{-linetype};
		     require BBBikeAdvanced;
		     plot_additional_layer($linetype, $file, %args);
		 },
		 Max => 12,
		};
	    load_last_loaded($last_loaded_layers_obj);
	}
	if ($Tk::platform ne 'MSWin32') {
	    $cusm->command(-label => M"Umordnen",
			   -accelerator => 'Shift-X',
			   -command => sub {
			       require BBBikeAdvanced;
			       layer_editor() });
	}
	$cusm->command(-label => M"Layer lschen",
		       -command => sub {
			   require BBBikeAdvanced;
			   delete_additional_layer() });
	$cusm->command(-label => M"Ausschnitt an Layer anpassen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_zoom_view_for_layer() });
	$cusm->command(-label => M"Scrollregion an Layer anpassen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_set_scrollregion_for_layer() });
	$cusm->command(-label => M"Scrollregion fr Layer vergrern",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_enlarge_scrollregion_for_layer() });
	if ($advanced) {
	    $cusm->checkbutton(-label => M"Linienbreite 1 Punkt",
			       -variable => \$default_line_width,
			       -offvalue => undef, # XXX don't work,
                                                   # set to 0... ???
			       -onvalue => 1,
			      );
	}
	$cusm->radiobutton(-label => M"WWW-Klickmodus", # XXX bessere Bezeichnung
			   -variable => \$map_mode,
			   -value => MM_URL_SELECT,
			   -command => \&set_map_mode,
			  );
	$cusm->separator;
	$cusm->command(-label => M"Gpsman-Daten zeichnen",
		       -command => sub {
			   draw_gpsman_data($top);
		       });
	$cusm->command(-label => M"GPS-Track-Animation",
		       -command => sub {
			   require BBBikeAdvanced;
			   gps_animation($top);
		       });
    }
    menuright($newlayer_label, $nlm);
    menuarrow($nlmb, $nlm, $col++, -special => 'LAYER');

    # room for plugin buttons
    my $mode_layer_plugin_frame = $misc_frame->Frame->grid
	(-row => $curr_row, -column => $col, -sticky => 's');
    $top->Advertise(ModeLayerPluginFrame => $mode_layer_plugin_frame);
    my $mode_layer_menu_plugin_frame = $misc_frame->Frame->grid
	(-row => $curr_row+1, -column => $col, -sticky => 'news');
    $top->Advertise(ModeLayerMenuPluginFrame => $mode_layer_menu_plugin_frame);
    $col++;

    $misc_frame->Label(-text => ' ')->grid(-row => $curr_row,
					   -column => $col++);

    if (0 && !$no_map) { # no map anymore...
	require BBBikeAdvanced;
	map_button($misc_frame, $curr_row, \$col);
    }

###### Vergrern #####
    my $mapscale_plus_photo = load_photo($misc_frame,
					 'viewmag+.' . $default_img_fmt);
    my $mapscale_plus_button = $misc_frame->Button
      (image_or_text($mapscale_plus_photo, '+'),
       -command => sub { scalecanvas($c, 2) },
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($mapscale_plus_button, -msg => M"Vergrern");
    $ch->attach($mapscale_plus_button, -pod => "^\\s*Vergrern-Symbol");
    $col++;

###### Verkleinern #####
    my $mapscale_minus_photo = load_photo($misc_frame,
					  'viewmag-.' . $default_img_fmt);
    my $mapscale_minus_button = $misc_frame->Button
      (image_or_text($mapscale_minus_photo, '-'),
       -command => sub { scalecanvas($c, 0.5) },
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($mapscale_minus_button, -msg => M"Verkleinern");
    $ch->attach($mapscale_minus_button, -pod => "^\\s*Verkleinern-Symbol");
    $col++;

##### Scale of the map #####
    my $scale_button = $misc_frame->Button
      (-textvariable => \$mapscale,
       -width => 9,
       -relief => 'ridge',
       -bd => ($small_icons ? 0 : 2),
       -command => sub { enter_scale() },
       -font => $font{'fix15'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($scale_button, -msg => M"Mastab");
    $ch->attach($scale_button, -pod => "^\\s*Mastab-Feld");
    $default_mapscale = calc_mapscale();
    $col++;

##### bersichtskarte
    my $berlin_overview_small_photo
      = load_photo($top, 'berlin_overview_small.' . $default_img_fmt);
    my $overview_check = $misc_frame->$Checkbutton
      (image_or_text($berlin_overview_small_photo, 'Ovw'),
       -variable => \$show_overview,
       -command => sub { show_overview() },
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $overview_check->bind('<Button-3>' => sub { $show_overview = 1;
						show_overview(1) });
    enter_leave_bind_for_help($overview_check,
			      [M"bersichtskarte zeigen",
			       "",
			       M"bersichtskarte neu laden",
			      ]);

    $balloon->attach($overview_check, -msg => M"bersichtskarte");
    $ch->attach($overview_check, -pod => "^\\s*bersichtskarten-Symbol");
    $col++;

    $misc_frame->Label(-text => ' ')->grid(-row => $curr_row,
					   -column => $col++);

##### Windrose #####
    my $windrose_photo = load_photo($misc_frame,
				    'windrose.' . $default_img_fmt);
    eval {
	die "Low memory" if $lowmem;
	require Tk::FireButton;
	Tk::FireButton->VERSION(0.04);
    };
    my $err = $@;
    warn $err if $verbose and $err;
    my $firebutton = (!$err ? 'FireButton' : 'Button');
    $windrose_button = $misc_frame->$firebutton
	(image_or_text($windrose_photo, "Wind\nrose"),
	 -command => \&windrose,
	 -takefocus => 0,
	);
    if ($windrose_button->isa('Tk::FireButton')) {
	$windrose_button->configure(-repeatinterval => 300);
    }
    $windrose_button->grid(-row => $curr_row, -column => $col, -rowspan => 2);
    $windrose_button->bind("<ButtonPress-2>" => sub { windrose(5) });
    $windrose_button->bind("<ButtonPress-3>" => sub { center_best() });
    enter_leave_bind_for_help($windrose_button,
			      [M"Karte scrollen",
			       M"Karte schneller scrollen",
			       M"Karte zentrieren"]);
    $balloon->attach($windrose_button, -msg => M"Kartenausschnitt bewegen");
    $ch->attach($windrose_button, -pod => "^\\s*Windrosen-Symbol");
    $col++;

    $misc_frame->Label(-text => ' ')->grid(-row => $curr_row,
					   -column => $col++);

    $top->Advertise(MapFrame => $misc_frame);

##### misc_frame2 ... #####

    $misc_frame2 = $sym_frame->$DockFrame
	(-bd => 1, -relief => 'raised',
       ($DockFrame eq 'DockFrame' ? ('-dock' => $dock_port2) : ()));
    $col = 0;

##### Komplex: Suche/Route ... #####
    $search_photo = load_photo($misc_frame2, 'search.' . $default_img_fmt);
    my $search_button = $misc_frame2->$Radiobutton
      (image_or_text($search_photo, 'Route'),
       -variable => \$map_mode,
       -value => MM_SEARCH,
       -command => \&set_map_mode,
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($search_button, -msg => M"Route suchen");
    $ch->attach($search_button, -pod => "^\\s*Route suchen");

    my $sbmb = $misc_frame2->Menubutton;
    my $sbm = $sbmb->Menu(-title => M"Route suchen");

    $sbm->radiobutton(-label => M"Suchmodus",
		      -variable => \$map_mode,
		      -value => MM_SEARCH,
		      -command => \&set_map_mode,
		     );
    $sbm->cascade(-label => M('Route lschen'));
    my $sbm_reset_menu_index = $sbm->index("last");

    $sbm->command(-label => M"Route wiederherstellen (Undo)",
		  -command =>\&get_undo_route,
		  -accelerator => 'Ctrl-Z');
    # XXX Brauche ich diesen Menpunkt?
    $sbm->command(-label => M"Route aktualisieren",
		  -command => \&redraw_path);
    $sbm->command(-label => M"Suche wiederholen",
		  -command => \&re_search_gui);
    $sbm->command(-label => M"Rckweg",
		  -command => \&way_back_gui);
    $sbm->command(-label => M"Register",
		  -command => \&show_register,
		  -accelerator => '*',
		 );
    $sbm->command(-label => M"Ausschnitt an Route anpassen",
		  -command => sub { zoom_view() });
    $sbm->cascade(-label => M"Automatische Anpassung");
    {
	my $aasm = $sbm->Menu(-title => M"Automatische Anpassung");
	$sbm->entryconfigure('last', -menu => $aasm);
	$aasm->checkbutton(-label => M"nach dem Laden anpassen",
			   -variable => \$zoom_loaded_route,
			   -onvalue => 1,
			   -offvalue => 0);
	$aasm->checkbutton(-label => M"nach dem Laden zentrieren",
			   -variable => \$center_loaded_route);
	$aasm->checkbutton(-label => M"nach der Berechnung anpassen",
			   -variable => \$zoom_new_route,
			   -onvalue => 1,
			   -offvalue => 0);
	$aasm->checkbutton(-label => M"nach der Berechnung aus der Straenliste anpassen",
			   -variable => \$zoom_new_route_chooseort,
			   -onvalue => 1,
			   -offvalue => 0);
    }
    $sbm->separator;

    if ($advanced) {
	add_search_menu_entries($sbm);
    }
    if ($advanced || $lowmem) {
	$sbm->command(-label => M"Straennetz neu berechnen",
		      -command => \&make_net);
	$sbm->command(-label => M"undef netz",
		      -command => sub {
			  undef $net;
			  undef $comments_net;
			  undef $comments_pos_net
		      });
    }
    if ($advanced) {
	add_search_net_menu_entries($sbm);
	$sbm->separator;
    }

    $sbm->checkbutton(-label => M"Steigungen/Geflle zeigen",
		      -variable => \$show_grade);
    $sbm->cascade(-label => M('Einfrben der Route').' ...');
    {
	my $fbm = $sbm->Menu(-title => M('Einfrben der Route').' ...');
	$sbm->entryconfigure('last', -menu => $fbm);
	foreach my $d ([M"Wind", 'wind'],
		       [M"Leistung", 'power'],
		       [M"schwarz", 'black'],
		       [M"rot", 'red'],
		       [M"blau", 'blue'],
		      ) {
	    my $val = $d->[1];
	    $fbm->radiobutton(-label => $d->[0],
			      -variable => \$coloring,
			      -value => $val,
			      -command => \&redraw_path,
			      );
	}
	$fbm->checkbutton(-label => M"gestrichelt",
			  -variable => \$route_dashed,
			  -command => \&redraw_path,
			 );
	$fbm->checkbutton(-label => M"mit Richtungspfeil",
			  -variable => \$route_arrowed,
			  -command => \&redraw_path,
			 );
	if ($advanced && $devel_host) {
	    $fbm->command(-label => "spezial gestrichelt",
			  -command => sub {
			      # XXX this functionality should probably go into addpoint_xy
			      for ($c->find("withtag"=>"route"))  { $c->createLine($c->coords($_),-fill=>"black",-dash=>[1,3],-tags=>["route"],-width=>$c->itemcget($_,-width)) if $c->type($_) eq "line"}
			  });
	}
    }

    $sbm->command
	(-label => M"Streckenprofil",
	 -command => sub {
	     require BBBikeProfil;
	     @{$bbbike_context}{qw/Profil Coords Hoehe Transient Canvas/} =
		 (new BBBikeProfil,
		  \@realcoords,
		  \%hoehe,
		  $transient,
		  $c);
	     $bbbike_context->{Profil}->Show($top, $bbbike_context);
	 });
    require BBBikeVia;
    {
	$sbm->cascade(-label => M('Start/Via/Ziel').' ...');
	my $viam = $sbm->Menu(-title => M('Start/Via/Ziel').' ...');
	$sbm->entryconfigure('last', -menu => $viam);
	BBBikeVia::menu_entries($viam);
    }

    $sbm->separator;
    $sbm->checkbutton(-label => M"Kalorienverbrauch anzeigen",
		      -variable => \$show_calories,
		      -command => sub { show_calories() },
		     );

    menuright($search_button, $sbm);
    menuarrow($sbmb, $sbm, $col++, -menulabel => M"R~oute");

    #####

    $search_pref_photo = load_photo($misc_frame2, 'search_pref.' . $default_img_fmt);
    my $search_pref_button = $misc_frame2->$Checkbutton
      (image_or_text($search_pref_photo, 'Sucheinst.'),
       -variable => \$show_enter_opt_preferences,
       -command => \&toggle_enter_opt_preferences,
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($search_pref_button, -msg => M"Sucheinstellungen");
    $ch->attach($search_pref_button,
                -pod => "^\\s*Sucheinstellungen");

    my $sb2mb = $misc_frame2->Menubutton;
    my $sb2m = $sb2mb->Menu(-title => M"Sucheinstellungen");

    # Note interplay between these two checkbuttons: 
    $sb2m->checkbutton(-label => M"Einbahn-/gesperrte Straen beachten",
		       -variable => \$sperre{'sperre'},
		       -command => sub {
			   $sperre{'einbahn'} = $sperre{'wegfuehrung'} = $sperre{'sperre'};
			   if (!$sperre{'sperre'}) {
			       $sperre{'einbahn-strict'} = 0;
			   }
			   pending(1, 'recalc-net');
		       },
		      );
    $sb2m->checkbutton(-label => M"Einbahn-/gesperrte Straen *strikt* beachten",
		       -variable => \$sperre{'einbahn-strict'},
		       -command => sub {
			   if ($sperre{'einbahn-strict'}) {
			       $sperre{'einbahn'} = $sperre{'wegfuehrung'} = $sperre{'sperre'} = 1;
			   }
			   pending(1, 'recalc-net');
		       },
		      );
    $sb2m->cascade(-label => M"Benutzerdefinierte Sperrungen");
    {
	my $bdm = $sb2m->Menu(-title => M"Benutzerdefinierte Sperrungen");
	$sb2m->entryconfigure('last', -menu => $bdm);
	$bdm->radiobutton(-label => M"Definieren",
			  -variable => \$map_mode,
			  -value => MM_USEREDIT,
			  -accelerator => "Shift-U",
			  -command => sub { # XXX don't duplicate code, see <U>
			      set_cursor('delnet');
			  });
	$bdm->command(-label => M"Standard laden",
		      -command => sub { load_user_dels() });
	$bdm->command(-label => M"Standard speichern",
		      -command => sub { save_user_dels() });
	$bdm->command(-label => M"Laden",
		      -command => sub {
			  my $file = $top->getOpenFile;
			  if (defined $file) {
			      load_user_dels($file);
			  }
		      });
	$bdm->command(-label => M"Speichern",
		      -command => sub {
			  my $file = $top->getSaveFile;
			  if (defined $file) {
			      save_user_dels($file);
			  }
		      });
	if ($advanced) {
	    $bdm->checkbutton
		(-label => M"Aktive Sperrungen zeichnen und beachten",
		 -variable => \$show_active_temp_blockings,
		 -command => sub {
		     activate_temp_blockings($show_active_temp_blockings);
		 },
		);
	    $bdm->command
		(-label => M"Aktive Sperrungen zeichnen fr Datum",
		 -command => \&active_temp_blockings_for_date_dialog,
		);
	    $bdm->command
		(-label => M"Aktive und zuknftige Sperrungen zeichnen",
		 -command => sub {
		     $show_active_temp_blockings = 1;
		     activate_temp_blockings($show_active_temp_blockings, -from => time);
		 },
		);
	    $bdm->command
		(-label => M"Frhere und zuknftige Sperrungen zeichnen",
		 -command => sub {
		     $show_active_temp_blockings = 1;
		     activate_temp_blockings($show_active_temp_blockings, -from => 0);
		 },
		);
	    $bdm->command
		(-label => M"Speichern fr temp_blockings",
		 -command => sub {
		     require BBBikeEdit;
		     BBBikeEdit::temp_blockings_editor();
		 }
		);
	}
	$bdm->command(-label => M"Alle lschen",
		      -command => sub { delete_user_dels() });
	if ($advanced) {
	    $bdm->command(-label => M"In die Zwischenablage kopieren",
			  -command => sub {
			      my $s = $net->create_user_deletions_object;
			      # XXX usage of @inslauf_selection is a hack!
			      $c->SelectionOwn;
			      @inslauf_selection = $s->as_string;
			  },
			 );
	}
    }

    $sb2m->checkbutton(-label => M"Tragen strikt vermeiden",
		      -variable => \$sperre{'tragen'},
		      -command => sub {
			  pending(1, 'recalc-net');
		      },
		     );
    $sb2m->checkbutton(-label => M"Schlechte Wege vermeiden",
		      -variable => \$sperre{'Q3'},
		      -command => sub {
			  pending(1, 'recalc-net');
		      },);
    $sb2m->checkbutton(-label => M"Fhren verwenden",
                      -variable => \$use_faehre,
                      -command => sub {
                          pending(1, 'recalc-net');
                      },
		     );
    $sb2m->separator;
    $sb2m->checkbutton(-label => M"Straenqualitt-Optimierung",
		      -variable => \$qualitaet_s_optimierung,
		     );
    $sb2m->checkbutton(-label => M"Straenkategorie-Optimierung",
		       -variable => \$strcat_optimierung,
		       -command => sub {
			   if ($strcat_optimierung) {
			       $N_RW_optimization = 0;
			   }
		       },
		     );
    $sb2m->checkbutton(-label => M"Optimierung der sonstigen Beeintrchtigungen",
		      -variable => \$handicap_s_optimierung,
		     );
    $sb2m->checkbutton(-label => M"Ampel-Optimierung",
		      -variable => \$ampel_optimierung,
		      -command => \&calc_ampel_optimierung,
		     );
    $sb2m->checkbutton(-label => M"Radwege-Optimierung",
		       -variable => \$radwege_optimierung,
		       -command => sub {
			   if ($radwege_optimierung) {
			       $N_RW_optimization = 0;
			   }
		       }
		      );
    $sb2m->checkbutton(-label => M"Hauptstraen ohne Radwege/Busspuren meiden",
		       -variable => \$N_RW_optimization,
		       -command => sub {
			   if ($N_RW_optimization) {
			       $radwege_optimierung = 0;
			       $strcat_optimierung = 0;
			   }
		       }
		      );
    {
	$sb2m->cascade(-label => M("Grne Wege")."...");
	my $gwm = $sb2m->Menu(-title => M"Grne Wege");
	$sb2m->entryconfigure('last', -menu => $gwm);
	$gwm->radiobutton(-label => M"egal",
			  -variable => \$green_optimization,
			  -value => 0,
			 );
	$gwm->radiobutton(-label => M"bevorzugen",
			  -variable => \$green_optimization,
			  -value => 1,
			 );
	$gwm->radiobutton(-label => M"stark bevorzugen",
			  -variable => \$green_optimization,
			  -value => 2,
			 );
    }
    $sb2m->checkbutton(-label => M"Unbeleuchtete Straen meiden",
		       -variable => \$unlit_streets_optimization,
		      );
    $sb2m->checkbutton(-label => M"Steigungsoptimierung",
		      -variable => \$steigung_optimierung,
		     );
    if ($advanced && $devel_host) {
	# sowieso vorerst sinnlos...
	$sb2m->checkbutton(-label => M"Abbiege-Optimierung",
			  -variable => \$abbiege_optimierung,
			  );
    }
    $sb2m->separator;
    $sb2m->command(-label => M"Optimierungsparameter einstellen",
		  -command => \&enter_opt_preferences,
		 );
    if ($advanced) {
	# experimenteller Code
	$sb2m->command(-label => M"Optimierungsparameter einstellen Nr.2",
		      -command => \&enter_opt_preferences2,
		     );
	require BBBikeAdvanced;
	penalty_menu($sb2m);
    }

    menuright($search_pref_button, $sb2m);
    menuarrow($sb2mb, $sb2m, $col++, -menulabel => M"Sucheinstellungen");

    #####

    my $strlist_photo = load_photo($misc_frame2,
				   'strlist.' . $default_img_fmt);
    my $strlist_button = $misc_frame2->$Checkbutton
	(image_or_text($strlist_photo, 'StrL'),
	 -variable => \$show_strlist,
	 -command => \&show_route_strname,
	 )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($strlist_button,
		     -msg => M"Beschreibung der aktuellen Route");
    $ch->attach($strlist_button,
                -pod => "^\\s*Beschreibung der aktuellen Route");
    my $slbmb = $misc_frame2->Menubutton;
    my $slbm = $slbmb->Menu(-title => M"Beschreibung der aktuellen Route");
    $slbm->checkbutton
	(-label    => M"Routenliste",
	 -accelerator => "Shift-B",
	 -variable => \$show_strlist,
	 -command  => \&show_route_strname);
    $slbm->checkbutton
	(-label    => M"Automatisches Anzeigen",
	 -variable => \$auto_show_list,
	);
    $slbm->command
	(-label    => M"Statistik",
	 -command  => \&show_statistics,
	);
    if ($advanced) {
	$slbm->command(-label => M"Ampeln an der aktuellen Route",
		       -command => sub { ampeln_on_route(@realcoords) });
	$slbm->command(-label => M"GPS-Upload mit Ampelschaltungen",
		       -command => sub {
			   require "$FindBin::RealBin/GpsmanDataAmpeln.pm";
			   make_ampel_route();
		       });
    }
    menuright($strlist_button, $slbm);
    menuarrow($slbmb, $slbm, $col, -menulabel => M"Routen~liste");
    $col++;

    my $reset_photo = load_photo($misc_frame2, 'cross.' . $default_img_fmt);
    my $reset_button = $misc_frame2->Button
	(image_or_text($reset_photo, 'X'),
	 -command => \&delete_route,
	 )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($reset_button, -msg => M"Route lschen");
    $ch->attach($reset_button, -pod => "^\\s*Route lschen");
    my $resetmb = $misc_frame2->Menubutton;
    my $resetm = $resetmb->Menu(-title => M"Route lschen");
    $resetm->command(-label => M"Gesamte Route lschen",
		     -command => \&delete_route,
		    );
    $resetm->command(-label => M"Letzten Punkt der Route lschen",
		     -command => \&mouse_dellast,
		     -accelerator => '<-',
		    );
    $resetm->command(-label => M"Bis zum letzten Via lschen",
		     -command => \&deltovia,
		     -accelerator => 'Del',
		    );
    menuright($reset_button, $resetm);
    menuarrow($resetmb, $resetm, $col, -menulabel => M"Route lschen");
    $col++;
    # XXX Check this on Windows! XXX The Tk::Menu manual says: do not
    # use "clone" outside of the Tk library!
    $sbm->entryconfigure($sbm_reset_menu_index, -menu => $resetm->clone($sbmb, "normal"));

    my $reverse_photo = load_photo($misc_frame2,
				   'rueckweg.' . $default_img_fmt);
    my $reverse_button = $misc_frame2->Button
	(image_or_text($reverse_photo, 'Rev'),
	 -command => \&way_back_gui,
	 )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $reverse_button->bind("<ButtonPress-3>" => sub {
	IncBusy($top);
	eval {
	    reverse_route();
	};
	DecBusy($top);
    });
    $balloon->attach($reverse_button, -msg => M"Rckweg");
    $ch->attach($reverse_button, -pod => "^\\s*Rckweg-Symbol");
    $col++;

    my $koord_photo = load_photo($misc_frame2, 'koord.' . $default_img_fmt);
    my $buttonpoint_check = $misc_frame2->$Radiobutton
      (image_or_text($koord_photo, 'Koord'),
       -variable => \$map_mode,
       -value => MM_BUTTONPOINT,
       -command => \&set_map_mode,
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($buttonpoint_check, -msg => M"Koordinaten in Zwischenablage");
    $ch->attach($buttonpoint_check, -pod => "^\\s*Koordinaten-Symbol");

    my($bpcm);
    if (!$advanced) {
	$buttonpoint_check->configure(-state => 'disabled');
    } else {
	my $bpcmb = $misc_frame2->Menubutton;
	$bpcm = $bpcmb->Menu(-title => M"Bearbeiten");
	advanced_coord_menu($bpcm);
	menuright($buttonpoint_check, $bpcm);
	menuarrow($bpcmb, $bpcm, $col, -menulabel => M"~Bearbeiten");
    }
    $col++;

    my $info_photo = load_photo($misc_frame2, 'info.' . $default_img_fmt);
    my $info_check = $misc_frame2->$Radiobutton
	(image_or_text($info_photo, 'Info'),
	 -variable => \$map_mode,
	 -value => MM_INFO,
	 -command => \&set_map_mode,
	)->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($info_check, -msg => M"Information");
    $ch->attach($info_check, -pod => "^\\s*Info-Symbol");
    $col++;

    my $drag_photo = load_photo($misc_frame2, 'movehand.' . $default_img_fmt);
    my $drag_check = $misc_frame2->$Radiobutton
	(image_or_text($drag_photo, 'Drag'),
	 -variable => \$map_mode,
	 -value => MM_DRAG,
	 -command => \&set_map_mode,
	)->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($drag_check, -msg => M"Karte verschieben");
    # XXX $ch->attach($drag_check, -pod => "^\\s*Karte verschieben");
    $col++;

    # room for plugin buttons
    my $mode_plugin_frame = $misc_frame2->Frame->grid
	(-row => $curr_row, -column => $col, -sticky => 's');
    $top->Advertise(ModePluginFrame => $mode_plugin_frame);
    my $mode_menu_plugin_frame = $misc_frame2->Frame->grid
	(-row => $curr_row+1, -column => $col, -sticky => 'news');
    $top->Advertise(ModeMenuPluginFrame => $mode_menu_plugin_frame);
    $col++;

    $misc_frame2->Label(-text => ' ')->grid(-row => $curr_row,
					    -column => $col++);

## DEBUG_BEGIN
#mymstat("iconframe: load/save/print buttons");
## DEBUG_END
##### Komplex: Laden/Speichern/Drucken #####
    my $load_photo = load_photo($misc_frame2, 'open.' . $default_img_fmt);
    my $load_button = $misc_frame2->Button
      (image_or_text($load_photo, 'Load'),
       -command => sub { load_save_route(0) }
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($load_button, -msg => M"Laden einer Route");
    $ch->attach($load_button, -pod => "^\\s*ffnen-Symbol");
    my $last_loaded_mb = $misc_frame2->Menubutton;
    $last_loaded_menu = $last_loaded_mb->Menu
	(-title => M"letzte geffnete Routen",
	 -disabledforeground => $wb->cget(-foreground));
    menuright($load_button, $last_loaded_menu);
    menuarrow($last_loaded_mb, $last_loaded_menu, $col,
	      -menulabel => M"letzte geffnete Routen",
	      -special   => "OPEN");
    $col++;

    my $save_photo = load_photo($misc_frame2, 'save.' . $default_img_fmt);
    my $save_button = $misc_frame2->Button
      (image_or_text($save_photo, 'Save'),
       -command => sub { load_save_route(1) }
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($save_button, -msg => M"Sichern einer Route");
    $ch->attach($save_button, -pod => "^\\s*Speichern-Symbol");
    my $svmb = $misc_frame2->Menubutton;
    my $svm = $svmb->Menu(-title => M"Exportieren",
			  -disabledforeground => $save_button->cget(-foreground));
    $svm->command(-label => M('Karte speichern als').' ...',
		  -state => "disabled",
		  -font => $font{"bold"});

    foreach my $fmt (['Postscript', 'ps'],
		     ['PDF',        'pdf'],
		     ['PNG',        'png'],
		     ['GIF',        'gif'],
		     ['JPEG',       'jpeg'],
		     ['PPM',        'ppm'],
		    ) {
	$svm->command(-label => "$fmt->[0]",
		      -command => sub {
			  $svm->after(50, sub { export_visible_map($fmt->[1]) });
		      });
	if ($fmt->[1] eq 'ps') {
	    $svm->cascade(-label => M("Postscript-Auflsung").' ...');
	    my $psm = $svm->Menu(-title => M("Postscript-Auflsung").' ...');
	    $svm->entryconfigure("last", -menu => $psm);
	    my(%sizes) = (36 => 0, 72 => 0, 100 => 0, 150 => 0);
	    $sizes{int($top_dpi)}++;
	    foreach my $size (sort { $a <=> $b } keys %sizes) {
		$psm->radiobutton(-label => $size . " dpi"
				  . ($size == int($top_dpi) ? " ".M"(normal)" : ""),
				  -variable => \$ps_image_res,
				  -value => $size . "x" . $size,
				 );
	    }
	}
    }

    $svm->separator;
    $svm->command(-label => M('Route speichern als').' ...',
		  -state => "disabled",
		  -font => $font{"bold"});
    foreach my $fmt (
		     # vector oriented
		     'PDF',
		     'XFig',
		     ($advanced ? ('SVG') : ()),
		     # map/gis
		     'bbd (BBBike data)',
		     ($advanced ? ('ESRI') : ()),
		     # XXX not yet ready: ($devel_host ? ('OVL (TOP50)') : ()),
		     # GPS
		     ($advanced ?
		      (
		       # XXX not yet --- bbd2gpx only supports wpt based routes: 'GPX-Route',
		       'GPX-Track',
		      ) : ()),
		     ['G7toWin (ASCII)', 'G7toWin_ASCII'],
		     ['GPSMAN (Tracklog)', 'GpsmanData'],
		     ['Waypoint+ (Track)', 'WaypointPlus'],
		     '-',
		     'GPS direkt',
		     [M('Route zu einem Garmin senden'), 'DirectGarmin'],
		     [M('Senden der Route zu einem Garmin simulieren'), 'DirectGarmin_Test'],
		    ) {
	if ($fmt eq '-') {
	    $svm->separator;
	} elsif ($fmt eq 'GPS direkt') {
	    $svm->command(-label => M($fmt),
			  -state => "disabled",
			  -font => $font{"bold"});
	} elsif ($fmt eq 'PDF') {
	    $svm->command
		(-label => $fmt,
		 -command => \&pdf_export,
		);
	} elsif ($fmt eq 'SVG') {
	    $svm->command
		(-label => $fmt,
		 -command => \&svg_export,
		);
	} elsif ($fmt eq 'XFig') {
	    $svm->command
		(-label => $fmt,
		 -command => sub {
		     my $file = $top->getSaveFile
			 (-defaultextension => '.fig',
			  -filetypes => [[M"FIG-Dateien" => '.fig'],
					 [M"Alle Dateien" => '*']],
			 );
		     return unless defined $file;
		     require Tk::CanvasFig;
		     IncBusy($top);
		     eval {
			 mkdir $file."-images", 0755;
			 $c->fig(-file => $file,
				 -imagetype => (is_in_path("ppmtopcx") ? 'pcx' : 'xpm'),
				 -imagedir => $file."-images");
		     };
		     warn __LINE__ . ": $@" if $@;
		     DecBusy($top);
		 });
	} elsif ($fmt =~ /^ovl/i) {
	    $svm->command
		(-label => $fmt,
		 -command => sub {
		     require GPS::Ovl;
		     GPS::Ovl->new->tk_export(coords => \@realcoords);
		 }
		);
	} elsif ($fmt =~ /^bbd/) {
	    if (-x "$FindBin::RealBin/miscsrc/bbr2bbd") {
		$svm->command
		    (-label => $fmt,
		     -command => \&save_route_as_bbd
		    );
	    }
	} elsif ($fmt =~ /^esri/i) {
	    if (-x "$FindBin::RealBin/miscsrc/bbd2esri" &&
		-x "$FindBin::RealBin/miscsrc/bbr2bbd"
	       ) {
		$svm->command
		    (-label => $fmt,
		     -command => \&save_route_as_esri
		    );
	    }
	} elsif ($fmt eq 'GPX-Route') {
	    $svm->command
		(-label => $fmt,
		 -command => sub { save_route_as_gpx(-as => "route") },
		);
	} elsif ($fmt eq 'GPX-Track') {
	    $svm->command
		(-label => $fmt,
		 -command => sub { save_route_as_gpx(-as => "track") },
		);
	} elsif (ref $fmt eq 'ARRAY') {
	    $svm->command
		(-label => "$fmt->[0]",
		 -command => sub { gps_interface(@$fmt) },
		);
	}
    }

    menuright($save_button, $svm);
    menuarrow($svmb, $svm, $col++, -menulabel => M"Speichern",
	      -special   => 'SAVE');

    my $print_photo = load_photo($misc_frame2, 'printer.' . $default_img_fmt);
    my $print_button = $misc_frame2->Button
	(image_or_text($print_photo, 'Print'),
	 -command => sub { print_function() },
	 )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($print_button, -msg => M"Drucken der Karte");
    $ch->attach($print_button, -pod => "^\\s*Drucken-Symbol");
    my $prmb = $misc_frame2->Menubutton;
    my $prm = $prmb->Menu(-title => M"Druckeinstellungen");
    foreach my $color ([M"Farbe", 'color'],
		       [M"Graustufen", 'gray'],
		       [M"Schwarz/Wei", 'mono'],
		      ) {
	$prm->radiobutton(-label => $color->[0],
			  -value => $color->[1],
			  -variable => \$ps_color,
			 );
    }
    $prm->separator;
    $prm->radiobutton(-label => M"Landscape",
		      -value => 1,
		      -variable => \$ps_rotate,
		     );
    $prm->radiobutton(-label => M"Portrait",
		      -value => 0,
		      -variable => \$ps_rotate,
		     );
    $prm->separator;
    $prm->checkbutton(-label    => M"auf A4 skalieren",
		      -variable => \$ps_scale_a4,
		     );
    $prm->checkbutton(-label    => M"Legende",
		      -variable => \$use_legend,
		     );
    $prm->checkbutton(-label    => M"Legende rechts statt links",
		      -variable => \$use_legend_right,
		     );
    menuright($print_button, $prm);
    menuarrow($prmb, $prm, $col++, -menulabel => M"Drucken",
	      -special   => 'PRINT');

    $misc_frame2->Label(-text => ' ')->grid(-row => $curr_row,
					    -column => $col++);

##### Bikepower #####
    my $bike_photo = load_photo($misc_frame2, 'bicycle.' . $default_img_fmt);
    my $bike_button = $misc_frame2->Button
      (image_or_text($bike_photo, 'Bike'),
       -command => sub { my %args;
			 unless (defined $ENV{LANG} && $ENV{LANG} !~ /^de/) {
			     $args{-lang} = 'de';
			 }
			 $args{-applyhook} = $args{-savedefaultshook} = sub {
			     # XXX
			 };
			 eval {
			     my $bp = $bp_obj->tk_interface($top, %args);
			     set_as_toolwindow($bp);
			 };
			 if ($@) { status_message($@, 'err') }
		     }
      )->grid(-row => $curr_row, -column => $col, -rowspan => 2);
    $bike_button->configure(-state => 'disabled') if !$bikepwr;
    $balloon->attach
      ($bike_button,
       -balloonmsg => M"Bikepower",
       -statusmsg => M"Bikepower: Eingeben von fahrradspezifischen Daten");
    $ch->attach($bike_button, -pod => "^\\s*Fahrrad-Symbol");
    $col++;

    $misc_frame2->Label(-text => ' ')->grid(-row => $curr_row,
					   -column => $col++);

##### Komplex: sonstige Optionen #####
    my $opt_photo = load_photo($misc_frame2, 'opt.' . $default_img_fmt);
    my $opt_button = $misc_frame2->Button
      (image_or_text($opt_photo, 'Opt'),
       -command => \&optedit,
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    if (!$opt) {
	$opt_button->configure(-state => 'disabled');
    }
    $balloon->attach($opt_button, -msg => M"Optionen");
    $ch->attach($opt_button, -pod => "^\\s*Options-Symbol");

    my $opbmb = $misc_frame2->Menubutton;
    my $opbm = $BBBike::Menubar::option_menu = $opbmb->Menu(-title => M"Einstellungen");
    $BBBike::Menubar::option_menu = $BBBike::Menubar::option_menu; # peacify -w
    # XXX wenn die Save-Funktion funktioniert, folgendes immer ausfhren:
    if ($advanced && $devel_host) {
	$opbm->command(-label => M("Konfigurations-Wizard"),
		       -command => sub { require Wizards;
					 config_wizard($top);
				     });
	$opbm->separator;
    }
    if ($advanced) {
        $opbm->radiobutton(-label => M"Landscape",
			   -variable => \$orientation,
			   -value => 'landscape',
			   -command => sub {
			       my $replotsub = get_plotted();
			       set_landscape();
			       $replotsub->();
			   });
        $opbm->radiobutton(-label => M"Portrait",
			   -variable => \$orientation,
			   -value => 'portrait',
			   -command => sub {
			       my $replotsub = get_plotted();
			       set_portrait();
			       $replotsub->();
			   });
    }
    $opbm->cascade(-label => M('Scope').' ...');
    {
	my $sbm = $opbm->Menu(-title => M('Scope').' ...');
	$opbm->entryconfigure('last', -menu => $sbm);
	$sbm->command(-label => M"Stadt",
		      -command => \&city_settings);
	$sbm->command(-label => M"nheres Umland",
		      -command => \&region_settings);
	$sbm->command(-label => M"jwd",
		      -command => \&jwd_settings);
    }
    $opbm->separator;
    if (defined $c_balloon) {
	$opbm->cascade(-label => M('Canvas balloon').' ...');
	{
	    my $cbm = $opbm->Menu(-title => M('Canvas balloon').' ...');
	    $opbm->entryconfigure('last', -menu => $cbm);
	    foreach my $d ([M('kein'), 0],
			   [M('nur Route'), 1],
			   [M('berall'), 2]) {
		my $val = $d->[1];
		$cbm->radiobutton(-label => $d->[0],
				  -variable => \$use_c_balloon,
				  -value => $val,
				  -command => sub { $c_balloon->configure
						      (-show => $val);
						},
				 );
	    }
	}
    }
    $opbm->command
      (-label => M"Farben ndern",
       -command => sub {
	   require Tk::ColorEditor;
	   my $cedit = $top->ColorEditor;
	   $cedit->Show;
       },
      );
    $opbm->command
      (-label => M"Schriftart ndern",
       -command => sub {
	   eval {
	       require Tk::FontDialog;
	       Tk::FontDialog->VERSION(0.05);
	   };
	   if ($@) {
	       return if !perlmod_install_advice('Tk::FontDialog');
	   }
	   my $fedit = $top->FontDialog;
	   my $f = $fedit->Show;
	   if (defined $f) {
	       $font{'normal'} = $f;
	       $top->optionAdd("*font" => $font{'normal'}, 'userDefault');
	       # XXX RefontTree ndert auch $font{'standard'}
	       $top->RefontTree(-font => $font{'normal'}); # -canvas nicht
	       set_fonts($font{'normal'});
	   }
       },
      );
    $opbm->checkbutton(-label => M"gedrehte Zeichenstze",
		       -variable => \$use_font_rot);
    $opbm->checkbutton(-label => M"Stndige Markierung",
		       -variable => \$steady_mark,
		      );
    $opbm->command(-label => M"Markierung lschen",
		   -command => sub {
		       $c->delete('show');
		       if ($showmark_after) {
			   $showmark_after->cancel;
			   undef $showmark_after;
		       }
		   },
		  );
    $opbm->cascade(-label => M"Mittlere Maustaste");
    {
	my $sopbm = $opbm->Menu(-title => M"Mittlere Maustaste");
	$opbm->entryconfigure('last', -menu => $sopbm);
	foreach my $val (B2M_NONE, B2M_SCAN, B2M_FASTSCAN,
			 B2M_AUTOSCROLL, B2M_DELLAST,
			) {
	    my $label = $b2_mode_desc{$val};
	    $label = "???" if (!defined $label);
	    $sopbm->radiobutton(-label => $label,
				-variable => \$b2_mode,
				-value => $val,
				-command => \&set_b2,
			       );
	}
    }

    {
	$opbm->cascade(-label => M('Aktualisieren').' ...');
	my $am = $opbm->Menu(-title => M('Aktualisieren').' ...');
	$opbm->entryconfigure("last", -menu => $am);

	my $set_immediate_sub = sub {
	    my($val) = @_;
	    foreach (qw(replot-str-s replot-str-l
			replot-str-qs replot-str-ql
			replot-str-hs replot-str-hl
			replot-str-r replot-str-b
			replot-str-u replot-str-rw
			replot-str-v replot-str-f
			replot-p-r   replot-p-b
			replot-p-u
			replot-p-o replot-str-w
		       )) { # XXX weitere replots???
		$immediate{$_} = $val;
	    }
	};

	my $rp; # XXX ein bichen hacky (weiter unten)
	foreach my $def ([M"Auf Anfrage aktualisieren", 0],
			 [M"Ausgabe sofort aktualisieren", 1],
			 [M"Ausgabe verzgert aktualisieren", 2],
			) {
	    my $val = $def->[1];
	    my $button = $am->radiobutton
	      (-label => $def->[0],
	       -variable => \$immediate_replot,
	       -value => $val,
	       -command => sub { $set_immediate_sub->($val) });
	    $rp = $button if ($val == $immediate_replot);
	}
	# XXX hier mten eigentlich auch die drei Alternativen stehen
	my $rc = $am->checkbutton
	  (-label => M"Netz sofort aktualisieren",
	   -variable => \$immediate_recalc,
	   -command => sub {
	       $immediate{'recalc-net'} = $immediate_recalc;
	   },
	  );

	if ($Tk::VERSION < 803 || $Tk::VERSION >= 804.025) {
	    $rp->cget(-command)->Call if $rp;
	    $rc->cget(-command)->Call;
	} else {
	    $rp->cget(-command)->() if $rp;
	    $rc->cget(-command)->();
	}
	$am->command(-label => M"Alles aktualisieren",
		     -command => sub { update() });
    }

### not yet..., see start_followmouse()
#      $opbm->checkbutton(-label => M"Followmouse",
#  		       -variable => \$followmouse,
#  		       -command => sub {
#  			   if ($followmouse) {
#  			       start_followmouse();
#  			   } else {
#  			       stop_followmouse();
#  			   }
#  		       },
#  		      );
    if ($advanced) {
	stderr_menu($opbm);
    }
    $opbm->checkbutton(-label => M"Wortreich (verbose)",
		       -variable => \$verbose,
		       -command => \&set_verbose);

    $opbm->command
	(-label => M"Daten-Update ber das Internet",
	 -command => sub {
	     if ($devel_host && $ENV{HOST} !~ /^devpc01/) {
		 status_message("Kein Update auf cabulja/vran/cvrsnica/spiff mglich!", "die");
		 die;
	     }
	     require Tk::Dialog;
	     if ($top->Dialog
		 (-title => M"Update",
		  -text => M("Soll das Update gestartet werden?\nJe nach Internet-Verbindung und Stand der Daten kann das Update 5 bis 10 Minuten dauern. Alternativ knnen die Dateien als ZIP-Datei von\n$BBBike::BBBIKE_UPDATE_DATA_CGI\ngeholt und in das Verzeichnis\n$FindBin::RealBin/data\nausgepackt werden.\n"),
		  -bitmap => 'question',
		  -buttons => [M"Ja", M"Nein"])->Show eq M"Ja") {
		 require Update;
		 Update::bbbike_data_update();
	     }
	 },
	);

    $opbm->command(-label => M"Alarmliste",
		   -command => sub {
		       require BBBikeAlarm;
		       BBBikeAlarm::tk_show_all();
		   },
		  );

    if ($advanced && $os ne "win") {
	$opbm->command(-label => M"Start BBBike-Server",
		       -command => sub {
			   require BBBikeServer;
			   if (!BBBikeServer::running()) {
			       BBBikeServer::create_server($top);
			   }
		       },
		      );
    }

    if (!$standard_menubar) {
	plugin_menu($opbm);
    }
    if ($advanced) {
	advanced_option_menu($opbm);
    }
    menuright($opt_button, $opbm);
    menuarrow($opbmb, $opbm, $col++,
	      -menulabel => M"Einstellungen", -special => 'OPTIONS');

    my $help_photo = load_photo($misc_frame2, 'help.' . $default_img_fmt);
    my $help_button = $misc_frame2->Button
      (image_or_text($help_photo, '?'),
       -command => sub {
	   eval {
	       require Tk::Pod;
	       Tk::Pod->Dir($FindBin::Bin);
	       $top->Pod(-file => $FindBin::Script . ".pod",
			 -title => M"Dokumentation zu BBBike");
	   };
	   if ($@) {
	       my $r;
	       my $bbbike_html = Tk::findINC("bbbike.html");
	       my $url;
	       if (defined $bbbike_html && -r $bbbike_html) {
		   $url = "file:$bbbike_html";
		   require WWWBrowser;
		   $r = WWWBrowser::start_browser($url);
	       }
	       if (!$r) {
		   return if !perlmod_install_advice('Tk::Pod');
	       }
	   }
       },
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($help_button, -msg => M"Hilfe");
    $ch->attach($help_button, -pod => "^\\s*Hilfe-Symbol");

    my $hpbmb = $misc_frame2->Menubutton;
    my $hpbm = $hpbmb->Menu(-title => M"Hilfe");
    $hpbm->checkbutton(-label => M"Legende",
		       -command => sub {
			   toggle_legend($top, -realcanvas => $c);
		       },
		       -variable => \$show_legend,
		       -accelerator => 'F1');
    my $this_index = $hpbm->index("last");
    $top->bind("<F1>" => sub { $hpbm->invoke($this_index) });

    $hpbm->checkbutton(-label => M"Maushilfe",
		       -command => \&toggle_mouse_help,
		       -variable => \$show_mouse_help,
		      );
    if ($use_contexthelp) {
	$hpbm->command(-label => M"Kontexthilfe",
		       -command => sub { $ch->activate });
    }
    my $bbbike_html = Tk::findINC("bbbike.html");
    my $url;
    if (defined $bbbike_html && -r $bbbike_html) {
	$url = "file:$bbbike_html";
	$hpbm->command
	  (-label => M"Dokumentation (lokal)",
	   -command => sub {
	       require WWWBrowser;
	       WWWBrowser::start_browser($url);
	   });
    }
    $hpbm->command
      (-label => M"Dokumentation (WWW)",
       -command => sub {
	   my $url = "$BBBike::BBBIKE_SF_WWW/bbbike/bbbike.html";
	   require WWWBrowser;
	   WWWBrowser::start_browser($url);
       });
    $hpbm->command(-label => M('ber').' ...',
		   -command => sub { show_logo('as_about') });
    $hpbm->command(-label => M"Copyright",
		   -command => sub { copying_viewer($top) });
    $hpbm->command(-label => M"Changes",
		   -command => sub { simple_file_viewer
					 ($top,	"$FindBin::RealBin/CHANGES", 
					  -title => M"Changes",
					  -class => "BBBike Changes",
					 );
				 });
## XXX del: Ist schon seit Aenon nicht mehr notwendig
#    $hpbm->command(-label => M"Busy-Zeiger zurcksetzen",
#		   -command => sub { ResetBusy($top) });
    menuright($help_button, $hpbm);
    menuarrow($hpbmb, $hpbm, $col++, -menulabel => M"~Hilfe");

    my $context_help_button;
    if (!$small_icons) {
	# The only reason for the restriction: the image on the button
	# is too large.
	$context_help_button =
	    $ch->HelpButton($misc_frame2)->grid
		(-row => $curr_row, -column => $col,
		 -rowspan => 2);
	$balloon->attach($context_help_button, -msg => M"Kontexthilfe");
	$col++;
    }

    if (!$standard_menubar) {
	# No need for yet another close button if there's already a
	# standard menu:

	$misc_frame2->Label(-text => ' ')->grid(-row => $curr_row,
						-column => $col++);

	my $exit_photo = load_photo($misc_frame2, 'exit.' . $default_img_fmt);
	my $exit_button = $misc_frame2->Button
	    (image_or_text($exit_photo, 'Exit'),
	     -command => \&exit_app,
	    )->grid(-row => $curr_row, -column => $col, -sticky => 's');
	$balloon->attach($exit_button, -msg => M"BBBike beenden");
	$ch->attach($exit_button, -pod => "^\\s*Ende-Symbol");
	$col++;
    }

## DEBUG_BEGIN
#mymstat("iconframe: underline all");
## DEBUG_END
    if ($misc_frame->can('UnderlineAll'))  { $misc_frame->UnderlineAll }
    if ($misc_frame2->can('UnderlineAll')) { $misc_frame2->UnderlineAll }

    arrange_symframe();

#XXX del: (now in "Aktuelle Route")
#    $ampelstatus_label = $sym_frame->Label(-justify => "left")->grid
#      (-row => 0, -column => 2, -sticky => 'n');

## DEBUG_BEGIN
#mymstat("iconframe: bindings");
## DEBUG_END
    bind_nomod($top, "<s>" => sub { $strasse_check->invoke });
    bind_nomod($top, "<l>" => sub { $landstrasse_check->invoke });
    bind_nomod($top, "<o>" => sub { $ort_check->invoke });
    bind_nomod($top, "<u>" => sub { $ubahn_check->invoke });
    bind_nomod($top, "<b>" => sub { $sbahn_check->invoke });
    bind_nomod($top, "<r>" => sub { $rbahn_check->invoke });
    bind_nomod($top, "<w>" => sub { $wasser_check->invoke });
    bind_nomod($top, "<f>" => sub { $flaechen_check->invoke });
    bind_nomod($top, "<p>" => sub { $hs_check->invoke }) if $hs_check;

    bind_nomod($top, "<R>" => sub {
		   # Same problems as in <Q>, see below.
		   if ($str_draw{'l'} || $str_draw{'comm-cyclepath'}) {
		       $lstrcm->invoke($radwege_l_check_index);
		   }
		   if ($str_draw{'s'} || $str_draw{'rw'} || !$str_draw{'l'}) {
		       $strcm->invoke($radwege_check_index);
		   }
	       });
    bind_nomod($top, "<a>" => sub { $strcm->invoke($ampeln_check_index) });
    bind_nomod($top, "<g>" => sub { $strcm->invoke($sperre_check_index) });
    bind_nomod($top, "<Q>" => sub {
		   # XXX hmmm... nicht gerade ideal. Beispiel: Landstraen
		   # sind aktiv, Q, Straen werden aktiv gemacht, Q
		   # togglet jetzt genau entgegengesetzt...
		   if ($str_draw{'l'} || $str_draw{'ql'}) {
		       $lstrcm->invoke($qualitaet_l_check_index);
		   }
		   if ($str_draw{'s'} || $str_draw{'qs'} || !$str_draw{'l'}) {
		       $strcm->invoke($qualitaet_check_index);
		   }
	       });
    bind_nomod($top, "<H>" => sub {
		   # XXX hmmm... nicht gerade ideal. Beispiel: Landstraen
		   # sind aktiv, H, Straen werden aktiv gemacht, H
		   # togglet jetzt genau entgegengesetzt...
		   if ($str_draw{'l'} || $str_draw{'hl'}) {
		       $lstrcm->invoke($handicap_l_check_index);
		   }
		   if ($str_draw{'s'} || $str_draw{'hs'} || !$str_draw{'l'}) {
		       $strcm->invoke($handicap_check_index);
		   }
	       });
    bind_nomod($top, "<question>" => sub {
	$strcm->invoke($fragezeichen_check_index) })
	if defined $fragezeichen_check_index;

    bind_nomod($top, "<L>" => sub { $lstrcm->invoke($land_jwd_check_index) });
    bind_nomod($top, "<O>" => sub { $ocm->invoke($ort_jwd_check_index) });
    bind_nomod($top, "<W>" => sub { $wcm->invoke($wasserumland_check_index) });
    bind_nomod($top, "<B>" => sub { $strlist_button->invoke });

    # XXX restliche Widgets fehlen noch
    for my $w ($strasse_check, $landstrasse_check, $ort_check,
	       $ubahn_check, $sbahn_check, $rbahn_check, $wasser_check,
	       $flaechen_check) {
	enter_leave_bind_for_help($w, [M"Option umschalten", '', M"Men"]);
    }

} # do_iconframe

sub telefonbuch_dialog {
    my $type = shift;
    require Telefonbuch;
    my $get_coord = sub {
	my($x, $y) = @_;
	transpose($x, $y);
    };
    my $mark = sub {
	my($x, $y, %args) = @_;
	my $tcoords = [[]];
	$tcoords->[0][0] = [ transpose($x, $y) ];
	mark_point(-coords => $tcoords, %args,
		   -clever_center => 1);
    };
    if ($type eq 'str') {
	Telefonbuch::tk_str_dialog($top, $mark, $get_coord);
    } else {
	Telefonbuch::tk_tel_dialog($top, $mark, $get_coord);
    }
}

# Berechnet das Layout des obersten Frames neu (z.B. bei einem Resize)
sub arrange_topframe {
    my(@order) = ($hslabel_frame, $km_frame, $speed_frame[0],
		  $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
		  @speed_frame[1..$#speed_frame],
		  @power_frame[1..$#power_frame],
		 );
    my(@col)   = (0, 1, 3, 4+$#speed_frame, 5+$#speed_frame+$#power_frame,
		  2, 6+$#speed_frame+$#power_frame,
		  4..3+$#speed_frame,
		  5+$#speed_frame..4+$#speed_frame+$#power_frame);
    $top->idletasks;
    my $width = 0;
    my(%gridslaves) = map {($_, 1)} $top_frame->gridSlaves;
    for(my $i = 0; $i <= $#order; $i++) {
	my $w = $order[$i];
	next unless Tk::Exists($w);
	my $col = $col[$i] || 0;
	$width += $w->reqwidth;
	if ($gridslaves{$w}) {
	    $w->gridForget;
	}
	if ($width <= $top->width) {
	    $w->grid(-row => 0,
		     -column => $col,
		     -sticky => 'nsew'); # XXX
	}
    }
}

# Berechnet das Layout des Symbol-Frames (das die Icons enthlt) neu
sub arrange_symframe {
    my($old_row, $new_row);
    return unless $misc_frame2 || $DockFrame eq 'DockFrame';
    my $p = $misc_frame2->parent;
    if (grep($_ eq $misc_frame2, $p->gridSlaves)) {
	# already gridded
	my %a = $misc_frame2->gridInfo;
	$old_row = $a{-row};
    } else {
	# force computation of reqwidth
	$misc_frame2->idletasks;
    }
    my $new_col;
    my $is_two_row;
    if ($misc_frame->reqwidth + $misc_frame2->reqwidth + 10
	> $top->width) {
	$new_row = 1;
	$new_col = 0;
	$is_two_row = 1;
    } else {
	$new_row = 0;
	$new_col = 1;
	$is_two_row = 0;
    }
    if (!defined $old_row || $old_row != $new_row) {
	if (defined $old_row) {
	    $misc_frame2->gridForget;
	}
	$misc_frame2->grid(-row => $new_row,
			   -column => $new_col,
			   -sticky => 'nsw');
    }

    # Maybe remove borders between two frames
    if ($os eq 'unix' && $devel_host) { # not tested yet on Windows XXX
	my $lf = $p->Subwidget("HideLeftBorder");
	my $lc = $p->Subwidget("HideLeftCorner");
	my $rf = $p->Subwidget("HideRightBorder");
	if (!$is_two_row) {
	    if (!Tk::Exists($rf)) {
		$rf = $misc_frame->Frame(-bg => $misc_frame->cget(-bg));
		$p->Advertise("HideRightBorder" => $rf);
	    }
	    if (!Tk::Exists($lf)) {
		$lf = $misc_frame2->Frame(-bg => $misc_frame->cget(-bg));
		$p->Advertise("HideLeftBorder" => $lf);
	    }
	    if (!Tk::Exists($lc)) {
		$lc = $misc_frame2->Frame
		    (-bd => 0, -bg => $misc_frame->Darken($misc_frame->cget(-bg), 60));
		$p->Advertise("HideLeftCorner" => $lc);
	    }
	    $lf->place(-rely => 0, -relx => 0, -x => -1,
		       -width => 1, -relheight => 1);
	    $lc->place(-rely => 1, -relx => 0, -x => -1,
		       -width => 1, -height => 1);
	    $rf->place(-rely => 0, -relx => 1,
		       -width => 1, -relheight => 1);
	} else {
	    for my $w ($rf, $lf, $lc) {
		$w->placeForget if Tk::Exists($w) && $w->manager eq 'place';
	    }
	}
    }
}

$splash_screen->Update(0.3) if $splash_screen;

##### sonstige Bilder #####
## DEBUG_BEGIN
#mymstat("load photos");
## DEBUG_END
load_photos();

my $linestip = eval { Tk::findINC('images/stip.xbm') };

##### configure Canvas/Scrollbars #####
## DEBUG_BEGIN
#mymstat("create/config canvas");
## DEBUG_END
my $canvas_frame = $frame->Frame->pack(-fill => 'both', -expand => 1);
$canvas_frame->gridColumnconfigure(0, -weight => 1);
$canvas_frame->gridRowconfigure(0, -weight => 1);

$c = $canvas_frame->Canvas
  (Name => 'karte',
   -bg => $map_bg,
   -closeenough => 3, # XXX hmmm ... manchmal gut, manchmal schlect
   -scrollregion => \@scrollregion,
   #-xscrollincrement => 4, -yscrollincrement => 4,
  )->grid(-row => 0, -column => 0, -sticky => 'eswn');
$top->Advertise(Map => $c);
$c->{Configure}{-seeview} = \&Tk::Canvas::smooth_scroll;
#XXX$c->BindMouseWheel if defined &Tk::Widget::BindMouseWheel;

$sy = $canvas_frame->Scrollbar(-command => ["yview", $c],
			       -takefocus => 0,
			       -highlightthickness => 0,
			      );
$sx = $canvas_frame->Scrollbar(-orient => "horiz",
			       -command => ["xview", $c],
			       -takefocus => 0,
			       -highlightthickness => 0,
			      );

$c->configure(-yscrollcommand =>
	      sub { $sy->set(@_);
		    overview_update();
		    if (defined &plotstr_on_demand
			and $BBBikeLazy::mode) {
			my($x1,$y1,$x2,$y2) = $c->get_corners;
			plotstr_on_demand(anti_transpose($x1,$y1),
					  anti_transpose($x2,$y2));
		    }
		    $c_balloon->Deactivate(1) if defined $c_balloon;
	      },
              -xscrollcommand =>
              sub { $sx->set(@_);
		    overview_update();
		    if (defined &plotstr_on_demand
			and $BBBikeLazy::mode) {
			my($x1,$y1,$x2,$y2) = $c->get_corners;
			plotstr_on_demand(anti_transpose($x1,$y1),
					  anti_transpose($x2,$y2));
		    }
		    $c_balloon->Deactivate(1) if defined $c_balloon;
		},
	     );

## XXX Enable after some rethaught...
## XXX and remove the scrollregion code from scalecanvas
# for my $hook (qw(after_plot after_resize)) {
#     Hooks::get_hooks($hook)->add
# 	    (sub {
# 		 # XXX Is this fast enough?
# 		 $c->configure(-scrollregion => [ $c->bbox("all") ]);
# 	     }, "bbbike-scrollregion");
#     $c->OnDestroy
# 	(sub {
# 	     Hooks::get_hooks($hook)->del("bbbike-scrollregion");
# 	 });
# }

# Additional MouseWheel bindings
$c->Tk::bind("<4>" => [sub { return if $_[1] ne "" && $_[1] ne "B4-";
			     $c->yviewScroll(-1,"units") },
		       Tk::Ev('s')]);
$c->Tk::bind("<5>" => [sub { return if $_[1] ne "" && $_[1] ne "B5-";
			     $c->yviewScroll(+1,"units") },
		       Tk::Ev('s')]);
for ("<Control-5>", "<Shift-5>", "<B1-5>") {
    $c->Tk::bind($_ => sub { $c->xviewScroll(+1,"units") });
}
for ("<Control-4>", "<Shift-4>", "<B1-4>") {
    $c->Tk::bind($_ => sub { $c->xviewScroll(-1,"units") });
}

if ($c->can('DropSite')) {
    eval {
	$c->DropSite
	  (-dropcommand => [\&accept_drop, $c],
	   -droptypes => ($os eq 'win' ?
			  'Win32' :
			  # KDE is removed from Tk804.02x
			  [($Tk::VERSION >= 804 ? () : 'KDE'), 'XDND', 'Sun']
			 )
	  );
	warn M("Datei-DND wird akzeptiert") . "\n" if $verbose;
    };
    warn __LINE__ . ": $@" if $@ && $verbose;
}

# erst hier setzen, weil die Hintergrundfarbe von -xrm und dem Window-System
# abhngt
$category_color{'I'} = $c->cget(-background);

standard_selection_handle();

$sy->grid(-row => 0, -column => 1, -sticky => 'ns');
$sx->grid(-row => 1, -column => 0, -sticky => 'ew');

##### Statuszeile/Progress Bar #####
{
    my $status_frame = $frame->Frame(-height => 16)->pack(-fill => 'x');
    # XXX hmmm, das kriege ich nicht so gut hin....
    $status_frame->gridColumnconfigure(0, -weight => 1);
    $status_frame->gridColumnconfigure(1, -weight => 5);
    $status_frame->gridColumnconfigure(2, -weight => 0);
    $status_frame->gridColumnconfigure(3, -weight => 0);
    my $gridx = 0;

    require Tk::SRTProgress;
    Tk::SRTProgress->VERSION(0.06);
    $progress = $status_frame->SRTProgress
	(-relief => 'sunken',
	 -borderwidth => 2,
	 -visible => 0,
	 -width => $top->width/10,
	)->grid(-row => 0,
		-column => $gridx++,
		-sticky => 'ew');
    $status_label = $status_frame->Label(-justify => 'left', -anchor => 'w')
      ->grid(-row => 0, -column => $gridx++, -sticky => 'ew');

    $status_button_column = $gridx;
    $status_button = $status_frame->Button(-padx => 0, -pady => 0); $gridx++; # do not map

    $indicator_frame = $status_frame->Frame
	->grid(-row => 0, -column => $gridx++, -sticky => "ew");
    if ($advanced) {
	$edit_mode_indicator = $indicator_frame->$Checkbutton
	    (-text => 'EDIT',
	     -variable => \$edit_mode_flag,
	     -command => sub {
		 set_edit_mode();
	     })->pack(-side => "left");
	$edit_mode_type = $indicator_frame->Label
	    (-text => '', -relief => 'sunken')
		->pack(-side => "left");
	gui_set_edit_mode($edit_mode);
    }
    $balloon->configure(-statusbar => $status_label);
}

$splash_screen->Update(0.4) if $splash_screen;

##### initiales Zeichnen ######################################
## DEBUG_BEGIN
#BEGIN{mymstat("before init draw BEGIN");} mymstat("before init draw");
## DEBUG_END
$progress->InitGroup;
if (defined $set_mode && $set_mode eq 'edit') {
    require BBBikeAdvanced;
    set_edit_mode(1);
#     #XXX inefficient!
#     switch_edit_standard_mode();
#     $lazy_plot = 1;
}
# special case 'pp':
if ($init_p_draw{'pp'} && !defined $set_mode) {
    $p_draw{'pp'} = 1;
}
foreach (keys %init_str_draw) {
    $str_draw{$_} = $init_str_draw{$_};
    eval {
	plot('str',$_)   if $str_draw{$_};   # Strecken plotten
    };
    if ($@ && !$no_original_datadir) {
	die $@;
    }
}
foreach (keys %init_p_draw) {
    if ($_ eq 'pp' && defined $set_mode) {
	# XXX already set
    } else {
	$p_draw{$_}   = $init_p_draw{$_};
    }
    eval {
	plot('p',$_)     if $p_draw{$_};     # Punkte (z.B. Ampeln) zeichnen
    };
    if ($@ && !$no_original_datadir) {
	die $@;
    }
}
# Hhen einlesen
read_hoehe()  if $show_grade || $steigung_optimierung || $use_hoehe;
read_ampeln() unless $lowmem;
read_sperre_tragen() unless $lowmem;
plot_sperre() if $p_draw{'sperre'};
activate_temp_blockings(1) if $do_activate_temp_blockings;

if ($net_type =~ /^(us|r|rus|wr)$/) {
    make_net();
}

if (!$search_route_flag) {
    search_route_mouse(1);
}

## DEBUG_BEGIN
#BEGIN{mymstat("after init draw BEGIN");} mymstat("after init draw");
## DEBUG_END
$progress->FinishGroup;

$splash_screen->Update(0.7) if $splash_screen;

set_bindings();

foreach my $def (qw(start watch ziel addnet delnet info salesman xy
		    movehand www)) {
    load_cursor($def);
}

if ($cursor{"watch"}) {
    $busy_watch_args{-cursor} = ['@' . $cursor{"watch"}, $cursor_mask{"watch"},
				 'black', 'white'];
}

$splash_screen->Update(0.8) if $splash_screen;

$last_loaded_obj =
    {
     List => [],
     File => "$bbbike_configdir/last",
     Menu => $last_loaded_menu,
     Title => M('Letzte Routen-Dateien').':',
     Cb => sub { load_save_route(0, $_[0]) },
     Max => 12,
    };
load_last_loaded($last_loaded_obj);

hide_logo();
$top->deiconify unless $top->{initial_iconic};

# XXX should be after deiconify, otherwise center does not work (?)
choose_from_plz(-str   => $center_on_str)   if defined $center_on_str;
choose_from_plz(-coord => $center_on_coord) if defined $center_on_coord;

$splash_screen->Update(0.9) if $splash_screen;

set_mouse_desc();

if ($map_mode eq MM_SEARCH) {
    set_cursor("start");
}

if ($preload_file) {
    load_save_route(0, $preload_file);
}

if ($init_from) {
    set_route_start_street($init_from);
}
if ($init_to) {
    set_route_ziel_street($init_to);
}

eval { local $SIG{'__DIE__'};
       require $progname . "_2.config" };

if ($advanced) {
    # Besser wre es, wenn mit "use" die aktuelle Zeit des Moduls
    # aufgezeichnet werden knnte. So beschrnke ich mich auf
    # minutenweise berprfen, ob neue Module geladen wurden.
    check_new_modules();
    $top->repeat(60*1000, \&check_new_modules);
}

if ($stderr_window) {
    require BBBikeAdvanced;
    stderr_window_command();
}

## DEBUG_BEGIN
#BEGIN{mymstat("before mainloop BEGIN");} mymstat("before mainloop");
## DEBUG_END

#use Devel::Symdump;
#my $symdump = rnew Devel::Symdump;
#print $symdump->as_string;

if ($use_server and $os ne 'win') { # Win32 untersttzt kein fork etc.
    require BBBikeServer;
    BBBikeServer::create_server($top);
}

if ($turbo) {
    bbbikelazy_init();
}

if (defined $initial_plugins && $initial_plugins ne "") {
    foreach my $plugin (split /,/, $initial_plugins) {
	load_plugin($plugin);
    }
}

if (defined $initial_layers && $initial_layers ne "") {
    require BBBikeAdvanced;
    foreach my $layer_def (split /,/, $initial_layers) {
	plot_additional_layer_cmdline($layer_def);
    }
}

$splash_screen->Destroy if $splash_screen; undef $splash_screen;

choose_streets()                            if $init_choose_street;

if ($ENV{BBBIKE_GUI_TEST}) {
    eval qq{
      require $ENV{BBBIKE_GUI_TEST};
      \$top->afterIdle(\\&$ENV{BBBIKE_GUI_TEST}::start_guitest);
    };
    warn $@ if $@;
}

# XXX workaround for BBBikeLazy bug
if (defined $set_mode && $set_mode eq 'edit' && $lazy_plot) {
    $lazy_plot = 0;
}

$booting = 0;
MainLoop unless $ENV{BBBIKE_TEST_PERFORMANCE};

##### Subs ### RELOADER_START ############################################

sub handle_options {
    @opttable =
	(M"Strecken/Punkte",
	 ['','',M"Strecken und Punkte, die beim Start von BBBike\ngezeichnet werden sollen."],
	 ['str','!',1,	alias=>[qw(strasse strassen)],
	  label => M"Straen",	var => \$init_str_draw{'s'}],
	 ['landstr','!',0,	alias=>[qw(landstrasse landstrassen)],
	  label => M"Landstraen",	var => \$init_str_draw{'l'}],
	 ['landstrjwd','!',0,
	  label => M"Landstraen jwd", var => \$str_far_away{'l'}], # XXX init_str_far_away?
	 ['sbahn','!',1,
	  label => M"S-Bahnlinien",	var => \$init_str_draw{'b'}],
	 ['sbahnhof','!',1,
	  label => M"S-Bahnhfe",	var => \$init_p_draw{'b'}],
	 ['ubahn','!',1,
	  label => M"U-Bahnlinien",	var => \$init_str_draw{'u'}],
	 ['ubahnhof','!',1,
	  label => M"U-Bahnhfe",	var => \$init_p_draw{'u'}],
	 ['rbahn','!',0,
	  label => M"R-Bahnlinien",	var => \$init_str_draw{'r'}],
	 ['rbahnhof','!',0,
	  label => M"R-Bahnhfe",	var => \$init_p_draw{'r'}],
	 ['wasser','!',0,	alias=>[qw(gewaesser)],
	  label => M"Gewsser",	var =>\$init_str_draw{'w'}],
	 ['wasserstadt','!',1,
	  label => M"Gewsser in der Stadt", var => \$wasserstadt],
	 ['wasserumland','!',0,
	  label => M"Gewsser im Umland", var => \$wasserumland], # XXX auch init!
	 ['wasserjwd','!',0,
	  label => M"Gewsser jwd", var => \$str_far_away{'w'}],
	 ['faehre','!',0,	alias=>[qw(faehren)],
	  label => M"Fhren",	var => \$init_str_draw{'e'}],
	 ['flaeche','!',0,	alias=>[qw(flaechen)],
	  label => M"Flchen",	var => \$init_str_draw{'f'}],
	 ['ort','!',0,	alias=>[qw(orte)],
	  label => M"Orte",		var => \$init_p_draw{'o'}],
	 ['ortjwd','!',0,
	  label => M"Orte jwd",	var => \$p_far_away{'o'}],
	 ['sehenswuerdigkeiten','!',0,
	  label => M"Sehenswrdigkeiten", var => \$init_str_draw{'v'}],
	 ['fragezeichen','!',0,
	  label => M"Fragezeichen",	var => \$init_str_draw{'fz'}],

	 M"Plot-Attribute",
	 ['outline','!',0,
	  label => M"Outline zeichnen", var => \$all_outline],
	 ['ampel','!',1,	alias=>[qw(ampeln|lsa)],
	  label => M"Ampeln zeichnen", var => \$init_p_draw{'lsa'}],
	 ['lsamaybe','!',undef, nogui => 1,
	  label => M"unsichere Ampeln", var => sub { $str_restrict{'lsa'} = {qw(? 1 X 0 B 0 F 0)} }],
	 ['plothoehe','!',0,
	  label => M"Hhenangaben zeichnen",	var => \$init_p_draw{'hoehe'}],
	 ['showgrade','!',1,
	  label => M"Anzeige der Steigungen/Geflle", var => \$show_grade],
	 ['grademinimum','=f',0.01, # ab 1% Steigungen/Geflle zeigen
	  label => M"minimal angezeigte Steigung",	var => \$grade_minimum],
	 ['grademinimumshort','=f',0.02, # kurze Stcke erst ab 2% zeigen
	  label => Mfmt("minimale Steigung (kurze Strecken bis %dm)", $grade_minimum_short_length),	var => \$grade_minimum_short],
	 ['strname','!',0,
	  label => M"Straennamen plotten",	var => \$str_name_draw{'s'}],
	 ['ubahnname','!',1,
	  label => M"Namen von U-Bahnhfen anzeigen", var => \$p_name_draw{'u'}],
	 ['sbahnname','!',1,
	  label => M"Namen von S-Bahnhfen anzeigen", var => \$p_name_draw{'b'}],
	 ['ortname','!',1,
	  label => M"Ortsnamen plotten",	var => \$p_name_draw{'o'}],
	 ['ortkategorie','=s','auto',
	  label => M"Ortskategorie",
	  longhelp => M"Minimale Ortskategorie, die gezeichnet werden soll",
	  choices => [qw(auto), MIN_ORT_CAT .. MAX_ORT_CAT],
	  var =>  \$place_category],
	 ['wassername','!',1,		alias => [qw(gewaessername)],
	  label => M"Gewssernamen plotten",	var => \$str_name_draw{'w'}],
	 ['rbahnnetz','!',undef, nogui => 1,
	  label => M"R-Bahnnetz",	var => sub { $net_type = "r" }],
	 ['usbahnetz','!',undef, nogui => 1,
	  label => M"U/S-Bahnnetz",	var => sub { $net_type = "us" }],
	 ['bahnnetz','!',undef, nogui => 1,
	  label => M"Gesamtes Bahnnetz", var => sub { $net_type = "rus" }],
	 ['scope','=s',undef,
	  label => M"Scope", var => \$init_scope,
	  choices => ["", qw/city region jwd/]],
	 ['fast','!',undef,	nogui => 1, var => \&fast_settings],
	 ['turbo','!',undef,  nogui => 1, var => sub { fast_settings();
						       $turbo = 1;
						   },
	 ],
	 #XXX -nolazy geht nicht!
	 ['lazy','!',undef,   nogui => 1, var => sub {
	      $lazy_plot = 1;
	      #        $p_far_away{'o'}   = 1;
	      #        $str_far_away{'w'} = 1;
	      #        $str_far_away{'l'} = 1;
	      #        $wasserumland      = 1;
	      #        $str_draw{'l'}     = $str_draw{'s'};
	      #        $p_draw{'o'}       = 1;
	  }],
	 ['lowmem','!',undef, nogui => 1, var => sub {
	      fast_settings();
	      $lowmem = 1;
	      $use_contexthelp = 0;
	      $use_balloon = 0;
	      $use_c_balloon = 0;
	      $want_wind = 0;
	      $bikepwr = 0;
	      @speed = (20);
	      $init_p_draw{'lsa'} = 0;
	      $map_color = 'pixmap';
	      $show_grade = 0;
	      $use_hoehe = 0;
	  }],
	 ['slowcpu','!',undef, nogui => 1, var => sub {
	      $slowcpu = 1;
	      # XXX more
	  }],
	 ['center','=s',undef,
	  label => M"Beim Starten auf Strae zentrieren", var => \$center_on_str],
	 ['centerc','=s',undef,
	  label => M"Beim Starten auf Koordinaten zentrieren",
	  var => \$center_on_coord],
	 ['choosestreet','!',1,
	  label => M"Beim Starten Straenauswahl zeigen",
	  var => \$init_choose_street],
	 ['autoshowlist','!',1,
	  label => M"Automatisches Anzeigen der Beschreibung",
	  var => \$auto_show_list],
	 ['city','=s',undef,
	  label => M"Stadt", var => \$city, nosave => 1],
	 ['country','=s',undef,
	  label => M"Land", var => \$country, nosave => 1],
	 ['datadir','=s',undef,
	  label => M"Verzeichnis mit Straendaten",
	  subtype => 'dir', nosave => 1, var => \$datadir],

	 M"Anzeige",
	 ['','',M"Bei den meisten Optionen muss BBBike neu gestartet werden,\num die nderungen sichtbar zu machen."],
	 ['fontrot','!',1,
	  label => M"Rotierte Zeichenstze", var => \$use_font_rot],
	 ['fontfamily','=s',undef, #'helvetica',#XXX no defaults!
	  label => M"Zeichensatz (Proportional)", var =>        \$font_family],
	 ['fixedfontfamily','=s','courier',
	  label => M"Zeichensatz (Fixed)", var =>   \$fixed_font_family],
	 ['fontheight','=i',undef, #12,#XXX no defaults!
	  alias => [qw(fontsize)],
	  label => M"Zeichensatzgre", var => \$font_size],
	 ['labelfontheight','=i',10,
	  alias => [qw(labelfontsize)],
	  label => M"Zeichensatzgre fr Labels", var => \$label_font_size],
	 ['fontweight','=s',undef,
	  label => M"Zeichensatzform", var => \$font_weight],
	 ['geometry','=s',undef,
	  subtype => "geometry", # XXX use fix_geometry for tk::getopt editor
	  label => M"Geometry", var => \$geometry],
	 ['maximized','!',0,
	  label => M"immer maximiert ffnen", var => \$open_maximized],
	 ['scaling','=f',undef,
	  label => M"Skalierung", var => \$scaling],
	 ['visual','=s',undef,
	  label => M"Visual", var => \$visual],
	 ['scale','=s',undef,
	  label => M"Skalierung", nogui => 1,
	  var => \$init_scale_massstab,
	 ],
	 ['overviewwasser','!',1,
	  label => M"bersichtskarte mit Gewssern", var => \$overview_draw{'w'}],
	 ['overviewsbahn','!',0,
	  label => M"bersichtskarte mit S-Bahnen", var => \$overview_draw{'b'}],
	 ['overviewsbahn','!',0,
	  label => M"bersichtskarte mit Hauptstraen", var => \$overview_draw{'s'}],
	 ['coloring','=s','red',
	  label => M"Einfrben der Route", var => \$coloring,
	  choices => [qw(red blue black power wind)]],
	 ['handheld','!',undef,
	  label => M"Handheld", var => \$is_handheld],

	 M"GUI",
	 ['menu','!',1,	# XXX hier stand mal "menu|stdmenu|standardmenu" => aber Aliase werden anscheinend von Tk::GetOpt nicht untersttzt?!
	  label => M"Standard-Men", var => \$standard_menubar],
	 ['balloon','!',1,
	  label => M"Balloons", var => \$use_balloon],
	 ['cballoon','!',2,    # 0 = nie, 1 = auf der Route, 2 = immer
	  label => M"Canvas balloons", var => \$use_c_balloon],
	 ['cballoonwait','=i',350,
	  label => M"Wartezeit fr Canvas balloons", var => \$c_balloon_wait],
	 ['flat','!',1,
	  label => M"Flaches Relief", var => \$flat_relief],
	 ['contexthelp','!',1,
	  label => M"Kontextsensitive Hilfe", var => \$use_contexthelp],
	 ['rightispopup','!',1,
	  label => M"Popup-Men rechts", var => \$right_is_popup],
	 ['smoothscroll','!',0,
	  label => M"Weiches Scrollen", var => \$use_smooth_scroll],
	 ['followmouse','!',0,
	  label => M"Kartenausschnitt folgt Cursor", var => \$followmouse],
	 ['dialog','!',1,
	  label => M"Verwendung von Dialog-Fenstern", var => \$use_dialog],
	 ['transient','!',1,
	  label => M"Transiente Fenster", var => \$transient,
	  longhelp => M('Verwendung von transienten Fenster oder "Toolwindows"')],
	 ($os eq 'unix' ?
	  ['pathentrydialog','!',undef, nogui => 1,
	   label => M"Alternative Dateiauswahl verwenden",
	   var => sub {
	       if (1) {	# XXX determine current value --- Tk::GetOpt update necessary
		   eval 'use Tk::PathEntry::Dialog qw(as_default)';
	       } else {
		   eval 'use Tk::FBox qw(as_default)';
	       }
	       warn $@ if $@;
	   },
	  ] : ()),		# do not change dialog on Windows
	 ['askquit','!',1,
	  label => M"vor Beenden fragen", var => \$ask_quit],
	 ['b2mode','=i',B2M_FASTSCAN, nogui => 1,
	  var => \$b2_mode],
	 ['autoscroll','!',undef, # XXX make nogui => 0, choices!
	  label => M"Autoscrolling", nogui => 1, var => sub { $b2_mode = B2M_AUTOSCROLL }],
	 ['autoscrollspeed','=s','normal',
	  choices => [qw(slow normal fast)],
	  label => M"Autoscrolling-Geschwindigkeit", var =>   \$autoscroll_speed],
	 ['autoscrollmiddle','!',undef,
	  label => M"Autoscrollpunkt in der Mitte", var =>   \$autoscroll_middle],
	 ['focuspolicy','=s',undef,
	  label => M"Focus-Policy",
	  longhelp => 'click:'.M("Click-to-focus")."\n".
	  'follow:'.M("Focus-follows-mouse")."\n",
	  var => \$focus_policy,
	  choices => [qw(click follow)],
	 ],

	 M"Suchoptionen",
	 ['qualitaetoptimierung','!',0,
	  label => M"Straenqualitt beachten", var => \$qualitaet_s_optimierung],
	 ['qualitaetwerte','!',{Q0 => 100,
				Q1 => 25,
				Q2 => 18,
				Q3 => 13},
	  label => M"Straenqualitt konfigurieren", var => \%qualitaet_s_speed,
	  nogui => 1],		# XXX Tk::Getopt can't handle this yet
	 ['kategorieoptimierung','!',0,
	  label => M"Straenkategorien beachten", var => \$strcat_optimierung],
	 ['kategoriewerte','!',{B  => 100,
				HH => 100,
				#BAB => 100,
				H  => 100,
				N  => 100,
				NN => 100},
	  label => M"Straenkategorien konfigurieren", var => \%strcat_speed,
	  nogui => 1],		# XXX Tk::Getopt can't handle this yet
	 ['radwegeoptimierung','!',0, var => \$radwege_optimierung,
	  label => M"Radwege-Optimierung"],
	 ['N_RW_optimization', '!', 0, var => \$N_RW_optimization, nogui => 1],
	 ['greenoptimierung', '=i', 0, choices => [0,1,2],
	  longhelp => "0: ".M("egal")."\n".
	  "1: ".M("bevorzugen")."\n".
	  "2: ".M("stark bevorzugen")."\n",
	  label => M"Grne Wege bevorzugen", var => \$green_optimization,
	 ],
	 ['unbeleuchtetoptimierung', '!', 0, var => \$unlit_streets_optimization,
	  label => M"Unbeleuchtete Straen meiden"],
	 ['steigungoptimierung', '!', 0, var => \$steigung_optimierung,
	  label => M"Steigungsoptimierung"],
	 ['handicapoptimierung','!',0,
	  label => M"Sonstige Beeintrchtigungen beachten", var => \$handicap_s_optimierung],
	 ['handicapwerte','!',{q0 => 100,
			       q1 => 25,
			       q2 => 18,
			       q3 => 13,
			       q4 => 5, # z.B. Fugngerzonen
			      },
	  label => M"Sonstige Beeintrchtigungen konfigurieren", var => \%handicap_s_speed,
	  nogui => 1],		# XXX Tk::Getopt can't handle this yet
	 ['sperre','!',undef,		alias => [qw(gesperrt)],
	  label => M"Gesperrte Straen beachten", nogui => 1,
	  var => sub {
	      $sperre{'einbahn'} = $sperre{'sperre'} = $sperre{'wegfuehrung'} = 1;
	  },
	  savevar => \$sperre{'einbahn'},
	 ],
	 ['einbahn-strict','!',undef,
	  label => M"Alle Einbahnstraen *strikt* beachten", nogui => 1,
	  var => sub {
	      $sperre{'einbahn-strict'} = 1;
	  },
	  savevar => \$sperre{'einbahn-strict'},
	 ],
	 ['nichttragen','!',0,
	  label => M"Tragen strikt vermeiden", var => \$sperre{'tragen'}],
	 ['tempblockings','!',0,
	  label => M"Temporre Sperrungen verwenden", var => \$do_activate_temp_blockings],
	 ['ampeloptimierung','!',0,
	  label => M"Ampeloptimierung verwenden", var => \$ampel_optimierung],
	 ['beschleunigung','=f',1,
	  label => M"Beschleunigung (m/s^2)", var => \$beschleunigung],
	 ['wind','!',1,
	  label => M"Windgeschwindigkeit beachten", var => \$want_wind],
	 ['faehre','!',0,
	  label => M"Fhren verwenden", var => \$use_faehre],
	 ['bikepwr','!',1,	alias => [qw(bikepower)],
	  label => M"Bikepower verwenden", var => \$bikepwr],
	 ['resetpower','!',undef, nogui => 1, var => sub { @power = () }],
	 ['power','=i@',undef, nogui => 1, var => \@power], # XXX gui => 1
	 ['resetspeed','!',undef, nogui => 1, var => sub { @speed = () }],
	 ['speed','=i@',[qw(15 20)], nogui => 1, var => => \@speed], # XXX gui => 1
	 ['speedpowerreference','=s',undef, nogui => 1, var => \$speed_power_reference_string],
	 ['from','=s',undef, nogui => 1, -var => \$init_from],
	 ['to','=s',undef, nogui => 1, -var => \$init_to],

	 M"WWW",
	 ['www','!',0, # 1, wenn Wetterdaten vom Web geholt werden sollen
	  label => M"WWW verwenden", var => \$do_www],
	 ['wwwmap','!',undef,
	  label => M"Karten bers WWW holen", var => \$do_wwwmap],
	 ['wwwcache','!',0,
	  label => M"Cache fr WWW-Karten verwenden", var => \$use_wwwcache],
	 ['cachedir','=s',undef,
	  label => M"Cacheverzeichnis", subtype => 'dir',
	  var => \$cache_root],
	 ['wwwslow','!',1,
	  label => M"WWW ist langsam", var => \$www_is_slow],
	 ['proxy','=s',undef,
	  label => M"HTTP-Proxy (Format: http://host:port/)", var => \$proxy],

	 M"GPS",
	 ['exporttxtmode','=i',EXPORT_TXT_SIMPLIFY_AUTO,
	  label => M"Vereinfachung von Routen",
	  longhelp => M"GPS-Gerte knnen nur eine begrenzte Anzahl von Waypoints pro Route verwenden.
Eine von BBBike berechnete Route erzeugt meist mehr Waypoints.
Mit dieser Option kann eingestellt werden, welche Strategie
dazu verwendet wird",
	  choices => [[M("Komplette Route"), EXPORT_TXT_FULL],
		      [M("Unterschiedliche Straennamen"), EXPORT_TXT_SIMPLIFY_NAME],
		      [M("Abbiegevorgnge"), EXPORT_TXT_SIMPLIFY_ANGLE],
		      [M("Abbiegevorgnge/unterschiedliche Straennamen"), EXPORT_TXT_SIMPLIFY_NAME_OR_ANGLE],
		      [M("automatisch"), EXPORT_TXT_SIMPLIFY_AUTO],
		     ],
	  strict => 1,
	  var =>  \$export_txt_mode],
	 ['exporttxtminangle','=s',30,
	  choices => [5,15,30,45,60],
	  label => M"Minimalwinkel bei Route-Vereinfachung",
	  longhelp => M"Minimalwinkel in Grad bei der Vereinfachung von Routen\n",
	  var => \$export_txt_min_angle],
	 ['gpswaypoints','=i',50,
	  choices => [20,50],
	  label => M"Maximale Anzahl der GPS-Waypoints",
	  longhelp => M"Moderne Garmin-Gerte knnen 50 Waypoints pro Route verwenden,\nwhrend ltere nur 20 Waypoints laden knnen\n",
	  var => \$gps_waypoints,
	 ],
	 ['gpsdevice','=s',($os eq 'win' ? "COM1" : ($os_bsd ? '/dev/cuaa0' : '/dev/ttyS0')),
	  choices => (  $os eq 'win' ? [map {  "COM$_" 			       } (1..4) ]
		      : $os_bsd      ? [map {  "/dev/cuaa$_"		       } (0..3) ]
		      :                [map { ("/dev/ttyS$_", "/dev/ttyUSB$_") } (0..3) ]
		     ),
	  label => M"GPS-Device", var => \$gps_device],

	 M"Sonstiges",
	 ['kde','!',undef,
	  label => M"Fr KDE optimieren", var => \$run_under_kde],
	 ['coordout','=s','standard',
	  label => M"Koordinatenausgabe", var => \$coord_output],
	 ['printcmd','=s',undef,
	  label => M"Druckerkommando", var => \$print_cmd],
	 ['printbackend','=s',undef,
	  label => M"Druck-Backend", var => \$print_backend,
	  choices => ["", qw(ps pdf)],
	 ],
	 ['ps_fixed_font','=s',"Courier7",
	  label => M"Druckerzeichensatz (fixed)", var => \$ps_fixed_font],
	 ['mapcolor','=s','color',
	  choices => [qw(mono pixmap gray color)],
	  label => M"Farbeinstellung beim Drucken", var => \$map_color],
	 ['gvreuse','!',0,	# 1: alten gv-Prozess wiederverwenden
	  label => M"GV-Fenster wiederverwenden", var => \$gv_reuse],
	 ['server','!',undef,
	  label => M"Server-Modus", var => \$use_server],
	 ['autosave','!',1,
	  label => M"Speichern beim Beenden", var => \$autosave_opts],
	 ['environment','=s','normal',
	  # "novacom" (fr GDF-Daten als Standard)
	  # "onlineoffice" (fr Onlineoffice-Prsentationen)
	  nogui => 1, var => \$environment],
	 ['mldbm','!',0,
	  label => M"Verwendung von MLDBM",
	  longhelp => M"Die interne Straennetz-Struktur wird als MLDBM-Hash
auf der Festplatte statt im RAM gehalten. Langsamer, aber
speicherplatzsparender.",
	  var => \$use_mldbm],
	 ['palmdocfmt','=s','isilo',
	  choices => [qw(isilo pdbdoc)],
	  label => M"Palm-Doc-Format", var => \$palm_doc_format],
	 ['usexwd','!',undef,
	  label => M"xwd als Screengrabber", var => \$use_xwd_if_possible],

	 M"Advanced",
	 ['edit','!',undef,
	  label => M"Editmodus beim Starten",
	  nogui => 1,		# XXX remove some day?
	  var => sub {
	      $set_mode = "edit";
	  }
	 ],
	 ['stderr','!',0,
	  label => M"Fehlerausgabe auf stderr", var => \$stderr],
	 ['stderrwindow','!',undef,
	  label => M"STDERR in ein Fenster", var => \$stderr_window],
	 ['autoinstall','!',0,
	  label => M"Auto-Installation vom CPAN (experimentell!)", var => \$auto_install_cpan],
	 ['pp','!',0,
	  label => M"Kurvenpunkte und Kreuzungen zeichnen", var => \$init_p_draw{'pp'}],
	 ['advanced','!',undef, var => \$advanced,
	  label => M"Advanced mode"],
	 ['public','!',undef, nogui => 1,
	  var => sub { $public_test = 1;
		       $advanced = 0;
		       $devel_host = 0;
		       $do_www = 0;
		       $no_map = 1;
		       $public = 1;
		       $autosave_opts = 0;
		       $lazy_plot = 0;
		       undef $proxy;
		   }],
	 ['v','!',0,	alias => [qw(verbose)],
	  label => M"Verbose", var => \$verbose],
	 ['version','!',undef,
	  nogui => 1, var => sub {
	      print
		  "$progname $VERSION\n(file revision $PROG_REVISION)\n",
		      "perl $]\nTk $Tk::VERSION\n";
	      exit 0;
	  }],
	 ['plugins','=s',undef,
	  label => M"Plugins beim Starten laden", var => \$initial_plugins,
	  longhelp => M"Kommaseparierte Liste von Plugins, z.B. BBBikeThunder,BBBikeSalesman,BBBikeRuler"],
	 ['layers','=s',undef,
	  label => M"Zustzliche Layer zeichnen", var => \$initial_layers],
	 ['algorithm','=s','A*', var => \$global_search_args{Algorithm},
	  longhelp => M"Nur A* (Perl-Implementation) und C-A* (C-Implementation) sind von Interesse",
	  choices => ['A*', 'C-A*', ($devel_host||$advanced ? ("C-A*-2", 'srt') : ())],
	  label => M"Suchalgorithmus",
	  strict => 1],
	 ['h','!',undef, nogui => 1, alias => [qw(help)],
	  var => sub {
	      if ($opt) {
		  print STDERR $opt->usage;
	      } else {
		  die M"Usage?";
	      }
	      exit(0);
	  }],
	 ['nosplash','!',undef, nogui => 1], # pseudo option, handled at BEGIN
	);

    eval {
	require Tk::Getopt;
	Tk::Getopt->VERSION(0.50);
    };
    if ($@) {			# XXX
	die "Please report to author: use opttable_to_getopt!!!! XXX";
	warn __LINE__ . ": $@" if $verbose;
	my @getopt_list;
	foreach (@getopt) {
	    push @getopt_list, $_ unless /^=/;
	}
	# XXX '@' geht nur mit Getopt::Long
	push @getopt_list, 'power=i@' => \@power, 'speed=i@' => \@speed;
	require Getopt::Long;
	#XXX X11-Optionen durchschleifen...
	#    if (!Getopt::Long::GetOptions(@getopt_list)) { usage('', \@getopt_list) }
	Getopt::Long::config('pass_through');
	Getopt::Long::GetOptions(@getopt_list);
	#XXX    if (!GetOptions(@getopt_list)) { usage('', \@getopt_list) }
    } else {
	$Tk::Getopt::x11_pass_through = 1;
	$opt = new Tk::Getopt(-opttable => \@opttable,
			      -filename => catfile($bbbike_configdir, "config"),
			     );
	$opt->set_defaults;
	pre_check_arguments();
	$opt->load_options unless $public; # force defaults
	if (!$opt->get_options) {
	    print $opt->usage;
	    exit 1;
	}
	$opt->process_options;
    }
    Tk::CmdLine::SetArguments(); # XXX here correct position?
    if (@ARGV) {
	require Getopt::Long;
	Getopt::Long::config('nopass_through');
	Getopt::Long::GetOptions() or die;
    }
}

# Check for -public option --- in this case do not load the config file.
sub pre_check_arguments {
    foreach my $arg (@ARGV) {
	if ($arg eq '-public') {
	    $public = 1;
	    last;
	}
    }
}

# For binding plain keybindings without modifiers
sub bind_nomod {
    my($top, $ev, $cb) = @_;
    $top->bind
	($ev, sub {
	     my $w = shift;
	     my $e = $w->XEvent;
	     # auf Alt, Control und CapsLock checken
	     # bei Win95/NT ist 8 nicht CapsLock, sondern NumLock
	     if ($Tk::VERSION < 800) {
		 return if $e->s & (1+($os eq 'win' ? 0 : 8)); # XXX control is missing ... 4? 2 ist Shift?
	     } else {
		 return if $e->s =~ /\b(Alt|Lock|Control)-/;
	     }
	     $cb->($w, @_);
	 });
}

# km <=> m
sub change_unit {
    $unit_km = ($unit_km eq 'km' ? 'm' : 'km');
    updatekm();
}

sub standard_selection_handle {
    $c->SelectionHandle
	(sub {
	     my($offset, $maxbytes) = @_;
	     my($inslauf) = join(" ", @inslauf_selection);
	     substr($inslauf, $offset, $maxbytes);
	 });
}

sub load_photos {
    $flag_photo{'start'} = load_photo($top, 'flag2_bl_centered.' . $default_img_fmt);
    $flag_photo{'via'}   = load_photo($top, 'flag_via_centered.' . $default_img_fmt);
    $flag_photo{'ziel'}  = load_photo($top, 'flag_ziel_centered.' . $default_img_fmt);
    $ampel_photo         = load_photo($top, 'ampel.' . $default_img_fmt);
    $ampel_klein2_photo  = load_photo($top, 'ampel_klein2.' . $default_img_fmt);
    $ampelf_photo        = load_photo($top, 'ampelf.' . $default_img_fmt);
    $ampelf_klein_photo  = load_photo($top, 'ampelf_klein.' . $default_img_fmt);
    $ampelf_klein2_photo = load_photo($top, 'ampelf_klein2.' . $default_img_fmt);
    $andreaskr_klein_photo = load_photo($top,
					'andreaskr_klein.' . $default_img_fmt);
    $andreaskr_klein2_photo= load_photo($top,
					'andreaskr_klein2.' . $default_img_fmt);
    $andreaskr_photo     = load_photo($top, 'andreaskr.' . $default_img_fmt);
    $vorfahrt_photo      = load_photo($top, 'vorfahrt.' . $default_img_fmt);
    $vorfahrt_klein_photo= load_photo($top, 'vorfahrt_klein.' . $default_img_fmt);
    $windrose2_photo     = load_photo($top, 'windrose2.' . $default_img_fmt);
    $kneipen_photo       = load_photo($top, 'glas.' . $default_img_fmt);
    $kneipen_klein_photo = load_photo($top, 'glas_klein.' . $default_img_fmt);
    $essen_photo         = load_photo($top, 'essen.' . $default_img_fmt);
    $essen_klein_photo   = load_photo($top, 'essen_klein.' . $default_img_fmt);
    $kino_klein_photo    = load_photo($top, 'kino_klein.' . $default_img_fmt);
    $steigung_photo      = load_photo($top, 'steigung.' . $default_img_fmt);
    $gefaelle_photo      = load_photo($top, 'gefaelle.' . $default_img_fmt);
    $inwork_photo        = load_photo($top, 'inwork.' . $default_img_fmt);
    $ferry_photo         = load_photo($top, 'ferry.' . $default_img_fmt);
    $ferry_klein_photo   = load_photo($top, 'ferry_klein.' . $default_img_fmt);
    $zugbruecke_photo    = load_photo($top, 'zugbruecke.' . $default_img_fmt);
    $zugbruecke_klein_photo
	= load_photo($top, 'zugbruecke_klein.' . $default_img_fmt);
#XXX not yet necessary:
#    $blocked_photo       = load_photo($top, 'redcross.' . $default_img_fmt);
}

sub set_default_geometry {
    if (defined $Plugin::brinfo{x_len} and
	defined $Plugin::brinfo{y_len}) {
	$top->geometry($Plugin::brinfo{x_len} . "x" . $Plugin::brinfo{y_len});
    } else {
	if ($geometry && !$open_maximized) {
	    @want_extends = parse_geometry_string($geometry);
	    if (!$want_extends[GEOMETRY_WIDTH] || !$want_extends[GEOMETRY_HEIGHT]) { # test on 0 or undef
		($want_extends[GEOMETRY_WIDTH], $want_extends[GEOMETRY_HEIGHT]) =
		    ($top->screenwidth, $top->screenheight);
	    }
	    if (!defined $want_extends[GEOMETRY_X] || !defined $want_extends[GEOMETRY_Y]) {
		($want_extends[GEOMETRY_X], $want_extends[GEOMETRY_Y]) = (0, 0);
	    }
	} else {
	    @want_extends = (0, 0, $top->screenwidth, $top->screenheight);
	}
	if ($kde) {
	    @max_extends = $kde->client_window_region();
	} elsif ($os eq 'win') {
	    @max_extends = Win32Util::client_window_region($top);
	} else {
	    if ($top->property("exists", "_NET_CURRENT_DESKTOP", "root") &&
		$top->property("exists", "_NET_WORKAREA", "root")) {
		(undef, my $desktop) = $top->property("get", "_NET_CURRENT_DESKTOP", "root");
		if (defined $desktop) {
		    my @vals = ($top->property("get", "_NET_WORKAREA", "root"))[$desktop*4+1 .. $desktop*4+4];
		    if (@vals && defined $vals[0]) {
			@max_extends = @vals;
		    }
		}
		$max_extends[2]-=10; # XXX
		$max_extends[3]-=24;
	    }
	}
	if (!@max_extends) {
	    # XXX guess width/height of wm borders and title bar
	    @max_extends = (0, 0, $top->screenwidth-10, $top->screenheight-24);
	}
	if ($exceed) {
	    $max_extends[GEOMETRY_HEIGHT] -= 35; # possible task bar --- but what to do if the taskbar is not at the standard location or has more than one row?
	}

	crop_geometry(\@want_extends, \@max_extends);
    }
}


# after geometry processing
sub geometry_dependent_settings {
    my $win_width = @want_extends ? $want_extends[GEOMETRY_WIDTH] : $top->width;
    my $win_height = @want_extends ? $want_extends[GEOMETRY_HEIGHT] : $top->height;
    if ($win_width <= 320 || $win_height <= 320 || $is_handheld) {
	$small_icons = 1;
	$standard_menubar = 0;
	set_canvas_scale(DEFAULT_SMALL_SCALE);
    }
    if ($is_handheld) {
	$use_balloon = 0;
	$use_c_balloon = 0;
	$use_contexthelp = 0;
	$right_is_popup = 0;
	$followmouse = 0;
	$b2_mode = B2M_NONE;
    }
}

sub define_item_attribs {
# grey99 wird als Wei-Ersatz verwendet (damit die Postscript-Umwandlung
# besser funktioniert)
# grey98 ebenfalls, aber wenn Outlines eingeschaltet sind, dann wird
# diese Farbe nach Wei umgewandelt.
# white wird berall dort verwendet, wo eine andere Hintergrundfarbe an der
# Stelle definiert ist, z.B. beim U-Bahn-Symbol oder in der Legende
    %category_color =
	('N'  => 'grey98',
	 'NN' => '#bdffbd',
	 'H'  => '#ffffa0', 	# blassgelb
	 'HH' => '#fff800', 	# krftiges gelb
	 'BAB' => 'DarkBlue',
	 'B'  => 'red3',
	 # zweiter (pragmatischer) Versuch einer Qualittskategorisierung
	 # sehr guter Asphalt = guter Asphalt (genauere Kategorisierung nicht
	 # erforderlich)
	 # sehr gutes Kopfsteinpflaster = guter Asphalt		Q0
	 # gutes Kopfsteinpflaster      = miger Asphalt	Q1
	 # miges Kopfsteinpflaster    = schlechter Asphalt	Q2
	 # schlechtes Kopfsteinpflaster				Q3
	 'Q0' => 'DarkSeaGreen4',
	 'Q1' => 'YellowGreen',
	 'Q2' => 'gold',
	 'Q3' => 'red',
	 # sonstige Beeintrchtigungen, die nicht auf schlechte Qualitt zurckzufhren
	 # sind und nur die Geschwindigkeit reduzieren. Geschwindigkeitsreduktion
	 # wie bei Q.
	 'q0' => 'DarkSeaGreen4',
	 'q1' => 'YellowGreen',
	 'q2' => 'gold',
	 'q3' => 'red',
	 'q4' => '#c00000',
	 # sonstiges
	 'SA' => 'green3',	# S-Bahn, Zone A
	 'SB' => 'green3',	# S-Bahn, Zone B
	 'SC' => '#008000', 	# S-Bahn, Zone C
	 'S0' => '#a0b0a0', 	# stillgelegte S-Bahn bzw. in Bau
	 ## neues Farbschema an DB-Farben orientiert
	 ## nicht gut, da nicht gut von Bundesstraen unterscheidbar
	 #     'RA' => '#bb171d',  # R-Bahn, Zone A
	 #     'RB' => '#bb171d',  # R-Bahn, Zone B
	 #     'RC' => '#bb171d', # R-Bahn, Zone C
	 #     'R'  => '#bb171d', # R-Bahn, auerhalb
	 #     'R0' => '#d0c0c0', # stillgelegte R-Bahn bzw. in Bau
	 ## altes Farbschema
	 'RA' => 'green3',	# R-Bahn, Zone A
	 'RB' => 'green3',	# R-Bahn, Zone B
	 'RC' => '#008000', 	# R-Bahn, Zone C
	 'R'  => '#006400', 	# R-Bahn, auerhalb
	 'R0' => '#a0b0a0', 	# stillgelegte R-Bahn bzw. in Bau
	 'U'  => '#000080', 	# U-Bahn
	 'UA' => '#000080', 	# U-Bahn, Zone A
	 'UB' => '#000080', 	# U-Bahn, Zone B
	 'U0' => '#a0a0b0', 	# U-Bahn in Bau
	 'W'  => '#bad5f7', 	# Gewsser
	 'WR' => '#404080',	# Wasserrouten
	 'P'  => '#76c48b', 	# Parks
	 '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
	 'Ae' => 'white',	# Flughfen
	 'F'  => 'grey99',	# sonstige Flchen
	 'SW' => 'red',		# Sehenswrdigkeit
	 'Q'  => 'grey99',	# Fhre
	 'I'  => 'grey85',	# Inseln (wird spter berschrieben)
	 'Z'  => 'black',	# PLZ-Grenzen

	 'RW1' => 'SlateBlue',	# siehe Radwege.pm
	 'RW2' => '#00008b',   	# DarkBlue ist in der Win-Version undefiniert
	 'RW3' => 'LightBlue',
	 'RW4' => 'green',
	 'RW5' => 'orange',
	 'RW6' => 'yellow3',
	 'RW7' => 'green',
	 'RW8' => '#000060',
	 'RW9' => 'SlateBlue',
	 'RW10' => 'green',
	 'RW'  => 'SlateBlue',

	 'sperre0' => 'red',	# Tragen
	 'sperre1' => 'blue',	# Einbahnstraen
	 'sperre1s' => '#b0b0ff',  # Einbahnstraen (nur mit "einbahn-strict")
	 'sperre2' => 'red',	# voll gesperrt
	 'sperre3' => 'red',	# Wegfhrung gesperrt

	 'IN' => 'violet',	# Industrieanlagen
	 'HB' => 'DarkViolet',	# Hafenanlagen
	 'BU' => '#c08080',    	# Built-up areas
	 'FO' => '#46b47b',    	# Wlder
	 'MO' => '#008080',    	# Moor

	 '?'  => '#9f0000',
	 '??' => '#8b0000', 	# DarkRed, bei Win undefiniert
	 '?p' => '#af0000',
	 'GPS' => 'red',	# GPS Relation
	 'GPSs'   => "#c000c0",  # GPS street
	 'GPSs~'  => "#f4c0f4",  # inaccurate
	 'GPSs~~' => "#e4c8e4",  # even more inaccurate
	 'GPSs?'  => "#303030",  # unsure
	 'GPSp'   => "#0000a0",  # GPS point
	 'GPSp~'  => "#c0c0b0",  # GPS point
	 'GPSp~~' => "#c8c8c0",  # GPS point
	 'GPSp?'  => "#303030",  # unsure

	 'CP' => '#a000a0',
	 'CP2'=> '#a000a0',
	 'CS' => '#a000a0',
	 'St' => '#b00080',
	 'Gf' => '#c00080',
	 'PI' => '#a000a0',
	 'P0' => '#a000a0',

	 '-2' => '#008000', # (relativ) verkehrsarme Strae
	 '-1' => '#00c000',
	 '+1' => '#c00000',
	 '+2' => '#800000', # (relativ) verkehrsreiche Strae

	 'green1' => '#7fbb7f',
	 'green2' => '#008b00',

	 'X' => "red", # fallback color
	);
    %category_font_color =
	(
	 'W'  => '#2a45b7',
	 'U'  => '#000060',
	 'S'  => '#006000',
	 'R'  => '#006000', 	# altes Farbschema
	 #   'R'  => '#a00000',# neues Farbschema
	);
    for (qw(UA UB U0)) { $category_font_color{$_} = $category_font_color{"U"} }
    for (qw(SA SB SC S0)) { $category_font_color{$_} = $category_font_color{"S"} }
    for (qw(RA RB RC R0)) { $category_font_color{$_} = $category_font_color{"R"} }
    %category_font =
	(
	 'W'  => 'helvetica %d italic',
	 'P'  => 'helvetica %d',
	 'Ae' => 'helvetica %d',
	);
    for (qw(Forest Forestabove Pabove Cemetery Orchard Green Sport Industrial)) { 
	$category_font{$_} = $category_font{'P'};
    }

    $pp_color = '#008000';

    for my $nr (0, 1, 2) {
	$category_color{'W' . $nr}      = $category_color{'W'};
	$category_font_color{'W' . $nr} = $category_font_color{'W'};
	$category_font{'W' . $nr}       = $category_font{'W'};
    }
    # fallback, falls kein %category_color definiert ist
    %str_color =
	('s'   => 'yellow',
	 'L'   => 'red',
	 'qs'  => 'red',
	 'ql'  => 'red',
	 'hs'  => 'red',
	 'hl'  => 'red',
	 'nl'  => 'black',
	 'gr'  => 'green',
	);
    %p_color =
	();

    %category_image =
	('bg'  => "behindertengerecht.gif",
	 'bf'  => "behindertenfreundlich.gif",
	);

    %category_stipple =
	('Cemetery' => 'crosses.xbm');

    %line_width =
	('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],
	 'sBAB-BAB' => [1, 2, 3, 4, 6, 10],
	 's-N'      => [1, 1, 2, 2, 4, 7],
	 's-NN'     => [1, 1, 2, 2, 4, 7],
	 'comm'     => [1, 2, 3, 4, 6, 10],
	 'mount'    => [1, 2, 3, 4, 6, 10],
	 'qs'       => [3, 4, 5, 6, 8, 12],
	 'hs'       => [3, 4, 5, 6, 8, 12],
	 'temp_sperre_s' => [5, 6, 7, 8, 10, 14],
	 'rw'       => [1, 2, 3, 4, 6, 10],
	 'l'        => [2, 2, 3, 4, 6, 10],
	 'gr'       => [5, 7, 8, 9, 10, 14], # s-H + 4 pixels
	 'ql'       => [3, 4, 5, 6, 8, 12],
	 'hl'       => [3, 4, 5, 6, 8, 12],
	 'z'        => [1, 1, 2, 3, 5, 8],
	 'g'        => [1, 2, 3, 4, 6, 10],
	 'e'        => [1, 2, 3, 4, 6, 10],
	 #   'sperre0'  => [3, 5, 7, 9, 11,15],
	 'sperre0'  => [1, 2, 2, 2, 3, 3],
	 'sperre1'  => [0, 0, 2, 3, 4, 6],
	 'sperre2'  => [0, 0, 2, 3, 5, 8],
	 'sperre3'  => [0, 0, 1, 2, 4, 6],
	 'w'        => [1, 1, 2, 2, 4, 7],
	 'w-W0'     => [0, 1, 1, 1, 3, 5],
	 'w-W1'     => [2, 2, 3, 5, 7, 11],
	 'w-W2'     => [3, 4, 6, 8, 10,13],
	 'default'  => [1, 2, 3, 4, 6, 10],
	);
    foreach (qw/H HH B BAB N NN/) {
	$line_width{"l-$_"} = [@{ $line_width{"s-$_"}}];
    }
    foreach (qw/sperre1s/) {
	$line_width{$_} = [@{ $line_width{"sperre1"}}];
    }
    foreach (qw/gP gD/) {
	$line_width{$_} = [@{ $line_width{"g"}}];
    }
    foreach (@comments_types) {
	$line_width{"comm-".$_} = [@{ $line_width{"comm"}}];
    }

    %line_dash =
	('qs'   => [5,2],
	 'ql'   => [5,2],
	 'hs'   => [2,5],
	 'hl'   => [2,5],
	 'temp_sperre_s' => [2,5],
	 'nl'   => [2,4],
	 'comm' => [5,2],
	 'mount'=> [5,2],
	 'e'    => [5,2],	# Fhren
	 'g'    => [8,5,2,5],	# Grenzen
	 'z'    => [8,5,2,5],	# PLZ-Grenzen
	 'sperre3' => [6,2],
	 'fz'   => [8,5],
	 'Tu'   => [2,5],	# Tunnel (addinfo)
	);
    foreach (qw/gP gD/) {
	$line_dash{$_} = [@{ $line_dash{"g"}}];
    }
    foreach (@comments_types) {
	$line_dash{"comm-".$_} = [@{ $line_dash{"comm"}}];
    }

    %line_length =
	('sperre1'  => [0, 0, 4, 5, 7, 10],
	 'sperre2'  => [0, 0, 3, 4, 6, 8],
	 'default'  => [2, 3, 4, 5, 7, 10],
	);
    foreach (qw/sperre1s/) {
	$line_length{$_} = [@{ $line_length{"sperre1"}}];
    }

    %line_arrow =
	('PI' => 'last',
	 'P0' => 'last',
	);
    %line_shorten =
	('CP'  => 1,
	 'CP2' => 1,
	 'P0'  => 1,
	 'PI'  => 1,
	);
    # Label size per category
    %category_size =
	('N'  => 8,
	 'NN' => 7,
	 'H'  => 10,
	 'HH' => 10,
	 'B'  => 10,
	 'BAB'=> 10,
	 'W'  => 12);
    %outline_color =
	('s' => 'grey70',
	 'l' => 'grey70',
	 'w' => 'blue4',
	 'i' => 'blue4',
	);
    %str_file =
	('s'  => 'strassen',
	 'l'  => 'landstrassen', # this is really scoped
	 'u'  => 'ubahn',
	 'b'  => 'sbahn',
	 'r'  => 'rbahn',
	 'w'  => 'wasserstrassen', # this is really scoped
	 'f'  => 'flaechen',
	 'v'  => 'sehenswuerdigkeit',
	 'z'  => 'plz',
	 'g'  => 'berlin',
	 'gP' => "potsdam",
	 'gD' => "deutschland",
	 'e'  => 'faehren',
	 'rw' => 'radwege',
	 'qs' => 'qualitaet_s',
	 'ql' => 'qualitaet_l',
	 'hs' => 'handicap_s',
	 'hl' => 'handicap_l',
	 'nl' => 'nolighting',
	 'gr' => 'green',
	 'comm' => 'comments', # this is splitted into multiple files
	 'mount' => 'mount',
	 'fz' => "fragezeichen",
	 'wr' => "wasserrouten",
	);
    foreach my $type (@comments_types) {
	$str_file{"comm-$type"} = "comments_$type";
    }
    if ($devel_host) {
	$str_file{"is"} = "$FindBin::RealBin/projects/infrasystem/data/landstrassen-corrected";
    }
    %p_file =
	('lsa'    => 'ampeln',
	 'u'      => 'ubahnhof',
	 'u_bg'   => 'ubahnhof_bg',
	 'b'      => 'sbahnhof',
	 'b_bg'   => 'sbahnhof_bg',
	 'r'      => 'rbahnhof',
	 'o'      => 'orte',	# XXX scoped
	 'sperre' => $sperre_file,
	 'sperre_u' => 'gesperrt_u',
	 'sperre_b' => 'gesperrt_s',
	 'sperre_r' => 'gesperrt_r',
	 'obst'   => 'obst',
	 'pl'     => 'plaetze',
	 'vf'     => 'vorfahrt',

	 'kn'     => 'kneipen',
	 'ki'     => 'kinos',
	 'rest'   => 'restaurants',
	);

    # Feld-Elemente
    # 0: Bezeichnung, Singular
    # 1: Bezeichnung, Plural
    # 2: Linien (bool)
    # 3: (falls vorhanden) lange Bezeichnung
    %str_attrib =
	('s' => [M"Strae",      M"Straen",      0],
	 'l' => [M"Landstrae",  M"Landstraen",  0],
	 'u' => [M"U-Bahnlinie", M"U-Bahnlinien", 1],
	 'b' => [M"S-Bahnlinie", M"S-Bahnlinien", 1],
	 'r' => [M"R-Bahnlinie", M"R-Bahnlinien", 1],
	 'w' => [M"Gewsser",    M"Gewsser",     0],
	 'f' => [M"Flche",      M"Flchen",      0],
	 'v' => [M"Sehenswrdigkeit", M"Sehenswrdigkeiten",      0],
	 'z' => [M"PLZ-Gebiet",  M"PLZ-Gebiete",  0],
	 'g' => [M"Grenze von Berlin", M"Grenze von Berlin",       0],
	 'gP' => [M"Grenze von Potsdam", M"Grenze von Potsdam",       0],
	 'gD' => [M"Staatsgrenze", M"Staatsgrenze",       0],
	 'e' => [M"Fhre",       M"Fhren",       0],
	 'rw' => [M"Radweg",     M"Radwege", 0],
	 'qs' => [M"Straenqualitt", M"Straenqualitt", 0],
	 'ql' => [M"Straenqualitt (Landstrae)", M"Straenqualitt (Landstrae)", 0],
	 'hs' => [M"Sonst. Beeintrchtigungen", M"Sonst. Beeintrchtigungen", 0],
	 'hl' => [M"Sonst. Beeintrchtigungen (Landstrae)", M"Sonst. Beeintrchtigungen (Landstrae)", 0],
	 'nl' => [M"Unbeleuchtete Strae", M"Unbeleuchtete Straen", 0],
	 'gr' => [M"Grner Weg", M"Grne Wege", 0],
	 'comm' => [M"Kommentare", M"Kommentare", 0],
	 # XXX specific comm types?
	 'mount' => [M"Steigung", M"Steigungen", 0],
	 'wr'   => [M"Wasserroute", M"Wasserrouten", undef],
	);
    %p_attrib =
	('lsa'  => [M"Ampel",       M"Ampeln",       undef],
	 'u'    => [M"U-Bahnhof",   M"U-Bahnhfe",   undef],
	 'u_bg' => [M"Fahrradfreundlicher Zugang (U-Bahn)",   M"Fahrradfreundliche Zugnge (U-Bahn)",   undef],
	 'b'    => [M"S-Bahnhof",   M"S-Bahnhfe",   undef],
	 'u_bg' => [M"Fahrradfreundlicher Zugang (S-Bahn)",   M"Fahrradfreundliche Zugnge (S-Bahn)",   undef],
	 'r'    => [M"R-Bahnhof",   M"R-Bahnhfe",   undef],
	 'r_bg' => [M"Fahrradfreundlicher Zugang (Regionalbahn)",   M"Fahrradfreundliche Zugnge (Regionalbahn)",   undef],
	 'o'    => [M"Ort",         M"Orte",         undef],
	 'p'    => [M"Haltestelle", M"Haltestellen", undef],
	 'obst' => [M"Obst",        M"Obst",         undef],
	 'pl'   => [M"Platz/Brcke",M"Pltze/Brcken",undef],
	 'vf'   => [M"Vorfahrt",    M"Vorfahrt",     undef],
	 'pp'   => [M"Kreuzung",    M"Kreuzungen",   undef],
	 'kn'   => [M"Kneipe",      M"Kneipen",      undef],
	 'ki'   => [M"Kino",        M"Kinos",        undef],
	 'rest' => [M"Restaurant",  M"Restaurants",  undef],
	 'hoehe' => [M"Hhenangabe", M"Hhenangaben",  undef],
	 'personal' => [M"Persnlicher Ort", M"Persnliche Orte",  undef],
	);
    %category_attrib =
	('UA' => [M"U-Bahn Zone A", undef, undef],
	 'UB' => [M"U-Bahn Zone B", undef, undef],
	 'SA' => [M"S-Bahn Zone A", undef, undef],
	 'SB' => [M"S-Bahn Zone B", undef, undef],
	 'SC' => [M"S-Bahn Zone C", undef, undef],
	 'RA' => [M"R-Bahn Zone A", undef, undef],
	 'RB' => [M"R-Bahn Zone B", undef, undef],
	 'RC' => [M"R-Bahn Zone C", undef, undef],
	 'R'  => [M"R-Bahn auerhalb Berlin ABC", undef, undef],
	 'HH' => [M"wichtige Hauptstrae", M"wichtige Hauptstraen", undef],
	 'B'  => [M"Bundesstrae", M"Bundesstraen", undef],
	 'H'  => [M"Hauptstrae", M"Hauptstraen", undef],
	 'N'  => [M"Nebenstrae", M"Nebenstraen", undef],
	 'NN' => [M"fr Kfz gesperrte Strae", M"fr Kfz gesperrte Straen", undef],
	 'BAB'=> [M"Autobahn", M"Autobahnen", undef],
	 'P'  => [M"Park", M"Parks", undef],
	 'Pabove' => [M"Park", M"Parks", undef],
	 'Forest' => [M"Wald", M"Wlder", undef],
	 'Forestabove' => [M"Wald", M"Wlder", undef],
	 'Cemetery' => [M"Friedhof", M"Friedhfe", undef],
	 'Green' => [M"Grnanlage", M"Grnanlagen", undef],
	 'Orchard' => [M"Kleingrten", M"Kleingrten", undef],
	 'Sport' => [M"Sportanlage", M"Sportanlagen", undef],
	 'Industrial' => [M"Industriegebiet", M"Industriegebiete", undef],
	 'Ae' => [M"Flughafen", M"Flughfen", undef],
	 'F'  => [M"Flughafen", M"Flughfen", undef],
	 'Q0' => [M"sehr guter Belag", undef, undef,
		  M"sehr guter Belag (Asphalt)"],
	 'Q1' => [M"guter Belag", undef, undef,
		  M"guter Belag (Asphalt oder gutes Kopfsteinpflaster)"],
	 'Q2' => [M"miger Belag", undef, undef,
		  M"miger Belag (schlechter Asphalt oder miges Kopfsteinpflaster)"],
	 'Q3' => [M"schlechter Belag", undef, undef,
		  M"schlechter Belag (Katzenkopfsteinpflaster oder unbefestigte Wege)"],
	 'q0' => [M"keine", undef, undef,
		  M"keine Beeintrchtigungen"],
	 'q1' => [M"auf ca. 25 km/h", undef, undef,
		  M"Beeintrchtigungen auf ca. 25 km/h"],
	 'q2' => [M"auf ca. 18 km/h", undef, undef,
		  M"Beeintrchtigungen auf ca. 18 km/h"],
	 'q3' => [M"auf ca. 13 km/h", undef, undef,
		  M"Beeintrchtigungen auf ca. 13 km/h"],
	 'q4' => [M"auf Schrittgeschwidigkeit", undef, undef,
		  M"Beeintrchtigungen auf Schrittgeschwidigkeit"],

	 '6'  => [M"Gro- oder Millionenstadt", M"Gro- oder Millionenstdte", undef],
	 '5'  => [M"Grostadt", M"Grostdte", undef],
	 '4'  => [M"Ortskategorie 4", M"Ortskategorie 4", undef],
	 '3'  => [M"Ortskategorie 3", M"Ortskategorie 3", undef],
	 '2'  => [M"Ortskategorie 2", M"Ortskategorie 2", undef],
	 '1'  => [M"kleiner Ort", M"kleine Orte", undef],
	 '0'  => [M"Ortsteil", M"Ortsteile", undef],
	 'WR' => [M"Wasserroute", M"Wasserrouten", undef],
	);
    foreach (@Radwege::category_order) {
	if (defined $Radwege::category_code{$_}) {
	    $category_attrib{$Radwege::category_code{$_}} =
		[$Radwege::category_name{$_}, $Radwege::category_plural{$_}, undef];
	}
    }

    $default_img_fmt = 'xpm';
    %obst_file =
	('apfel'   => 'apfel.'   . $default_img_fmt,
	 'kirsche' => 'kirsche.' . $default_img_fmt,
	 'birne'   => 'birne.'   . $default_img_fmt,
	 'pflaume' => 'pflaume.' . $default_img_fmt,
	);

    # fr Orte und Sonstiges
    $xadd_anchor_type->{'o'} = {'w' => 4, 'n' => 0, 'e' => -4, 's' => 0,
				'nw' => 2, 'sw' => 2};
    $yadd_anchor_type->{'o'} = {'w' => 0, 'n' => 1, 'e' => 0,  's' => -1,
				'nw' => 1, 'sw' => -1};
    $label_spaceadd{'o'} = " ";

    # fr Routen
    $xadd_anchor_type->{'route'} = {'w' => 10, 'n' => 0, 'e' => -10, 's' => 0,
				    'nw' => 5, 'sw' => 5};
    $yadd_anchor_type->{'route'} = {'w' => 0, 'n' => 10, 'e' => 0,  's' => -10,
				    'nw' => 5, 'sw' => -5};
    # $label_spaceadd not needed here

    # U-Bahnsymbole
    $xadd_anchor_type->{'u'} = {'w' => 8, 'n' => 0, 'e' => -8, 's' => 0,
				'nw' => 5, 'sw' => 5};
    $yadd_anchor_type->{'u'} = {'w' => 0, 'n' => 8, 'e' => 0,  's' => -8,
				'nw' => 5, 'sw' => -5};
    $label_spaceadd{'u'} = "  ";

    # Sehenswrdigkeiten (star)
    $xadd_anchor_type->{'v'} = {'w' => 8, 'n' => 0, 'e' => -8, 's' => 0,
				'nw' => 5, 'sw' => 5};
    $yadd_anchor_type->{'v'} = {'w' => 0, 'n' => 8, 'e' => 0,  's' => -8,
				'nw' => 5, 'sw' => -5};
    $label_spaceadd{'v'} = "  ";

    # normale Reihenfolge fr das bereinanderlegen bei restack()
    #XXX labels sollten grundstzlich immer oben sein. Problematisch bei tag_groups
    @normal_stack_order =
	(qw(map f w-out w i-out i f-Pabove crosshairs e e-img
	    gP gD z g gP gD
	    s-out l-out show gr rw s-NN s-N s-H s-HH s-B s-BAB sBAB sBAB-BAB l v
	    f-label-bg wr w-label-bg f-label w-label
	    u sperre_u u-bg u-fg u_bg-img r sperre_r b sperre_b
	    r-bg r-fg r_bg-img b-bg b-fg b_bg-img
	    u-label r-label b-label
	    hoehe vf-bg sperre temp_sperre_s temp_sperre v-fg obst
	    fz route comm),
	 (map { "comm-$_" } @comments_types),
	 qw(comm-route-label-bg comm-route-label qs hs ql hl mount nl delnet
	    O o p pl-fg lsas lsa-bg lsa-fg lsas-t
	    vf-fg pp kn-bg kn-fg ki-bg ki-fg rest-bg rest-fg
	    s-label-bg s-label l-label-bg l-label
	    personal-fg personal-label ovl
	    gpsanimrect zoomrect),
	);
    # XXX remove these? (was between rest-fg and personal-fg) L pp-L L-img L-fg 
}

sub generate_plot_functions {
    $plotstr_draw_sub = <<'EOF';
        sub {
	    my $ret = shift;
	    my $strname = $ret->[Strassen::NAME];
	    my @kreuzungen = @{$ret->[Strassen::COORDS]};
            @kreuzungen = map { $conv->($_) } @kreuzungen
		if $conv;
	    my $cat_hin = $ret->[Strassen::CAT];
	    my $cat_rueck;
	    my(@addinfo_hin, @addinfo_rueck);
	    if ($cat_hin =~ /^(.*);(.*)$/) {
		($cat_hin, $cat_rueck) = ($1, $2);
	    }
	    if ($cat_hin =~ /^(.+?)::(.*)$/) { # XXX will change
		$cat_hin = $1;
		@addinfo_hin = split ':', $2;
	    }
	    if (defined $cat_rueck && $cat_rueck =~ /^(.+?)::(.*)$/) { # XXX this will change!
		$cat_rueck = $1;
		@addinfo_rueck = split ':', $2;
	    }
# XXX Problems with cat = ";anything": $cat_hin is empty and thus always
# restricted. Workaround: always use "anything;" with the reversed
# coord list. But nevertheless $ignore and $restrict won't work correctly.
	    return if defined $ignore and $cat_hin =~ /$ignore/;
	    return if defined $restrict and $cat_hin !~ /$restrict/;
	    my $this_color_hin = $cat_hin =~ /^\#/ ? $cat_hin :
		$category_color{$cat_hin} || $str_color{$abk} || 'white';
	    my $this_color_rueck = defined $cat_rueck ?
		($cat_rueck =~ /^\#/ ? $cat_rueck :
		 $category_color{$cat_rueck} || $str_color{$abk} || 'white') :
		     'white';
	    my $this_width_hin = $category_width{$cat_hin} || $default_width || 1;
	    my $this_width_rueck = defined $cat_rueck ?
		($category_width{$cat_hin} || $default_width || 1) :
		    1;
	    my @coordlist;
	CROSSINGS_LOOP:
	    foreach (@kreuzungen) {
	      TRY: {
		    my($xx, $yy);
		    if (!$edit_mode && !$edit_mode_flag) {
			($xx, $yy) = split /,/, $_;
			if (!defined $yy) { # ignore invalid coords like "*"
			    next CROSSINGS_LOOP;
			}
                    } elsif ($edit_mode_flag) {
                        /^(?::.*:)?(-?[\d\.]+),(-?[\d\.]+)$/;
                        ($xx, $yy) = ($1, $2);
                        next CROSSINGS_LOOP if !defined $yy;
		    } elsif ($edit_mode &&
			     /([A-Za-z]+)?(-?[\d\.]+),(-?[\d\.]+)$/) {
			# XXX Verwendung von data/BASE (hier und berall)
			my $this_coordsys = (defined $1 ? $1 : '');
			if ($this_coordsys eq $coordsys ||
			    (!($this_coordsys ne '' || $coordsys ne 'B'))) {
			    ($xx, $yy) = ($2, $3);
                        } else {
			    # the hard way: convert it
			    $this_coordsys = 'B' if $this_coordsys eq '';
			    ($xx,$yy) = $Karte::map_by_coordsys{$this_coordsys}->map2map($coord_system_obj, $2, $3);
#warn "($xx,$yy)";
			}
		    } else {
			last TRY;
		    }
		    push @coordlist, $transpose->($xx, $yy);
		    if ($p_draw{'pp'} && ($p_draw{"pp-$abk"}||$p_draw{"pp-all"})) {
			my($x, $y) = @coordlist[$#coordlist-1 .. $#coordlist];
			# keine Verwendung von _coord_as_string
			$c->createLine
			  ($x, $y, $x, $y,
			   -tags => ['pp', "$xx,$yy", undef, "pp-$abk"],
			  );
		    }
		}
	    }
	    if (@coordlist > 0) {
		my $abk = $abk;
		my($mx,$my);
		my $image;
		my $anchor = "c";

		if (exists $line_shorten{$cat_hin}) { # XXX no $cat_rueck handling
		    line_shorten(\@coordlist);
		}

		my $sight_draw = sub {
		    # speciality for sights: draw a star
		    if (!defined $mx) {
			if (@coordlist > 2) {
			    ($mx,$my) = get_polygon_center(@coordlist);
			}
			if (!defined $mx) {
			    ($mx,$my) = @coordlist[0,1];
			}
		    }
		    if ($image) {
			if (!$photo{$image}) {
			    my $f = file_name_is_absolute($image) ? $image : Tk::findINC("images/$image");
			    if ($f) {
				$photo{$image} = image_from_file($top, $f);
			    } else {
				warn "Can't find photo $image (1)";
			    }
			}
			if ($photo{$image}) {
			    $c->createImage($mx,$my,-image => $photo{$image},
					    -anchor => $anchor,
					    -tags => ["$abk-fg", $strname]);
			} else {
			    warn "No image for $image";
			}
		    } else {
			$c->createImage($mx,$my,-image => $star_photo,
					-tags => ["$abk-fg", $strname]);
		    }
		};

		if ($cat_hin =~ /^F:(.*)$/) { # Flche, no $cat_rueck handling here
		    my $item;
		    my $category = $1;
		    my($color, $rest) = split(/\|/, $category);
		    my $stipple = $category_stipple{$category};
		    if (defined $rest && $rest ne "") {
			if ($rest =~ /^IMG:([^|]+)(?:\|ANCHOR:([^|]+))?$/) {
			    $image = $1;
			    $anchor = $2 if $2;
			} else {
			    $stipple = $rest;
			}
		    }
		    if ($color eq 'I') { $abk = 'i' } # Inseln
		    $color = $category_color{$color} || $color;
		    $stipple = Tk::findINC($stipple) if $stipple;
		    $stipple = '@' . $stipple if $stipple;
		    if ($str_outline{$abk} && @coordlist > 2) {
			$item = $c->createPolygon
			  (@coordlist,
			   -fill    => $outline_color{$abk},
			   -outline => $outline_color{$abk},
			   -width   => 2,
			   -tags    => ["$abk-out", "$abk-$category-out"],
			  );
		    }
		    if (@coordlist == 2) {
			# dicken Punkt zeichnen
			$item = $c->createLine
			    (@coordlist, @coordlist,
			     -fill => $color,
			     -width => 5, # XXX skalieren
			     -capstyle => 'round',
			     -tags => [$abk, $strname, $kreuzungen[0],
				       $abk."-".$i
				      ],
			    );
		    } else {
			$item = $c->createPolygon
			    (@coordlist,
			     -fill    => $color,
			     ($stipple ? (-stipple => $stipple) : ()),
			     -tags    => [$abk, $strname,
					  "$abk-$category",$abk."-".$i],
			    );
		    }

		    if ($str_name_draw{$abk}) {
			my($name, $add) = split(/\|/, $strname);
			$name = "" if !defined $name;
			if ($add) {
			    $name .= " $add";
			}
			$name =~ s/\cK/\n/g; # vert tab -> newline
			($mx,$my) = get_polygon_center(@coordlist);
			if (!defined $mx || ! do {
			    my @zipped_coordlist;
			    for(my $i = 0; $i < $#coordlist; $i+=2) {
				push @zipped_coordlist, [$coordlist[$i], $coordlist[$i+1]];
			    }
			    point_in_polygon([$mx,$my], \@zipped_coordlist);
			}) {
			    my $middle = int $#coordlist/2;
			    if ($middle%2 != 0) {
				$middle--;
			    }
			    ($mx,$my) = @coordlist[$middle,$middle+1];
			}

			my $abk_fg = $abk;
			if ($abk eq 'v') {
			    $abk_fg = 'v-fg';
			} elsif ($abk =~ /^[fw]$/) {
			    $abk_fg = $abk."-label";
			}
			my $tags = [$abk_fg, $strname];
			my %args = (-text => $name,
				    -tags => $tags,
				    -outlinewidth => 2,
				    (exists $category_font_color{$category} ? (-fill => $category_font_color{$category}) : ()),
				    (exists $category_font{$category} ? (-font => $category_font{$category}) : ()),
				   );
			if (exists $category_font{$category} &&
			    $category_font{$category} =~ /%d/) {
			    my $bbox_area = get_bbox_area($item);
			    # XXX bessere Abstufungen
			    if ($bbox_area < 1500) {
				$args{-font} = sprintf $category_font{$category}, 7;
			    } elsif ($bbox_area > 5000) {
				$args{-font} = sprintf $category_font{$category}, 12;
			    } else {
				$args{-font} = sprintf $category_font{$category}, 10;
			    }
			}

			if (!$no_overlap_label{$abk} ||
			    !draw_text_intelligent
			        ($c, $mx, $my,
				 %args,
				 -abk  => $abk_fg,
				 -xadd => $xadd_anchor,
				 -yadd => $yadd_anchor,
				 -outline => 1,
				)) {
			    my($mx,$my) = ($mx,$my);
			    if (defined $label_spaceadd) {
			        $args{-text} = $label_spaceadd . $args{-text};
				$args{-anchor} = "w";
			    } elsif (# shift to right for points,
				     # center for polygons
				     @coordlist == 2 || $abk eq 'v') {
			        $mx += $xadd_anchor->{'w'};
			        $my += $yadd_anchor->{'w'};
				$args{-anchor} = "w";
			    }
			    outline_text($c, $mx, $my, %args);
			}
		    }

		    if (($abk eq 'v' && $star_photo) || $image) {
			$sight_draw->();
		    }

		} elsif ($cat_hin =~ /^IMG:([^|]+)(?:\|ANCHOR:([^|]+))?$/) { # Bild, no $cat_rueck handling here
		    my $img = $1;
		    my $anchor = ($2 ? $2 : "c");
		    $img = file_name_is_absolute($img) ? $img : Tk::findINC("data/$img");
		    my $p = image_from_file($top, $img);
		    # XXX this is leaking (photo never deleted...)
		    # XXX $abk-XXX => $abk-fg or $abk-img ?
		    # XXX use $abk-fg for now (scaling works!)
		    if ($p) {
			$c->createImage(@coordlist[0..1], -image => $p,
					-anchor => $anchor,
					-tags => [$abk, $strname,
						  "$abk-fg", "$abk-" . $i],
				       );
		    } else {
			warn "Can't find photo $img (2)";
		    }
		} elsif ($use_stippleline == 1) { # old stipple code
		    # XXX no $cat_rueck handling here (this code branch is anyway obsolete)
		    # min. 4 Koordinaten erzwingen
		    @coordlist == 2 && push(@coordlist, @coordlist);

		    Tk::StippleLine::create
		      ($c, @coordlist,
		       -fill => $this_color_hin,
		       -width => $this_width_hin,
		       -joinstyle => 'bevel',
		       -tags => [$abk, $strname,
				 "$abk-$cat_hin", "$abk-" . $i],
		      );

		} else {
		    if (@coordlist == 2) {
			# Points do not have $cat_rueck
			if ($abk eq 'v') {
			TRY_IMAGE: {
				if ($cat_hin =~ /\|IMG:([^|]+)/) {
				    $image = $1;
				} elsif ($star_photo) {
				    $image = undef; # default to $star_photo
				} else {
				    last TRY_IMAGE;
				}
				$sight_draw->();
				return; # next loop
			    }
			}

			# dicken Punkt zeichnen
			$c->createLine(@coordlist, @coordlist,
				       -fill => $this_color_hin,
				       -width => 5, # XXX skalieren
				       -capstyle => 'round',
				       -tags => [$abk, $strname,
						 "$abk-$cat_hin", "$abk-" . $i,
						 @extra_tags],
				      );
		    } else {
			my @std_tags = ($abk, $strname,"$abk-$cat_hin","$abk-" . $i);
			my $line_dash = $line_dash{$abk};
		        if (@addinfo_hin) { # ignore @addinfo_rueck for now
			    for my $addinfo_hin (@addinfo_hin) {
			        if ($addinfo_hin eq 'Tu') {
				    $line_dash = $line_dash{"Tu"};
				    draw_tunnel_entrance(\@coordlist, width => $this_width_hin+4, tags => \@std_tags);
				} elsif ($addinfo_hin eq 'Br') {
				    draw_bridge(\@coordlist, width => $this_width_hin+4, tags => \@std_tags);
				}
			    }
			}
			if (!$use_stippleline) {
			    undef $line_dash;
			}
			if ($str_outline{$abk}) {
			    # XXX no $cat_rueck support yet for outlines
			    $c->createLine
			      (@coordlist,
			       -fill      => $outline_color{$abk},
			       -width     => $this_width_hin+2,
			       -joinstyle => 'bevel',
			       -tags      => ["$abk-out",
					      "$abk-$cat_hin-out"],
                               ($line_dash ? (-dash => $line_dash) : ()),
			       (exists $line_arrow{$cat_hin} ? (-arrow => $line_arrow{$cat_hin}) : ()),
			      );
			}
			if (defined $cat_rueck) {
			    my %side_coordlist;
			    for my $dir (1, -1) {
				my($cl, $this_color, $this_width, $cat);
				if ($dir == 1 && $cat_hin ne '') {
				    $this_color = $this_color_hin;
				    $this_width = $this_width_hin/2;
				    $cat        = $cat_hin;
				    $cl         = [@coordlist],
				} elsif ($dir == -1 && $cat_rueck ne '') {
				    $this_color = $this_color_rueck;
				    $this_width = $this_width_rueck/2;
				    $cat        = $cat_rueck;
				    $cl         = [];
				    for(my $cl_i = $#coordlist-1; $cl_i >= 0; $cl_i-=2) {
					push @$cl, @coordlist[$cl_i, $cl_i+1];
				    }
				} else {
				    next;
				}
				my $delta = -$this_width;

				for(my $ii = 2; $ii < $#$cl; $ii+=2) {
				    # atan2(y2-y1, x2-x1)
				    my $alpha = atan2($cl->[$ii+1]-$cl->[$ii-1], $cl->[$ii]-$cl->[$ii-2]);
				    my $beta  = $alpha - pi()/2;
				    my($dx, $dy) = ($delta*cos($beta), $delta*sin($beta));
				    $cl->[$ii] += $dx;
				    $cl->[$ii+1] += $dy;
				    if ($ii == 2) {
					$cl->[0] += $dx;
					$cl->[1] += $dy;
				    }
				}
				$c->createLine
				    (@$cl,
				     -fill  => $this_color,
				     -width => $this_width,
				     -joinstyle => 'bevel',
				     -tags  => [@std_tags,
						@extra_tags],
				     ($line_dash ? (-dash => $line_dash) : ()),
				     #(exists $line_arrow{$cat} ? (-arrow => $line_arrow{$cat}) : ()),
				     -arrow => "last",
				    );
			    }
			} elsif ($cat_hin eq 'Br') {
			    draw_bridge(\@coordlist, width => $this_width_hin+4, tags => \@std_tags);
			} elsif ($cat_hin eq 'Tu') {
			    draw_tunnel_entrance(\@coordlist, width => $this_width_hin+4, tags => \@std_tags);
			} else {
			    $c->createLine
				(@coordlist,
				 -fill      => $this_color_hin,
				 -width     => $this_width_hin,
				 -joinstyle => 'bevel',
				 -tags      => [@std_tags,
						@extra_tags],
				 ($line_dash ? (-dash => $line_dash) : ()),
				 (exists $line_arrow{$cat_hin} ? (-arrow => $line_arrow{$cat_hin}) : ()),
				);
			}

			# no $cat_rueck support for names
			if ($str_name_draw{$abk}
			    && (($abk =~ /^[ls]/ &&
				 ($cat_hin =~ /^[BH]/ ||
				  ($lazy_str{$abk} && $scale >= 10)
				 )) || 0) # nur Hauptstraen zeichnen (wg. Performance
                                          # und bersichtlichkeit), oder auch Nebenstraen,
                                          # falls lazy_plot und kleiner Mastab 
			   ) {
			    my $strname = Strassen::strip_bezirk($strname);
			    Tk::RotFont::canvas
			      ($c, $abk, \@coordlist,
			       $category_rot_font{$cat_hin} || $rot_font_sub,
			       $category_size{$cat_hin} || 10,
			       $strname,
			       (defined $category_font_color{$cat_hin} ? (-fill => $category_font_color{$cat_hin}) : ()),
			      );
			}
			if ($str_nr_draw{$abk}) {
			    draw_street_numbers($c,$strname,$abk,\@coordlist);
			}

			my $street_photo;
			# XXX Generalize
			if ($abk eq 'e') {
			    my $p = get_symbol_scale($abk);
			    $street_photo = $p if $p;
			} elsif ($cat_hin eq 'St') {
			    $street_photo = $steigung_photo if $steigung_photo;
			} elsif (@addinfo_hin # ignore @addinfo_rueck for now
				) {
			    for my $addinfo_hin (@addinfo_hin) {
			        if ($addinfo_hin eq 'inwork' && $inwork_photo) {
				    $street_photo = $inwork_photo;
				}
			    }
			}
			if ($street_photo) {
			    my($mx,$my) = get_polyline_center(@coordlist);
			    my $anchor = $street_photo eq $steigung_photo ? "s" : "nw";
			    $c->createImage($mx,$my,
					    -anchor => $anchor,
					    -image => $street_photo,
					    # $abk-img or $abk-fg ?
					    -tags => [$abk,$strname,"$abk-img",
						      "$abk-" . $i]);
			    if ($street_photo eq $steigung_photo) {
				if ($strname =~ /([\d\.]+)\s*%/) {
				    outline_text
					($c,
					 $mx, $my,
					 -anchor => "n",
					 -text => "$1%",
					 -font => $font{'small'},
					 -tags => [$abk,$strname,"$abk-fg",
						   "$abk-" . $i],
					 -outlinewidth => 2,
					);
				}
			    }
			}
		    }
		}
	    }
	};
EOF

    # XXX maybe combine this code with parsing coords code in $plotstr_draw_sub
    my $parse_coords_code = <<'EOF';
	      TRY: {
#XXX		    my($xx, $yy);
		    if (!$edit_mode) {
			($xx, $yy) = split /,/, $_;
		    } elsif ($edit_mode &&
			     /([A-Za-z]+)?(-?[\d\.]+),(-?[\d\.]+)$/) {
			# XXX Verwendung von data/BASE (hier und berall)
			my $this_coordsys = (defined $1 ? $1 : '');
			if ($this_coordsys eq $coordsys ||
			    (!($this_coordsys ne '' || $coordsys ne 'B'))) {
			    ($xx, $yy) = ($2, $3);
                        } else {
			    # the hard way: convert it
			    $this_coordsys = 'B' if $this_coordsys eq '';
			    ($xx,$yy) = $Karte::map_by_coordsys{$this_coordsys}->map2map($coord_system_obj, $2, $3);
#warn "($xx,$yy)";
			}
		    } else {
			last TRY;
		    }
		}
EOF

    $plotpoint_draw_sub = <<'EOF'
	sub {
	    my $ret = shift;
	    my $category = $ret->[Strassen::CAT];
	    return if defined $restrict and $category !~ /$restrict/;
	    my $pointname = $ret->[Strassen::NAME];
	    my $koord = $ret->[Strassen::COORDS][0]; # erste Koordinate
            $koord = $conv->($koord) if $conv;
	    my($xx,$yy);
	    $_ = $koord;
EOF
    . $parse_coords_code . <<'EOF';
	    my($x, $y) = transpose($xx, $yy);

	    if (defined $category_image{$category}) {
		$category = "IMG:$category_image{$category}";
	    }
	    if ($category =~ /^IMG:([^|]+)(?:\|ANCHOR:([^|]+))?$/) {
		my $photo = $1;
		my $anchor = ($2 ? $2 : "c");
		my($base) = ($photo =~ m|/| ? $photo =~ /([^\/]+)$/ : $photo);
		$base = "p_$base";
		my $images = ($top->{'MapImages'} ||= {});
		my $p = $images->{$base};
		if (!$p) {
		    eval {
			#warn "Try $photo...\n";
			$p = $c->Photo(-file => $photo);
		    };
		    if (!$p) {
			eval {
			    my $photo = Tk::findINC($photo);
			    #warn "Try $photo...\n";
			    $p = $c->Photo(-file => $photo)
				if defined $photo;
			};
			if (!$p) {
			    eval {
				my $dir = dirname($p_file{$abk});
			        #warn "Try $dir/$photo...\n";
				$p = $c->Photo(-file => "$dir/$photo");
			    };
			}
		    }
		    if ($p) {
			$images->{$base} = $p;
		    }
		}
		if ($p) {
		    $c->createImage($x, $y, -image => $p,
				    -anchor => $anchor,
				    -tags => ["$abk-img", "$xx,$yy", $pointname, ($abk =~ /^L\d+$/ ? ("L-fg") : ())],
				   );
		    return;
		}
		warn "Can't find image $photo (3)";
	    }

	    if ($abk =~ /^[ubr]$/) {
		$c->createLine($x-$ubahn_length, $y, $x+$ubahn_length, $y,
			       -tags => ["$abk-bg", "$xx,$yy", $pointname]);
		$c->createText($x, $y,
			       -tags => ["$abk-fg", "$xx,$yy", $pointname]);
	    } elsif ($abk eq 'lsa') {
		# keine Verwendung von _coord_as_string
		$c->createImage
		  ($x, $y,
		   -image => ($category eq 'B'
			      ? $andreaskr_photo
			      : $category eq 'Zbr'
				? $zugbruecke_photo
				: $category eq 'F'
				  ? $ampelf_photo
			          : $ampel_photo
			     ),
		   -tags => ["$abk-fg", "$xx,$yy", $pointname,
			     "$abk-" . $category . "-fg",
			     $abk."-".$i],
		  );
		$ampeln{"$xx,$yy"} = $category;
	    } elsif ($abk eq 'pl') {
		$c->createLine($x, $y, $x, $y,
			       -tags => ["$abk-fg", "$xx,$yy", $pointname],
			      );
	    } elsif ($abk eq 'vf') {
		$c->createImage(transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][1])}),
				-tags => "$abk-fg");
		my($x1,$y1,$x2,$y2,$x3,$y3) =
		  (transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][0])}),
		   transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][1])}),
		   transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][2])}));
		my $len1 = Strassen::Util::strecke([$x1,$y1], [$x2,$y2]);
		my $whole_len1 = $len1 > 20 ? 20 : $len1;
		my $len2 = Strassen::Util::strecke([$x2,$y2], [$x3,$y3]);
		my $whole_len2 = $len2 > 20 ? 20 : $len2;
		my($cx1,$cy1,$cx2,$cy2,$cx3,$cy3)
		  = (($x1-$x2)/$len1*$whole_len1+$x2,
		     ($y1-$y2)/$len1*$whole_len1+$y2,
		     $x2,$y2,
		     ($x3-$x2)/$len2*$whole_len2+$x2,
		     ($y3-$y2)/$len2*$whole_len2+$y2,
		    );
		$c->createLine($cx1,$cy1,$cx2,$cy2,$cx3,$cy3,
			       -tags => "$abk-bg");
	    } elsif ($abk =~ /^L(\d+)/) {
		my $color = $category =~ /^\#/ ? $category : exists $category_color{$category} ? $category_color{$category} : undef;
		my $width = $category_width{$category} || $p_width{$abk} || $default_width || 6;
		$c->createLine($x, $y, $x, $y,
			       (defined $color ? (-fill => $color) : ()),
			       -width => $width,
			       -tags => ["$abk-fg", "$xx,$yy", $pointname, "p-" . $i, "L-fg"]);
	    } elsif ($abk =~ /^(kn|ki|rest)$/) {
		$c->createImage($x, $y,
				-tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . $i]);
	    } elsif ($abk =~ /^label/) {
		# $category should contain font, anchor etc.
		$c->createText($x, $y, -text => $pointname,
			       -font => $font{'large'}, # XXX
			       -anchor => "w", # XXX
			       -tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . $i]);
	    } else {
		# Else draw a generic point (broad, color from cat)
		my $color = $category_color{$category} || ($category =~ /^\#/ ? $category : 'red');
		my $width = $category_width{$category} || $p_width{$abk} || $default_width || 6;
		$c->createLine($x, $y, $x, $y,
			       -fill => $color, -capstyle => 'round',
			       -width => $width,
			       -tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . $i]);
	    }
	    if ($name_draw) {
		my %args = ((exists $category_font_color{$category} ? (-fill => $category_font_color{$category}) : ()),
			    (exists $category_font{$category} ? (-font => $category_font{$category}) : ()),
			    -outlinewidth => 2,
			    -text => $pointname,
			    -tags => $name_draw_tag,
			   );
		if ($orientation eq 'portrait' && $Tk::VERSION >= 800) {
		    require Tk::RotFont;
		    # XXX geht nicht...
		    Tk::RotFont::createRotText
			    ($c, $x, $y,
			     -text => $pointname,
			     -rot => 3.141592653/2,
			     #-font => get_orte_label_font($cat),
			     -font => $rot_font_sub->(100), # no $cat...
			     -tags => $name_draw_tag,
			    );
		} elsif (!$no_overlap_label ||
			 !draw_text_intelligent
			 ($c, $x, $y,
			  -abk  => $name_draw_other,
			  -xadd => $xadd_anchor,
			  -yadd => $yadd_anchor,
			  -outline => 1,
			  %args,
			 )) {
		    my($x,$y) = ($x,$y);
		    if (defined $label_spaceadd) {
			$args{-text} = $label_spaceadd . $args{-text};
		    } else {
			$x += $xadd_anchor->{'w'};
			$y += $yadd_anchor->{'w'};
		    }
		    outline_text($c, $x, $y, -anchor => 'w', %args);
		}
	    }
	};
EOF

    $plotorte_draw_sub = <<'EOF'
	sub {
	    my $ret = shift;
	    my $cat = $ret->[Strassen::CAT];
	    my($name, $add) = split(/\|/, $ret->[Strassen::NAME]);
	    my($xx,$yy);
	    $_ = $ret->[Strassen::COORDS][0];
            $_ = $conv->($_) if $conv;
EOF
    . $parse_coords_code . <<'EOF';
#	    if ($ret->[Strassen::COORDS][0] =~ /(-?\d+),(-?\d+)/) {
	    if (defined $xx) {
#		my($x, $y) = ($1, $2);
#		my($tx, $ty) = $transpose->($x, $y);
		my($tx, $ty) = $transpose->($xx, $yy);
		my $fullname = ($add ? $name . " " . $add : $name);
		return if ($place_category && $place_category ne "auto" && $cat < $place_category);
		my $point_item;
                if (!$municipality) {
                    $point_item = $c->createLine
			($tx, $ty, $tx, $ty,
			 -tags => [$type, "$xx,$yy", $fullname, $label_tag."P$cat", $type."-".($i-1)],
			);
                }
		if ($name_o) {
		    my $text = ($args{Shortname}
				? $name
				: $fullname);
		    my(@tags) = ($label_tag, "$label_tag$cat", $label_tag."-".($i-1));
		    if ($orientation eq 'portrait' && $Tk::VERSION >= 800) {
			require Tk::RotFont;
			# XXX geht nicht...
			Tk::RotFont::createRotText
				($c, $tx, $ty-4,
				 -text => $text,
				 -rot => 3.141592653/2,
				 #-font => get_orte_label_font($cat),
				 -font => $rot_font_sub->(100+$cat*12),
				 -tags => \@tags,
				);
		    } elsif ($no_overlap_label && !$municipality) {
			push(@orte_coords_labeling,
			     [$text, $tx, $ty, $cat, $point_item]);
		    } else {
			if ($do_outline_text) {
			    outline_text
				($c,
				 $tx+4,
				 $ty,
				 -text => $text,
				 -tags => \@tags,
				 -anchor => 'w',
				 -justify => 'left',
				 -fill => '#000080',
				 -font => get_orte_label_font($cat),
				);
			} else {
			    $c->createText($tx, $ty,
					   -text => $label_spaceadd{'o'} . $text,
					   -tags => \@tags,
					  );
			}
		    }
		}
	    }
	};
EOF
}

sub set_bindings {
    foreach (qw(p pp o
		u-bg u-fg u_bg-img b-bg b-fg b_bg-img r-bg r-fg r_bg-img
		sperre sperre_u sperre_b sperre_r temp_sperre
		lsa-fg lsa-bg show pl-fg
		L-img L-fg kn-fg ki-fg rest-fg)) {
	std_p_binding($_);
    }

    foreach (qw(s sBAB S l L u b r f v v-fg w W i e comm mount),
	     (map { "comm-$_" } @comments_types),
	     qw(gr qs hs ql hl fz nl ovl temp_sperre_s rw wr)) {
	std_str_binding($_);
    }

    # XXX Some bindings are here and in std_p_binding, which cause
    # problems as both function set the <Leave> binding
    # XXX route: no!
    foreach (qw(lsa-bg lsa-fg vf-bg vf-fg
		s-label-bg s-label sBAB-label-bg sBAB-label
		w-label-bg w-label f-label-bg f-label
		l-label-bg l-label
		u-label b-label r-label show O)) {
	std_transparent_binding($_);
    }
    # spezielle Bindings fr Routen
    $c->bind('route', '<Any-Enter>'  => sub { enterroute($_[0]) });
    $c->bind('route', '<Any-Motion>' => sub { enterroute($_[0]) });
    $c->bind('route', '<Any-Leave>'  => \&leaveroute);

    # Cursor bei delnet-Kreuzen:
    $c->bind("delnet", "<Any-Enter>" => sub {
		 if ($map_mode eq MM_USEREDIT) {
		     $c->{SavedCursor} = $c->get_cursor;
		     set_cursor("addnet");
		 }
	     });
    $c->bind("delnet", "<Any-Leave>" => \&_restore_cursor);

    foreach (qw(all)) {
	# XXX TODO should be ButtonRelease-1 some day, if using
	# B1-Motion for rubberbanding a zoom region
	$c->bind($_, "<ButtonPress-1>" => \&set_route_point);
    }

    # Stack in tkstadtware fr dragging angucken! XXX
    $c->CanvasBind("<1>" => sub {
		       if ($map_mode =~ /^BBBike/) {
			   my $button_callback = $map_mode . '::button';
			   if (defined &$button_callback) {
			       my $e = $c->XEvent;
			       eval $button_callback.'($_[0], $e)';
			       die $@ if $@;
			       return;
			   }
		       } elsif ($map_mode eq MM_CUSTOMCHOOSE) {
			   set_route_point($c);
		       } elsif ($map_mode eq MM_SCRIBBLE) {
			   # XXX not Tk::Babybike!
			   Tk::Babybike::handle_button1_scribble($c,$c->XEvent);
		       } elsif ($map_mode eq MM_URL_SELECT) {
			   my($url) = grep { $_ } map {
			       my($url) = $_ =~ m{(http://\S+)};
			       defined $url ? $url : undef;
			   } $c->gettags("current");
			   if ($url) {
			       require WWWBrowser;
			       main::status_message("URL: $url", "info");
			       WWWBrowser::start_browser($url);
			   } else {
			       warn "Cannot get URL from " . join(", ", $c->gettags("current"));
			   }
		       }
		       return unless $map_mode eq MM_DRAG;
		       my $e = $c->XEvent;
		       $c->scan('mark', $e->x, $e->y);
		   });
    $c->CanvasBind('<B1-Motion>' => sub {
		       if ($map_mode eq MM_SCRIBBLE) {
			   # XXX not Tk::Babybike!
			   return Tk::Babybike::handle_button1_motion_scribble($c,$c->XEvent);
		       }
		       return unless $map_mode eq MM_DRAG;
		       my $e = $c->XEvent;
		       $c->scan('dragto', $e->x, $e->y, 1);
		   });

    set_b2();

    # Canvas menu
    my $popup_menu;
    if ($right_is_popup) {
	$popup_menu = $c->Menu(-title => M"Kartenmen",
			       -tearoff => $Tk::platform eq 'unix');
	$popup_menu->command(-label => M"Gesamte Route lschen",
			     -command => sub { delete_route() },
			    );
	$popup_menu->command(-label => M"Suche wiederholen",
			     -command => \&re_search_gui,
			    );
	$popup_menu->command(-label => M"Rckweg",
			     -command => \&way_back,
			    );
    }
    if ($c->can("menu") and $c->can("PostPopupMenu") and $Tk::VERSION >= 800) {
	$c->menu($popup_menu);
	$c->Tk::bind('<3>' => sub {
			 if ($right_is_popup) {
			     my $e = $_[0]->XEvent;
			     $_[0]->PostPopupMenu($e->X, $e->Y);
			 } else {
			     delete_route();
			 }
		     });
    } else {
	# legacy code
	$frame->bind($c, "<ButtonPress-3>" => sub {
			 if ($right_is_popup) {
			     my $e = $_[0]->XEvent;
			     $popup_menu->Post($e->X, $e->Y);
			 } else {
			     delete_route();
			 }
		     });
    }
    $top->Advertise(PopupMenu => $popup_menu)
	if $popup_menu;

    my $alt_mouse1 = sub {
## DEBUG_BEGIN
#benchbegin("Alt Mouse1");
## DEBUG_END	   
	if ($alt_set_route_point{$map_mode}) {
	    return $alt_set_route_point{$map_mode}->(@_);
	}
	if ($map_mode eq MM_BUTTONPOINT) {
	    freerec_sub(@_);
	}
	freedraw_sub(@_);
## DEBUG_BEGIN
#benchend();
## DEBUG_END	   
    };

    foreach (qw(Alt Shift Lock)) {
	$frame->bind($c, "<$_-ButtonPress-1>"   => $alt_mouse1);
    }

    if ($followmouse) {
	start_followmouse();
    }

    # Zoom
    for my $kp ('plus', 'KP_Add') {
	$top->bind("<$kp>" => sub { my $e = $c->XEvent;
				    return unless $e;
				    my($x, $y) = ($c->canvasx($e->x),
						  $c->canvasy($e->y));
				    scalecanvas($c, 2, $x, $y);
				});
    }
    for my $kp ('minus', 'KP_Subtract') {
	$top->bind("<$kp>" => sub { my $e = $c->XEvent;
				    return unless $e;
				    my($x, $y) = ($c->canvasx($e->x),
						  $c->canvasy($e->y));
				    scalecanvas($c, 0.5, $x, $y);
				});
    }

    $top->protocol('WM_DELETE_WINDOW', \&exit_app_noninteractive);
    my($old_width, $old_height);
    my $in_configure_event;
    $top->bind('<Configure>' => sub {
		   my $e = $top->XEvent;
		   return if !$e || $in_configure_event;
		   $in_configure_event++;
		   eval {
		       if (!defined $old_width || $old_width != $e->w ||
			   !defined $old_height || $old_height != $e->h) {
			   arrange_symframe();
			   arrange_topframe();
			   $old_width = $e->w;
			   $old_height = $e->h;
		       }
		   };
		   my $err = $@;
		   $in_configure_event--;
		   die $err if $err;
	       });

    $top->bind("<<CloseMainWin>>" => \&exit_app);
    for my $mod (qw(Alt Control)) {
	$top->bind("<$mod-r>" => sub { reload_all() });
    }

    $top->bind('<Control-o>' => sub { load_save_route(0) });
    $top->bind('<Control-s>' => sub { load_save_route(1) });
    $top->bind('<Control-underscore>' => \&get_undo_route);
    $top->bind('<Control-z>' => \&get_undo_route);
    $top->bind($_ => sub {
		   require BBBikeAdvanced;
		   search_anything();
	       })
	for ('<Control-Key-f>', '<Key-slash>');

    $top->bind("<Escape>" => sub { $escape = 1 });
    $top->bind('Busy', '<Escape>' => sub { $escape = 1; });
    $top->bind('Busy', '<KeyRelease-Escape>' => sub { });
    bind_nomod($top, '<asterisk>' => \&show_register);
    for my $i (0 .. 9) {
	my $ii = $i;
	$top->bind("<Key-$ii>" => sub { get_route_from_register($ii) });
    }

    bind_nomod($top, "<P>" => sub {
		   require BBBikeAdvanced;
		   start_ptksh();
	       });
    $top->bind("<Control-R>" => sub {
		   require BBBikeAdvanced;
		   reload_new_modules();
	       });
    bind_nomod($top, "<S>" => sub {
#XXX del?
# 		   if ($BBBikeLazy::mode) {
# 		       bbbikelazy_clear();
# 		   } else {
# 		       bbbikelazy_init();
# 		   }
		   set_map_mode(MM_SEARCH);
	       });
    bind_nomod($top, "<U>" => sub {
		   $map_mode = MM_USEREDIT;
		   set_cursor('delnet');
	       });
    if ($Tk::platform ne 'MSWin32') { # XXX aber auf der Win98-Maschine von Monika laeuft es gut?!
	bind_nomod($top, "<X>" => \&layer_editor);
    }
    bind_nomod($top, "<i>" => sub { show_info() });

    if (!$no_map) {
	bind_nomod($top, '<Key-M>' => sub { $map_draw = 1; getmap() });
	$top->bind('<Control-Key-M>' => sub { delete_map() });
    }

    $top->bind("<BackSpace>" => \&mouse_dellast);
    $top->bind("<Shift-BackSpace>" => \&delete_route);
    $top->bind("<Delete>" => \&deltovia);

    if ($advanced) {
	advanced_bindings();
    }

    for my $kp ('', 'KP_') {
	eval { # perl/Tk+win definiert keine KP_-Keysyms
	$top->bind("<${kp}Down>"  => sub { $c->yview(scroll =>  1, 'units') });
	$top->bind("<${kp}Up>"    => sub { $c->yview(scroll => -1, 'units') });
	$top->bind("<${kp}Left>"  => sub { $c->xview(scroll => -1, 'units') });
	$top->bind("<${kp}Right>" => sub { $c->xview(scroll =>  1, 'units') });

	$top->bind("<${kp}Begin>" => sub { center_best() });
        };
    }

    $top->bind("<Next>"  => sub { $c->yview(scroll =>  5, 'units') });
    $top->bind("<Prior>" => sub { $c->yview(scroll => -5, 'units') });
    $top->bind("<Home>"  => sub { $c->xview(scroll => -5, 'units') });
    $top->bind("<End>"   => sub { $c->xview(scroll =>  5, 'units') });
    eval {
    $top->bind("<KP_Next>"  => sub { $c->xview(scroll =>  1, 'units');
				     $c->yview(scroll =>  1, 'units') });
    $top->bind("<KP_Prior>" => sub { $c->xview(scroll =>  1, 'units');
				     $c->yview(scroll => -1, 'units') });
    $top->bind("<KP_Home>"  => sub { $c->xview(scroll => -1, 'units');
				     $c->yview(scroll => -1, 'units') });
    $top->bind("<KP_End>"   => sub { $c->xview(scroll => -1, 'units');
				     $c->yview(scroll =>  1, 'units') });
    };

    $top->bind("<Shift-KP_2>" => sub { $c->yview(scroll =>  5, 'units') });
    $top->bind("<Shift-KP_8>" => sub { $c->yview(scroll => -5, 'units') });
    $top->bind("<Shift-KP_4>" => sub { $c->xview(scroll => -5, 'units') });
    $top->bind("<Shift-KP_6>" => sub { $c->xview(scroll =>  5, 'units') });

    $top->bind("<Shift-KP_3>" => sub { $c->xview(scroll =>  5, 'units');
				       $c->yview(scroll =>  5, 'units') });
    $top->bind("<Shift-KP_9>" => sub { $c->xview(scroll =>  5, 'units');
				       $c->yview(scroll => -5, 'units') });
    $top->bind("<Shift-KP_7>" => sub { $c->xview(scroll => -5, 'units');
				       $c->yview(scroll => -5, 'units') });
    $top->bind("<Shift-KP_1>" => sub { $c->xview(scroll => -5, 'units');
				       $c->yview(scroll =>  5, 'units') });

}

sub set_map_mode {
    if (@_) {
	$map_mode = $_[0];
    }
    execute_and_set_map_mode_deactivate(undef);
    if ($map_mode eq MM_SEARCH) {
	if (defined $search_route_flag && $search_route_flag =~ /^ziel/) {
	    set_cursor('ziel');
	} else {
	    set_cursor('start');
	}
    } elsif ($map_mode eq MM_BUTTONPOINT) {
	set_cursor('xy');
    } elsif ($map_mode eq MM_INFO) {
#XXX	$map_mode_deactivate->() if $map_mode_deactivate;
	set_cursor('info');
#XXX	undef $map_mode_deactivate;
    } elsif ($map_mode eq MM_DRAG) {
	set_cursor('movehand');
    } elsif (exists $map_mode_callback{$map_mode} &&
	     ref $map_mode_callback{$map_mode} eq 'CODE') {
	$map_mode_callback{$map_mode}->();
    } elsif ($map_mode eq MM_URL_SELECT) {
	set_cursor('www');
    }
}

sub execute_and_set_map_mode_deactivate {
    my($new_sub) = @_;
    if ($map_mode_deactivate) {
	$map_mode_deactivate->();
	undef $map_mode_deactivate;
    }
    if ($new_sub) {
	$map_mode_deactivate = $new_sub;
    }
}

# Bindings
# ... unter Mauszeiger anzeigen
# Punkte
sub std_p_binding {
    my $tag = $_[0];
    $c->bind($tag, '<Any-Enter>' => sub {
		 $layer_pre_enter_command{$tag}->()
		     if exists $layer_pre_enter_command{$tag};
		 enterpoint($_[0]);
		 $layer_post_enter_command{$tag}->()
		     if exists $layer_post_enter_command{$tag};
	     });
    unless (/^lsa-/) { # lsa-fg/bg: leavepoint wird unten gesetzt
	$c->bind($tag, '<Any-Leave>' => sub {
		     $layer_pre_leave_command{$tag}->()
			 if exists $layer_pre_leave_command{$tag};
		     leavepoint(@_);
		     $layer_post_leave_command{$tag}->()
			 if exists $layer_post_leave_command{$tag};
		 });
    }
}
# Strecken, Flchen
sub std_str_binding {
    my $tag = $_[0];
    $c->bind($tag, '<Any-Enter>' => sub {
		 $layer_pre_enter_command{$tag}->()
		     if exists $layer_pre_enter_command{$tag};
		 enterstr($_[0]);
		 $layer_post_enter_command{$tag}->()
		     if exists $layer_post_enter_command{$tag};
	     });
    $c->bind($tag, '<Any-Leave>' => sub {
		 $layer_pre_leave_command{$tag}->()
		     if exists $layer_pre_leave_command{$tag};
		 leavestr($_[0]);
		 $layer_post_leave_command{$tag}->()
		     if exists $layer_post_leave_command{$tag};
	     });
    if (defined $c_balloon) {
	$c->bind($tag, '<Any-Motion>' => sub { $c_balloon->Track });
    }
}

# unter den Tags nachgucken, ob es eine Strae zum Anzeigen gibt
# ("durchsichtige" Tags)
sub std_transparent_binding {
    # Motion statt Enter, da sich die Strae unter einer Route
    # ndern kann.
    $c->bind($_[0], '<Any-Motion>' => sub {
		 my $str = show_below_route_str($_[0]);
		 if (defined $str && $str ne ''
		     && defined $c_balloon
		     && $use_c_balloon > 1) {
		     # XXX before each $c_ballon->Popup should be this line (maybe move into sub?):
		     if ($leave_after) { $leave_after->cancel; undef $leave_after }
		     $c_balloon->Popup($str);
		 }
	     });
    if ($_[0] =~ /^(show$|lsa-)/) { # XXX this special handling should go away
	$c->bind($_[0], '<Any-Leave>'  => sub { &leavepoint;
						&leavestr; } );
    } else {
	$c->bind($_[0], '<Any-Leave>'  => \&leavestr);
    }
}

# Aufzeichnen eines Punktes
sub freerec_sub {
    my $e = $_[0]->XEvent;
    my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    require BBBikeAdvanced;
    buttonpoint(anti_transpose($xx, $yy));
}

# freies Zeichnen von Punkten
sub freedraw_sub {
    my $e = $_[0]->XEvent;
    my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    my($ax, $ay) = anti_transpose($xx, $yy);
    return if !defined(addpoint_xy($ax, $ay, $xx, $yy));
    push @search_route_points, [join(",",@{ $realcoords[-1] }), POINT_MANUELL];
    if ($net && $map_mode ne MM_BUTTONPOINT) {
	push @act_search_route,
	    $net->route_to_name([$realcoords[-2], $realcoords[-1]],
				 -startindex => $#realcoords+1);
	add_new_point($net, join(",",@{ $realcoords[-1] }), -quiet => 1);
    }
    if ($map_mode ne MM_BUTTONPOINT) {
	set_flag('via');
	set_flag('ziel');
	set_cursor('ziel');
	$search_route_flag = 'ziel_cont';
    }
    updatekm();
    if (!$edit_mode && !$edit_normal_mode) {
	update_route_strname();
    }
}

# Letzten Punkt lschen
sub mouse_dellast {
    if ($special_edit ne '') {
	eval $special_edit . '_edit_mouse3(@_)';
	die $@ if $@;
    } else {
	if ($map_mode eq MM_BUTTONPOINT) {
	    dellast_selection();
	}
	dellast()
    }
}

# delete_route light. Allerdings nicht ganz klar, wo das hier warum
# verwendet wird.
sub reset_button_command {
    reset_undo_route();
    undef $search_route_flag;
    if ($map_mode eq MM_SEARCH) {
	search_route_mouse(1);
    }
}

sub change_net_type {
    undef $handicap_s_net;
    if ($net_type eq "r") {
	*set_coords = \&set_coords_rbahn;
    } elsif ($net_type eq "us") {
	*set_coords = \&set_coords_usbahn;
    } elsif ($net_type eq "rus") {
	*set_coords = \&set_coords_bahn;
    } elsif ($net_type eq 'wr') {
	*set_coords = \&set_coords_wasserrouten;
	if (!$str_draw{wr}) {
	    plot("str", "wr", -draw => 1);
	}
    } elsif ($net_type eq 'custom') {
	if (!keys %custom_net_str) {
	    require BBBikeAdvanced;
	    select_layers_for_net_dialog();
	}
	*set_coords = \&set_coords_custom;
    } else {
	*set_coords = \&set_coords_str;
    }
    if (defined $net) {
	make_net();
    }
}

# Routenpunkt festlegen
sub set_route_point {
    my $e = $_[0]->XEvent;
    # auf Alt, Shift und CapsLock checken
    # bei Win95/NT ist 8 nicht CapsLock, sondern NumLock
    if ($Tk::VERSION < 800) {
	return if $e->s & (1+2+($os eq 'win' ? 0 : 8));
    } else {
	return if $e->s =~ /\b(Shift|Alt|Lock)-/;
    }
    if ($map_mode eq MM_EDITPOINT) {
	my(@tags) = $c->gettags('current');
	if ($tags[0] eq 'pp' || $tags[0] =~ /^vf/ || $tags[0] =~ /^lsa/) {
	    $point_editor->set($tags[1]);
	}
    } elsif ($map_mode eq MM_INSERTPOINT) {
	insert_point_from_canvas($c);
    } elsif ($map_mode eq MM_CREATERELATION) {
	create_relation_from_canvas($c);
    } elsif ($map_mode eq MM_DRAG) {
	$c->scan('mark', $e->x, $e->y);
    } elsif ($special_edit ne '') {
	eval $special_edit . '_edit_mouse1(@_)';
	die $@ if $@;
    } elsif ($map_mode eq MM_CUSTOMCHOOSE_TAG || $map_mode eq MM_CUSTOMCHOOSE) {
	$customchoosecmd->($c, $e);
    } elsif ($map_mode eq MM_SEARCH) { # XXX doppelt
	#XXX defined $search_route_flag && ????
	if (defined $search_route_flag && $search_route_flag eq 'ziel_cont') {
	    search_route_mouse_cont();
	} elsif ($search_route_flag) {
	    search_route_mouse();
	} else {
	    warn "XXX activating....";
	    $search_route_flag = "start";
	    search_route_mouse();
	}
	Tk->break; # XXX insert more Tk->break in this subroutine?
    } elsif ($map_mode eq MM_BUTTONPOINT) {
	my $item = 'current';
	my(@tags) = $c->gettags($item);
	if ($tags[0] !~ /^(pp|o)$/) {
	    ($item) = find_below($c, "pp", "o");
	    if (!defined $item) {
		warn "Not over a <pp> or <o> point, got @tags";
		return;
	    }
	}
	require BBBikeAdvanced;
	buttonpoint(undef,undef,$item);
	freedraw_sub($_[0]);
    } elsif ($map_mode eq MM_INFO) {
	show_info();
    } elsif ($map_mode =~ /^BBBike/) {
	my $itembutton_callback = $map_mode . '::itembutton';
	if (defined &$itembutton_callback) {
	    eval $itembutton_callback.'($c,$e)';
	    die $@ if $@;
	}
    } elsif ($map_mode eq MM_USEREDIT) {
	user_edit_street();
	Tk->break; # XXX insert more Tk->break in this subroutine?
    } elsif ($set_route_point{$map_mode}) {
	$set_route_point{$map_mode}->($e);
    } elsif ($map_mode ne MM_SEARCH) {
	addpoint_inter();
    }
}

sub draw_street_numbers {
    # the coloring is german specific
    my($c,$strname,$abk,$coordlist_ref) = @_;
    my $do_round = 0;
    # XXX handling of multiple street numbers? e.g. "F1, R1" or "B2/B5"?
    my($type,$nr) = Strasse::parse_street_type_nr($strname);
    # Extra routes in and outer Berlin:
    if (!defined $type && $city_obj && $city_obj->can("parse_street_type_nr")) {
	($type, $nr, $do_round) = $city_obj->parse_street_type_nr($strname);
    }
    if (defined $type) {
	my $dist = 0;
	my $drawn = 0;
	my $draw_sub = sub {
	    my $coord_i = shift;
	    my($midx,$midy) = Strassen::Util::middle(@{$coordlist_ref}[$coord_i..$coord_i+3]);
	    my $item = $c->createText
		($midx,$midy,-text => ($type =~ /^(B|BAB)$/ ? "" : $type) . $nr,
		 -fill => ($do_round          ? 'white'  :
			   $type eq 'BAB'     ? 'white'  :
			   $type =~ /^(F|R)$/ ? 'green4' :
			                        'black'),
		 -tags => "$abk-label");
	    my(@bbox) = $c->bbox($item);
	    my $r_item;
	    if ($do_round) {
		$r_item = $c->createOval
		    ($bbox[0]-2,$bbox[1]-2,$bbox[2]+2,$bbox[3]+2,
		     -fill => '#90d090',
		     -outline => 'black',
		     -width => 1,
		     -tags => ["$abk-label-bg", "strnr", "strnr-$item"],
		    );
	    } else {
		$r_item = $c->createRectangle
		    ($bbox[0]-2,$bbox[1]-2,$bbox[2]+2,$bbox[3]+2,
		     -fill => ($type eq 'B' ? 'yellow' :
			       ($type eq 'BAB' ? 'blue' :
				'white')),
		     -outline => ($type eq 'BAB' ? 'white' :
				  ($type =~ /^(F|R)$/ ? 'green4' : 'black')),
		     -width => 2,
		     -tags => ["$abk-label-bg", "strnr", "strnr-$item"],
		    );
	    }
	    $c->raise($item,$r_item);
	    $dist = 0;
	    $drawn++;
	};

	for(my $ci=2; $ci<$#$coordlist_ref; $ci+=2) {
	    $dist += Strassen::Util::strecke([@{$coordlist_ref}[$ci-2,$ci-1]], [@{$coordlist_ref}[$ci,$ci+1]]);
	    if ($dist >= 400) { # should be in the magnitude of canvas height
		$draw_sub->($ci-2);
	    }
	}
	if (!$drawn) {
	    $draw_sub->(int($#$coordlist_ref/4)*2); # XXX ueberdenken
	}
    }
}

# middle mouse button bindings
sub set_b2 {
    # first delete all canvas b2 bindings
    foreach my $bind (qw(ButtonPress-2 2 B2-Motion)) {
	$c->CanvasBind("<$bind>" => '');
    }
    if ($b2_mode == B2M_DELLAST) {
	$c->CanvasBind("<ButtonPress-2>" => \&mouse_dellast);
    } elsif ($b2_mode == B2M_AUTOSCROLL) {
	require Tk::Autoscroll;
	my %extra_args;
	$extra_args{'-speed'}  = $autoscroll_speed if ($autoscroll_speed);
	$extra_args{'-middle'} = !!$autoscroll_middle;
	Tk::Autoscroll::Init($c, %extra_args);
    } elsif ($b2_mode == B2M_SCAN || $b2_mode == B2M_FASTSCAN) {
	my $gain = $b2_mode == B2M_SCAN ? 1 : 10;
	$c->CanvasBind('<2>',
		       [sub {
			    my($w,$x,$y) = @_;
			    $w->scan('mark',$x,$y);
			},Tk::Ev('x'),Tk::Ev('y')]);
	$c->CanvasBind('<B2-Motion>',
		       [sub {
			    my($w,$x,$y) = @_;
			    $w->scan('dragto',$x,$y,$gain);
			},Tk::Ev('x'),Tk::Ev('y')]);
    } elsif ($b2_mode == B2M_CUSTOM && $b2m_customcmd) {
	$c->CanvasBind('<2>', [$b2m_customcmd, $c]);
	$c->CanvasBind('<B2-Motion>', '');
    } else {
	# no bindings
    }
    set_mouse_desc();
}

# Setzen der Hilfstexte fr die Maustastenbelegung
sub enter_leave_bind_for_help {
    my($w, $textref) = @_;
    my(@save_mouse_text);
    $w->bind
      ('<Enter>' => sub {
	   for my $i (1..3) {
	       if (defined $textref->[$i-1]) {
		   $save_mouse_text[$i] = $mouse_text[$i] || '';
		   $mouse_text[$i] = $textref->[$i-1];
	       }
	   }
       });
    $w->bind
      ('<Leave>' => sub {
	   for my $i (1..3) {
	       if (defined $save_mouse_text[$i]) {
		   $mouse_text[$i] = $save_mouse_text[$i];
		   undef $save_mouse_text[$i];
	       }
	   }
       });
}

sub set_datadir {
    my($newdir, %args) = @_;
    if ($args{-clearold}) {
	@Strassen::datadirs = ();
    }
    if (defined $newdir && -d $newdir) {
	unshift @Strassen::datadirs, $newdir;
	$datadir = $newdir;
    } else {
	$datadir = $Strassen::datadirs[0];
    }
    if ($verbose) {
	warn Mfmt("Aktuelles Datenverzeichnis ist %s\n", $datadir);
    }
}

# Beendet die Anwendung. Bei Bedarf werden Konfigurationsdateien gesichert.
# Temporre Dateien werden gelscht.
sub exit_app {

    if (Tk::Exists($top) && $ask_quit && $Tk::VERSION >= 800) {
	# deiconify seems to be required on Solaris CDE
	$top->deiconify;
	# XXX and raise makes the thing slow on KDE :-(
	$top->raise;
	return if ($top->messageBox
		   (-icon => "question",
		    -title => M"BBBike beenden",
		    -message => M"Soll BBBike beendet werden?",
		    -type => "YesNo") =~ /no/i); # XXX Sprache?
    }

    exit_app_noninteractive();
}

sub exit_app_noninteractive {
    save_last_loaded($last_loaded_obj);
    save_last_loaded($last_loaded_layers_obj) if $last_loaded_layers_obj;

    if ($autosave_opts && defined $opt) {
	# get actual geometry
	$geometry = fix_geometry();
	# get actual font parameters
	if ($top->can("fontActual")) {
	    my %f_attr = $top->fontActual($font{'normal'});
	    $font_family = $f_attr{-family};
	    $font_size   = $f_attr{-size};
	    $font_weight = $f_attr{-weight};
	}
	# Reference power/speed
	my $speed_or_power = ($active_speed_power{Type} eq 'speed'
			      ? \@speed
			      : \@power
			     );
	$speed_power_reference_string = $active_speed_power{Type} . ":" . $speed_or_power->[$active_speed_power{Index}];
	# save options
	eval {
	    $opt->save_options;
	};
	if ($@) {
	    status_message($@, "warn");
	}
    }

    if (defined &BBBikeServer::server_cleanup) {
	BBBikeServer::server_cleanup();
    }

    my @todel;
    if (keys %tmpfiles) {
	push @todel, keys %tmpfiles;
	if ($INC{'GfxConvert.pm'}) {
	    push @todel, keys %GfxConvert::tmpfiles;
	}
    }
    unlink @todel if (@todel);
    $top->destroy if Tk::Exists($top);
    exit;
}

######################################################################

# Verndern der aktuellen Default-Geschwindigkeit oder Default-Leistung.
# $type ist entweder "speed" oder "power"
# $index ist der zu nderne Eintrag
sub change_active_speed_power {
    my($type, $index) = @_;
    my $has_old = 0;
    if (defined %active_speed_power) {
	# delete old
	my $frame = ($active_speed_power{Type} eq 'speed'
		     ? \@speed_frame
		     : \@power_frame
		    );
	my $inx = $active_speed_power{Index};
	if (defined $frame->[$inx]) {
	    $frame->[$inx]->configure(-relief => "raised",
				      -borderwidth => 1);
	}
	$has_old = 1;
    }

    %active_speed_power = (Type  => $type,
			   Index => $index);

    # set new
    my $frame = ($active_speed_power{Type} eq 'speed'
		 ? \@speed_frame
		 : \@power_frame
		);
    my $inx = $active_speed_power{Index};
    if (defined $frame->[$inx]) {
	$frame->[$inx]->configure(-relief => "raised",
				  -borderwidth => 2);
    }

    calc_ampel_optimierung() if $ampel_optimierung;

    redraw_path() if $has_old;
}

sub change_ampel_count {
    my($type, $index) = @_;
    $ampel_count->{$type}[$index] = !$ampel_count->{$type}[$index];
    if ($ampel_count->{$type}[$index]) {
	$ampel_count_button->{$type}[$index]->configure
	  (-image => $ampel_klein_photo);
	updatekm();
    } else {
	$ampel_count_button->{$type}[$index]->configure
	  (-image => $ampel_klein_grey_photo);
	updatekm();
    }
}

sub change_kopfstein_count {
    my($type, $index) = @_;
    $kopfstein_count->{$type}[$index] = !$kopfstein_count->{$type}[$index];
    if ($kopfstein_count->{$type}[$index]) {
	$kopfstein_count_button->{$type}[$index]->configure
	  (-image => $kopfstein_klein_photo);
	updatekm();
    } else {
	$kopfstein_count_button->{$type}[$index]->configure
	  (-image => $kopfstein_klein_grey_photo);
	updatekm();
    }
}

# Erzeugt den String fr den Label der Leistung
sub mk_power_txt {
    my($i) = @_;
    if (defined $i) {
	$power_txt[$i] = "$power[$i] W";
    } else {
	for($i = 0; $i <= $#power; $i++) {
	    $power_txt[$i] = "$power[$i] W";
	}
    }
}

# Dialog zum Eingeben der Leistung
### AutoLoad Sub
sub enter_power {
    my($i) = @_;
    my $t = redisplay_top($top, "power-$i", -title => M"Leistung");
    return if !defined $t;
    my $var = $power[$i];
    my $scale_var = $var;
    my $row = 0;
    $t->Label(-text => M('Leistung (in W)').':'
	     )->grid(-row => $row, -column => 0);
    my $e = $t->Entry(-textvariable => \$var,
		      -width => 4)->grid(-row => $row, -column => 1);
    $e->tabFocus;
    $row++;
    $t->Scale(-from => 10,
	      -to => 500,
	      -bigincrement => 50,
	      -resolution => 5,
	      -orient => 'horiz',
	      -showvalue => 0,
	      -variable => \$scale_var,
	      -command => sub { $var = $scale_var },
	     )->grid(-row => $row, -column => 1, -sticky => 'we');
    $row++;
    my $ref_row = $row;
    my $create_reference_label = sub {
	$t->Label(-text => M"Referenzleistung",
		 )->grid(-row => $ref_row, -column => 0, -columnspan => 2);
    };
    my $is_reference = ($active_speed_power{Type} eq 'power' &&
			$active_speed_power{Index} eq $i);
    if (!$is_reference) {
	my $rb;
	$rb = $t->Button
	    (-text => M"Als Referenzleistung verwenden",
	     -command => sub {
		 change_active_speed_power("power", $i);
		 $create_reference_label->();
		 $rb->gridForget;
	     },
	    )->grid(-row => $row, -column => 0, -columnspan => 2);
	$row++;
    } else {
	$create_reference_label->();
	$row++;
    }
    my $close_window = sub { $t->destroy; };
    my $apply_window = sub { IncBusy($t);
			     eval {
				 $power[$i] = $var;
				 after_changed_power($i);
			     };
			     DecBusy($t);
			 };
    my $ok_window    = sub { &$close_window;
			     &$apply_window };
    my $bf = $t->Frame->grid(-row => $row, -column => 0,
			     -columnspan => 2);
    my $okb = $bf->Button
      (Name => 'ok',
       -command => $ok_window)->grid(-row => 0, -column => 0,
				     -sticky => 'ew');
    $bf->Button(Name => 'apply',
		-command => $apply_window)->grid(-row => 0, -column => 1,
						 -sticky => 'ew');
    my $cb = $bf->Button
      (Name => 'close',
       -command => $close_window)->grid(-row => 0, -column => 2,
					-sticky => 'ew');

    $t->bind('<Return>' => sub { $okb->invoke });
    $t->bind('<<CloseWin>>' => sub { $cb->invoke });

    my_popup($t);
}

sub after_changed_power {
    my($i) = @_; # index
    my $is_reference = ($active_speed_power{Type} eq 'power' &&
			$active_speed_power{Index} eq $i);
    mk_power_txt($i);
    calc_ampel_optimierung()
	if $ampel_optimierung && $is_reference;
    recalc_bikepwr();
    updatekm();
}

# Erzeugt den String fr den Label der Geschwindigkeit
sub mk_speed_txt {
    my($i) = @_;
    if (defined $i) {
	$speed_txt[$i] = "$speed[$i] km/h";
    } else {
	for($i = 0; $i <= $#speed; $i++) {
	    $speed_txt[$i] = "$speed[$i] km/h";
	}
    }
}

# Dialog zum Eingeben der Geschwindigkeit
### AutoLoad Sub
sub enter_speed {
    my($i) = @_;
    my $t = redisplay_top($top, "speed-$i", -title => M"Geschwindigkeit");
    return if !defined $t;
    my $var = $speed[$i];
    my $scale_var = $var;
    my $row = 0;
    $t->Label(-text => M('Geschwindigkeit (in km/h)').':'
	     )->grid(-row => $row, -column => 0);
    my $e = $t->Entry(-textvariable => \$var,
		      -width => 3)->grid(-row => $row, -column => 1);
    $e->tabFocus;
    $row++;
    $t->Scale(-from => 5,
	      -to => 60,
	      -bigincrement => 5,
	      -resolution => 1,
	      -orient => 'horiz',
	      -showvalue => 0,
	      -variable => \$scale_var,
	      -command => sub { $var = $scale_var },
	     )->grid(-row => $row, -column => 1, -sticky => 'we');
    $row++;
    my $ref_row = $row;
    my $create_reference_label = sub {
	$t->Label(-text => M"Referenzgeschwindigkeit",
		 )->grid(-row => $ref_row, -column => 0, -columnspan => 2);
    };
    my $is_reference = ($active_speed_power{Type} eq 'speed' &&
			$active_speed_power{Index} eq $i);
    if (!$is_reference) {
	my $rb;
	$rb = $t->Button
	    (-text => M"Als Referenzgeschwindigkeit verwenden",
	     -command => sub {
		 change_active_speed_power("speed", $i);
		 $create_reference_label->();
		 $rb->gridForget;
	     },
	    )->grid(-row => $row, -column => 0, -columnspan => 2);
	$row++;
    } else {
	$create_reference_label->();
	$row++;
    }
    my $close_window = sub { $t->destroy; };
    my $apply_window = sub { IncBusy($t);
			     eval {
				 $speed[$i] = $var;
				 mk_speed_txt($i);
				 calc_ampel_optimierung()
				     if $ampel_optimierung && $is_reference;
				 updatekm();
			     };
			     DecBusy($t);
			 };
    my $ok_window    = sub { &$close_window;
			     &$apply_window };
    my $bf = $t->Frame->grid(-row => $row, -column => 0,
			     -columnspan => 2);
    my $okb = $bf->Button
      (Name => 'ok',
       -command => $ok_window)->grid(-row => 0, -column => 0,
				     -sticky => 'ew');
    $bf->Button(Name => 'apply',
		-command => $apply_window)->grid(-row => 0, -column => 1,
						 -sticky => 'ew');
    my $cb = $bf->Button
      (Name => 'close',
       -command => $close_window)->grid(-row => 0, -column => 2,
					-sticky => 'ew');
    $t->bind('<Return>' => sub { $okb->invoke });
    $t->bind('<<CloseWin>>' => sub { $cb->invoke });

    my_popup($t);
}

# Dialog zum Eingeben der Windgeschwindigkeit und -richtung
### AutoLoad Sub
sub enter_wind {
    require Tk::Optionmenu;
    require Met::Wind;
    import Met::Wind;
    my $t = redisplay_top($top, "wind", -title => M"Wind");
    return if !defined $t;
    my @var = ($winddir, $wind_v_max, $wind_v);
    my @scale_var = @var;
    my(@e, @om, @sc);
    my %wind_range =
      ('Beaufort' => [0, 16],
       'm/s' => [0, 56],
       'km/h' => [0, 200],
       'mi/h' => [0, 125],
       'kn' => [0, 100]);
    my @wind_unit = (undef, 'm/s', 'm/s');
    my @last_wind_unit = @wind_unit;
    $t->Label(-text => M("Windrichtung").":")->grid(-row => 0, -column => 0);
    $t->Label(-text => M("max. Windgeschwindigkeit").":"
	     )->grid(-row => 1, -column => 0);
    $t->Label(-text => M("mitt. Windgeschwindigkeit").":"
	     )->grid(-row => 2, -column => 0);

    my $rbf = $t->Frame->grid(-row => 0, -column => 1, -columnspan => 10);
    foreach my $spec ([qw(sw 0 2)],
		      [qw(w  0 1)],
		      [qw(nw 0 0)],
		      [qw(n  1 0)],
		      [qw(ne 2 0)],
		      [qw(e  2 1)],
		      [qw(se 2 2)],
		      [qw(s  1 2)]) {
	my($windri, $col, $row) = @$spec;
	$col*=2;
	$rbf->Label(-text => uc($windri))->grid(-row => $row,
						-column => $col);
	$rbf->Radiobutton(-variable => \$var[0], -value => $windri,
			 )->grid(-row => $row, -column => $col+1);
    }
    if (defined $windrose2_photo) {
	$rbf->Label(-image => $windrose2_photo)->grid(-row => 1,
						      -column => 1*2,
						      -columnspan => 2);
    }

    for(my $i = 1; $i <= $#var; $i++) {
	$e[$i] = $t->Entry(-textvariable => \$var[$i],
			   -width => 5)->grid(-row => $i, -column => 1);
    }

    for(my $i = 1; $i <= $#var; $i++) {
	my $ii = $i;
	$om[$i] = $t->Optionmenu
	  (-takefocus => 1,
	   -highlightthickness => 2,
	   -variable => \$wind_unit[$i],
	   -command => sub {
	       if ($last_wind_unit[$ii] ne $wind_unit[$ii]) {
		   my $old_var = $var[$ii];
		   $sc[$ii]->configure
		     (-from => $wind_range{$wind_unit[$ii]}->[0],
		      -to   => $wind_range{$wind_unit[$ii]}->[1],
		     );
		   $var[$ii] = wind_velocity([$old_var,
					      $last_wind_unit[$ii]],
					     $wind_unit[$ii]);
		   $last_wind_unit[$ii] = $wind_unit[$ii];
	       }
	   })->grid(-row => $i, -column => 2);
	$om[$i]->addOptions('m/s', 'km/h', 'Beaufort', 'mi/h', 'kn');
	$sc[$i] = $t->Scale(-from => $wind_range{$wind_unit[$i]}->[0],
			    -to   => $wind_range{$wind_unit[$i]}->[1],
			    -orient => 'horiz',
			    -showvalue => 0,
			    -variable => \$scale_var[$i],
			    -command => sub { $var[$ii] = $scale_var[$ii] },
			   )->grid(-row => $i, -column => 3, -sticky => 'we');
    }

    $rbf->focus;
    for(my $i = 1; $i < $#var; $i++) {
	my $ii = $i;
	$e[$i]->bind('<Return>' => sub { $e[$ii+1]->tabFocus });
    }

    my $apply_window = sub {
	for(my $i = 1; $i <= $#var; $i++) {
	    if ($wind_unit[$i] ne 'm/s') {
		$om[$i]->setOption('m/s');
		# Der Rest wird automatisch im -command vom Optionmenu
		# erledigt.
	    }
	}
	if (defined $var[0] and $var[0] =~ /^([ns][ew]?|[ew])$/i) {
	    analyze_wind(undef, undef, @var);
	    $wind = 1; # XXX ?
	    if ($coloring eq 'wind') {
		redraw_path();
		updatekm();
	    }
	} else {
	    status_message(Mfmt("Unerlaubte Windrichtung: <%s>", $var[0]),
			   'warn');
	}
    };
    my $close_window = sub { $t->destroy };
    my $ok_window = sub { &$close_window;
			  &$apply_window; };

    my $bf = $t->Frame->grid(-row => 3, -column => 0,
			     -columnspan => 10, -sticky => 'we');
    my $okb = $bf->Button(Name => 'ok',
			  -command => $ok_window,
			 )->pack(-side => 'left', -fill => 'x', -expand => 1);
    $bf->Button(Name => 'apply',
		-command => $apply_window,
	       )->pack(-side => 'left', -fill => 'x', -expand => 1);
    my $cb = $bf->Button(Name => 'close',
			 -command => $close_window,
			)->pack(-side => 'left', -fill => 'x', -expand => 1);
    $bf->Label->pack(-side => 'left', -fill => 'x', -expand => 1);
    $bf->Button(-text => M"Beaufort-Tabelle",
		-command => sub {
		    Met::Wind::beaufort_table
		      ($t,
		       -command => sub {
			   my($num, $unit, $toplevel) = @_;
			   $var[2] = Met::Wind::wind_velocity([$num, $unit],
							      $wind_unit[2]);
			   $toplevel->destroy;
		       },
		      )
		  },
	       )->pack(-side => 'left', -fill => 'x', -expand => 1);

    $e[-1]->bind('<Return>' => sub { $okb->invoke });
    $t->bind('<<CloseWin>>' => sub { $cb->invoke });
    #XXX del: $t->idletasks; # XXX help popup to display on the right location
    my_popup($t);
}

# Dialog zum Eingeben des Mapscales
### AutoLoad Sub
sub enter_scale {
    return unless $mapscale =~ /:\s*(\d+)/;
    my($old_mapscale, $new_mapscale, $new_mapscale_scale);
    $old_mapscale = $new_mapscale = $new_mapscale_scale = $1;

    my $t = redisplay_top($top, "scale", -title => M"Mastab");
    return if !defined $t;
    $t->Label(-text => M"Mastab 1:"
	     )->grid(-row => 0, -column => 0, -sticky => 'e');
    my $e = $t->Entry(-textvariable => \$new_mapscale,
		      -width => 8)->grid(-row => 0, -column => 1,
					 -sticky => 'ew');
    $e->tabFocus;
    my $sc;
    if (defined $default_mapscale && $default_mapscale != 0) {
	$t->Button(Name => 'default',
		   -command => sub {
		       $new_mapscale = $new_mapscale_scale = $default_mapscale;
		   },
		  )->grid(-row => 0, -column => 2);
    }
    my $Scale = 'Scale';
    my %scaleargs = (-bigincrement => 5000,
		     -resolution => 1000,
		     -showvalue  => 0,
		    );
    eval {
	require Tk::LogScale;
	require Tie::Watch;
	$Scale = 'LogScale';
	%scaleargs = (-resolution => 0.01,
		      -showvalue => 0);
    };
    my $scale = $t->$Scale
      (-from => 1000,
       -to => 3_000_000,
       %scaleargs,
       -orient => 'horiz',
       -variable => \$new_mapscale_scale,
       -command => sub { $new_mapscale = int($new_mapscale_scale); },
      )->grid(-row => 1, -column => 1,
	      -columnspan => 2,
	      -sticky => 'we');
    my $close_window = sub { $t->destroy; };
    my $apply_window = sub {
	IncBusy($t);
	eval {
	    if ($old_mapscale != $new_mapscale and $new_mapscale != 0) {
		scalecanvas($c, $old_mapscale/$new_mapscale);
		if ($mapscale =~ /:\s*(\d+)/) {
		    $old_mapscale = $new_mapscale = $1;
		    if (Tk::Exists($scale)) {
			# Die Abfrage ist ein Workaround, ansonsten
			# gibt es einen Perl-Panic, wenn Tk::LogScale
			# verwendet wird. Mglicher Grund: es wird auf
			# eine Tie-Variable zugegriffen, die
			# anscheinend schon zerstrt ist (?), bzw.
			# deren Tie-Objekt zerstrt ist.
			$new_mapscale_scale = $1;
		    }
		} else {
		    die Mfmt("Fehler beim Parsen des Massstabs: %s",
			     $mapscale);
		}
	    }
	};
	DecBusy($t);
    };
    my $ok_window    = sub { &$close_window;
			     &$apply_window };
    my $bf = $t->Frame->grid(-row => 2, -column => 0,
			     -columnspan => 2);
    my $okb = $bf->Button
      (Name => 'ok',
       -command => $ok_window)->grid(-row => 0, -column => 0,
				     -sticky => 'ew');
    $bf->Button(Name => 'apply',
		-command => $apply_window)->grid(-row => 0, -column => 1,
						 -sticky => 'ew');
    my $cb = $bf->Button
      (Name => 'close',
       -command => $close_window)->grid(-row => 0, -column => 2,
					-sticky => 'ew');

    $t->bind('<Return>' => sub { $okb->invoke });
    $t->bind('<<CloseWin>>' => sub { $cb->invoke });

    my_popup($t);
}

# ndert den -state einer gesamten Widgethierarchie unter $frame
# $enable gibt an, ob die Widgets de/aktiviert werden sollen
# $exceptions ist ein Hash, wobei die Keys die Ausnahmen unter den Widgets
# angeben
### AutoLoad Sub
sub change_state_all {
    my($frame, $enable, $exceptions) = @_;
    foreach ($frame->children) {
	next if exists $exceptions->{$_};
	if ($enable) {
	    eval { $_->configure(-state => 'normal') };
	} else {
	    eval { $_->configure(-state => 'disabled') };
	}
	if ($_->can('children')) {
	    change_state_all($_, $enable, $exceptions);
	}
    }
}

sub toggle_enter_opt_preferences {
    if ($show_enter_opt_preferences) {
	enter_opt_preferences();
    } else {
	$toplevel{"optparam"}->withdraw
	    if Tk::Exists($toplevel{"optparam"});
    }
}

# Dialog zum Einstellen der Optimierungseinstellungen
### AutoLoad Sub
sub enter_opt_preferences {
    my($i) = @_;
    $show_enter_opt_preferences = 1;
    my $t = redisplay_top($top, "optparam", -title => M"Optimierungsparameter");
    return if !defined $t;
    my $withdraw = sub { $show_enter_opt_preferences = 0;
			 $t->withdraw;
		     };
    $t->protocol('WM_DELETE_WINDOW', $withdraw);
    require Tk::NoteBook;
    my $nb = $t->NoteBook->grid(-row => 0, -column => 0,
				-columnspan => 3);
    my %var = %qualitaet_s_speed;
    my %var4 = %handicap_s_speed;
    my %var2 = %strcat_speed;
    my %var3 = %radwege_speed;
    my $Entry = 'Entry';
    eval {
	require Tk::NumEntry;
	$Entry = 'NumEntry';
    };
    my @act_page;
    $act_page[0] = $nb->add("q", -label => M"Straenqualitt");
    my $gridy = 0;
    $act_page[0]->Label(-text => M"Straenqualitt",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 0);
    $act_page[0]->Label(-text => M"max. Geschwindigkeit",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 1,
						   -columnspan => 2,
						  );
    $gridy++;
#XXX geht nicht...warum ???
#     $t->bind('<Return>' => sub {
# warn $t->focusCurrent;
# 		   if ($t->focusCurrent->isa('Tk::Entry')) {
# 		       $t->focusNext->tabFocus;
# 		   }
# 	       });

    my @e;
    for (0 .. 3) {
	my $i = $_;
	$act_page[0]->Label(-text => "Q$i: " .
			          $category_attrib{"Q$i"}->[ATTRIB_LONG],
			)->grid(-row => $gridy, -column => 0, -sticky => 'w');
	my $w;
	$w = $e[$i] = $act_page[0]->$Entry(-textvariable => \$var{"Q$i"},
					-width => 3);
	$w->grid(-row => $gridy, -column => 1, -sticky => 'e');
	$act_page[0]->Label(-text => 'km/h')->grid(-row => $gridy, -column => 2,
						-sticky => 'w');
	$gridy++;
    }
    $e[0]->tabFocus;

    my $cb1;
    $cb1 = $act_page[0]->Checkbutton
      (-text => M"Verwenden",
       -variable => \$qualitaet_s_optimierung,
       -command => sub { change_state_all($act_page[0], $qualitaet_s_optimierung,
					  {$cb1=>1}); },
      )->grid(-row => $gridy++,
	      -column => 2,
	      -sticky => 'e');
    change_state_all($act_page[0], $qualitaet_s_optimierung, {$cb1=>1});

    #######
    $act_page[1] = $nb->add("cat", -label => M"Straenkategorien",
-createcmd => sub {
    $gridy = 0;
    $act_page[1]->Label(-text => M"Straenkategorien",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 0);
    $act_page[1]->Label(-text => M"max. Geschwindigkeit",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 1,
						   -columnspan => 2,
						  );
    $gridy++;
    # XXX BAB
    for (qw(HH H N NN)) {
	my $i = $_;
	$act_page[1]->Label(-text => $category_attrib{$i}->[ATTRIB_PLURAL] . ": "
			)->grid(-row => $gridy, -column => 0,
				-sticky => 'w');
	my $w = $act_page[1]->$Entry(-textvariable => \$var2{$i},
				  -width => 3);
	# bind return XXX
	$w->grid(-row => $gridy, -column => 1, -sticky => 'e');
	$act_page[1]->Label(-text => 'km/h')->grid(-row => $gridy, -column => 2,
						-sticky => 'w');
	$gridy++;
    }

    {
	require Tk::Optionmenu;
	# Die Verwendung von $name2inx ist nur ein Workaround...
	# Eigentlich wrde ich die [Name => Wert]-Notation von Optionmenu
	# verwenden wollen, aber das geht nicht :-(
	my $name2inx =
	    {M"Nur Hauptstraen" => 0,
	     M"Hauptstraen bevorzugen" => 1,
	     M"Alle Straen bercksichtigen" => 2,
	     M"Nebenstraen bevorzugen" => 3,
	     M"Nur Nebenstraen" => 4,
	    };
	my $default = M"Alle Straen bercksichtigen";
	my $o = $act_page[1]->Optionmenu
	  (-options => [sort { $name2inx->{$a} <=> $name2inx->{$b} } keys %$name2inx],
	   -variable => \$default,
	   -command => sub {
	       my $i = 0;
	       # XXX BAB
	       for (qw(HH H N NN)) {
		   $var2{$_} = [[100,100,1,1],
				[100,100,12,12],
				[100,100,100,100],
				[12,12,100,100],
				[1,1,100,100],
			       ]->[$name2inx->{$default}][$i];
		   $i++;
	       }
	   })->grid(-row => $gridy,
		    -column => 0,
		    -sticky => 'w');
    }

    my $cb2;
    $cb2 = $act_page[1]->Checkbutton
      (-text => M"Verwenden",
       -variable => \$strcat_optimierung,
       -command => sub { change_state_all($act_page[1], $strcat_optimierung,
					  {$cb2=>2}); },
      )->grid(-row => $gridy++,
	      -column => 2,
	      -sticky => 'e');
    change_state_all($act_page[1], $strcat_optimierung, {$cb2=>2});
});
    #######
    $act_page[2] = $nb->add("rw", -label => M"Radwege",
-createcmd => sub {
    $gridy = 0;
    $act_page[2]->Label(-text => M"Radwege",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 0);
    $act_page[2]->Label(-text => M"max. Geschwindigkeit",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 1,
						   -columnspan => 2,
						  );
    $gridy++;
    require Radwege;
    for (@Radwege::bbbike_category_order) {
	my $i = $_;
	$act_page[2]->Label(-text => $Radwege::bez{$i} .": "
			)->grid(-row => $gridy, -column => 0,
				-sticky => 'w');
	my $w = $act_page[2]->$Entry(-textvariable => \$var3{$i},
				  -width => 3);
	# bind return XXX
	$w->grid(-row => $gridy, -column => 1, -sticky => 'e');
	$act_page[2]->Label(-text => 'km/h')->grid(-row => $gridy, -column => 2,
						-sticky => 'w');
	$gridy++;
    }

    my $N_RW_cb;
    my $cb3;
    $cb3 = $act_page[2]->Checkbutton
      (-text => M"Verwenden",
       -variable => \$radwege_optimierung,
       -command => sub { change_state_all($act_page[2], $radwege_optimierung,
					  {$cb3=>3,$N_RW_cb=>1}); },
      )->grid(-row => $gridy++,
	      -column => 2,
	      -sticky => 'e');
    change_state_all($act_page[2], $radwege_optimierung, {$cb3=>3});

    $N_RW_cb = $act_page[2]->Checkbutton
	(-text => M"Hauptstraen ohne Radwege/Busspuren meiden",
	 -variable => \$N_RW_optimization,
	 -command => sub {
	     if ($N_RW_optimization) {
		 $radwege_optimierung = 0;
		 $strcat_optimierung = 0;
		 change_state_all($act_page[2], $radwege_optimierung,
				  {$cb3=>1,$N_RW_cb=>1});
	     }
	 },
	)->grid(-row => $gridy++,
		-column => 0,
		-sticky => "w");
});

    #######
    $act_page[3] = $nb->add("lsa", -label => M"Ampel-Optimierung",
-createcmd => sub {
    $gridy = 0;
    $act_page[3]->Label(-text => M"Ampel-Optimierung",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 0);
#      $act_page[3]->Label(-text => M"max. Geschwindigkeit",
#  		     -font => $font{'bold'})->grid(-row => $gridy,
#  						   -column => 1,
#  						   -columnspan => 2,
#  						  );
    $gridy++;

    my $dgf = $act_page[3]->Frame->grid(-row => $gridy++, -column => 0,
				     -sticky => 'w', -columnspan => 3);
    my $gridyy = 0;
    $dgf->Label(-text => M("Durchschnittsgeschwindigkeit (km/h)").":"
	       )->grid(-row => $gridyy, -column => 0,
		       -sticky => 'w');
    my $gridxx = 1;
    for (qw(10 15 20 25 30)) {
	$dgf->Radiobutton(-text => $_,
			  -variable => \$average_v,
			  -value => $_,
			  -command => \&calc_ampel_optimierung,
			 )->grid(-row => $gridyy, -column => $gridxx++,
				 -sticky => 'w');
    }
    $gridyy++;
    my $am_frame = $dgf->Frame->grid(-row => $gridyy,
				     -column => 1,
				     -columnspan => 5,
				     -sticky => "nw");
    $am_frame->Radiobutton(-text => M"Automatisch",
			   -variable => \$average_v,
			   -value => 0,
			   -command => \&calc_ampel_optimierung,
			   )->pack(-side => 'left');
    $am_frame->Radiobutton(-text => M"Manuell ber Strecke",
			   -variable => \$average_v,
			   -value => -1,
			   -command => \&calc_ampel_optimierung,
			   )->pack(-side => 'left');

    $dgf->Label(-text => M("Beschleunigung (m/s^2)").":"
	       )->grid(-row => ++$gridyy, -column => 0,
		       -sticky => 'w');
    $gridxx = 1;
    my $found_beschleunigung;
    for (qw(0.5 1 1.5 2)) {
	$dgf->Radiobutton(-text => $_,
			  -variable => \$beschleunigung,
			  -value => $_,
			  -command => \&calc_ampel_optimierung,
			 )->grid(-row => $gridyy, -column => $gridxx++,
				 -sticky => 'w');
	if ($beschleunigung == $_) {
	    $found_beschleunigung++;
	}
    }

    if (!$beschleunigung) { $beschleunigung = 1 }
    if (!$found_beschleunigung) {
	if ($beschleunigung > 2) { $beschleunigung = 2 }
	elsif ($beschleunigung < 0.5) { $beschleunigung = 0.5 }
	$beschleunigung = int($beschleunigung*2)/2;
    }
    $gridyy++;

    $dgf->Label(-text => M("Verlorene Strecke (m)").":"
		)->grid(-row => $gridyy, -column => 0, -sticky => "w");
    $dgf->Entry(-textvariable => \$lost_strecke_per_ampel,
		-width => 5
		)->grid(-row => $gridyy, -column => 1,
			-columnspan => 5, -sticky => "w");

    my $cb4;
    $cb4 = $act_page[3]->Checkbutton
      (-text => M"Verwenden",
       -variable => \$ampel_optimierung,
       -command => sub { change_state_all($act_page[3], $ampel_optimierung,
					  {$cb4=>4}); },
      )->grid(-row => $gridy++,
	      -column => 2,
	      -sticky => 'e');
    change_state_all($act_page[3], $ampel_optimierung, {$cb4=>4});
});

    ####
    $act_page[4] = $nb->add("h", -label => M"Sonst. Beeintrchtigungen");
    $gridy = 0;
    $act_page[4]->Label(-text => M"Sonst. Beeintrchtigungen",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 0);
    $act_page[4]->Label(-text => M"max. Geschwindigkeit",
		     -font => $font{'bold'})->grid(-row => $gridy,
						   -column => 1,
						   -columnspan => 2,
						  );
    $gridy++;
#XXX geht nicht...warum ???
#     $t->bind('<Return>' => sub {
# warn $t->focusCurrent;
# 		   if ($t->focusCurrent->isa('Tk::Entry')) {
# 		       $t->focusNext->tabFocus;
# 		   }
# 	       });

    @e = ();
    for (0 .. 4) {
	my $i = $_;
	$act_page[4]->Label(-text => "q$i: " .
			          $category_attrib{"q$i"}->[ATTRIB_LONG],
			)->grid(-row => $gridy, -column => 0, -sticky => 'w');
	my $w;
	$w = $e[$i] = $act_page[4]->$Entry(-textvariable => \$var4{"q$i"},
					-width => 3);
	$w->grid(-row => $gridy, -column => 1, -sticky => 'e');
	$act_page[4]->Label(-text => 'km/h')->grid(-row => $gridy, -column => 2,
						-sticky => 'w');
	$gridy++;
    }
    $e[0]->tabFocus;

    my $cb5;
    $cb5 = $act_page[4]->Checkbutton
      (-text => M"Verwenden",
       -variable => \$handicap_s_optimierung,
       -command => sub { change_state_all($act_page[4], $handicap_s_optimierung,
					  {$cb5=>5}); },
      )->grid(-row => $gridy++,
	      -column => 2,
	      -sticky => 'e');
    change_state_all($act_page[4], $handicap_s_optimierung, {$cb5=>5});

    #######
    $gridy = 1;
#XXX    my $close_window = sub { $t->destroy; };
    my $close_window = $withdraw;
    my $apply_window = sub { eval {
				 while(my($k,$v) = each %var) {
				     if ($qualitaet_s_speed{$k} != $v) {
					 undef $qualitaet_s_net;
				     }
				     $qualitaet_s_speed{$k} = $v;
				 }
				 while(my($k,$v) = each %var2) {
				     if ($strcat_speed{$k} != $v) {
					 undef $strcat_net;
				     }
				     $strcat_speed{$k} = $v;
				 }
				 while(my($k,$v) = each %var3) {
				     if ($radwege_speed{$k} != $v) {
					 undef $radwege_net;
				     }
				     $radwege_speed{$k} = $v;
				 }
				 while(my($k,$v) = each %var4) {
				     if ($handicap_s_speed{$k} != $v) {
					 undef $handicap_s_net;
				     }
				     $handicap_s_speed{$k} = $v;
				 }
			     };
			 };
    my $ok_window    = sub { &$close_window;
			     &$apply_window };
    my $bf = $t->Frame->grid(-row => $gridy++, -column => 0,
			     -columnspan => 3);
    my $okb = $bf->Button
      (Name => 'ok',
       -command => $ok_window)->grid(-row => 0, -column => 0,
				     -sticky => 'ew');
    $bf->Button(Name => 'apply',
		-command => $apply_window)->grid(-row => 0, -column => 1,
						 -sticky => 'ew');
    my $clb = $bf->Button
      (Name => 'close',
       -command => $close_window)->grid(-row => 0, -column => 2,
					-sticky => 'ew');

    $t->bind('<Return>' => sub { $okb->invoke });
    $t->bind('<<CloseWin>>' => sub { $clb->invoke });

    $t->Popup(@popup_style);
}

# Macht aus den negativen Werten positive und aus den positiven reziproke
# Werte fr die Penalty-Berechnung.
### AutoLoad Sub
sub optprefs2penalty {
    my $val = shift;
    if ($val < 0 ) {
	$val = -$val;
    } elsif ($val > 0) {
	$val = 1/$val;
    }
}

# Alternativer Dialog zum Einstellen der Optimierung. Noch nicht
# fertig.
### AutoLoad Sub
sub enter_opt_preferences2 {
    my $t = redisplay_top($top, "optprefs", -title => M"Optimierungsvorlieben");
#XXX handicap XXX
    return if !defined $t;
    my @l = ([M"Ampeln", M"Ampeln vermeiden", M"Ampeln bevorzugen"],
	     [M"Abbiegen", M"Abbiegen vermeiden", M"Abbiegen bevorzugen"],
	     [M"Qualitt", M"schlechte Qualitt vermeiden", M"schlechte Qualitt bevorzugen"],
	     [M"Kategorie", M"Hauptstraen vermeiden", M"Nebenstraen vermeiden"],
	     [M"Radwege", M"Radwege vermeiden", M"Radwege bevorzugen"],
	     [M"Steigung", M"Steigungen vermeiden", M"Steigungen bevorzugen"]);

# Kategorie: B/HH: 3, H: 2, N: 1, NN: 0

# Kat     Scale	Res

# 0	-5	-5
# 1	-5	-2
# 2	-5	+2
# 3	-5	+5

# 0	-3	-3
# 1	-3	-1
# 2	-3	+1
# 3	-3	+3

# 0	0	0
# 1	0	0
# 2	0	0
# 3	0	0

# 0	+3	+3
# 1	+3	+1
# 2	+3	-1
# 3	+3	-3

# 0	+5	+5
# 1	+5	+2
# 2	+5	-2
# 3	+5	-5

    my @scale;
    my $y = 0;
    for my $l_def (@l) {
	my($l, $minus, $plus) = @$l_def;
	$optprefs{$l} = 0 unless defined $optprefs{$l};
	$t->Label(-text => $minus)->grid(-row => $y, -column => 0,
					 -sticky => 'e',
					);
	$scale[$y] = $t->Scale(-showvalue => 0,
			       -from => -5,
			       -to   => 5,
			       -variable => \$optprefs{$l},
			       -orient => 'h')->grid(-row => $y, -column => 1);
	$t->Label(-text => $plus)->grid(-row => $y, -column => 2,
					-sticky => 'w',
				       );
	$y++;
    }

    my $close_window = sub { $t->destroy; };
    # XXX berhaupt mit apply und so arbeiten? Wie war das gedacht gewesen?
    my $apply_window = sub {
	eval {
	    # Ampeloptimierung
	    #XXX $lost_time_per_ampel    = -$optprefs{"Ampeln"}*?;
	    # XXX what about F ...?
	    $lost_strecke_per_ampel = -$optprefs{"Ampeln"}*40;
	    $ampel_optimierung      = ($optprefs{Ampeln} != 0);

	    # Abbiegeoptimierung
	    $abbiege_penalty     = -$optprefs{"Abbiegen"}*30;
	    $abbiege_optimierung = ($optprefs{Abbiegen} != 0);

	    # Qualittsoptimierung
#  	    foreach (0 .. 3) {
#  	    $qualitaet_s_speed{"Q
#  	    $qualitaet_s_optimierung = ($optprefs{Qualitt} != 0);
	};
    };
    my $ok_window    = sub { &$close_window;
			     &$apply_window };
    my $bf = $t->Frame->grid(-row => $y++, -column => 0,
			     -columnspan => 3,
			     -sticky => "ew");
    my $gridx = 0;
    my $okb = $bf->Button
      (Name => 'ok',
       -command => $ok_window)->grid(-row => 0, -column => $gridx++,
				     -sticky => 'ew');
    $bf->Button(-text => M"Zurcksetzen",
		-command => sub {
		    for my $l_def (@l) {
			$optprefs{$l_def->[0]} = 0;
		    }
		})->grid(-row => 0,
			 -column => $gridx++,
			 -sticky => 'ew');
    $bf->Button(Name => 'apply',
		-command => $apply_window)->grid(-row => 0,
						 -column => $gridx++,
						 -sticky => 'ew');
    my $clb = $bf->Button
      (Name => 'close',
       -command => $close_window)->grid(-row => 0, -column => $gridx++,
					-sticky => 'ew');

    $t->bind('<Return>' => sub { $okb->invoke });
    $t->bind('<<CloseWin>>' => sub { $clb->invoke });

    $t->idletasks;
    my $bar = $t->Frame(-bg => 'red'
		       )->place('-y' => $scale[0]->y,
				'-x' => $scale[0]->x + $scale[0]->width/2-1,
				-width => 2,
				-height => ($scale[-1]->y-$scale[0]->y+
					    $scale[-1]->height),
			       );

    # fast ein Hack: Events im senkrechten Strich werden auf die
    # daruterliegenden Scales weitergeleitet
    if ($bar->can('eventGenerate')) {
	foreach my $evt (qw(Motion
			    B1-Motion 1 ButtonRelease-1
			    B2-Motion 2 ButtonRelease-2
			   )) {
	    my $evt2 = $evt;
	    $bar->bind("<$evt2>" => sub {
			   my $e = shift->XEvent;
			   my($X,$Y) = ($e->X, $e->Y);
			   # feststellen, welches Scale-Widget sich
			   # darunter befindet
			   my $wid = $bar->containing($X+5,$Y);
			   if (defined $wid && $wid->isa('Tk::Scale')) {
			       $wid->eventGenerate("<$evt2>",
						   '-x' => $X-$wid->rootx,
						   '-y' => $Y-$wid->rooty,
						  );
			   }
		       });
	}
    }

    my_popup($t);

}

# Berechnet fr die Watt-Zahl die entsprechende Geschwindigkeit
### AutoLoad Sub
sub power2speed {
    my($power, %args) = @_;
    return if !$bp_obj;
    my $new_bp_obj = clone BikePower $bp_obj;
    $new_bp_obj->given('P');
    $new_bp_obj->headwind(0);
    my $grade = $args{-grade} || 0;
    $new_bp_obj->grade($grade);
    $new_bp_obj->power($power);
    $new_bp_obj->calc;
    $new_bp_obj->velocity*3.6;
}

# Berechnet fr die angegebene Geschwindigkeit die Watt-Zahl
### AutoLoad Sub
sub speed2power {
    my($speed, %args) = @_;
    return if !$bp_obj;
    my $new_bp_obj = clone BikePower $bp_obj;
    $new_bp_obj->given('v');
    $new_bp_obj->headwind(0);
    my $grade = $args{-grade} || 0;
    $new_bp_obj->grade($grade);
    $new_bp_obj->velocity($speed/3.6);
    $new_bp_obj->calc;
    $new_bp_obj->power;
}

# Berechnet den Faktor fr die max. Geschwindigkeit, die auf der
# jeweiligen Strae (wegen Belag, Kategorie ...) gefahren werden kann.
### AutoLoad Sub
sub max_speed {
    my($speed_belag) = @_;
    my $speed_radler = get_active_speed();
    ($speed_belag >= $speed_radler
     ? 1
     : $speed_radler/$speed_belag);
}

# Return active speed in km/h.
### AutoLoad Sub
sub get_active_speed {
    my $speed;
    if ($active_speed_power{Type} eq 'power') {
	$speed = power2speed($power[$active_speed_power{Index}]);
    } else {
	$speed = $speed[$active_speed_power{Index}];
    }
    if (!$speed) {
	$speed = 20; # fr alle Flle
    }
    $speed;
}

sub toggle_mouse_help {
    if (defined $toplevel{"help"} and
	Tk::Exists($toplevel{"help"})) {
	$toplevel{"help"}->destroy;
    } else {
	mouse_help();
    }
}

# Gibt ein Hilfsfenster mit der derzeitigen Maustastenbelegung aus
### AutoLoad Sub
sub mouse_help {
    my $bgcolor = 'grey80';
    my $help_t = redisplay_top($top, 'help',
			       -title => M"Maushilfe",
			       @popup_style,
			       -bg => $bgcolor);
    return if !defined $help_t;
    $help_t->protocol('WM_DELETE_WINDOW' => sub {
			  $show_mouse_help = 0;
			  $help_t->destroy;
		      });
    my $row = 0;
    $help_t->gridColumnconfigure($_, -minsize => "1.6i") for (0..2);
    $help_t->gridRowconfigure($row, -minsize => "0.7i");
    $help_t->Message(-textvariable => \$mouse_text[1],
		     -width => "1.5i",
		     -bg => $bgcolor,
		    )->grid(-row => $row+1, -column => 0, -sticky => 'ne');
    $help_t->Message(-textvariable => \$mouse_text[2],
		     -width => "1.5i",
		     -bg => $bgcolor,
		    )->grid(-row => $row, -column => 1, -sticky => 's');
    $help_t->Message(-textvariable => \$mouse_text[3],
		     -width => "1.5i",
		     -bg => $bgcolor,
		    )->grid(-row => $row+1, -column => 2, -sticky => 'nw');
    $row++;
    # Maus zeichnen
    my $c = $help_t->Canvas(-width => "1.13i", -height => "1.38i",
			    -bg => $bgcolor,
			    -borderwidth => 0,
			    -highlightthickness => 0,
			    -takefocus => 0,
			   )->grid(-row => $row, -column => 1);
    $c->create('rectangle',"0.070866i","0.070866i","1.062992i","1.311024i",
	       -fill => 'white',
	       -outline => undef);
    $c->create('line',"1.062992i","1.311024i","1.062992i","0.070866i","0.070866i","0.070866i","0.070866i","1.311024i","1.062992i","1.311024i");
    $c->create('line',"0.744094i","0.122047i","1.027559i","0.122047i","1.027559i","0.531496i","0.744094i","0.531496i","0.744094i","0.122047i");
    $c->create('line',"0.425197i","0.122047i","0.708661i","0.122047i","0.708661i","0.531496i","0.425197i","0.531496i","0.425197i","0.122047i");
    $c->create('line',"0.106299i","0.122047i","0.389764i","0.122047i","0.389764i","0.531496i","0.106299i","0.531496i","0.106299i","0.122047i");
    $c->create('line', "0.106299i", "0.318898i", "0.000000i", "0.318898i");
    $c->create('line', "1.133858i", "0.318898i", "1.027559i", "0.318898i");
    $c->create('line', "0.562992i", "0.007874i", "0.562992i", "0.114173i");
}

## DEBUG_BEGIN
#BEGIN{mymstat("50% BEGIN");}
## DEBUG_END

# Ldt bzw. speichert eine Route
### AutoLoad Sub
sub load_save_route {
    my($save, $file, %args) = @_;
    status_message("");
    my $path;
    my $ext = $bbbike_route_ext;
    if (!defined $file) {
	my $method = $save ? "getSaveFile" : "getOpenFile";
	$file = $top->$method
	    (-title => ($save ? M"Route speichern" : M"Route laden"),
	     -initialdir => $oldpath,
	     ($save ?
	      (-defaultextension => ".$ext") :
	      (-filetypes => [[M"Route-Dateien", '.' . $bbbike_route_ext],
			      [M"GPS-Tracks", ['.tracks','.trk']],
			      [M"G7toWin", ['.g7t', '.G7T']],
			      [M"MPS-Tracks", ['.mps', '.MPS']],
			      [M"Alle Dateien",  '*']]),
	     ));
	return if !defined $file;
	$oldpath = dirname $file;
    }
    if (!-f $file && !file_name_is_absolute($file)) { # unvollstndiger Dateiname
        $file = catfile($bbbike_routedir, "$file.$ext");
    }
    if (!$save) { # load
        IncBusy($top) if $top;
	eval {

	    my $res = Route::load($file,
				  { ResetRoute => \&reset_undo_route },
				  -fuzzy => 0);

	    if ($res->{IsStrFile}) {
		# eine Strassen-Datei
		plot_layer('str', $file);
		return;
	    }

	    @realcoords          = @{ $res->{RealCoords} };
	    @search_route_points = @{ $res->{SearchRoutePoints} };

	    if (!@realcoords) {
		die M"Leere Routendatei";
	    }

	    add_last_loaded($file, $last_loaded_obj);
	    @coords = ();
	    my $i;
	    my($minx, $miny, $maxx, $maxy);
	    my $std = ($coord_system eq 'standard');
	    foreach (@realcoords) {
		my($x, $y);
		if ($std) {
		    ($x, $y) = transpose($_->[0], $_->[1]);
		} else {
		    ($x, $y) = transpose
		      ($coord_system_obj->standard2map($_->[0], $_->[1]));
		    require BBBikeAdvanced;
		    buttonpoint($x, $y);
		};
		push(@coords, [$x, $y]);
		if (!defined $minx || $x < $minx) { $minx = $x }
		if (!defined $maxx || $x > $maxx) { $maxx = $x }
		if (!defined $miny || $y < $miny) { $miny = $y }
		if (!defined $maxy || $y > $maxy) { $maxy = $y }
	    }

	    if ($zoom_loaded_route) {
		zoom_view($minx, $miny, $maxx, $maxy);
	    } elsif ($center_loaded_route) {
		my $x2 =
		  (abs($coords[0]->[0]-$minx) > abs($coords[0]->[0]-$maxx)
		   ? $minx : $maxx);
		my $y2 =
		  (abs($coords[0]->[1]-$miny) > abs($coords[0]->[1]-$maxy)
		   ? $miny : $maxy);
		$c->center_view2($coords[0]->[0], $coords[0]->[1], $x2, $y2);
	    }

	    restore_search_route_points();

	    redraw_path();
	    updatekm();
	    update_route_strname();

	    undef $search_route_flag;
	    search_route_mouse_cont();

	    status_message(Mfmt("Typ der Routendatei: %s, Punkte: %s", $res->{Type}, scalar(@realcoords)), "info");
	};

	if ($@) {
	    status_message($@, 'err');
	}
	DecBusy($top) if $top;
    } else { # Save
	my $case = ($os eq 'win' ? '(?i)' : '');
	if ($file !~ /$case\.$ext$/i) {
	    $file .= ".$ext";
	}
	make_backup($file);
	eval {
	    Route::save(-file => $file,
			-realcoords => \@realcoords,
			-searchroutepoints => \@search_route_points);
	};
	if ($@) {
	    status_message($@, 'err');
	} else {
	    add_last_loaded($file, $last_loaded_obj);
	}
    }
}

### AutoLoad Sub
sub save_route_as_bbd {
    my $file = $top->getSaveFile(-defaultextension => '.bbd');
    return unless defined $file;
    my $tmpfile = "$tmpdir/bbbike-$$.bbr";
    load_save_route(1, $tmpfile);
    system("$FindBin::RealBin/miscsrc/bbr2bbd", $tmpfile, $file);
    unlink $tmpfile;
}

### AutoLoad Sub
sub save_route_as_esri {
    my $file = $top->getSaveFile(-defaultextension => '.shp');
    return unless defined $file;
    $file =~ s/\.shp$//;
    my $tmpfile1 = "$tmpdir/bbbike-$$.bbr";
    my $tmpfile2 = "$tmpdir/bbbike-$$.bbd";
    load_save_route(1, $tmpfile1);
    eval {
	# XXX Better diagnostics. bbr2bbd and bbd2esri should be
	# callable as modules.
	system("$FindBin::RealBin/miscsrc/bbr2bbd", $tmpfile1, $tmpfile2);
	status_message(Mfmt("Das Ausfhren von %s ist mit dem Code %s fehlgeschlagen", "bbr2bbd", $?), "die") if $? != 0;
	system("$FindBin::RealBin/miscsrc/bbd2esri", $tmpfile2, "-o", $file);
	status_message(Mfmt("Das Ausfhren von %s ist mit dem Code %s fehlgeschlagen", "bbd2esri", $?), "die") if $? != 0;
    }; warn $@ if $@;
    unlink $tmpfile2;
    unlink $tmpfile1;
}

### AutoLoad Sub
sub save_route_as_gpx {
    my(%args) = @_;
    if (!eval { require Strassen::GPX; 1 }) {
	guess_perlmod_install_advice($@);
    } else {
	my $file = $top->getSaveFile(-defaultextension => '.gpx');
	return unless defined $file;
	my $tmpfile = "$tmpdir/bbbike-$$.bbr";
	my $tmp2file = "$tmpdir/bbbike-$$.bbd";
	load_save_route(1, $tmpfile);
	system("$FindBin::RealBin/miscsrc/bbr2bbd", $tmpfile, $tmp2file);
	my $s = Strassen->new($tmp2file);
	my $out = $s->Strassen::GPX::bbd2gpx(%args);

	open(FH, "> $file") or status_message("Can't write to $file: $!", "die");
	binmode FH;
	print FH $out;
	close FH;

	unlink $tmpfile;
	unlink $tmp2file;
    }
}

# weiter zur Druckfunktion...
### AutoLoad Sub
sub print_function {
    my $print_backend = $print_backend;
    if (!defined $print_backend || $print_backend eq "") {
	if ($os eq 'win') {
	    my $available = print_postscript(undef, -checkavailability => 1);
	    if (!$available) {
		# a PDF viewer should be available everywhere nowadays on Win32
		$print_backend = "pdf";
	    } else {
		$print_backend = "ps";
	    }
	} else {
	    $print_backend = "ps";
	}
    }

    if ($print_backend eq 'pdf') {
	require File::Temp;
	my($fh, $tmpfile) = File::Temp::tempfile(UNLINK => 1,
						 SUFFIX => ".pdf");
	$tmpfiles{$tmpfile}++;
	pdf_export(-visiblemap => 1, -file => $tmpfile);
	close($fh);
	if (-e $tmpfile) {
	    view_pdf($tmpfile);
	}
	return;
    }

    return if slow_postscript_generation();

    my $tmpfile = create_postscript
	($c,
	 -legend => ($use_legend ?
		     ($use_legend_right ? 'right' : 'left') : 0),
	 -colormode => $ps_color,
	 -rotate    => $ps_rotate,
	 -scale_a4  => $ps_scale_a4,
	);
    my @print_args;
    if ($ps_scale_a4) {
	push @print_args, -media => 'A4';
    }
    print_postscript($tmpfile, @print_args);
}

# Berechnet die Canvas-Koordinaten der Route aus den Standard-Koordinaten
### AutoLoad Sub
sub realcoords2coords {
    @coords = ();
    my $i;
    my $std = ($coord_system eq 'standard');
    foreach (@realcoords) {
	my($x, $y);
	if ($std) {
	    ($x, $y) = transpose($_->[0], $_->[1]);
	} else {
	    ($x, $y) = transpose
	      ($coord_system_obj->standard2map($_->[0], $_->[1]));
	}
	push @coords, [$x, $y];
    }
}

######################################################################
#
# Funktionen zum Zeichnen der Kartenelemente (Strecken und Punkte)
#
# Allegemeine Plot-Funktion
sub plot {
    my($type, $abk, %args) = @_;
    Hooks::get_hooks("before_plot")->execute;
    if (exists $args{'-draw'}) {
	if ($type eq 'str') {
	    $str_draw{$abk} = $args{'-draw'};
	} else {
	    $p_draw{$abk} = $args{'-draw'};
	}
	delete $args{'-draw'};
    }
    if ($type eq 'str') {
	plotstr($abk, %args);
    } elsif ($type eq 'p') {
	if ($abk =~ /sperre/) {
	    my $object_or_file = $args{-object} || $args{-filename} || $p_obj{$abk};
	    $args{-abk} = $abk;
	    plot_sperre($object_or_file, %args);
	} else {
	    plotp($abk, %args);
	}
    } else {
	die "Unknown type $type";
    }
###XXX Hh?
#    if ($BBBikeLazy::mode && defined &bbbikelazy_remove_data) {
#	bbbikelazy_remove_data($type, $abk);
#    }
    Hooks::get_hooks("after_plot")->execute;
}

sub plot_layer {
    my($type, $file, %args) = @_;
    my $abk = next_free_layer();
    if (!defined $abk) {
	status_message("Kein freier Layer mehr vorhanden", "err");
	return;
    }
    fix_stack_order($abk);
    if ($type eq 'p') {
	$p_draw{$abk} = 1;
	$p_file{$abk} = $file if defined $file;
    } else {
	$str_draw{$abk} = 1;
	$str_file{$abk} = $file if defined $file;
    }
    plot($type, $abk, %args);
    $abk;
}

# XXX
# hheres Canvas-Objekt
# - derzeitige Transpose-Funktion
# - Scale
# - Koordinatensystem
#
# Zeichnet Strecken auf dem Canvas
sub plotstr {
    my($abk, %args) = @_;
    my $c = $c;
    return if !$c;
    my $std = 1;
    my $transpose = \&transpose;
    if (exists $args{Canvas}) {
	$c = $args{Canvas};
	$std = 0;
	$transpose = ($show_overview_mode eq 'brb'
		      ? \&transpose_small
		      : \&transpose_medium);
    }

    status_message("");
    $abk   = 's'      if !defined $abk;

    # alte Tags lschen
    if (!$std || !$args{FastUpdate} || !$str_draw{$abk}) {
	$c->delete($abk);		# evtl. alte Koordinaten lschen
	$c->delete("pp-$abk");
    }
    $c->delete("$abk-out");
    $c->delete("$abk-label");
    $c->delete("$abk-label-bg");
    $c->delete("$abk-fg") if $abk eq 'v'; # XXX do not use for "b", "r" or "u"!
    if ($abk eq 'w') { # Wasser *und* Inseln lschen
	$c->delete("i");
	$c->delete("i-out");
    }

    if ($std && !$str_draw{$abk}) {
	if ($lazy_str{$abk}) {
	    bbbikelazy_remove_data("str", $abk);
	}
	return;
    }

    # Get source from filename or street object
    my($filename, $filename_maybe, $str, $has_filename);
    if (!defined $args{-object}) {
	$filename = $args{-filename} || $args{Filename};
	if (defined $filename) {
	    $str_file{$abk} = $filename;
	} else {
	    $filename = get_strassen_file($str_file{$abk});
	    $filename_maybe = $str_file{$abk} if $edit_mode_flag; # as fallback if no -orig version available
	}
	$has_filename = 1;
	delete $pending{"replot-str-$abk"};
	if (!defined $filename) {
	    status_message(Mfmt("Dateiname fr <%s> ist nicht definiert.", $abk),
			   'err');
	    return;
	}
    } else {
	$str = delete $args{-object};
    }

    # Radwege werden im Edit-Modus besser mit radweg_draw_canvas() gezeichnet
    # XXX ups? stimmt das noch immer???
    if ($abk eq 'rw' and $coord_system ne 'standard') {
	radweg_open();
	radweg_draw_canvas();
	return;
    }

    my $dont_use_cache;
    my $dont_set_cache = 1;

    if (!$str) {
	$dont_use_cache = ($coord_system ne 'standard' ||
			   $args{FastUpdate} ||
			   $abk =~ /^L\d+/);
	$dont_set_cache = ($coord_system ne 'standard' ||
			   $abk =~ /^L\d+/);
    TRYCACHE: {
	    if (defined $str_obj{$abk} && !$dont_use_cache) {
		last TRYCACHE if ($abk eq 'l' and
				  (defined $str_cache_attr{'l'} and
				   $str_cache_attr{'l'} ne "$str_far_away{'l'}"));
		last TRYCACHE if ($str_regions{'l'} && @{$str_regions{'l'}});
		last TRYCACHE if !$str_obj{$abk}->is_current;
		$str = $str_obj{$abk};
	    }
	}
    }

    if (!defined $str) {
	cache_decider_init();
	# XXX use get_any_strassen_obj?
	if ($abk eq 'w') {
	    $str = _get_wasser_obj($filename);
	} elsif ($abk eq 'l') {
	    $str = _get_landstr_obj();
	} elsif ($abk eq 'comm') {
	    $str = _get_comments_obj();
	} else {
	    eval { $str = Strassen->new($filename); };
	    if ($@ && $filename_maybe) {
		eval { $str = Strassen->new($filename_maybe); };
	    }
	    if ($@) {
		if ($edit_mode || $edit_normal_mode) {
		    status_message(Mfmt("Beim Laden der Datei %s: %s", $filename, $@), "info");
		    return;
		}
		# Do not "die", may be in Progress mode
		if (!$no_original_datadir) {
		    $str_draw{$abk} = 0;
		    status_message($@, "err");
		}
		return;
	    }
	}
	if ($abk ne 'w') { # XXX get_cache_identifier benutzen
	    if ((!$dont_set_cache && cache_decider()) ||
		$abk =~ /^[sl]$/ ||
		$edit_normal_mode # Always cache in edit mode to make "reload all" work
	       ) {
		# fr nearest_line_points Caching erzwingen
		$str_obj{$abk} = $str;
		if ($abk eq 'l') {
		    $str_cache_attr{'l'} = "$str_far_away{'l'}";
		    # XXX str_regions?
		}
	    }
	}
    }

    if (!defined $str) {
	status_message(M"Kein Objekt definiert!", "err");
	return;
    }

    handle_global_directives($str, $abk);
    # XXX obsolete:
    if (defined $filename && -e "$filename.desc") {
	require BBBikeAdvanced;
	read_desc_file("$filename.desc", $abk);
    }

    if ($str_name_draw{$abk}) {
	require Tk::RotFont;
    }

    my $lazy = defined $args{-lazy} ? $args{-lazy} : $lazy_plot;
    if ($std && $lazy && $has_filename) {
	return bbbikelazy_add_data("str", $abk, $str);
    }

    my $complete_str = $str;
    my $diffed_str = 0;
    my $indexmap;
    if ($args{FastUpdate}) {
	my($new_str, $todelref);
	($new_str, $todelref, $indexmap) = $str->diff_orig(-clonefile => 1);
	if (!defined $new_str) {
	    warn M("Diff-Ausgabe wird nicht verwendet"), "\n" if $verbose;
	    $c->delete($abk);		# evtl. alte Koordinaten lschen
	    $c->delete("pp-$abk");
	} else {
	    if ($verbose) {
		warn M("Diff-Ausgabe wird verwendet"), "\n";
		warn Mfmt("Anzahl der neu zu zeichnenden Straen: %d", scalar @{$new_str->data}), "\n";
		warn Mfmt("Anzahl der zu lschenden Straen: %d", scalar @$todelref), "\n";
	    }
	    for my $id (@$todelref) {
		for my $strdeladd ("", "-label") {
		    $c->delete("$abk$strdeladd-$id");
		}
	    }
	    $str = $new_str;
	    $diffed_str = 1;
	}
    }

    my($restrict, @restrict, $ignore, @ignore);
    if (exists $str_restrict{$abk} ||
	exists $str_ignore{$abk}) {
	my $all_set = 1;
	my($k,$v);
	if (exists $str_restrict{$abk}) {
	    while(($k,$v) = each %{$str_restrict{$abk}}) {
		if (!$v) {
		    $all_set = 0;
		} else {
		    push @restrict, $k;
		}
	    }
	}
	if (exists $str_ignore{$abk}) {
	    while(($k,$v) = each %{$str_ignore{$abk}}) {
		if ($v) {
		    $all_set = 0;
		    push @ignore, $k;
		}
	    }
	}
	if (exists $str_restrict{$abk}) {
	    if ($all_set || !@restrict) {
		undef $restrict;
	    } else {
		$restrict = '^(' . join('|', map { quotemeta $_ } @restrict) . ")\$";
	    }
	}
	if (exists $str_ignore{$abk}) {
	    $ignore = '^(' . join('|', map { quotemeta $_ } @ignore) . ")\$";
	}
	if ($] >= 5.005) {
	    eval q{
	    $restrict = qr/$restrict/
		if defined $restrict;
	    $ignore = qr/$ignore/
		if defined $ignore;
            }; die $@ if $@;
	}
    }

    my %category_color = %category_color;
    if ($abk eq 'l') {
	my($k,$v);
	while(($k,$v) = each %category_color) {
	    if ($k =~ /^\d+$/ && $k != 0) {
		$category_color{$k} = $category_color{0};
	    }
	}
    }
    if ($abk =~ /^g(|[PD])$/ && !$std) {
	$category_color{Z} = '#9e9e9e';
    }

    my %category_width; # XXX the global category_width is ignored!!! should be changed
    my $default_width = get_line_width($abk) || 4;
    if (defined $args{Width}) { $default_width = $args{Width} }
    {
	my $scale = (exists $args{Canvas}
		     ? ($show_overview_mode eq 'brb'
			? $small_scale
			: $medium_scale)
		     : $scale);
	foreach (keys %line_width) {
	    if (/^$abk-(.*)/) {
		my $cat = $1;
		$category_width{$cat} = get_line_width($_, $scale);
	    }
	}
    }

    # current category size
    my %category_size = map {
	($_, $category_size{$_}* $label_font_size/10)
    } keys %category_size;

    my $no_overlap_label = (exists $args{NoOverlapLabel}
			    ? $args{NoOverlapLabel} : $no_overlap_label{$abk});

    my $coordsys = $coord_system_obj->coordsys;

    my $use_stippleline = 0; # XXX Duplikat in BBBikeLazy
    if (exists $line_dash{$abk}) {
	if ($Tk::VERSION >= 800.016) {
	    $use_stippleline = 2; # new dash code
	} else {
	    $use_stippleline = 1;
	    require Tk::StippleLine;
	}
    } else {
	if ($Tk::VERSION >= 800.016) {
	    $use_stippleline = 3; # signal that -dash exists
	}
    }

    destroy_delayed_restack();

    IncBusy($top);
    $progress->Init(-dependents => $c,
		    (defined $filename ? (-label => $filename) : ()),
		   );

    eval {
	# XXX Experiment
	if ($orientation eq 'landscape' &&
	    !$edit_mode &&
#XXX?	    !$edit_normal_mode &&
	    !$str_name_draw{$abk} &&
	    !$str_nr_draw{$abk} &&
	    !exists $args{Canvas} &&
	    !$p_draw{'pp'} &&
	    ($abk eq 'l' || $abk eq 's') &&
	    defined &BBBike::fast_plot_str) {
	    eval {
		die if $str->isa("Strassen::Storable");
		# Wenn outline nicht definiert ist, dann wird es
		# eigenmchtig gesetzt. Die XS-Routine ist dafr schnell
		# genug.
		if (!defined $str_outline{$abk}) {
		    $str_outline{$abk} = 1;
		}
		my(@files) = $str->file;
		if (grep { /\.gz$/ } @files) {
		    die "fast_plot_str can't handle gzipped files yet";
		}
		my(@args) = ($c, $abk,
			     (@files > 1 ? \@files : @files),
			     $progress);
		if (@restrict) {
		    push @args, \@restrict;
		} else {
		    push @args, undef;
		}
		push @args, \%category_width;
		if (@ignore) {
		    push @args, \@restrict;
		} else {
		    push @args, undef;
		}
		BBBike::fast_plot_str(@args);
	    };
	    my $err = $@;
	    if (!$err) {
		goto PLOTSTR_CONT;
	    } else {
		warn $err if $^W;
	    }
	}

	my $xadd_anchor = $xadd_anchor_type->{$abk};
	my $yadd_anchor = $yadd_anchor_type->{$abk};
	my $label_spaceadd = $label_spaceadd{$abk};

	my $real_i = 0;
	my $i;
	my $anzahl_eindeutig = $str->count;
	$str->init;
	$escape = 0;
	my @extra_tags = ($abk =~ /^L\d+/ ? ("$abk-s") : ());

	my %conv_args;
	if ($args{-map}) {
	    $conv_args{Map} = $args{-map};
	}
	my $conv = $str->get_conversion(%conv_args);

	my $draw_sub = eval $plotstr_draw_sub;
	string_eval_die($@, $plotstr_draw_sub) if $@; #die $@ if $@;

	my $bench = Tk::Time_So_Far();
	while (1) {
	    my $ret = $str->next;
	    last if !@{$ret->[Strassen::COORDS]};
	    if (!$diffed_str) {
		if ($real_i % 80 == 0) {
		    $progress->Update($real_i/$anzahl_eindeutig);
		    # XXX Probleme mit diesem $top->update, falls
		    # ein anderer plot-Vorgang damit gestartet wird
		    #if ($progress) {
		    #$top->update; # fr Escape
		    #if ($escape) {
		    #	status_message("Zeichnen von <$filename> abgebrochen",
		    #		       "warn");
		    #	last;
		    #    }
		    #}
		}
	    }
#last if $i > 100; # for Debugging XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

	    $i = $indexmap && exists $indexmap->{$real_i} ? $indexmap->{$real_i} : $real_i; 
	    $draw_sub->($ret); # XXX evtl. den Code mit eval erzeugen
	    $real_i++;
	}
# XXXXXX can this ever happen? XXXXXXXXXXXXXXXXXXXXXXXXXXX
# XXX Yes: If a bbd file contains a half-valid line (with name and cat, but without coords)
if ($str->pos != scalar @{$str->{Data}}) { status_message("warning: " . $str->pos . " != " . scalar(@{$str->{Data}}) . "!", "dialog", "err") }
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
	warn sprintf "Plotting streets took %.3fs\n", Tk::Time_So_Far()-$bench
	    if $verbose;

      PLOTSTR_CONT:
	$c->itemconfigure('pp',
			  -capstyle => $capstyle_round,
			  -width => 5,
			  -fill => $pp_color,
			 );
	if ($layer_active_color{$abk}) {
	    $c->itemconfigure($abk, -activefill => $layer_active_color{$abk});
	}
	if ($abk eq 'e' && defined $linestip) {
	    # XXX hacky: make sure that e-img do not get configured,
	    # so use 'e-Q' instead of just 'e'
	    $c->itemconfigure('e-Q', -stipple => '@' . $linestip);
	}

	if (!exists $args{Canvas} && !$no_make_net && !$edit_mode && !$edit_normal_mode) {
	    if (defined $net && !$net->is_source($str) && $abk =~ /^[sl]$/) {
		make_net();
	    } elsif (!defined $net && $abk =~ /^[sl]$/) {
		make_net();
	    }
	}

	if (($edit_mode || $edit_normal_mode || $abk eq 'relgps' || $args{FastUpdate})) { # XXX? and !$diffed_str) {
	    warn "Try to copy original data" if $verbose;
	    my $r = $complete_str->copy_orig;
	    warn "Returned $r" if $verbose;
	}

	if ($std) {
	    restack_delayed(); # XXX check!
	}

	if ($abk =~ /^L\d+/) {
	    std_str_binding($abk);
	}

    };
    warn __LINE__ . ": $@" if ($@);
    $progress->Finish;
    DecBusy($top);
}

# Arguments:
#   $c: canvas to draw onto
#   $x, $y: canvas coordinates
#   %args: options for createText, special options are:
#      -outlinecolor: color of the outline, by default canvas background
#      -outlinewidth: width of the outline, by default 1
### AutoLoad Sub
sub outline_text {
    my($c, $x, $y, %args) = @_;
    my $outline_color = delete $args{'-outlinecolor'} || $c->cget(-background);
    my $fg            = delete $args{'-fill'}         || "black";
    my $outline_width = delete $args{'-outlinewidth'} || 1;
    my $tags          = delete $args{'-tags'};
    $tags = [$tags] if ref $tags ne 'ARRAY';
    $outline_i++;
    if (defined $outline_color && defined $outline_width) {
        my @outlines;
        foreach (1 .. $outline_width) {
            push(@outlines, [-$_, 0], [$_, 0], [0, $_], [0, -$_]);
        }
        foreach (@outlines) {
            $c->createText($x + $_->[0], $y + $_->[1],
			   -fill => $outline_color,
			   -tags => [@$tags, 'outlslave-'.$outline_i,
				     'outldata_'.join("_",@$_)],
			   %args);
        }
    }
    $c->createText($x, $y,
		   -fill => $fg,
		   -tags => [@$tags, 'outlmaster', 'outlmaster-'.$outline_i,
			     "outlmaster-width-$outline_width"],
		   %args);
}

### AutoLoad Sub
sub plot_mount {
    my $mount;
    if ($str_draw{'mount'}) {
	my $comm = Strassen->new(get_strassen_file("comments_mount"));
	my $comm_mount = Strassen->new_copy_restricted($comm, -grep => ["St;"]);
	$mount = MultiStrassen->new($str_file{"mount"},
				    $comm_mount);
    }
    plot('str','mount', -object => $mount);
}

# Zeichnet gesperrte Straen und Einbahnstraen.
# XXX gesperrte Wegfhrungen werden noch nicht gezeichnet
### AutoLoad Sub
sub plot_sperre {
    my $file_or_object = shift;
    my %args = @_;
    my $abk = $args{-abk} || 'sperre';
    Hooks::get_hooks("before_plot")->execute;
    if (!$args{FastUpdate}) {
	$c->delete($abk);
    }
    if (!$p_draw{$abk}) {
	Hooks::get_hooks("after_plot")->execute; # XXX should not be here
	return;
    }
    IncBusy($top);
    eval {
	my $gesperrt;
	if (UNIVERSAL::isa($file_or_object, "Strassen")) {
	    $gesperrt = $file_or_object;
	} else {
	    $gesperrt = new Strassen (defined $file_or_object
				      ? $file_or_object
				      : get_strassen_file($sperre_file)
				     );
	}
	$p_obj{$abk} = $gesperrt;
	my $is_car = $gesperrt->file =~ /gesperrt_car/;
	my $car_photo;
	if ($is_car) {
	    $car_photo = load_photo($top, 'car.' . $default_img_fmt, -persistent => 1);
	}

	my $width0  = get_line_width('sperre0');
	my $width1  = get_line_width('sperre1');
	my $width2  = get_line_width('sperre2');
	my $width3  = get_line_width('sperre3');
	my $length1 = get_line_length('sperre1');
	my $length2 = get_line_length('sperre2');

	my %type2cat =
	    (StrassenNetz::BLOCKED_ONEWAY()        => "sperre1",
	     StrassenNetz::BLOCKED_ONEWAY_STRICT() => "sperre1s",
	     StrassenNetz::BLOCKED_COMPLETE()      => "sperre2",
	     StrassenNetz::BLOCKED_CARRY()         => "sperre0",
	    );

	my %type2fill =
	    (StrassenNetz::BLOCKED_ONEWAY()        =>
	     ($width1 && $length1 ? $category_color{'sperre1'} : undef),
	     StrassenNetz::BLOCKED_ONEWAY_STRICT() =>
	     ($width1 && $length1 ? $category_color{'sperre1s'} : undef),
	    );
	my $fill2 = ($width2 && $length2 ? $category_color{'sperre2'} : undef);

	# korrigieren, damit beim Vergrern etwas erscheint
	$length1 = ($length1 ? $length1 : 1);
	$length2 = ($length2 ? $length2 : 1);

	# XXX don't duplicate code from plotstr!
	my $diffed_str = 0;
	my $str = $gesperrt;
	my $complete_str = $str;
	my $indexmap;
	#XXX Abfrage auf $edit_mode notwendig?
	if (#XXX del: ($edit_mode || $edit_normal_mode) &&
	    $args{FastUpdate}) {
	    my($new_str, $todelref);
	    ($new_str, $todelref, $indexmap) = $str->diff_orig(-clonefile => 1);
	    if (!defined $new_str) {
		warn M("Diff-Ausgabe wird nicht verwendet") if $verbose;
		$c->delete($abk);		# evtl. alte Koordinaten lschen
		$c->delete("pp-$abk");
	    } else {
		if ($verbose) {
		    warn M("Diff-Ausgabe wird verwendet"), "\n";
		    warn Mfmt("Anzahl der neu zu zeichnenden Objekte: %d", scalar @{$new_str->data}), "\n";
		    warn Mfmt("Anzahl der zu lschenden Objekte: %d", scalar @$todelref), "\n";
		}
		foreach (@$todelref) {
		    $c->delete("$abk-$_");
		}
		$str = $new_str;
		$diffed_str = 1;
		$gesperrt = $str;
	    }
	}

	$gesperrt->init;
	my $real_pos = -1;
	while (1) {
	    $real_pos++;
	    my $pos = $indexmap && exists $indexmap->{$real_pos} ? $indexmap->{$real_pos} : $real_pos;
	    my $ret = $gesperrt->next;
	    my @kreuzungen = @{$ret->[Strassen::COORDS]};
	    last if !@kreuzungen;

	    my($icon_x, $icon_y, $icon_anchor);
	    my $sub_cat;
	    my($cat,@addinfo) = split ':', $ret->[Strassen::CAT];
	    if ($cat eq StrassenNetz::BLOCKED_CARRY) {
		if ($width0) { # grer 0
		    $sub_cat = 'sperre0';
		    my($x,$y) =
		      transpose(@{Strassen::to_koord1($kreuzungen[0])});

		    my $rad = deg2rad($addinfo[1] || 0); # addinfo[1] is angle
		    my $cos4 = cos($rad)*4;
		    my $sin4 = sin($rad)*4;
		    for my $add ([-$cos4,$sin4], [0,0], [$cos4,-$sin4]) {
			my($yadd,$xadd) = @$add;
			$c->createLine
			    ($x-$cos4+$xadd, ($y+$yadd)-$sin4, $x+$cos4+$xadd, ($y+$yadd)+$sin4,
			     -width => $width0, # XXX $width0 verwenden und in get_line_width anpassen
			     -tags => [$abk, $sub_cat,
				       $ret->[Strassen::NAME], $abk.'-'.$pos],
			    );
		    }
		    ($icon_x, $icon_y, $icon_anchor) = ($x, $y, 'n');
		}
	    } elsif ($cat eq StrassenNetz::BLOCKED_NARROWPASSAGE) {
#XXX works, but write nicer...
		# if ($widthBNP) XXX
		$sub_cat = 'sperreBNP';
		my($x,$y) =
		    transpose(@{Strassen::to_koord1($kreuzungen[0])});

		my $rad = deg2rad($addinfo[1] || 0); # addinfo[1] is angle
		my $cos1 = cos($rad);
		my $sin1 = sin($rad);
		my $cos4 = cos($rad)*4;
		my $sin4 = sin($rad)*4;
		for my $add ([-$cos1,$sin1]) {
		    my($yadd,$xadd) = @$add;
		    $c->createLine
			($x-$cos1+$xadd, ($y+$yadd)-$sin1, $x+$cos4+$xadd, ($y+$yadd)+$sin4,
			 -width => $width0, # XXX $widthBNP verwenden und in get_line_width anpassen
			 -tags => [$abk, $sub_cat,
				   $ret->[Strassen::NAME], $abk.'-'.$pos],
			);
		}
		for my $add ([$cos1,-$sin1]) {
		    my($yadd,$xadd) =  @$add;
		    $c->createLine
			($x-$cos4+$xadd, ($y+$yadd)-$sin4, $x+$cos1+$xadd, ($y+$yadd)+$sin1,
			 -width => $width0, # XXX $widthBNP verwenden und in get_line_width anpassen
			 -tags => [$abk, $sub_cat,
				   $ret->[Strassen::NAME], $abk.'-'.$pos],
			);
		}
		($icon_x, $icon_y, $icon_anchor) = ($x, $y, 'n');
	    } elsif ($cat =~ /^@{[ StrassenNetz::BLOCKED_ROUTE ]}(nocross)?/) {
		my $is_nocross = defined $1;
		$sub_cat = 'sperre3';
		my @c;
		for(my $i = 0; $i <= $#kreuzungen; $i++) {
		    push @c, map { transpose(@$_) } Strassen::to_koord1($kreuzungen[$i]);
		}

		line_shorten(\@c);

		if (!$is_nocross) {
		    # move to the right
		    my $delta = -3;
		    for(my $i = 2; $i < $#c; $i+=2) {
			# atan2(y2-y1, x2-x1)
			my $alpha = atan2($c[$i+1]-$c[$i-1], $c[$i]-$c[$i-2]);
			my $beta  = $alpha - pi()/2;
			my($dx, $dy) = ($delta*cos($beta), $delta*sin($beta));
			$c[$i] += $dx;
			$c[$i+1] += $dy;
			if ($i == 2) {
			    $c[0] += $dx;
			    $c[1] += $dy;
			}
		    }
		}

		$c->createLine
		    (@c,
		     -width => $width3,
		     (!$is_nocross ? (-arrow => 'last',
				      -arrowshape => [4,6,3],
				      -smooth => 1,
				      -fill => 'red',				
				     )
		                   : (-fill => 'orange',
				     )
		     ),
		     ($Tk::VERSION >= 800.016 ? (-dash => $line_dash{sperre3}) : ()),
		     -tags => [$abk, $sub_cat,
			       $ret->[Strassen::NAME], $abk.'-'.$pos],
		    );
		($icon_x, $icon_y, $icon_anchor) = ($c[0], $c[1], 'n');
	    } else {
		$sub_cat = $type2cat{$cat};
		if ($cat eq StrassenNetz::BLOCKED_COMPLETE && $#kreuzungen == 0) {
		    # ein bisschen schummeln ...
		    push @kreuzungen, $kreuzungen[0];
		}
		for my $i (0 .. $#kreuzungen - 1) {
		    my($x1,$y1) =
			transpose(@{Strassen::to_koord1($kreuzungen[$i])});
		    my($x2,$y2) =
			transpose(@{Strassen::to_koord1($kreuzungen[$i+1])});
		    my($xm,$ym) = (int(($x2-$x1)/2+$x1), int(($y2-$y1)/2+$y1));

		    if ($cat eq StrassenNetz::BLOCKED_ONEWAY ||
			$cat eq StrassenNetz::BLOCKED_ONEWAY_STRICT) {
			my $alpha = atan2($y2-$y1, $x2-$x1);
			my($xd,$yd) = ($length1*cos($alpha),
				       $length1*sin($alpha));
			$c->createLine($xm+$xd, $ym+$yd, $xm-$xd, $ym-$yd,
				       -fill => $type2fill{$cat},
				       -width => $width1,
				       -arrow => 'last',
				       -arrowshape => [4,6,3],
				       -tags => [$abk, $sub_cat,
						 $ret->[Strassen::NAME], $abk.'-'.$pos],
				      );
		    } elsif ($cat eq StrassenNetz::BLOCKED_COMPLETE) {
			# 		    $c->createImage($xm,$ym,
			# 				    -image => $blocked_photo,
			# 				    -tags => [$abk, 'sperre2',
			# 					      $ret->[Strassen::NAME], $abk.'-'.$pos]);
			$c->createLine($xm-$length2, $ym-$length2,
				       $xm+$length2, $ym+$length2,
				       -fill => $fill2,
				       -width => $width2,
				       -tags => [$abk, $sub_cat,
						 $ret->[Strassen::NAME], $abk.'-'.$pos]);
			$c->createLine($xm-$length2, $ym+$length2,
				       $xm+$length2, $ym-$length2,
				       -fill => $fill2,
				       -width => $width2,
				       -tags => [$abk, $sub_cat,
						 $ret->[Strassen::NAME], $abk.'-'.$pos]);
		    }

		    if (defined $addinfo[0] && $addinfo[0] =~ /\binwork\b/ && $inwork_photo) {
			$c->createImage($xm,$ym,
					-anchor => "nw",
					-image => $inwork_photo,
					-tags => [$abk,$sub_cat,$ret->[Strassen::NAME], $abk.'-'.$pos]);
		    }

		    if ($is_car && $car_photo) {
			$c->createImage($xm, $ym,
					-image => $car_photo,
					-anchor => "sw",
					-tags => [$abk, $sub_cat,$ret->[Strassen::NAME], $abk.'-'.$pos]);
		    }
		}
	    }

	    if ($is_car && $car_photo && defined $icon_x) {
		$c->createImage($icon_x, $icon_y,
				-image => $car_photo,
				-anchor => $icon_anchor,
				-tags => [$abk, $sub_cat,$ret->[Strassen::NAME], $abk.'-'.$pos]);
	    }
	}

	if (($edit_mode || $edit_normal_mode || $args{FastUpdate}) and !$diffed_str) {
	    warn "Try to copy original data" if $verbose;
	    my $r = $complete_str->copy_orig;
	    warn "Returned $r" if $verbose;
	}

    };
    warn $@ if $@;
    DecBusy($top);
    Hooks::get_hooks("after_plot")->execute;
}

sub line_shorten {
    my($cref) = @_;
    if (@$cref > 4) { # else should never happen
	my $len1 = Strassen::Util::strecke([@{$cref}[0,1]], [@{$cref}[2,3]]);
	my $whole_len1 = $len1 > 20 ? 20 : $len1;
	my $len2 = Strassen::Util::strecke([@{$cref}[-4,-3]], [@{$cref}[-2,-1]]);
	my $whole_len2 = $len2 > 20 ? 20 : $len2;
	@{$cref}[0,1, -2,-1] =
	    (($cref->[0]-$cref->[2])/$len1*$whole_len1+$cref->[2],
	     ($cref->[1]-$cref->[3])/$len1*$whole_len1+$cref->[3],
	     ($cref->[-2]-$cref->[-4])/$len2*$whole_len2+$cref->[-4],
	     ($cref->[-1]-$cref->[-3])/$len2*$whole_len2+$cref->[-3],
	    );
    }
}

sub activate_temp_blockings {
    my $do_show_active_temp_blockings = shift;
    my(%args) = @_;
    my $now = $args{-now} || time;
    my $from = $args{-from};
    # XXX these should come from a file as constants
    my $temp_blockings_dir = "$FindBin::RealBin/data/temp_blockings"; # XXX was misc
    my $file = "$temp_blockings_dir/bbbike-temp-blockings.pl";
    if (!-r $file) {
	status_message(M("Kein Support fuer temporaere Sperrungen, das Verzeichnis $temp_blockings_dir fehlt. Dieses Verzeichnis ist aus dem CVS erhltlich, siehe README."), "warn");
	return;
    }
    if (!$do_show_active_temp_blockings) {
	$show_active_temp_blockings = 0;
	plot("p", "temp_sperre", -draw => 0);
	plot("str", "temp_sperre_s", -draw => 0);
	make_net(); # XXX find more performant solution
	undef $temporary_handicap_s;
	if ($handicap_s_net) {
	    undef $handicap_s_net;
	    make_handicap_net();
	}
	return;
    }

    eval {
	use vars qw(@temp_blocking); # XXX do not use a global such as this
	@temp_blocking = ();
	do $file; # XXX Safe?
	my @s;
	for my $o (@temp_blocking) {
	    next if !$o; # undefined entry
	    my $do_it = 0;
	    if (defined $from && (!defined $o->{until} || $o->{until} > $from)) {
		$do_it = 1;
	    }
	    if (!$do_it && ((!defined $o->{from} || $o->{from} < $now) &&
			    (!defined $o->{until} || $o->{until} > $now))) {
		$do_it = 1;
	    }

	    if ($do_it) {
		require POSIX;
		my $datefmt = "%d.%m.%Y %H:%M:%S";
		my $from_date_readable = defined $o->{from}  ? POSIX::strftime($datefmt, localtime($o->{from})) : "...";
		my $to_date_readable   = defined $o->{until} ? POSIX::strftime($datefmt, localtime($o->{until})) : "...";
		my $text = $o->{text} . " [" . $from_date_readable . " - " . $to_date_readable . "]";
		my $s;
		my $f;
		if ($o->{file}) {
		    $f = "$temp_blockings_dir/$o->{file}";
		    $s = Strassen->new($f);
		} else {
		    $s = Strassen->new_from_data_string($o->{data});
		}
		my $new_s = Strassen->new;
		push @{$new_s->{DependentFiles}}, $f if $f;
		$s->init;
		while(1) {
		    my $ret = $s->next;
		    last if !@{ $ret->[Strassen::COORDS()] };
		    $ret->[Strassen::NAME] = $text;
		    $new_s->push($ret);
		}
		push @s, $new_s;
	    }
	}
	if (!@s) {
	    if ($verbose) {
		if (defined $args{-now}) {
		    warn "Keine temporren Sperrungen am " . scalar(localtime($now)) . "\n";
		} else {
		    warn "Keine aktiven temporren Sperrungen\n";
		}
	    }
	    return;
	}
	my $ms = MultiStrassen->new(@s);
	warn "Aktive temporre Sperrungen: " . join(", ", $ms->dependent_files) . "\n" if $verbose;
	make_net() if !$net;
	$net->make_sperre($ms, Type => "all");
	$temporary_handicap_s = Strassen->new_copy_restricted($ms, -callback => sub { $_[0]->[Strassen::CAT] =~ /^q\d/ });
require Data::Dumper; print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([$temporary_handicap_s],[])->Indent(1)->Useqq(1)->Dump; # XXX
	if ($handicap_s_net) {
	    undef $handicap_s_net;
	    make_handicap_net();
	}
	plot("p", "temp_sperre", -object => $ms, -draw => 1);
	plot("str", "temp_sperre_s", -object => $ms, -draw => 1);
    };
    if ($@) {
	$show_active_temp_blockings = 0;
	status_message($@, "warn"); # do not die, may be called before mainloop
    } else {
	$show_active_temp_blockings = 1;
    }
}

### AutoLoad Sub
sub read_sperre_tragen {
    my($force) = @_;
    return if (!$force && keys %sperre_tragen != 0);
    %sperre_tragen = ();
    if (!eval {
	my $s = new Strassen get_strassen_file($sperre_file);
	$s->init;
	while(1) {
	    my $r = $s->next;
	    last if !@{ $r->[Strassen::COORDS] };
	    my($cat,@addinfo) = split /:/, $r->[Strassen::CAT];
	    if ($cat eq StrassenNetz::BLOCKED_CARRY &&
		defined $addinfo[0] && $addinfo[0] ne '') {
		$sperre_tragen{$r->[Strassen::COORDS][0]} = $addinfo[0];
	    } elsif ($cat eq StrassenNetz::BLOCKED_NARROWPASSAGE &&
		defined $addinfo[0] && $addinfo[0] ne '') {
		$sperre_narrowpassage{$r->[Strassen::COORDS][0]} = $addinfo[0];
	    }
	}
	1;
    }) {
	warn $@;
    }
}

# Liest aus der Datenbasis die Ampelinformation ein.
### AutoLoad Sub
sub read_ampeln {
    my($force) = @_;
    return if (!$force && keys %ampeln != 0);
    if (!eval {
	$p_obj{'lsa'} = new Strassen get_strassen_file($p_file{'lsa'});
	%ampeln = %{ $p_obj{'lsa'}->get_hashref_by_cat };
	1;
    }) {
	warn $@;
	%ampeln = ();
    }
}

# Liest aus der Datenbasis die Hheninformation ein.
### AutoLoad Sub
sub read_hoehe {
    my(%args) = @_;
    return if (!$args{-force} && keys %hoehe != 0 &&
	       $p_obj{"hoehe"} && $p_obj{"hoehe"}->is_current);
    if (!eval {
	my $h = new Strassen ($args{-file}
			      ? $args{-file}
			      : get_strassen_file("hoehe")
			     );
	%hoehe = %{ $h->get_hashref };
	$p_obj{"hoehe"} = $h;
	1;
    }) {
	warn $@;
	%hoehe = ();
    }
}

# Zeichnet die Hhendaten.
### AutoLoad Sub
sub plot_hoehe {
    my(%args) = @_;
    Hooks::get_hooks("before_plot")->execute;
    $c->delete('hoehe');
    if ($p_draw{'hoehe'}) {
	my $coordsys = $coord_system_obj->coordsys;
	IncBusy($top);
	eval {
	    read_hoehe(%args);
	    while(my($koord,$hoehe) = each %hoehe) {
		my($xx,$yy) = split(/,/, $koord);
		if ($edit_mode && $xx =~ /([A-Za-z])?(-?\d+)$/) {
		    my $this_coordsys = (defined $1 ? $1 : '');
		    if ($this_coordsys eq $coordsys ||
			!($this_coordsys ne '' || $coordsys ne 'B')) {
			$xx = $2;
		    } else {
			next; # while
		    }
		}
		my($x, $y) = transpose($xx, $yy);
		$c->createLine($x, $y, $x+1, $y+1,
			       -fill => 'red',
			       -tags => 'hoehe',
			      );
		$c->createText($x+1, $y+1, -anchor => 'nw',
			       -font => $font{'small'},
			       -text => $hoehe,
			       -tags => 'hoehe',
			      );
	    }
	};
	warn __LINE__ . ": $@" if $@;
	DecBusy($top);
    }
    Hooks::get_hooks("after_plot")->execute;
}

# XXX Folgende drei Funktionen zusammenfassen
# Gibt ein Gewsser-Objekt zurck.
### AutoLoad Sub
sub _get_wasser_obj {
    my $filename = shift;
    my @obj;
    if ($wasserstadt) {
	push @obj, Strassen->new($filename);
    }
    if ($wasserumland) {
	push @obj, Strassen->new(get_strassen_file("wasserumland"));
    }
    if ($str_far_away{'w'}) {
	push @obj, Strassen->new(get_strassen_file("wasserumland2"));
    }
    return if !@obj;
    return $obj[0] if (@obj == 1);
    new MultiStrassen @obj;
}

# Gibt ein Orte-Objekt zurck.
### AutoLoad Sub
sub _get_orte_obj {
    my $type = shift || "o";
    my $fname  = ($type eq 'oo' ? 'orte_city' : 'orte');
    my @obj;
    push @obj, new Strassen get_strassen_file($fname);
    if ($p_far_away{$type}) {
	push @obj, new Strassen get_strassen_file($fname . "2");
    }
    return $obj[0] if (@obj == 1);
    new MultiStrassen @obj;
}

# Gibt ein Landstraen-Objekt zurck.
### AutoLoad Sub
sub _get_landstr_obj {
    my @obj;
    push @obj, new Strassen get_strassen_file($str_file{'l'});
    if ($str_far_away{'l'}) {
	my $file = "landstrassen2";
	push @obj, new Strassen get_strassen_file($file);
    }
    if ($str_regions{'l'}) {
	foreach my $file (@{ $str_regions{'l'} }) {
	    push @obj, new Strassen get_strassen_file($file);
	}
    }
    return $obj[0] if (@obj == 1);
    new MultiStrassen @obj;
}

# Gibt ein Kommentar-Objekt zurck.
### AutoLoad Sub
sub _get_comments_obj {
    my @objs;
    for my $type (@comments_types) {
	next if $type eq "mount";
	eval {
	    my $f = get_strassen_file("comments_$type");
	    push @objs, Strassen->new($f);
	}; warn $@ if $@;
    }
    MultiStrassen->new(@objs);
}

# Zeichnet Punkte auf dem Canvas.
# plotp ist nur ein Dispatcher.
### AutoLoad Sub
sub plotp {
    my($abk, %args) = @_;
    return if $abk =~ /^pp/; # wird in plotstr gezeichnet
    return if !$c;
    if ($abk eq 'p') {
	require BBBikeAdvanced;
	ploths();
    } elsif ($abk eq 'o') {
	plotorte(Shortname => 1, %args);
    } elsif ($abk eq 'obst') {
	plotobst();
    } elsif ($abk eq 'hoehe') {
	plot_hoehe();
    } else {
	plot_point($abk, %args);
    }
}

# Zeichent ein Punktsymbol, z.B. ein U-Bahn-Zeichen
### AutoLoad Sub
sub plot_symbol {
    my($c, $abk, %args) = @_;
    my $tag_bg = $args{'-tag_bg'} || "$abk-bg";
    my $tag_fg = $args{'-tag_fg'} || "$abk-fg";
    if ($abk eq 'b' || $abk eq 'r') {
	my %arg = get_symbol_scale('b');
	$c->itemconfigure
	  ($tag_bg, -fill => ($abk eq 'b' ? $category_color{"SC"} : $category_color{"R"}), -capstyle => $capstyle_round,
	   -width => $arg{-width});
	$c->itemconfigure
	  ($tag_fg, -anchor => 'c', -fill => 'white',
	   -text => (defined $arg{-font}
		     ? ($abk eq 'b' ? 'S' : 'R') : ''),
	   (defined $arg{-font} ? (-font => $arg{-font}) : ()),
	  );
    } elsif ($abk eq 'u') {
	my %arg = get_symbol_scale('u');
	$c->itemconfigure($tag_bg, -fill => $category_color{'U'},
			  -width => $arg{-width});
	$c->itemconfigure
	  ($tag_fg, -anchor => 'c', -fill => 'white',
	   -text => (defined $arg{-font} ? 'U' : ''),
	   (defined $arg{-font} ? (-font => $arg{-font}) : ()),
	  );
    } elsif ($abk =~ /^L\d+/) {
  	eval {
  	    $c->itemconfigure($tag_fg,
  			      -capstyle => $capstyle_round,
			     );
  	}; warn $@ if $@;
    } elsif ($abk eq 'pl') {
	$c->itemconfigure($tag_fg, -fill => 'red', -capstyle => 'projecting',
			  -width => 8);
    } elsif ($abk eq 'vf') {
	$c->itemconfigure($tag_fg, -image => get_symbol_scale($abk));
	$c->itemconfigure($tag_bg, -fill => 'black',
			  -width => 3); # XXX width skalierbar machen
    } elsif ($abk =~ /^(kn|rest)$/) {
	$c->itemconfigure($tag_fg, -image => get_symbol_scale($abk));
    } elsif ($abk eq 'ki') {
	$c->itemconfigure($tag_fg, -image => $kino_klein_photo);
    }
}

# Zeichnen von Punkten. Hiermit werden U-/S-/R-Bahnhfe, Ampeln und alle
# sonstigen Punkte gezeichnet.
# Arguments:
#  $abk: layer token
#  -filename => $filename (Alias: Filename => $filename)
#  NameDraw => $boolean
### AutoLoad Sub
sub plot_point {
    my($abk, %args) = @_;

    status_message("");

    # Tags lschen
    my @del_tags = ("$abk-bg", "$abk-img", "$abk-fg", "$abk-label");

    if (!$args{FastUpdate}) {
	$c->delete($_) for (@del_tags);
    }

    my($ampel_photo, $ampelf_photo, $andreaskr_photo);
    if ($abk eq 'lsa') {
	undef %ampeln;
	$ampel_photo      = get_symbol_scale('lsa-X');
	$ampelf_photo     = get_symbol_scale('lsa-F');
	$andreaskr_photo  = get_symbol_scale('lsa-B');
	$zugbruecke_photo = get_symbol_scale('lsa-Zbr');
	$c->delete('lsas'); # Ampelschaltung-Symbole lschen
	$c->delete('lsas-t'); # Ampelschaltung-Symbole lschen
    }
    if (!$p_draw{$abk}) {
	if ($main::lazy_p{$abk}) {
	    bbbikelazy_remove_data("p", $abk);
	}
	return;
    }

    my $filename = $args{-filename} || $args{Filename};
    my $filename_maybe;
    if (!defined $filename) {
	$filename = get_strassen_file($p_file{$abk});
	$filename_maybe = $p_file{$abk} if $edit_mode_flag;
    }
    if (!defined $filename) {
	status_message("Filename is not defined", 'err');
	return;
    }

    my $lazy = defined $args{-lazy} ? $args{-lazy} : $lazy_plot;
    if ($lazy && !$args{FastUpdate}) {
	return bbbikelazy_add_data("p", $abk, $filename);
    }

    # XXX $ignore code fehlt noch...
    my $restrict;
    if (exists $str_restrict{$abk}) {
	my $all_set = 1;
	my($k,$v);
	my @restrict;
	while(($k,$v) = each %{$str_restrict{$abk}}) {
	    if (!$v) {
		$all_set = 0;
	    } else {
		$k =~ s/([?*])/\\$1/g; # quote special, XXX mehr davon bei Bedarf
		push @restrict, $k;
	    }
	}
	if ($all_set || !@restrict) {
	    undef $restrict;
	} else {
	    $restrict = '^(' . join('|', @restrict) . ")\$";
	}
    }

    my $default_width;
    if (defined $args{Width}) { $default_width = $args{Width} }

    my $coordsys = $coord_system_obj->coordsys;

    destroy_delayed_restack();

    IncBusy($top);
    $progress->Init(-dependents => $c,
		    (defined $filename ? (-label => $filename) : ()),
		   );

    eval {
	my $bhf;
	if ($args{FastUpdate} ||
	    (defined $p_obj{$abk} &&
	     $p_obj{$abk}->is_current &&
	     $coord_system eq 'standard' &&
	     $abk !~ /^L\d+/)
	   ) {
	    $bhf = $p_obj{$abk};
	} else {
	    cache_decider_init();
	    eval {
		$bhf = new Strassen $filename;
	    };
	    if ($@ && $filename_maybe) {
		eval {
		    $bhf = Strassen->new($filename_maybe);
		};
	    }
	    if ($@) {
		$p_draw{$abk} = 0;
		die "OK" if ($abk eq 'r' && $coord_system ne 'standard');
		die "no-original-datadir" if $no_original_datadir;
		die $@;
	    }
	    if (($coord_system eq 'standard' &&
		 (cache_decider() || $abk =~ /^L\d+/ || $abk eq 'kn') # 'L...' und 'kn' wegen Info
		) ||
		$edit_normal_mode # Always cache in edit mode to make "reload all" work
	       ) {
		$p_obj{$abk} = $bhf;
	    }
	}

	handle_global_directives($bhf, $abk);
	# XXX obsolete:
	if (-e "$filename.desc") {
	    require BBBikeAdvanced;
	    read_desc_file("$filename.desc", $abk);
	}

	my $complete_str = $bhf;
	my $diffed_str = 0;
	my $indexmap;
	if ($args{FastUpdate}) {
	    my($new_str, $todelref);
	    ($new_str, $todelref, $indexmap) = $bhf->diff_orig(-clonefile => 1);
	    if (!defined $new_str) {
		warn M("Diff-Ausgabe wird nicht verwendet") if $verbose;
		$c->delete($_) for (@del_tags);
	    } else {
		if ($verbose) {
		    warn M("Diff-Ausgabe wird verwendet"), "\n";
		    warn Mfmt("Anzahl der neu zu zeichnenden Punkte: %d", scalar @{$new_str->data}), "\n";
		    warn Mfmt("Anzahl der zu lschenden Punkte: %d", scalar @$todelref), "\n";
		}
		foreach my $id (@$todelref) {
		    for my $ptagadd ("") { # XXX what's necessary of the following?, "-fg", "-bg", "-img", "-label") {
			$c->delete("$abk$ptagadd-$id");
		    }
		}
		$bhf = $new_str;
		$diffed_str = 1;
	    }
	}

	# XXX Experiment!!!
	if ($orientation eq 'landscape' &&
	    !$edit_mode &&
#XXX?       !$edit_normal_mode &&
	    $abk eq 'lsa' &&
	    !$diffed_str &&
	    defined &BBBike::fast_plot_point) {
	    eval {
		die if $bhf->isa("Strassen::Storable");
		my(@files) = $bhf->file;
		if (grep { /\.gz$/ } @files) {
		    die "fast_plot_point can't handle gzipped files yet";
		}
		my(@args) = ($c, $abk,
			     (@files > 1 ? \@files : @files),
			     $progress);
		BBBike::fast_plot_point(@args);
	    };
	    my $err = $@;
	    if (!$err) {
		%ampeln = %{ $bhf->get_hashref_by_cat };
		goto PLOTPOINT_CONT;
	    } else {
		warn $err if $^W;
	    }
	}

	my $real_i = 0;
	my $i;
	my $anzahl_eindeutig = $bhf->count;
	$bhf->init;
	# XXX Duplikat in BBBikeLazy:
	my $ubahn_length = ($abk eq 'u'
			    ? do { my(%a) = get_symbol_scale('u');
				   $a{-width}/2 }
			    : 0);
	my $name_draw = (exists $args{NameDraw}
			 ? $args{NameDraw} : $p_name_draw{$abk});
	my $name_draw_tag = "$abk-label";
	my $name_draw_other = ($name_draw_tag =~ /^[ubr]-label$/
			       ? [qw(u-label b-label r-label)]
			       : $name_draw_tag);
	my $no_overlap_label = (exists $args{NoOverlapLabel}
				? $args{NoOverlapLabel} : $no_overlap_label{$abk});
	my $xadd_anchor = $xadd_anchor_type->{'u'};
	my $yadd_anchor = $yadd_anchor_type->{'u'};
	my $label_spaceadd = $label_spaceadd{'u'};

	my %conv_args;
	if ($args{-map}) {
	    $conv_args{Map} = $args{-map};
	}
	my $conv = $bhf->get_conversion(%conv_args);

	my $draw_sub = eval $plotpoint_draw_sub;
	string_eval_die($@, $plotpoint_draw_sub) if $@; #die $@ if $@;

	while(1) {
	    my $ret = $bhf->next;
	    last if !@{$ret->[Strassen::COORDS]};
	    $progress->Update($real_i/$anzahl_eindeutig) if $real_i % 80 == 0;
	    $i = $indexmap && exists $indexmap->{$real_i} ? $indexmap->{$real_i} : $real_i; 
	    $draw_sub->($ret);
	    $real_i++;
	}
	plot_symbol($c, $abk);
      PLOTPOINT_CONT:

	if (($edit_mode || $edit_normal_mode || $abk eq 'relgps' || $args{FastUpdate})) { # XXX? and !$diffed_str) {
	    warn "Try to copy original data" if $verbose;
	    my $r = $complete_str->copy_orig;
	    warn "Returned $r" if $verbose;
	}

	restack_delayed(); # XXX check!
    };
    if ($@) {
	if ($@ =~ /^no-original-datadir/) {
	    # silently ignore
	} elsif ($@ !~ /^OK/) {
	    status_message($@, ($edit_mode || $edit_normal_mode ? 'info-stack-trace' : 'err'));
	}
    }
    $progress->Finish;
    DecBusy($top);
}

# Gibt einen eindeutigen Bezeichner fr das Caching der Orts/Straenlisten
# zurck.
### AutoLoad Sub
sub get_cache_identifier {
    my($linetype, $type) = @_;
    if ($linetype eq 'p') {
	my $fa = $p_far_away{$type} || '';
	$fa;
    } elsif ($linetype eq 's' || $linetype eq 'str') { # XXX 'str' is probably wrong...
	my $fa = $str_far_away{$type} || '';
	# XXX str_regions?
	my $ret = $fa;
	if ($type eq 'w') {
	    $ret .= "-$wasserstadt-$wasserumland";
	}
	$ret;
    } else {
	die "Unknown linetype: $linetype";
    }
}

# Dialog zum Auswhlen einer Strae oder eines Ortes.
### AutoLoad Sub
sub choose_ort {
    my($linetype, $type, %args) = @_;

    my $data = $args{-data};
    my $nodraw = $args{-nodraw};
    my $ondestroy = $args{-ondestroy};
    my $additionalframe = $args{-additionalframe};
    my $sorted = exists $args{-unsorted} ? !$args{-unsorted} : 1;
    my $splitter = $args{-splitter};
    my $container = $args{-container};
    my $do_popup = exists $args{-popup} ? $args{-popup} : 1;

    unless ($nodraw) {
	if ($linetype =~ /^s/) {
	    if (!$str_draw{$type}) {
		$str_draw{$type} = 1;
		plot('str',$type);
	    }
	} elsif ($linetype =~ /^p/) {
	    if (!$p_draw{$type}) {
		$p_draw{$type} = 1;
		plot('p',$type);
	    }
	} else {
	    die "Unknown linetype: $linetype";
	}
    }

    my $action = (exists $args{'-action'}
		  ? $args{'-action'}
		  : ($linetype =~ /^s/
		     ? \&mark_street
		     : ($linetype =~ /^p/
			? \&mark_point
			: die "Unknown linetype: $linetype"
		       )
		    )
		 );

    if (!$args{-rebuild}) {
	if (!defined $choose_ort_cache{"$linetype-$type"} or
	    get_cache_identifier($linetype, $type)
	    ne $choose_ort_cache{"$linetype-$type"}) {
	    $args{-rebuild} = 1;
	}
    }

    if (!$toplevel{"chooseort-$type-$linetype"} or
	!Tk::Exists($toplevel{"chooseort-$type-$linetype"}) or
	$args{'-rebuild'} or
	$container) {
	if (defined $toplevel{"chooseort-$type-$linetype"} and
	    Tk::Exists($toplevel{"chooseort-$type-$linetype"})) {
	    $toplevel{"chooseort-$type-$linetype"}->destroy;
	    delete $toplevel{"chooseort-$type-$linetype"};
	}

	my $Listbox = "Listbox";
	if ($splitter) {
	    $Listbox = "HList";
	} else {
	    if ($sorted) {
		if (!defined $K2Listbox) {
		TRYLISTBOX: {
			foreach my $try (qw(K2Listbox KListbox WListbox)) {
			    if (eval q{ require Tk::} . $try . q{; 1;} && !$@) {
				$K2Listbox = $Listbox = $try;
				last TRYLISTBOX;
			    } else {
				warn "Can't use module Tk::$try: $@";
			    }
			}
		    }
		} else {
		    $Listbox = $K2Listbox;
		}
	    }
	}
	my $attrib = ($linetype eq 's'
		      ? $str_attrib{$type}
		      : $p_attrib{$type});
	IncBusy($top);
	my $t;
	eval {
	    if ($container) {
		$t = $container;
	    } else {
		$t = $top->Toplevel(-title => $attrib->[ATTRIB_PLURAL],
				    -class => "Bbbike Chooser");
		set_as_toolwindow($t);
		if ($coord_system eq 'standard') {
		    if ($ondestroy) {
			$t->protocol('WM_DELETE_WINDOW', [$ondestroy, $t]);
		    } else {
			$t->protocol('WM_DELETE_WINDOW', sub { $t->withdraw });
		    }
		    $toplevel{"chooseort-$type-$linetype"} = $t;
		}
	    }
	    my($showb, $closeb);

	    my $f = $t->Frame->pack(-side => "bottom"); # Button-Frame

	    if ($args{'-completelistbutton'}) {
		my $ff = $t->Frame->pack(-side => "bottom");
		my $label = $args{'completelistbuttonlabel'} || M"Komplette Liste";
		$ff->Button(-text => $label,
			    -command => $args{'-completelistbutton'},
			   )->pack;
	    }
	    if ($additionalframe) {
		my $ff = $f->Frame->pack(-fill => "both");
		$additionalframe->($t, $ff);
	    }

	    my $markf;
	    if ($args{'-markstartifactive'}) {
		if (($linetype eq 's' && $type =~ /^[sl]$/ &&
		     $net_type eq 's')                       ||
		    ($linetype eq 'p' && $type =~ /^[ub]$/ &&
		     $net_type eq 'us')                      ||
		    ($linetype eq 'p' && $type =~ /^[ubr]$/ &&
		     $net_type eq 'rus')                     ||
		    ($linetype eq 'p' && $type eq 'r' &&
		     $net_type eq 'r')			     ||
		    ($linetype eq 's' && $type =~ /^wr/ &&
		     $net_type eq 'wr')
		   ) {
		    $args{-markstart} = 1;
		}
	    }

	    if ($args{'-markstart'}) {
		 $markf = $t->Frame->pack(-side => "bottom");
	    }

	    my $lb;
	    my $max_cols;
	    if ($Listbox =~ /K.*Listbox/ && $Tk::VERSION >= 800) {
	        my $c = $t->Canvas(-takefocus => 0)->pack;
		my $x = 1;
		for ('A'..'Z') {
		    $c->createText($x, 1,
				   -text => $_,
				   -font => $font{'small'},
				   -anchor => 'nw',
				   -tags => $_,
				   -fill => 'black',
				  );
		    $x += $t->fontMeasure($font{'small'}, $_);
		}
		my $asc = $t->fontMetrics($font{'small'}, '-ascent');
		my $des = $t->fontMetrics($font{'small'}, '-descent');
		$c->GeometryRequest($x, $asc+$des+2);
		$c->bind('all', '<ButtonPress-1>' => sub {
			     my(@c) = $c->gettags('current');
			     $lb->Goto($c[0]);
			 });
		$c->bind('all', '<Enter>' => sub {
			     $c->itemconfigure('current', -fill => 'red');
			 });
		$c->bind('all', '<Leave>' => sub {
			     $c->itemconfigure('current', -fill => 'black');
			 });
	    }

	    my %orte;
	    my @orte;
	    my $object;
	    if ($type eq 'p') {
		my @haltestellen;
		require Fahrinfo;
		my $hs = tie @haltestellen, 'Fahrinfo::Haltestellen';
		for my $i (0 .. $hs->{'anzahl_namen'}-1) {
		    $orte{$hs->FETCH($i)} = $hs->get_eind_index($i);
		}
	    } elsif ($linetype =~ /^p/) {
		if ($data) {
		    $object = $data;
		} elsif (defined $p_obj{$type} && $coord_system eq 'standard') {
		    $object = $p_obj{$type};
		} else {
		    cache_decider_init();
		    if ($type eq 'o') {
			$object = _get_orte_obj("o");
		    } else {
			$object = get_strassen_obj($p_file{$type});
		    }
		    if ($coord_system eq 'standard' && cache_decider()) {
			$p_obj{$type} = $object;
		    }
		}

		my $i = 0;
		$object->init;
		while(1) {
		    my $ret = $object->next;
		    last if @{$ret->[Strassen::COORDS]} == 0;
		    my $strname = $ret->[Strassen::NAME];
		    $orte{$strname} = $i;
		    $i++;
		}
	    } elsif ($linetype =~ /^s/) {
		if ($data) {
		    $object = $data;
		} elsif (defined $str_obj{$type} && $coord_system eq 'standard') {
		    $object = $str_obj{$type};
		} else {
		    cache_decider_init();
		    $object = get_any_strassen_obj("str", $type);
		    if ($coord_system eq 'standard' && cache_decider()) {
			$str_obj{$type} = $object;
		    }
		}

		my $i = 0;
		$object->init;
		while(1) {
		    my $ret = $object->next;
		    last if @{$ret->[Strassen::COORDS]} == 0;
		    my $strname = $ret->[Strassen::NAME];
		    $strname =~ s/\|/ /g; # Bla|Foo: Pipe-Zeichen entfernen
		    my @strname;
		    if ($attrib->[ATTRIB_LINES]) { # Linien?
			@strname = split(/,/, $strname);
		    } else {
			@strname = ($strname);
		    }
		    foreach $strname (@strname) {
			if (exists $orte{$strname}) {
			    $orte{$strname} .= ",$i";
			} else {
			    $orte{$strname} = $i;
			}
		    }
		    $i++;
		}
	    }

	    if ($splitter) {
		my(@cols) = $splitter->((keys %orte)[0]);
		$max_cols = scalar @cols;
	    }

	    $lb = $t->Scrolled($Listbox,
			       -scrollbars => 'osoe',
			       -selectmode => 'single',
			       ($splitter
				? (-columns => $max_cols,
				   -exportselection => 1,
				  )
				: ()
			       ),
			      )->pack(-expand => 1, -fill => 'both');
	    $t->Advertise(Listbox => $lb->Subwidget("scrolled"));

	    if ($splitter) {
		my $wraplength = $max_cols > 1 ? int(800/($max_cols-1)) : 800; # XXX don't hardcode 800px
		my $text_style = $lb->ItemStyle('text', -wraplength => $wraplength);
		my $inx = 0;
		for my $ort (sort keys %orte) {
		    my(@cols) = $splitter->($ort);
		    $lb->add($inx, -text => shift @cols, -data => $ort);
		    for my $col (1 .. @cols) {
			next if $col >= $max_cols; # XXX off by one?
			$lb->itemCreate($inx, $col, -text => $cols[$col-1],
					-style => $text_style,
				       );
		    }
		    $inx++;
		}
	    } else {
		if (!$sorted) {
		    $lb->insert('end',
				map { $_->[1] }
				sort { $a->[0] <=> $b->[0] }
				map { [lc $orte{$_}, $_] }
				keys %orte);
		} else {
		    # XXX maybe use Sort::Naturally? speed issues?
		    my $tf_sub = (defined &Win32Util::sort_cmp_hack_transform &&
				  $os eq 'win'
				  ? sub { Win32Util::sort_cmp_hack_transform($_[0]) }
				  : sub { lc $_[0] });
		    $lb->insert('end',
				map { $_->[1] }
				sort { $a->[0] cmp $b->[0] }
				map { [ do { /^\(?(.*)/; $tf_sub->($1) }, $_] }
				keys %orte);
		}
	    }

	    eval {
		$lb->Cache(1);
	    };

	    my $show_sub =  sub {
		my %args = @_;
		my $lb_index = ($splitter
				? $lb->info('anchor')
				: $lb->index('active')
			       );
		return if !defined $lb_index;
		my $ort = ($splitter
			   ? $lb->info("data", $lb_index)
			   : $lb->get($lb_index)
			  );
		my $index = $orte{$ort};
		my $tcoords = [];
		$args{'-type'} = $type;
		if ($type eq 'o') {
		    my($x,$y) = split /,/, _get_orte_obj()->get($index)->[Strassen::COORDS]->[0];
		    $tcoords->[0][0] = [ transpose($x, $y) ];
		} elsif ($type eq 'p') {
		    $tcoords->[0][0] = [ transpose($koord->get($index)) ];
		} else {
		    my @i = split(/,/, $index);
		    my $i;
		    foreach $i (@i) {
			my $r = $object->get($i);
			push @{$tcoords},
			[ transpose_all(@{Strassen::to_koord($r->[Strassen::COORDS])}) ];
		    }
		    if ($linetype =~ /^p/) {
			$args{'-width'} = 20;
			$args{'-type'} = "$type-bg";
		    }
		}
		$action->(-coords        => $tcoords,
			  '-index'       => $index,
			  -showbutton    => $showb,
			  -cancelbutton  => $closeb,
			  -clever_center => 1,
			  %args,
			 );
	    };

	    if ($args{'-markstart'}) {
		my $markstart_sub = sub {
		    my($type) = @_;
		    my $lb_index = $lb->index('active');
		    return if !defined $lb_index;
		    my $index = $orte{$lb->get($lb_index)};
		    my @i = split(/,/, $index);
		    my $r = $object->get($i[0]);
		    my $coord = $r->[Strassen::COORDS][0];
		    if ($type eq 'start') {
			set_route_start($coord);
		    } else {
			set_route_ziel($coord, -caller => "chooseort");
		    }
		    if ($type eq 'start' || $zoom_new_route_chooseort == 0) {
			$show_sub->();
		    }
		};
		$markf->Label(-text => M('Markieren als').' ...',
			      -font => $font{'small'},
			     )->pack(-side => 'left');
		$markf->Button(-text => M"Start",
			       -command => sub { $markstart_sub->('start') },
			      )->pack(-side => 'left');
		$markf->Button(-text => M"Ziel",
			       -command => sub { $markstart_sub->('ziel') },
			      )->pack(-side => 'left');
	    }

	    $showb  = $f->Button(Name => 'show',
				 -command => sub { $show_sub->() },
				)->pack(-side => 'left');
	    $showb->bind("<2>" => sub { $show_sub->(-zoom_view => 1) });
	    $showb->bind("<3>" => sub { $show_sub->(-dont_center => 1) });
	    $closeb = $f->Button(Name => 'close',
				 -command => sub {
				     if ($ondestroy) {
					 $ondestroy->($t);
				     } else {
					 if ($t->can("withdraw")) {
					     $t->withdraw;
					 } else {
					     $t->destroy;
					 }
				     }
				 },
				)->pack(-side => 'left');

	    $t->bind('<<CloseWin>>' => sub { $closeb->invoke });
	    for (qw(Return Double-1 2)) {
		$lb->bind("<$_>", sub { $showb->invoke });
	    }
	    my $find_and_select_nearest = sub {
		my($w, $y) = @_;
		my $inx = $w->nearest($y);
		$w->selectionClear(0, "end");
		$w->selectionSet($inx);
		$w->activate($inx);
	    };
	    $lb->bind("<2>" =>
		      [sub {
			   $find_and_select_nearest->(@_);
			   $show_sub->(-zoom_view => 1);
		       }, Ev('y')]);
	    $lb->bind("<3>" =>
		      [sub {
			   $find_and_select_nearest->(@_);
			   $show_sub->(-dont_center => 1);
		       }, Ev('y')]);
	    $lb->focus;
	};
	warn __LINE__ . ": $@" if $@;
	DecBusy($top);

	$choose_ort_cache{"$linetype-$type"} =
	    get_cache_identifier($linetype, $type);
	if ($t->isa("Tk::Wm") && $do_popup) {
	    if (@popup_style == 0) {
		if (eval {require Tk::Placement; 1; }) {
		    # XXX use placer also for other toplevels --- replace
		    # all Popup(@popup_style) calls?
		    Tk::Placement::placer($t, -screen => $c,
					  -addx => 20, -addy => 25, # XXX for fvwm
					 );
		} else {
		    $t->Popup(-overanchor => "nw", -popanchor => "nw", -popover => $c);
		}
	    } else {
		my_popup($t);
	    }
	}
    } else {
	$toplevel{"chooseort-$type-$linetype"}->deiconify;
	# win32 bentigt zustzliches raise
	$toplevel{"chooseort-$type-$linetype"}->raise;
    }
}

# Spezialisierung von choose_ort fr Stadtstraen
### AutoLoad Sub
sub choose_streets {
    choose_ort(qw(s s),
	       -markstartifactive => 1,
	       -completelistbutton => sub { choose_from_plz(-interactive => 1) },
	       -completelistbuttonlabel => "Alle Straen",
	      );
}

# Markiert einen Punkt und/oder zentriert darauf Als Argumente werden
# Canvas-Koordinaten erwartet (Ergebnis von transpose), entweder als
# -x/-y, als -point oder als -coords-Argument (komplizierter, siehe
# Source)
### AutoLoad Sub
sub mark_point {
    my(%args) = @_;
    my($tx, $ty);
    if (exists $args{'-x'} && exists $args{'-y'}) {
	($tx, $ty) = ($args{'-x'}, $args{'-y'});
    } elsif (exists $args{'-point'}) {
	($tx, $ty) = split /,/, $args{'-point'};
    } else {
	($tx, $ty) = ($args{'-coords'}->[0][0][0], $args{'-coords'}->[0][0][1]);
    }
    my $width = $args{'-width'} || 9;
    $c->delete('show') unless $args{'-dont_delete_old'};
    my @show_mark_args;
    if ($args{-endlessmark}) {
	push @show_mark_args, -endlessmark => 1;
    }
    unless ($args{'-dont_mark'}) {
	my(@tags) = ('show');
	if (exists $args{'-addtag'}) {
	    if (ref $args{'-addtag'} eq 'ARRAY') {
		push @tags, @{$args{'-addtag'}};
	    } else {
		push @tags, $args{'-addtag'};
	    }
	}
	$c->createLine($tx, $ty, $tx, $ty,
		       -capstyle => $capstyle_round,
		       -width => $width,
		       -fill => $mark_color,
		       -tags => \@tags);
	show_mark(undef, @show_mark_args);
    }
    if (!$args{'-dont_center'}) {
	if ($args{'-clever_center'} && clever_center($tx, $ty)) {
	    # NOP
	} else {
	    $c->center_view($tx, $ty);
	}
    }
    eval { local $SIG{__DIE__}; $c->lower('show', $args{'-type'}) };
}

sub clever_center {
    my($tx,$ty,$tx2,$ty2) = @_;
    # For now, $tx2 and $ty2 are not used, but should be used to move
    # the region towards this point. See Tk::CanvasUtil::center_view2.
    return 0 if (!eval { require Tk::Placement; 1 });
    # Is ($tx/$ty) already visible? Then do nothing
    my($rx, $ry) = ($c->rootx+$c->widgetx($tx), $c->rooty+$c->widgety($ty));
    my $curr_w = $top->containing($rx, $ry);
    return 1 if $curr_w eq $c;
    my @win = Tk::Placement::get_toplevel_regions($top);
    if (!@win) { # no clever placement needed --- fallback to normal center
	return 0;
    }
    for (@win) {
	# adjust to canvas frame
	$_->{"x"} -= $c->rootx;
	$_->{"y"} -= $c->rooty;
    }
    my $box_w = $top->width/3;
    my $box_h = $top->height/3;
    my $dim = {width=>$box_w,height=>$box_h};
    my $scr = {x=>0,y=>0,width=>$c->width,height=>$c->height};
    my($px,$py) = Tk::Placement::Clever::placement
	($dim, $scr, \@win, 0, 0, 0);
    $px += $box_w/2; # move to center of box
    $py += $box_h/2;
    $c->scroll_canvasxy_to_rootxy($tx,$ty,
				  $c->rootx+$px,$c->rooty+$py);
    1;
}

# Markiert und/oder zentriert auf die Linie
# Important arguments:
#   -coords => [[[x,y],[x2,y2]], # first line
#               [[x3,y3],[x4,y4]], # second line
#              ]
### AutoLoad Sub
sub mark_street {
    my(%args) = @_;
    $c->delete('show') unless $args{'-dont_delete_old'};
    my @res_coords;
    # adapt width of mark
    my $line_width = $args{'-linewidth'} || get_line_width("s-H")+6; # outline takes 2 pixels...
    my $point_width = $args{'-pointwidth'} || $line_width+6;
    my @labels = $args{'-labels'} ? @{ $args{'-labels'} } : ();
    my($minx, $miny, $maxx, $maxy);
    my @all_coords = ();
    foreach (@{$args{'-coords'}}) {
	my @coords = @$_;
	@res_coords = ();
	foreach (@coords) {
	    if (ref $_ eq 'ARRAY') {
	        if (!defined $minx || $_->[0] < $minx) { $minx = $_->[0] }
	        if (!defined $maxx || $_->[0] > $maxx) { $maxx = $_->[0] }
	        if (!defined $miny || $_->[1] < $miny) { $miny = $_->[1] }
	        if (!defined $maxy || $_->[1] > $maxy) { $maxy = $_->[1] }
	    }
	    push @res_coords, (ref $_ eq 'ARRAY'
			       ? ($_->[0], $_->[1])
			       : $_);
	}
	push @all_coords, @res_coords;
	unless ($args{'-dont_mark'}) {
	    my $label = shift @labels;
	    if ($args{'-polygon'}) {
		if (@res_coords == 2) {
		    push @res_coords, (@res_coords) x 2;
		}
		$c->createPolygon(@res_coords,
				  -width => 5,
				  -fill => $mark_color,
				  -tags => ['show', $label]);
	    } else {
		my @add_args;
		if (@res_coords == 2) {
		    push @res_coords, @res_coords;
		    push @add_args, -capstyle => $capstyle_round,
			            -width => $point_width;
		} else {
		    push @add_args, -width => $line_width,
		}
		$c->createLine(@res_coords,
			       @add_args,
			       -fill => $mark_color,
			       -tags => ['show', $label]);
	    }
 	}
    }
    show_mark() unless $args{'-dont_mark'};
    if ($args{'-zoom_view'} && defined $minx) {
	zoom_view($minx, $miny, $maxx, $maxy);
    } else {
	# Prefer an already visible point to scroll to
	my($vx,$vy) = find_visible_point(\@all_coords);
	if (!defined $vx) {
	    ($vx,$vy) = @all_coords[0,1];
	}
	if (!$args{'-dont_center'}) {
	    if ($args{'-clever_center'} && clever_center($vx,$vy,@all_coords[$#all_coords-1,$#all_coords])) {
		# NOP
	    } else {
		$c->center_view2($vx,$vy,@all_coords[$#all_coords-1,$#all_coords]);
	    }
	}
    }
    eval { local $SIG{__DIE__}; $c->lower('show', $args{'-type'}) };
}

sub find_visible_point {
    my($c_ref) = @_;
    my($x1,$y1,$x2,$y2) = $c->get_corners;
    for(my $i = 0; $i < $#$c_ref; $i+=2) {
	my($cx,$cy) = @{$c_ref}[$i,$i+1];
	if (point_in_grid($cx,$cy,$x1,$y1,$x2,$y2)) {
	    return($cx,$cy);
	}
    }
    ();
}

# Dialog zum Auswahl eines Strae aus der Postleitzahl-Datenbank
### AutoLoad Sub
sub choose_from_plz {
    my(%args) = @_;

    return if $city ne "Berlin";

    my $batch = (defined $args{'-str'} || defined $args{'-coord'});
    if (!$batch) {
	if ($toplevel{"chooseplz"} && Tk::Exists($toplevel{"chooseplz"})) {
	    $toplevel{"chooseplz"}->deiconify;
	    $toplevel{"chooseplz"}->raise;
	    return;
	}
    }

    require PLZ;
    my $plz;
    if ($city eq 'Berlin') {
	require PLZ::Multi;
	my @objs = ("Berlin.coords.data",
		    "Potsdam.coords.data",
		   );
	eval {
	    # XXX why?
	    my $plaetze = Strassen->new("plaetze");
	    push @objs, $plaetze if $plaetze;
	}; warn $@ if $@;

	$plz = PLZ::Multi->new(@objs, -cache => 1);
    } else {
	$plz = new PLZ;
    }
    if (!$plz) {
	$plzmcmd->configure(-state => 'disabled');
	status_message(M"Keine PLZ-Datenbank vorhanden!", 'err');
	return;
    }

    my $show_sub = sub {
	my($street_obj, $dont_mark) = @_;

	IncBusy($top);
	eval {
	    if (!defined $str_obj{'s'}) {
		$str_obj{'s'} = new Strassen $str_file{'s'};
	    }
	    my $s = $str_obj{'s'};
	    if (!defined $str_obj{'z'}) {
		$str_obj{'z'} = new Strassen $str_file{'z'};
	    }
	    my $z = $str_obj{'z'};
	    die "Str ($s)/PLZ ($z)-Objekt?" if !$s || !$z;
	    my($street, $bezirk, $plz_nr, $xy) = @$street_obj;

	    if (defined $xy) {
		mark_point(-coords => [[[ transpose(split /,/, $xy) ]]],
			   -clever_center => $args{-interactive});
	    } else {
		my(@pos) = $s->choose_street($street, $bezirk);
		if (!@pos || !defined $pos[0]) {

		    # PLZ-Gebiet markieren
		    $z->init;
		    while(1) {
			my $ret = $z->next;
			last if !@{$ret->[Strassen::COORDS]};
			if ($ret->[Strassen::NAME] eq $plz_nr) {
			    mark_street
				(-coords =>
				 [[ transpose_all(@{Strassen::to_koord($ret->[Strassen::COORDS])}) ]],
				 -type => 's',
				 -dont_mark => $dont_mark,
				 -polygon => 1,
				 );
			    return;
			}
		    }

		    my $plz_re = $plz->make_plz_re($plz_nr);
		    my @streets = $plz->look($plz_re, Noquote => 1);
		    @pos = $s->union(\@streets, Nouniq => 1);
		    if (!@pos) {
			die Mfmt("Keine Straen im PLZ-Gebiet %s.\n", $plz_nr);
		    }
		}

		# Straen im PLZ-Gebiet markieren
		my $i;
		for($i = 0; $i <= $#pos; $i++) {
		    my $o = $pos[$i];
		    mark_street
			(-coords =>
			 [[ transpose_all(@{Strassen::to_koord($s->get($o)->[Strassen::COORDS])}) ]],
			 -type => 's',
			 -dont_delete_old => ($i != 0),
			 -dont_center     => ($i != $#pos),
			 -dont_mark       => $dont_mark,
			 );
		}
		if (@pos > 1 && !$dont_mark) {
		    status_message(Mfmt("%s liegt im markierten Gebiet",
					$street), 'info');
		}
	    }
	};
	if ($@) {
	    status_message($@, 'err');
	}
	DecBusy($top);
    };


    my $str;
    if (defined $args{'-str'}) { # auf Strae zentrieren
	return if ($args{'-str'} eq "");
	$str = $args{'-str'};
	my($matchref) = $plz->look_loop($str, Agrep => 3, Max => 20);
	my(@match) = @$matchref;
	return if !@match;
	$show_sub->($match[0], 1) if !$args{-noshow};
	return $match[0]->[PLZ::LOOK_COORD()]; # return coords
    } elsif (defined $args{'-coord'}) { # auf Koordinaten zentrieren
	return if ($args{'-coord'} eq "");
	eval {
	    mark_point(-coords => [[[ transpose(split(/,/, $args{'-coord'})) ]]],
		       -dont_mark => 1);
	};
	warn $@ if $@;
    } else { # interaktiv
	my $t = $top->Toplevel(-title => M"Auswahl aus kompletter Straenliste",
			       -class => "Bbbike Extended Chooser");
	set_as_toolwindow($t);
	$toplevel{"chooseplz"} = $t;

	my $bf   = $t->Frame->pack(-fill => 'x', -side => "bottom");
	my $strf = $t->Frame->pack(-fill => 'x', -side => "top");

	$strf->Label(-text => M('Strae').':'
		    )->pack(-side => "left");
	my $Entry = 'Entry';
	my @extra_args;
	my $this_history_file;
	eval {
	    require Tk::HistEntry;
	    Tk::HistEntry->VERSION(0.37);
	    @extra_args = (-match => 1, -dup => 0, #-case => 0
			  );
	    $Entry = 'HistEntry';
	    $this_history_file = "$bbbike_configdir/bbbike_street_hist";
	};
	my $e = $strf->$Entry(-textvariable => \$str,
			      @extra_args,
			      -width => 30)->pack(-side => "left");
	$e->historyMergeFromFile($this_history_file)
	    if $e->can('historyMergeFromFile');

	$e->focus;
	my $srchb =
	  $strf->Button(Name => 'search',
			-padx => 0,
			-pady => 0,
		       )->pack(-side => "left");
	my $showb;
	my $lb = $t->Scrolled('Listbox',
			      -scrollbars => 'osoe',
			     )->pack(-fill => "x");
	my @match;
	my $show_sub_lb = sub {
	    $show_sub->($match[$lb->index('active')], 0);
	};

	for (qw(Double-1 2)) {
	    $lb->bind("<$_>" => sub {
			  $show_sub->($match
				      [$lb->nearest
				       ($lb->Subwidget('scrolled'
						      )->XEvent->y)], 0);
		      });
	}
	$t->OnDestroy(sub { delete $toplevel{"chooseplz"} });
	my $close_window = sub { $t->destroy; };
	my $search_window = sub {
	    if ($e->can('historyAdd') &&
		$e->can('historySave')) {
		$e->historyAdd;
		$e->historySave($this_history_file);
	    }

	    IncBusy($t);
	    eval {
		my($matchref) = $plz->look_loop($str, Agrep => 3, Max => 20);
		@match = @$matchref;
		if (!@match) {
		    $showb->configure(-state => 'disabled');
		    die M"Keine Straen gefunden.\n";
		} else {
		    $lb->delete(0, 'end');
		    foreach (@match) {
			$lb->insert('end', join("/", @{$_}[0..2]));
		    }
		    $lb->selection('set', 0);
		    $showb->configure(-state => 'normal');
		    $lb->focus;
		}
	    };
	    if ($@) {
		status_message($@, 'err');
	    }
	    DecBusy($t);
	};
	$e->bind('<Return>' => $search_window);
	$srchb->configure(-command => $search_window);
	$t->bind('<<CloseWin>>' => $close_window);
	$showb = $bf->Button
	  (Name => 'show',
	   -state => 'disabled',
	   -command => $show_sub_lb)->grid(-row => 0, -column => 1,
					   -sticky => 'ew');
	$lb->bind('<Return>' => $show_sub_lb);
	$bf->Button(Name => 'close',
		    -command => $close_window)->grid(-row => 0, -column => 2,
						     -sticky => 'ew');
	#$t->Popup(@popup_style);
	my($x,$y) = ($c->rootx+10, $c->rooty+10);
	$t->geometry("+$x+$y");

    }
}

# Gibt die aktuelle Fontgre fr die bergebene Ortskategorie zurck.
### AutoLoad Sub
sub get_orte_label_font {
    my($category, $is_overview_canvas) = @_;
    my $base_index = 0;
    if (!$is_overview_canvas) {
	if ($scale >= 6) {
	    $base_index = 2;
	} elsif ($scale >= 3) {
	    $base_index = 1;
	}
    }
    my $font;
    # This should handle the range MIN_ORT_CAT .. MAX_ORT_CAT:
    if      ($category <= 2) {
	$font = $font{$font[$base_index + $orte_label_size]};
    } elsif ($category == 3) {
	$font = $font{$font[$base_index + $orte_label_size+1]};
    } elsif ($category == 4) {
	$font = $font{$font[$base_index + $orte_label_size+2]};
    } elsif ($category == 5) {
	$font = $font{$font[$base_index + $orte_label_size+3]};
    } elsif ($category > 5) {
	$font = $font{$font[$base_index + $orte_label_size+4]};
    } else {
	die "Unknown category $category";
    }
    if (!defined $font) {
	$font = $font{'veryhuge'};
    }

    $font;
}

# Zeichnet Orte.
# XXX Modus zum Zeichnen von Bezirken
### AutoLoad Sub
sub plotorte {
    my(%args) = @_;

    my $std;
    my $c = $c;
    my $transpose;
    my $municipality = $args{-municipality};
    my $type         = $args{-type} || 'o';
    my $label_tag    = uc($type);
    my $is_overview_canvas;
    if (exists $args{Canvas}) {
	$c = $args{Canvas};
	$std = 0;
	$transpose = ($show_overview_mode eq 'brb'
		      ? \&transpose_small
		      : \&transpose_medium);
	$is_overview_canvas = 1;
    } else {
	$std = 1;
	$transpose = \&transpose;
    }

    # evtl. alte Koordinaten lschen
    if (!$args{FastUpdate}) {
	$c->delete($type);
	$c->delete($label_tag);
    }

    delete $pending{"replot-p-$type"};

    if ($std && !$p_draw{$type}) {
	undef $p_obj{$type};
	if ($main::lazy_p{$type}) {
	    bbbikelazy_remove_data("p", $type);
	}
	return;
    }

    my $orte = _get_orte_obj($type);

    my $lazy = defined $args{-lazy} ? $args{-lazy} : $lazy_plot;
    if ($std && $lazy) {
	return bbbikelazy_add_data("p", $type, $orte);
    }

    my $coordsys = $coord_system_obj->coordsys;

    destroy_delayed_restack();
    IncBusy($top);
    $progress->Init(-dependents => $c,
		    -label => 'orte');
    eval {
	my $place_category = (exists $args{PlaceCategory}
			      ? $args{PlaceCategory} : $place_category);
	my $name_o        = (exists $args{NameDraw}
			     ? $args{NameDraw}     : $p_name_draw{$type});
	my $no_overlap_label = (exists $args{NoOverlapLabel}
				? $args{NoOverlapLabel} : $no_overlap_label{$type});
	my $progress_hack = $name_o && $no_overlap_label;

	my $complete_str = $orte;
	my $diffed_orte = 0;
	if (#XXX del? ($edit_mode || $edit_normal_mode) &&
	    $args{FastUpdate}) {
	    my($new_orte, $todelref) = $orte->diff_orig(-clonefile => 1);
	    if (!defined $new_orte) {
		warn "Not using diff output" if $verbose;
		$c->delete($type); # evtl. alte Koordinaten lschen
		$c->delete($label_tag);
	    } else {
		warn "Using diff output" if $verbose;
		# XXX not used due to lack of tag $type-$i
		#foreach (@$todelref) {
		#    $c->delete("$type-$_");
		#}
		$orte = $new_orte;
		$diffed_orte = 1;
	    }
	}

	my @orte_coords_labeling;
#XXX del:
#  	foreach ($orte->file) {
#  	    $old_mtime{$_} = (stat($_))[STAT_MODTIME];
#  	    $mtime_file_type{$_} = ['p', $type];
#  	}

	my $next_meth;
	my $i;
	my $i_inc;
	if ($no_overlap_label) {
	    $orte->init;
	    $next_meth = 'next';
	    $i = 0;
	    $i_inc = +1;
	} else {
	    # in diesem Fall sollten die greren Orte _spter_ d.h. ber
	    # den kleineren gezeichnet werden
	    $orte->set_last;
	    $next_meth = 'prev';
	    $i = $orte->count; # XXX off by one???
	    $i_inc = -1;
	}
	my $anzahl_eindeutig = $orte->count;
	my $do_outline_text = $do_outline_text{$type};

	my %conv_args;
	if ($args{-map}) {
	    $conv_args{Map} = $args{-map};
	}
	my $conv = $orte->get_conversion(%conv_args);

	my $draw_sub = eval $plotorte_draw_sub;
	die $@ if $@;

	my $prog_i = 0;
	while(1) {
	    my $ret = $orte->$next_meth();
	    last if !@{$ret->[Strassen::COORDS]};
	    $progress->Update($prog_i/$anzahl_eindeutig*($progress_hack ? 0.5 : 1))
	      if $prog_i % 80 == 0;
	    $prog_i++;
	    $i += $i_inc;
	    $draw_sub->($ret);
	}

	$c->itemconfigure($type,
			  -capstyle => $capstyle_round,
			  -width => 5,
			  -fill => '#000080',
			 );
	if ($name_o) {
	    if ($no_overlap_label) {
		# nach Kategorie sortieren
		@orte_coords_labeling
		  = sort { $b->[3] <=> $a->[3] } @orte_coords_labeling;
		my $i = 0;
		foreach my $ort_def (@orte_coords_labeling) {
		    $progress->Update($i/$anzahl_eindeutig*.5+0.5)
		      if $i % 80 == 0;
		    $i++;
		    my($text, $tx, $ty, $cat, $point_item) = @$ort_def;
		    my $font = get_orte_label_font($cat, $is_overview_canvas);
		    my(@tags) = ($label_tag, "$label_tag$cat");
		    if (!draw_text_intelligent($c, $tx, $ty,
					       -text => $text,
					       -font => $font,
					       -tags => \@tags,
					       -abk  => $label_tag,
					      )) {
			if ($cat <= $place_category+1) {
			    $c->delete($point_item);
			} else {
			    my $anchor = 'w';
			    $c->createText
			      ($tx+$xadd_anchor_type->{'o'}{$anchor},
			       $ty+$yadd_anchor_type->{'o'}{$anchor},
			       -text => $text,
			       -font => $font,
			       -tags => \@tags,
			       -anchor => $anchor,
			       -justify => 'left',
			      );
			}
		    }
		}
	    }
	    if (!$no_overlap_label && !$municipality &&
		!$do_outline_text) {
		$c->itemconfigure($label_tag,
				  -anchor => 'w', -justify => 'left');
	    }
	    if ($orientation eq 'landscape' &&
		!$do_outline_text) {
		$c->itemconfigure($label_tag,
				  -font => get_orte_label_font(2, $is_overview_canvas));
	    }
	    if ($municipality) {
		$c->itemconfigure($label_tag, -fill => '#7e7e7e');
	    } elsif (!$do_outline_text) {
		$c->itemconfigure($label_tag, -fill => '#000080');
	    }
	    if ($orientation eq 'landscape' &&
		!$do_outline_text) {
		unless ($args{'AllSmall'}) {
		    # wichtigere Orte bekommen eine grere Schrift
		    foreach my $category (3 .. MAX_ORT_CAT) {
			$c->itemconfigure
			  ("$label_tag$category",
			   -font => get_orte_label_font($category, $is_overview_canvas));
		    }
		}
	    }
	}

	if (!($edit_mode || $edit_normal_mode) && !$municipality) {
	    change_place_visibility($c);
	}

	if (($edit_mode || $edit_normal_mode) and !$diffed_orte) {
	    warn "Try to copy original data" if $verbose;
	    my $r = $complete_str->copy_orig;
	    warn "Returned $r" if $verbose;
	}

	if ($std) {
	    restack_delayed();
	}
    };
    if ($@) {
	status_message($@, 'err');
    }
    $progress->Finish;
    DecBusy($top);
}

# Zeichnet Labels, wobei versucht wird, berlappungen zu vermeiden.
# Auf $canvas wird gezeichnet, die Koordinaten sind $tx/$ty
### AutoLoad Sub
sub draw_text_intelligent {
    my($canvas, $tx, $ty, %args) = @_;
    my @ct_args;
    foreach my $arg (qw(-text -font -tags -fill -font)) {
	push @ct_args, $arg => $args{$arg} if exists $args{$arg};
    }
    # mit welchen Tags berlappungen vermeiden
    my $abkrx = (ref $args{-abk} eq 'ARRAY'
		 ? '^(' . join('|', @{$args{-abk}}) . ")\$"
		 : "^$args{-abk}\$");
    # Anchor => X/Y-Versetzung
    my $xadd = (exists $args{-xadd} ? $args{-xadd} : $xadd_anchor_type->{'o'});
    my $yadd = (exists $args{-yadd} ? $args{-yadd} : $yadd_anchor_type->{'o'});
    my $check_tag_index = (exists $args{-checktagindex}
			   ? $args{-checktagindex}
			   : 0);
  LOOP:
    foreach my $anchor (qw(w e nw n sw s)) {
	my $item = $canvas->createText
	  ($tx+$xadd->{$anchor}, $ty+$yadd->{$anchor},
	   @ct_args,
	   -anchor => $anchor,
	   -justify => 'left',
	  );
	my(@bbox) = $canvas->bbox($item);
	if (@bbox) {
	    my(@overlap) = $canvas->find('overlapping', @bbox);
	    foreach my $i (@overlap) {
		next if $i == $item;
		my(@tags) = $canvas->gettags($i);
		next if !@tags;
		if ($check_tag_index eq 'all') {
		    foreach my $tag (@tags) {
			if ($tag =~ /$abkrx/) {
			    $canvas->delete($item);
			    next LOOP;
			}
		    }
		} else {
		    next if !defined $tags[$check_tag_index];
		    if ($tags[$check_tag_index] =~ /$abkrx/) {
			$canvas->delete($item);
			next LOOP;
		    }
		}
	    }
	}
	$ {$args{-returnanchor}} = $anchor
	    if ref $args{-returnanchor} eq 'SCALAR';
	if ($args{-outline}) {
	    $c->delete($item);
	    outline_text($c, $tx+$xadd->{$anchor}, $ty+$yadd->{$anchor},
			 @ct_args, -anchor => $anchor,
			 -outlinewidth => $args{-outlinewidth});
	}
	return 1;
    }
    0;
}

# Zeichnen von Stellen mit Obstvorkommen
### AutoLoad Sub
sub plotobst {
    my(%args) = @_;

    my $canvas = $c;
    my $transpose = \&transpose;

    # evtl. alte Koordinaten lschen
    $canvas->delete('obst');

    delete $pending{'replot-p-obst'};

    if (!$p_draw{'obst'}) {
	return;
    }

    destroy_delayed_restack();
    IncBusy($top);
    $progress->Init(-dependents => $canvas,
		    -label => $p_file{'obst'});
    eval {
	my $i = 0;
 	my $obst = get_strassen_obj($p_file{'obst'});
	$obst->init;
	my $anzahl_eindeutig = $obst->count;
	while(1) {
	    my $ret = $obst->next;
	    last if !@{$ret->[Strassen::COORDS]};
	    $progress->Update($i/$anzahl_eindeutig) if $i % 80 == 0;
	    $i++;
	    my $type = lc($ret->[Strassen::NAME]);
	    next if !exists $obst_file{$type}; # XXX warning
	    if ($ret->[Strassen::COORDS][0] =~ /(-?\d+),(-?\d+)/) {
		my($x, $y) = ($1, $2);
		my($tx, $ty) = $transpose->($x, $y);
		if (!exists $obst_photo{$type}) {
		    $obst_photo{$type} =
		      $canvas->Photo(-file => Tk::findINC($obst_file{$type}));
		}
		next if (!defined $obst_photo{$type});
		my $img = $obst_photo{$type};
		$canvas->createImage($tx, $ty,
				     -image => $img,
				     -tags => 'obst');
	    }
	}

	restack_delayed();
    };
    if ($@) {
	status_message($@, 'err');
    }
    $progress->Finish;
    DecBusy($top);
}

### AutoLoad Sub
sub draw_bridge {
    my($cl,%args) = @_;
    my $width = $args{width}||10;
    my $color = '#808080';
    my $thickness = 2; # make configurable XXX
#XXX complicated code, make nicer!
#XXX an den Enden etwas verkrzen
    for(my $i = 0; $i < $#$cl/2-1; $i++) {
	my($x1,$y1,$x2,$y2) = @{$cl}[$i*2..$i*2+3];
	my $alpha = atan2($y2-$y1,$x2-$x1);
	my $beta = $alpha - pi()/2;
	my $delta = $width/2;
	my($dx,$dy) = ($delta*cos($beta), $delta*sin($beta));
	$c->createLine($x1+$dx,$y1+$dy,$x2+$dx,$y2+$dy,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
	$c->createLine($x1-$dx,$y1-$dy,$x2-$dx,$y2-$dy,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
    }
    {
	my $alpha = atan2($cl->[3]-$cl->[1],$cl->[2]-$cl->[0]);
	my $beta  = $alpha - pi()/2;
	my $knick = $alpha - pi()/4;
	my $knick2 = $alpha + pi()/4;
	my $delta = $width/2;
	my $knick_length = $width/2;
	my($dx, $dy) = ($delta*cos($beta), $delta*sin($beta));
	my($kx, $ky) = ($knick_length*cos($knick), $knick_length*sin($knick));
	my($k2x, $k2y) = ($knick_length*cos($knick2), $knick_length*sin($knick2));
	$c->createLine($cl->[0]+$dx-$k2x, $cl->[1]+$dy-$k2y,
		       $cl->[0]+$dx, $cl->[1]+$dy,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
	$c->createLine(
		       $cl->[0]-$dx, $cl->[1]-$dy,
		       $cl->[0]-$dx-$kx, $cl->[1]-$dy-$ky,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
    }

    {
	my $alpha = atan2($cl->[-1]-$cl->[-3],$cl->[-2]-$cl->[-4]);
	my $beta  = $alpha - pi()/2;
	my $knick = $alpha - pi()/4;
	my $knick2 = $alpha + pi()/4;
	my $delta = $width/2;
	my $knick_length = $width/2;
	my($dx, $dy) = ($delta*cos($beta), $delta*sin($beta));
	my($kx, $ky) = ($knick_length*cos($knick), $knick_length*sin($knick));
	my($k2x, $k2y) = ($knick_length*cos($knick2), $knick_length*sin($knick2));
	$c->createLine($cl->[-2]+$dx+$kx, $cl->[-1]+$dy+$ky,
		       $cl->[-2]+$dx, $cl->[-1]+$dy,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
	$c->createLine(
		       $cl->[-2]-$dx, $cl->[-1]-$dy,
		       $cl->[-2]-$dx+$k2x, $cl->[-1]-$dy+$k2y,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
    }
    
}

### AutoLoad Sub
sub draw_tunnel_entrance {
    my($cl,%args) = @_;
    my $width = $args{width}||20;
    my $color = '#505050';
    my $thickness = 3;
#XXX complicated code, make nicer!
    {
	my $alpha = atan2($cl->[3]-$cl->[1],$cl->[2]-$cl->[0]);
	my $beta  = $alpha - pi()/2;
	my $knick = $alpha - pi()/4;
	my $knick2 = $alpha + pi()/4;
	my $delta = $width/2;
	my $knick_length = $width/3;
	my($dx, $dy) = ($delta*cos($beta), $delta*sin($beta));
	my($kx, $ky) = ($knick_length*cos($knick), $knick_length*sin($knick));
	my($k2x, $k2y) = ($knick_length*cos($knick2), $knick_length*sin($knick2));
	$c->createLine($cl->[0]+$dx-$k2x, $cl->[1]+$dy-$k2y,
		       $cl->[0]+$dx, $cl->[1]+$dy,
		       $cl->[0]-$dx, $cl->[1]-$dy,
		       $cl->[0]-$dx-$kx, $cl->[1]-$dy-$ky,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
    }
    {
	my $alpha = atan2($cl->[-1]-$cl->[-3],$cl->[-2]-$cl->[-4]);
	my $beta  = $alpha - pi()/2;
	my $knick = $alpha - pi()/4;
	my $knick2 = $alpha + pi()/4;
	my $delta = $width/2;
	my $knick_length = $width/3;
	my($dx, $dy) = ($delta*cos($beta), $delta*sin($beta));
	my($kx, $ky) = ($knick_length*cos($knick), $knick_length*sin($knick));
	my($k2x, $k2y) = ($knick_length*cos($knick2), $knick_length*sin($knick2));
	$c->createLine($cl->[-2]+$dx+$kx, $cl->[-1]+$dy+$ky,
		       $cl->[-2]+$dx, $cl->[-1]+$dy,
		       $cl->[-2]-$dx, $cl->[-1]-$dy,
		       $cl->[-2]-$dx+$k2x, $cl->[-1]-$dy+$k2y,
		       -width => $thickness,
		       -tags => $args{tags},
		       -fill => $color,
		      );
    }
}

# Lscht alle derzeitig gezeichneten Straen und Punkte und liefert
# eine Subroutine zurck, mit der die gelschten Objekte wieder
# gezeichnet werden knnen.
### AutoLoad Sub
sub get_plotted {
    my(@plotted_p, @plotted_str);
    while(my($k,$v) = each %str_draw) {
	push @plotted_str, $k if ($v);
    }
    while(my($k,$v) = each %p_draw) {
	push @plotted_p, $k if ($v);
    }
    sub {
	$progress->InitGroup;
	foreach (@plotted_p) {
	    plot('p',$_);
	}
	foreach (@plotted_str) {
	    plot('str',$_);
	}
	$progress->FinishGroup;
    }
}

# Setzt den Canvas in den Landscape-Modus (Default).
sub set_landscape {
    local($^W) = 0; # wegen sub-Redefinition
    $orientation = 'landscape';
    *transpose = \&transpose_ls;
    *anti_transpose   = \&anti_transpose_ls;
    *transpose_small  = \&transpose_ls_small;
    *transpose_medium = \&transpose_ls_medium;
    *anti_transpose_small  = \&anti_transpose_ls_small;
    *anti_transpose_medium = \&anti_transpose_ls_medium;
    delete_overview();
}

# Setzt den Canvas in den Portraint-Modus.
### AutoLoad Sub
sub set_portrait {
    local($^W) = 0; # wegen sub-Redefinition
    $orientation = 'portrait';
    *transpose = \&transpose_pt;
    *anti_transpose   = \&anti_transpose_pt;
    *transpose_small  = \&transpose_pt_small;
    *transpose_medium = \&transpose_pt_medium;
    *anti_transpose_small  = \&anti_transpose_pt_small;
    *anti_transpose_medium = \&anti_transpose_pt_medium;
    delete_overview();
}

# ndert das aktuelle Koordinatensystem.
# XXX verbessern...
### AutoLoad Sub
sub set_coord_system {
    my($o) = @_;
    if (!defined $o) {
	$o = $Karte::map{'standard'};
    }
    my $old_coord_system = $coord_system_obj ? $coord_system_obj->token : "";
    if ($old_coord_system eq $o->token) {
	# No change
	return;
    }
    if ($o->token eq 'standard') {
	set_landscape(); # XXX set scrollregion
	$coord_system = 'standard';
	$scale_coeff = 1;
	set_canvas_scale(DEFAULT_SCALE);
    } else {
	{
	    local($^W) = 0;
	    *transpose             = sub { ($_[0]*$scale, $_[1]*$scale) };
	    *anti_transpose        = sub { ($_[0]/$scale, $_[1]/$scale) };
	    *transpose_small       = sub { ($_[0]*$small_scale_edit, $_[1]*$small_scale_edit) };
	    *anti_transpose_small  = sub { ($_[0]/$small_scale_edit, $_[1]/$small_scale_edit) };
	    *transpose_medium      = sub { ($_[0]*$medium_scale_edit, $_[1]*$medium_scale_edit) };
	    *anti_transpose_medium = sub { ($_[0]/$medium_scale_edit, $_[1]/$medium_scale_edit) };
	}
	$scale_coeff = $o->scale_coeff;
	set_canvas_scale(1);
    }
    @scrollregion = $o->scrollregion;
    if ($o->token eq 'standard') { # XXX hack
	foreach (@scrollregion) {
	    $_ *= DEFAULT_SCALE;
	}
    }
    scalecanvas($c, 1);
    $coord_system_obj = $o;
    undef %hoehe;
}

# Setzt die GUI fr den Edit-Mode
sub gui_set_edit_mode {
    my($onoff) = @_;
    if ($onoff) {
	$edit_mode_indicator->configure(-fg => 'black'); # XXX don't hardcode
	$edit_mode_type->configure(-text => uc($onoff));
	if ($onoff eq 'std-no-orig') {
	    undef $edit_mode;
	    $edit_normal_mode = 1;
	} else {
	    $edit_mode = $onoff;
	}
	$edit_mode_flag = 1;
    } else {
	$edit_mode_indicator->configure(-fg => $dim_color);
	$edit_mode_type->configure(-text => '');
	undef $edit_mode;
	undef $edit_normal_mode;
	$edit_mode_flag = 0;
    }
}

# Zeigt Namen der aktuellen Haltestelle oder des aktuellen Ortes
# (unterhalb des Cursors).
sub enterpoint {
    my $c = shift;
    my(@tags) = $c->gettags('current');
    if ($tags[0] eq 'p') {
	$act_value{Haltestelle} = $names[$tags[1]];
	$hs_label->configure(-fg => 'black');
    } elsif ($tags[0] eq 'o' || $tags[0] =~ /^[ubr](?:-|_bg)/) {
	my $prefix = '';
	my $name = $tags[2];
	if      ($tags[0] =~ /^u(?:-|_bg)/) {
	    $prefix = 'U ';
	} elsif ($tags[0] =~ /^b(?:-|_bg)/) {
	    $prefix = 'S ';
	} elsif ($tags[0] =~ /^r(?:-|_bg)/) {
	    $prefix = 'Bhf. '; # XXX language?
	}
	$act_value{Haltestelle} = $prefix . $name;
	$hs_label->configure(-fg => 'black');
    } elsif ($tags[0] eq 'pp' || $tags[0] =~ /^(L\d+|kn|ki|rest)/) {
	if (defined $tags[2] && $tags[2] ne 'current') {
	    $act_value{Haltestelle} = $tags[2];
	} else {
	    $act_value{Haltestelle} = '';
	}
	if (exists $hoehe{$tags[1]}) {
	    $act_value{Haltestelle} .= " ($hoehe{$tags[1]}m)";
	}
	$hs_label->configure(-fg => 'black');
    } elsif ($tags[0] =~ /sperre/) {
	if ($tags[1] eq 'sperre0') {
	    $act_value{Haltestelle} = $tags[2] || M"tragen notwendig";
	} elsif ($tags[1] =~ /^sperre1/) {
	    $act_value{Haltestelle} = M("Einbahnstrae") .
		(defined $tags[2] and $tags[2] ne "" ? " - " . $tags[2] : "");
	} elsif ($tags[1] eq 'sperre2') {
	    if (defined $tags[2] and $tags[2] ne "") {
		$act_value{Haltestelle} = $tags[2];
	    } else {
		$act_value{Haltestelle} = M("gesperrte Strae");
	    }
	} else {
	    $act_value{Haltestelle} = $tags[2] || '';
	}
	$hs_label->configure(-fg => 'black');
    } elsif ($tags[0] =~ /^lsa-/) {
	my $exact_cat = $tags[3];
	if ($exact_cat !~ /^lsa-X/) {
	    $act_value{Haltestelle} = ($exact_cat =~ /^lsa-F/
				       ? M"Fugngerampel"
				       : ($exact_cat =~ /^lsa-B/
					  ? M"Bahnbergang"
					  : ($exact_cat =~ /^lsa-Zbr/
					     ? M"Zugbrcke (" . $tags[2] . ")"
					     : substr($exact_cat, 4, 1)
					    )
					 )
				      );
	    $hs_label->configure(-fg => 'black');
	} else {
	    $act_value{Haltestelle} = "";
	}
    } elsif ($tags[0] =~ /^show/) {
	if (defined $tags[1] && $tags[1] ne 'current') {
	    $act_value{Haltestelle} = $tags[1];
	    $hs_label->configure(-fg => 'black');
	}
	if (defined $tags[2] && $tags[1] ne 'current' && $tags[2] ne 'current') {
	    $act_value{Strasse} = $tags[2];
	    $str_label->configure(-fg => 'black');
	} else {
	    $str_label->configure(-fg => $dim_color);
	}
    } elsif ($tags[0] =~ /^pl/) {
	$act_value{Haltestelle} = $tags[2];
	$hs_label->configure(-fg => 'black');
    }

    my @l;
    my $str = show_below_str($c);
    if (defined $act_value{Haltestelle}
	     && $act_value{Haltestelle} ne '') {
	push @l, $act_value{Haltestelle};
    }
    if (defined $str && $str ne '') {
	push @l, $str;
    }
    if (defined $c_balloon) {
	if (@l && $use_c_balloon > 1) {
	    if ($leave_after) {	$leave_after->cancel; undef $leave_after }
	    $c_balloon->Popup(join(" / ", @l));
	} else {
	    $c_balloon->Deactivate;
	}
    }
}

# Wird beim Verlassen eines Punktes aufgerufen.
sub leavepoint {
    $hs_label->configure(-fg => $dim_color);
    $c_balloon->Deactivate(undef, -from => "event") if defined $c_balloon;
    leavestr();
}

# Zeigt aktuellen Straenzugnamen.
sub enterstr {
    my $c = shift;
    my(@tags) = $c->gettags('current');
    my @l;
    if (grep { $_ eq 'rw' } @tags) {
	# Special handling for cyclepaths
	(my $rw_code) = $tags[2] =~ /^rw-(RW\d+)/;
	my $name = Radwege::code2name($rw_code);
	if (defined $name) {
	    push @l, $name;
	}
    } else {
	$act_value{Strasse} = $tags[1];
	$act_value{Strasse} =~ s/\|.*$//; # Teil hinter "|" abschneiden
	if (($edit_mode || $edit_normal_mode) and defined $tags[3] and $tags[3] =~ /-(\d+)$/) {
	    $act_value{Strasse} .= " [" . ($1+1) . "]"; # Zeilennummer
	}
	$str_label->configure(-fg => 'black');

	if ($hs_label->cget(-fg) eq 'black') {
	    push @l, $act_value{Haltestelle};
	}
	if (defined $act_value{Strasse} && $act_value{Strasse} ne '') {
	    push @l, $act_value{Strasse};
	}
    }

    if (defined $c_balloon) {
	if (@l && $use_c_balloon > 1) {
	    if ($leave_after) {	$leave_after->cancel; undef $leave_after }
	    $c_balloon->Popup(join(" / ", @l));
	} else {
	    $c_balloon->Deactivate;
	}
    }
}

# Wird beim Verlassen einer Strecke aufgerufen.
sub leavestr {
    $str_label->configure(-fg => $dim_color);
    $c_balloon->Deactivate(undef, -from => "event") if defined $c_balloon;
}

# Zeigt den Strecken- und/oder Punktnamen unterhalb der Route.
sub enterroute {
    my($c, $item) = @_;
    return if !defined $c_balloon;
    $item = 'current' unless defined $item;
    my(@tags) = $c->gettags($item);
    my $routenr;
    if (defined $tags[2] && $tags[2] eq 'viaflag') {
	my($item2,@tags2) = find_below_rx($c, ['^route-'],[1]);
	if (defined $item2) {
	    ($item, @tags) = ($item2, @tags2);
	}
    }
    if (defined $tags[1] && $tags[1] =~ /^route-(.*)/) {
	$routenr = $1;
	if ($routenr eq "") { warn "@tags" } # XXXXX
    } else {
	if (!grep { $_ eq "viaflag" } @tags) {
	    warn "Unexpected: no route number in <@tags>";
	}
	return;
    }
    my @l;
    my $str = show_below_str($c);
    if (!defined $str) {
	# next try with bigger tolerance
	my $old_closeenough = $c->cget(-closeenough);
	$c->configure(-closeenough => 5);
	$str = show_below_str($c);
	# restore old tolerance value
	$c->configure(-closeenough => $old_closeenough);
    }
    push @l, Strassen::strip_bezirk($str)      if (defined $str);
    if (defined $routenr && $routenr >= 0) { # wenn mehr als nur der Startpunkt angewhlt ist
	push @l, s2hm($route_time[$routenr]) . "h" if ($route_time[$routenr]);
	push @l, m2km($route_distance[$routenr])   if ($route_distance[$routenr]);
    }
    if (@l) {
	if ($leave_after) { $leave_after->cancel; undef $leave_after }
	$c_balloon->Popup(join(" / ", @l));
    } else {
	$c_balloon->Deactivate;
    }
}

# Wird beim Verlassen einer Route aufgerufen.
sub leaveroute {
    if (!$leave_after) { # XXX not well tested yet!
	$leave_after =
	    $c->after(100, sub {
			  $str_label->configure(-fg => $dim_color);
			  $c_balloon->Deactivate(1) if defined $c_balloon;
			  undef $leave_after;
		      });
    }
}

# Gibt den ersten Tag aus @allowed_tags aus, der sich unter dem jetzigen
# Tag befindet.
sub find_below {
    my($c, @allowed_tags) = @_;
    my $e = $c->XEvent;
    my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    my(@items) = $c->find(overlapping => $xx-1, $yy-1, $xx+1, $yy+1);
    my %allowed_tags;
    foreach (@allowed_tags) { $allowed_tags{$_} = 1 }
    my %res;
    # Now using "reverse", so top-most items are preferred
    # XXX Hopefully this change does not break anything.
    foreach my $item (reverse @items) {
	my(@tags) = $c->gettags($item);
	if ($allowed_tags{$tags[0]} && !exists $res{$tags[0]}) {
	    $res{$tags[0]} = $item;
	}
    }
    foreach (@allowed_tags) {
	if (exists $res{$_}) {
	    return ($res{$_}, $c->gettags($res{$_}));
	}
    }
    undef;
}

# Similar to find_below, but use a list of regexes and restrict to
# a list of tag positions.
sub find_below_rx {
    my($c, $allowed_rx_tags, $tag_pos, $forbidden_rx_tags) = @_;
    my $e = $c->XEvent;
    my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    my(@items) = $c->find(overlapping => $xx-1, $yy-1, $xx+1, $yy+1);
    # Now using "reverse", so top-most items are preferred
    # XXX Hopefully this change does not break anything.
 ITEM:
    foreach my $item (reverse @items) {
	my(@tags) = $c->gettags($item);
	my @restricted_tags = $tag_pos ? @tags[@$tag_pos] : @tags;
	my $ok = 0;
	for my $tag (@restricted_tags) {
	    for my $rx (@$allowed_rx_tags) {
                if ($tag =~ /$rx/) {
		    if ($forbidden_rx_tags) {
			for my $frx (@$forbidden_rx_tags) {
			    if ($tag =~ /$frx/) {
				next ITEM;
			    }
			}
		    }
		    $ok = 1;
		}
	    }
	}
	if ($ok) {
	    return ($item, @tags);
	}
    }
    undef;
}

# Doc pending XXX
sub show_below_str {
    my($c) = @_;
    my($item, @tags) = find_below($c, qw/s l u b r f w/);
    return if !defined $item;
    $act_value{Strasse} = $tags[1];
    $str_label->configure(-fg => 'black');
    $act_value{Strasse};
}

# Guckt zunchst nach, ob sich darunter eine Route befindet und leitet
# bei Erfolg die Bearbeitung an enterroute() weiter, ansonsten wird
# show_below_str() verwendet.
sub show_below_route_str {
    my $c = shift;
    my($item, @tags) = find_below($c, qw/route/);
    if (!defined $item) {
	show_below_str($c); # Rckgabe: String
    } else {
	enterroute($c, $item);
	undef; # Rckgabe: undef
    }
}

# Zeigt Informationen zum aktuellen Tag.
### AutoLoad Sub
sub show_info {
    my($x, $y) = @_;
    my(@tags) = $c->gettags('current');
    return if !@tags || !defined $tags[0];
    my($base_tag, $is_p);

    my $recursion_breaker=0;#XXX
    while (1) {
	if($recursion_breaker++>10){die}#XXX
	$base_tag = $tags[0];
	@tags = grep { $_ ne "current" } @tags;
	$is_p = ($base_tag =~ /-(?:[fb]g|img)$/);
	$base_tag =~ s/-(?:[fb]g|img)$//;
	last unless !exists $p_file{$base_tag} and !$str_file{$base_tag};
	my($below_item, @below_tags) = find_below($c, qw/s l u b r f w o v/);
	if (!defined $below_item) {
	    main::status_message("Es wurde kein Kartenelement an dieser Position gefunden.", "err");
	    return;
	}
	@tags = @below_tags;
    }

    my $index;
    if ($#tags >= 3) {
	($index = $tags[3]) =~ s/^$base_tag-//;
	#warn $index;
    }
    my $strname = $tags[1];

    my(@coords) = $c->coords('current');
    my $current_is_label = $c->type('current') eq 'text';
    if (!@coords || @coords > 2 || $current_is_label) {
	my($px,$py) = $c->pointerxy;
        $px -= $c->rootx;
        $py -= $c->rooty;
	@coords = ($c->canvasx($px), $c->canvasy($py));
    }
    require Karte::Polar;
    require Karte::UTM;
    require Karte::ETRS89;
    my($sx,$sy) = $Karte::Standard::obj->trim_accuracy(anti_transpose($coords[0], $coords[1]));
    my($px,$py) = $Karte::Polar::obj->trim_accuracy($coord_system_obj->map2map($Karte::Polar::obj, $sx, $sy));
    my @polarcoord = (Karte::Polar::dms_human_readable("lat", Karte::Polar::ddd2dms($py)),
		      Karte::Polar::dms_human_readable("long", Karte::Polar::ddd2dms($px)));
    my @polarcoord2 = (Karte::Polar::dmm_human_readable("lat", Karte::Polar::ddd2dmm($py)),
		       Karte::Polar::dmm_human_readable("long", Karte::Polar::ddd2dmm($px)));
    my($gkk_zone_potsdam, $gkk_easting_potsdam, $gkk_northing_potsdam) = Karte::UTM::DegreesToGKK($py, $px, "Potsdam");
    my($gkk_zone_wgs84, $gkk_easting_wgs84, $gkk_northing_wgs84) = Karte::UTM::DegreesToGKK($py, $px, "WGS 84");
    my($utm_ze, $utm_zn, $utm_x, $utm_y) = Karte::UTM::DegreesToUTM($py, $px, "WGS 84");
    my($etrs_east, $etrs_north) = Karte::ETRS89::UTMToETRS89($utm_ze, $utm_zn, $utm_x, $utm_y);

    my @comments;
    if (!$str_obj{"comm"}) {
	$str_obj{'comm'} = _get_comments_obj();
    }
    if (!$comments_pos_net) {
	eval {
	    $comments_pos_net = $str_obj{"comm"}->make_coord_to_pos
		(sub {
		     my $cat = $_[0]->[Strassen::CAT];
		     $cat =~ /^(?:CS|[-+][12])/ ? 2 : 0;
		 });
	}; warn $@ if $@;
    }
    if ($comments_pos_net && $str_obj{"comm"}) {
	eval {
	    my($first, $second);
	    (undef,undef,$first,$second) = nearest_line_points_mouse($c);
	    $first = join(",",@$first);
	    $second = join(",",@$second);
	    if (defined $first && defined $second &&
		$comments_pos_net->{"${first}_${second}"}) {
		foreach my $pos (@{$comments_pos_net->{"${first}_${second}"}}) {
		    my $r = $str_obj{"comm"}->get($pos);
		    push @comments, $r->[Strassen::NAME];
		}
	    }
	}; warn $@ if $@;
    }

    my($area, $total_len);
    if (defined $index && $index =~ /^\d+/) {
	my $s = eval { get_any_strassen_obj("str", $base_tag) };
	if (!$s) {
	    $s = get_any_strassen_obj("p", $base_tag);
	}
	if ($s) {
	    require Strassen::Stat;
	    my $r = $s->get($index);
# XXX bei weitem noch nicht perfekt: statt des Indexes sollte der
# NAME verwendet werden, um alle gleichnamigen Objekte zusammenzufassen
# Auerdem sind manche Gewsser gleichzeitig Seen und Flsse (Havel), bei
# diesen sollten aus der Flche eine vernnftige Lnge berechnet werden
# und diese zu der normalen Lnge dazuaddiert werden.
	    if ($r) {
		if ($r->[Strassen::CAT()] =~ /^F:/) {
		    $area = Strassen::area($r) / 1_000_000;
#XXX Noch nicht --- siehe Kommentare in wasserstrassen-orig und data/Makefile
#  	    # Inseln abziehen
#  	    $s->set_index($index + 1);
#  	    while(1) {
#  		my $r = $s->next;
#  		last if !@{ $r->[Strassen::COORDS] };
#  		last if $r->[Strassen::CAT] ne 'F:I';
#  		$area - Strassen::area($r) / 1_000_000;
#  	    }
		} else {
		    $total_len = Strassen::total_len($r) / 1_000;
		}
	    }
	}
    }

    my $show_info_sub = sub {
	my(@txt_and_tag) = @_;
	#my $tl_tag = "info-$base_tag"; # one window per canvas type
	my $tl_tag = "info"; # one window for all
	my $info_top = redisplay_top($top, $tl_tag,
				     -title => M"Information",
				     -class => "BbbikePassive",
				    );
	if (defined $info_top) {
	    require Tk::ROText;
	    $info_text = $info_top->Scrolled('ROText',
					     -wrap => 'word',
					     -scrollbars => 'osoe',
					     -highlightthickness => 0,
					     -borderwidth => 0,
					     -width => 40,
					     -height => 10,
					     )->pack(-expand => 1, -fill => "both");
	    $info_text->tagConfigure("bold", -font => $font{'bold'});
	    $info_text->tagConfigure("fixed", -font => $font{'fixed'});
	    $info_top->Button(Name => 'close',
			      -command => sub { $info_top->destroy },
			     )->pack(-fill => "x");
	    toplevel_checker($info_top);
	}

	my $show_url = sub {
	    my($linkcount, $url) = @_;
	    $info_text->tagBind("link$linkcount", "<ButtonRelease-1>" => sub {
				    if (ref $url eq 'CODE') {
					$url = $url->();
				    }
				    require WWWBrowser;
				    main::status_message("URL: $url", "info");
				    WWWBrowser::start_browser($url);
				}
			       );
	};

	# Longest text for first column:
	$info_text->configure(-tabs => [$info_text->fontMeasure($font{normal}, "Sonnenuntergang: ")]);

	$info_text->delete("1.0", "end");
	my $linkcount = 1;

	for(my $i=0; $i<=$#txt_and_tag; $i+=2) {
	    my($txt, $tag) = @txt_and_tag[$i, $i+1];
	    for my $txtline (split /\n/, $txt) {
		my $pos = 0;
		while ($txtline =~ m{^(.*?)((?:ftp|https?)://\S+)}g) {
		    my($pre_text, $link_text) = ($1, $2);
		    $info_text->insert("end", $pre_text, $tag);
		    $info_text->insert("end", $link_text, "link$linkcount");
		    $show_url->($linkcount, $link_text);
		    $linkcount++;
		    $pos = pos($txtline);
		}
		$info_text->insert("end", substr($txtline, $pos), $tag);
		$info_text->insert("end", "\n");
	    }
	}

	my $comment_label_end_index;
	if (@comments) {
	    $info_text->insert("end", "\n\n" . M("Kommentare").": ", "bold");
	    $comment_label_end_index = $info_text->index("end - 1c");
	    $info_text->insert("end", "\t" . join("\n\t", @comments), "comments_text");
	}
	if (defined $area) {
	    $info_text->insert("end",
			       "\n\n" . M("Flche") . ":", "bold",
			       sprintf("\t%.2f km", $area) . M(" (ungefhr)"), undef); # XXX Msg
	}
	if (defined $total_len) {
	    $info_text->insert("end",
			       "\n\n" . M("Lnge") . ":", "bold",
			       sprintf("\t%.2f km", $total_len) . M(" (ungefhr)"), undef); # XXX Msg
	}

	$info_text->insert("end", "\n\n" . M("Koordinaten") . "\n", "bold");
	if (@polarcoord) {
	    $info_text->insert("end", M("Polar (DMS)") . ":\t$polarcoord[0]\n\t$polarcoord[1]\n");
	}
	if (@polarcoord2) {
	    $info_text->insert("end", M("Polar (DMM)") . ":\t$polarcoord2[0]\n\t$polarcoord2[1]\n");
	}
	if (defined $px && defined $py) {
	    $info_text->insert("end", M("Polar (DDD)") . ":\t$py\n\t$px\n");
	}
	if (defined $gkk_zone_potsdam) {
	    $info_text->insert("end", "GKK (Potsdam):\t[$gkk_zone_potsdam] $gkk_easting_potsdam/$gkk_northing_potsdam\n");
	}
	if (defined $gkk_zone_wgs84) {
	    $info_text->insert("end", "GKK (WGS 84):\t[$gkk_zone_wgs84] $gkk_easting_wgs84/$gkk_northing_wgs84\n");
	}
	if (defined $utm_ze) {
	    $info_text->insert("end", "UTM (WGS 84):\t[$utm_ze/$utm_zn] $utm_x/$utm_y\n");
	}
	if (defined $etrs_east) {
	    $info_text->insert("end", "ETRS 89:\t$etrs_east/$etrs_north\n");
	}
	$info_text->insert("end", "BBBike:\t$sx,$sy\n");
	$info_text->insert("end", "\n");

	$info_text->insert("end", "Links\n", "bold");
	# Mapserver XXX move to function for creating URL
	my @mapserver_def = ([$BBBike::BBBIKE_MAPSERVER_ADDRESS_URL,
			      "Mapserver"]);
	if ($devel_host) {
	    push @mapserver_def, [defined $ENV{BBBIKE_TEST_CGIDIR} ? "$ENV{BBBIKE_TEST_CGIDIR}/mapserver_address.cgi" : "http://www/~eserte/bbbike/cgi/mapserver_address.cgi", "Lokaler Mapserver"];
	}

	my @mapext = $c->get_corners;
	@mapext[0,1] = map { int } anti_transpose(@mapext[0,1]);
	@mapext[2,3] = map { int } anti_transpose(@mapext[2,3]);

	my @layers;
	# XXX move mapping or this function to a config-like module
	my @str_draw_mapping = ([w => "gewaesser"],
				[f => "flaechen"],
				[[qw(g gP gD)] => "grenzen"],
				[[qw(u b r)] => "bahn"],
				[[qw(qs ql)] => "qualitaet"],
				[[qw(hs hl)] => "handicap"],
				[rw => "radwege"],
				[e => "faehren"],
				[fz => "fragezeichen"],
				[v => "sehenswuerdigkeit"],
			       );
	my @p_draw_mapping   = ([o => "orte"],
				[lsa => "ampeln"],
				[obst => "obst"],
				[sperre => "blocked"],
			       );
	for my $type (qw(str p)) {
	    my $mapping = $type eq 'str' ? \@str_draw_mapping : \@p_draw_mapping;
	    my $draw    = $type eq 'str' ? \%str_draw         : \%p_draw;
	    for my $check (@$mapping) {
		my($abk, $ms_layer) = @$check;
		my $doit;
		if (ref $abk eq 'ARRAY') {
		    for (@$abk) {
			if ($draw->{$_}) {
			    $doit = 1;
			    last;
			}
		    }
		} elsif ($draw->{$abk}) {
		    $doit = 1;
		}
		if ($doit) {
		    push @layers, $ms_layer;
		}
	    }
	}

	# XXX maybe use Karte::trim_accuracy instead of int?
	my $real_coords = join(",", map { int } anti_transpose($coords[0], $coords[1]));

	for my $def (@mapserver_def) {
	    my $mapserver_url = $def->[0];
	    my $url = "$mapserver_url?coords=" . $real_coords;
	    $url .= ";mapext=" . join("+",@mapext);
	    if (@layers) {
		$url .= ";" . join(";", map { "layer=$_" } @layers);
	    }
	    $info_text->insert("end", $def->[1], "link$linkcount");
	    warn "Mapserver URL: $url\n";
	    $show_url->($linkcount, $url);
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

	my @bbbike_cgi_def = ([$BBBike::BBBIKE_DIRECT_WWW,
			       "BBBike im WWW"]);
	if ($devel_host) {
	    push @bbbike_cgi_def, [defined $ENV{BBBIKE_TEST_CGIDIR} ? "$ENV{BBBIKE_TEST_CGIDIR}/bbbike.cgi" : "http://www/~eserte/bbbike/cgi/bbbike.cgi", "BBBike im WWW, lokal"];
	}

	my $zielname = "";
	{
	    my $is_first = 1;
	    for my $def (@bbbike_cgi_def) {
		my $bbbike_cgi_url = $def->[0];
		$info_text->insert("end", $def->[1], "link$linkcount");
		$info_text->insert("end", " ");
		if ($is_first) {
		    my $zielname_e = $info_text->Entry(-textvariable => \$zielname,
						       -width => 10);
		    $info_text->insert("end", " Zielname:");
		    $info_text->windowCreate("end", -window => $zielname_e);
		    $is_first = 0;
		}
		$show_url->($linkcount, sub {
				require CGI;
				# sigh, ";" still makes problems...
				CGI->import('-oldstyle_urls');
				my $q = CGI->new({zielc    => $real_coords,
						  zielname => $zielname,
						 });
				my $url = "$bbbike_cgi_url?" . $q->query_string;
				$url;
			    });
		$info_text->insert("end", "\n");
		$linkcount++;
	    }
	}

	my($mapscale_scale) = $mapscale =~ /:\s*(\d+)/;

	{
	    $info_text->insert("end", "Google Maps",
			       "link$linkcount");
	    $show_url->($linkcount, sub {
			    require CGI;
			    my $wpt = "$zielname!$sx,$sy";
			    my $zoom;
			    if ($mapscale_scale < 4000) {
				$zoom = 0;
			    } elsif ($mapscale_scale < 8000) {
				$zoom = 1;
			    } elsif ($mapscale_scale < 16000) {
				$zoom = 2;
			    } else {
				$zoom = 3;
			    }
			    my $q2 = CGI->new({ wpt => $wpt,
						zoom => $zoom,
					      });
			    my $url = "http://www.radzeit.de/cgi-bin/bbbikegooglemap.cgi?" . $q2->query_string;
			    $url;
			});
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

	{
	    my $y_wgs = (Karte::Polar::ddd2dmm($py))[1];
	    my $x_wgs = (Karte::Polar::ddd2dmm($px))[1];
	    my $zoom = "100";
	    if ($mapscale_scale) {
		if ($mapscale_scale < 13000) {
		    $zoom = 100;
		} elsif ($mapscale_scale < 18000) {
		    $zoom = 75;
		} elsif ($mapscale_scale < 26000) {
		    $zoom = 50;
		} else {
		    $zoom = 27;
		}
	    }
	    my $url = "http://www.berliner-stadtplan.com/?y_wgs=${y_wgs}%27&x_wgs=${x_wgs}%27&zoom=$zoom&size=500x400&sub.x=15&sub.y=7";
	    $info_text->insert("end", "www.berliner-stadtplan.com",
			       "link$linkcount");
	    $show_url->($linkcount, $url);
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

	while(my($key, $plugin) = each %info_plugins) {
	    $info_text->insert("end", $plugin->{name} . "\n",
			       "link$linkcount");
	    $info_text->tagBind
		("link$linkcount", "<ButtonRelease-1>" => sub {
		     $plugin->{callback}->(coords => $real_coords,
					   street => $strname);
		 });
	    $linkcount++;
	}

	# Das war der letzte Link
	for (1 .. $linkcount) {
	    $info_text->tagConfigure("link$_", -underline => 1,
				     -foreground => "blue3");
	    $info_text->tagBind("link$_", "<Enter>" => sub {
				    $info_text->configure(-cursor => "hand2");
				});
	    $info_text->tagBind("link$_", "<Leave>" => sub {
				    $info_text->configure(-cursor => undef);
				});
	}

	eval {
	    require Astro::Sunrise;
	    Astro::Sunrise->VERSION(0.85);

	    my $get_sun_rise = sub {
		my $alt = shift;
		Astro::Sunrise::sun_rise($px,$py, $alt);
	    };
	    my $get_sun_set = sub {
		my $alt = shift;
		Astro::Sunrise::sun_set($px,$py, $alt);
	    };

	    my $sunrise_real     = $get_sun_rise->();
	    my $sunrise_civil    = $get_sun_rise->(-6);
	    my $sunrise_nautical = $get_sun_rise->(-12);
	    my $sunrise_astro    = $get_sun_rise->(-15);

	    my $sunset_real      = $get_sun_set->();
	    my $sunset_civil     = $get_sun_set->(-6);
	    my $sunset_nautical  = $get_sun_set->(-12);
	    my $sunset_astro     = $get_sun_set->(-15);

	    $info_text->insert("end", "\nSonnenaufgang/-untergang\n", "bold");
	    $info_text->insert("end", <<EOF, "fixed");
Sonnenaufgang:   $sunrise_real
Dmmerung ab:
  brgerliche:   $sunrise_civil
  nautische:     $sunrise_nautical
  astronomische: $sunrise_astro

Sonnenuntergang: $sunset_real
Dmmerung bis:
  brgerliche:   $sunset_civil
  nautische:     $sunset_nautical
  astronomische: $sunset_astro

EOF
	};
	warn $@ if $@;

	if (defined &show_info_ext) {
	    eval {
		my $txt = show_info_ext($c, @tags);
		if (defined $txt) {
		    $info_text->insert("end", "$txt\n");
		}
	    };
	    warn $@ if $@;
	}

	if (defined $comment_label_end_index) {
	    $info_text->update;
	    my @bbox = $info_text->bbox($comment_label_end_index);
	    $info_text->tagConfigure
		("comments_text",
		 -lmargin2 => $bbox[0]-1-$info_text->cget(-bd)-$info_text->cget(-highlightthickness),
		);
	}
    };

    # XXX zu viel Code dupliziert!
    my(%info, $info_file);
    if (defined $str_file{$base_tag} && $str_file{$base_tag} =~ /\.shp$/) {
	(my $dbf_file = $str_file{$base_tag}) =~ s/\.shp$/.dbf/;
	require BBBikeAdvanced;
	my $index;
	for (@tags) {
	    if (/^$base_tag-(\d+)/) {
		$index = $1;
		last;
	    }
	}
	if (defined $index) {
	    my $dbf_info = get_dbf_info($dbf_file, $index);
	    if (defined $dbf_info) {
		if (@tags > 3) {
		    my $text = splice @tags, 2, 1;
		    unshift @tags, $text, "";
		}
		$show_info_sub->("$dbf_info\n", undef,
				 "\nInterne Canvas-Tags:\n", "bold",
				 join("\n", @tags), undef);
		return;
	    }
	}
    }

    eval {
	require DB_File;
	require Fcntl;
	if (!$is_p) {
	    if ($str_file{$base_tag} !~ m|^/|) {
		$str_file{$base_tag} = "$datadir/$str_file{$base_tag}";
	    }
	    $info_file = $str_file{$base_tag} . "-info";
	} else {
	    if ($p_file{$base_tag} !~ m|^/|) {
		$p_file{$base_tag} = "$datadir/$p_file{$base_tag}";
	    }
	    $info_file = $p_file{$base_tag} . "-info";
	}
    };warn $@ if $@;

    if ($info_file && tie %info, 'DB_File', $info_file, &Fcntl::O_RDONLY) {
	warn "Use $info_file ...\n";
      TRY:
	{
	    foreach my $i (1 .. 4) {
		if (defined $tags[$i]) {
		    if (defined $info{$tags[$i]}) {
			$show_info_sub->("Info:\n", "bold",
					 $info{$tags[$i]});
			last TRY;
		    }
		    if ($tags[$i] =~ /^L\d+-(\d+)/) {
			my $id = $1;
			foreach my $type (qw(s p)) {
			    if (defined $info{"$type-$id"}) {
				$show_info_sub->("Info:\n", "bold",
						 $info{"$type-$id"});
				last TRY;
			    }
			}
		    }
		}
	    }
	    $show_info_sub->("Interne Canvas-Tags:\n", "bold",
			     join("\n", @tags), undef);
	}
	untie %info;
    } else {
	if ($advanced) {
	    if (@tags > 3) {
		my $text = splice @tags, 2, 1;
		unshift @tags, $text, "";
	    }
	    $show_info_sub->("Interne Canvas-Tags:\n", "bold",
			     join("\n", @tags), undef);
	} else {
	    if ($tags[0] =~ /^L\d+-(fg|img)$/) {
		$show_info_sub->($tags[2]); # show name
	    } else { # maybe more special cases?
		$show_info_sub->($tags[1]); # show name
	    }
	}
    }
}

### AutoLoad Sub
sub show_statistics {
    my $update_statistics;
    $update_statistics = sub {
        # XXX some day $dataset should replace all of %str_obj etc.
        $dataset = Strassen::Dataset->new if !$dataset;
        my $res = BBBikeStats::calculate
    	    (Route->new_from_realcoords(\@realcoords), $dataset);
        BBBikeStats::tk_display_result
	    ($top,$res,-markcommand => sub {
		 my($realcoordsref) = @_;

		 my @coordsref;
		 for (@$realcoordsref) {
		     push @coordsref, [ map { [transpose(split/,/,$_)] } @$_];
		 }
		 mark_street(-coords => \@coordsref,
			     -dont_center => 1);
	     },
	     -updatecommand => $update_statistics,
	     -reusewindow => 1,
	    );
    };

    IncBusy($top);
    eval {
        require BBBikeStats;
        require Strassen::Dataset;
	$update_statistics->();
    };
    my $err = $@;
    DecBusy($top);
    if ($err) {
        return status_message(Mfmt("Fehler: %s", $err), "error");
    }
}

### AutoLoad Sub
sub next_free_layer {
    my $max_i = 1;
    while($occupied_layer{"L$max_i"}) {
	$max_i++;
    }
    for my $type (\%str_draw, \%p_draw) {
	while(my($abk, $val) = each %$type) {
	    if ($val && $abk =~ /^L(\d+)/ && $1 >= $max_i) {
		$max_i = $1+1;
		while($occupied_layer{"L$max_i"}) {
		    $max_i++;
		}
	    }
	}
    }
    my $abk = "L$max_i";
    reset_free_layer($abk);
    $abk;
}

### AutoLoad Sub
sub reset_free_layer {
    my $abk = shift;
    delete $no_overlap_label{$abk};
    remove_from_stack($abk);
}

### AutoLoad Sub
sub set_coord_output_sub {
    my $_coord_output = shift;
    if (defined $_coord_output) {
	$coord_output = $_coord_output;
    }
    # XXX warum geht es mit keys, aber nicht mit each!!?!?!?!
    foreach my $k (keys %Karte::map) {
	#while(my($k,$v) = each %Karte::map) {
	my $v = $Karte::map{$k};
	#warn "$k => $v";
	if ($coord_output eq $k) {
	    my $o = $Karte::map{$k};
	    if ($edit_mode) { # XXX find better conditional
		my $from_o = $Karte::map{'berlinmap'}; # XXX don't hardcode, each edit_mode has its own map-token
		if ($k eq 'polar') {
		    $coord_output_sub = sub {
			my(@c) = map { $_ / $scale } transpose(@_);
			@c = map { sprintf "%d%02d'%05.2f\"", Karte::Polar::ddd2dms($_) } $from_o->can('map2map')->($from_o, $o, @c);
			@c;
		    };
		} else {
		    $coord_output_sub = sub {
			my(@c) = map { $_ / $scale } transpose(@_);
			@c = map { int } $from_o->can('map2map')->($from_o, $o, @c);
			@c;
		    };
		}
	    } else {
		if ($k eq 'polar') {
		    $coord_output_sub = sub {
			my(@c) = map { sprintf "%d%02d'%05.2f\"", Karte::Polar::ddd2dms($_) } $o->can('standard2map')->($o, @_);
			@c;
		    };
		} else {
		    $coord_output_sub = sub {
# XXX int oder nicht int?
			my(@c) = map { int } $o->can('standard2map')->($o, @_);
			@c;
		    };
		}
	    }
	    return;
	}
    }

    if ($coord_output eq 'canvas') {
 	$coord_output_sub = sub {
	    my(@c) = transpose(@_);
	    map {
		my $x = $_;
		if ($without_zoom_factor) {
		    $x = $x / $scale;
		}
		if ($coord_output_int) {
		    $x = int $x;
		}
		$x;
	    } @c;
	};
    } elsif ($coord_output ne '') {
	die "Unknown value for coordout: $coord_output";
    }
}

# Fgt interaktiv die angeklickte Stelle in die Route (ber die
# Funktion addpoint_xy) ein, erneuert die Kilometerangaben.
sub addpoint_inter {
## DEBUG_BEGIN
#benchbegin();
## DEBUG_END	   
    my(@tags) = $c->gettags('current');
    return if !@tags;
    my $res;
    if ($tags[0] eq 'pp' or $tags[0] =~ /^lsa/) {
	$res = addpoint_xy(@{Strassen::to_koord1($tags[1])},
			   $c->coords('current'));
    } elsif ($tags[0] eq 'o') {
	$res = addpoint_xy(anti_transpose($c->coords('current')),
			   $c->coords('current'));
    }
    return if !defined $res;
    updatekm();
    set_flag('via');
    set_flag('ziel');
    # XXX only for slowcpu?
    if (!($edit_mode || $edit_normal_mode)) {
	# restack_delayed is very slow for many points, so disabled here...
	restack_delayed();
	update_route_strname();
    }
## DEBUG_BEGIN
#benchend();
## DEBUG_END	   
}

# Eingaben: $x und $y als realcoords, $xx und $yy als Canvas-Koords
sub addpoint_xy {
    my($x, $y, $xx, $yy) = @_;
## DEBUG_BEGIN
#benchbegin();
## DEBUG_END	   

    if (!defined $xx) {
	if ($coord_system ne 'standard') {
	    warn "NYI: non-standard map mode and not supplied $xx and $yy to addpoint_xy";
	} else {
	    ($xx, $yy) = transpose($x, $y);
	}
    }

    my($deltax, $deltay, $etappe);
    if (@realcoords != 0) {
	($deltax, $deltay) = ($x - $realcoords[-1]->[0],
			      $y - $realcoords[-1]->[1]);
	$etappe = sqrt(sqr($deltax) + sqr($deltay));
	return undef if $etappe == 0; # keine leeren Etappen

	# Fhrstrecken von der Gesamtstrecke ausschlieen:
    CHECK_NO_FERRY: {
	    if ($net) {
		my $xy0 = join(",", @{$realcoords[-1]});
		my $xy1 = "$x,$y";
		my $name = ((exists $net->{Net2Name}{$xy0} && $net->{Net2Name}{$xy0}{$xy1}) ||
			    (exists $net->{Net2Name}{$xy1} && $net->{Net2Name}{$xy1}{$xy0}));
		if (defined $name && $name =~ /^Fhre /) {
		    last CHECK_NO_FERRY;
		}
	    }
	    $strecke += $etappe;
	}
    }
    my($prex, $prey);
    push(@coords, [$xx, $yy]);
    $nr++;
    push(@realcoords, [$x, $y]);
    if ($nr == 0) {
	($prex, $prey) = ($xx, $yy);
    } else {
	($prex, $prey) = @{$coords[-2]};
    }
    my $hw;
    $hw = BBBikeCalc::head_wind($deltax, $deltay) if $wind;
    my $curr_line = $c->createLine
	($prex, $prey, $xx, $yy,
	 -width => 5,
	 ($route_arrowed ? (-arrow => "last") : ()),
	 # -dash and -capstyle don't work well together
	 ($route_dashed ? (-dash => [4,5]) : (-capstyle => $capstyle_round)),
	 -tags => ['route', "route-$nr"]);
    if ($nr == 0) {
	set_flag('start');
    }

    # XXX auch hier mssten Fhrstrecken ausgeschlossen werden... wie?
    my $v_rel;
    if ($bikepwr && $etappe) {
	my $wind; # Berechnung des Gegenwindes
	{
	    local $^W = 0;
	    if ($hw >= 2) {
		$wind = -$wind_v;
	    } elsif ($hw > 0) { # unsicher beim Crosswind
		$wind = -$wind_v*0.7;
	    } elsif ($hw > -2) {
		$wind = $wind_v*0.7;
	    } else {
		$wind = $wind_v;
	    }
	}

	# Verhltnis zwischen der mglichen Geschwindigkeit, die ohne
	# Gegenwind und Steigung erreicht werden kann, und der tatschlich
	# erreichten

	for(my $i = 0; $i <= $#power; $i++) {

	    # In diesem Abschnitt wird versucht, eine Steigung zu finden.
	    # Wenn %hoehe nicht eingelesen wurde, passiert nichts.
	    # Wenn die Hhen von beiden Etappenpunkten definiert ist, kann
	    # die Steigung trivial errechnet werden. Wenn nur die Hhe des
	    # Etappenzielpunktes bekannt ist, wird nachgeguckt, ob in den
	    # bisherigen Etappenstartpunkten die Hhe bekannt ist, und
	    # bei Erfolg eine Durchschnittssteigung errechnet.
	    my($prev_x, $prev_y) = @{$realcoords[-2]};
	    my $grade;
	    my @grade_symbol_pos;
	    my $prev_hoehe = $hoehe{"$prev_x,$prev_y"};
	    my $this_hoehe = $hoehe{"$x,$y"};
	    my $grade_length = $etappe;
	    if ($use_hoehe && defined $this_hoehe) {
		if (defined $prev_hoehe) {
		    $grade = ($this_hoehe-$prev_hoehe)/$grade_length;
		    @grade_symbol_pos = (int(($xx-$prex)/2+$prex)+1,
					 int(($yy-$prey)/2+$prey)+1);
		} else {
		    for(my $j = $#{$bikepwr_all_time[$i]}; $j >= 0; $j--) {
			if (defined $bikepwr_all_time[$i]->[$j][3]) {
			    my @grade_line;
			    for(my $k = $j;
				$k <= $#{$bikepwr_all_time[$i]}; $k++) {
				$grade_length +=
				  $bikepwr_all_time[$i]->[$k][2];
				push @grade_line, @{$coords[$k]};
			    }
			    push @grade_line, $prex, $prey, $xx, $yy;
			    @grade_symbol_pos = get_polyline_center(@grade_line);
			    # XXX ist $etappe (und damit $grade_length)
			    # immer != 0?
			    $grade =
			      ($this_hoehe-$bikepwr_all_time[$i]->[$j][3])
				/ $grade_length;
			    for(my $k = $j;
				$k <= $#{$bikepwr_all_time[$i]}; $k++) {
				$bikepwr_all_time[$i]->[$k][4] = $grade;
			    }
			    last;
			}
		    }
		}
	    }

	    # XXX mglicherweise Performance-Killer bei reverse_route()?
	    # Caching verwenden?
	    my($current_v, $current_C) = bikepwr_get_v($wind, $i, $grade);
	    if ($coloring eq 'power' && $i == 0) {
		$v_rel = (bikepwr_get_v(0, $i, 0))[0] / $current_v;
	    }
	    my $bikepwr_time_etappe = $etappe / $current_v;
	    $bikepwr_time[$i] += $bikepwr_time_etappe;
	    my $bikepwr_cal_etappe = ($bikepwr_time_etappe
				      ? $current_C*($bikepwr_time_etappe/3600)
				      : 0);
	    $bikepwr_cal[$i] += $bikepwr_cal_etappe;

	    if (defined %active_speed_power &&
		$active_speed_power{Type} eq "power" &&
		$i == $active_speed_power{Index}) {
		if (!$nr) {
		    $route_time[0] = 0;
		} else {
		    $route_time[$nr-1] = 0 if !defined $route_time[$nr-1];
		    $route_time[$nr]
		      = $route_time[$nr-1] + $bikepwr_time_etappe;
		}
		if (%ampeln && $ampeln{"$x,$y"}) {
		    $route_time[$nr] += $lost_time_per_ampel{X}; # XXX F...
		}
	    }

	    my $grade_direction;
	    if ($show_grade && $i == 0) {
		if (!defined $grade) {
		    make_comments_net() if !$comments_net;

		    if ($comments_net) {
			for my $cat (@{ $comments_net->{Net}{"$prev_x,$prev_y"}{"$x,$y"} }) {
			    if ($cat =~ /^(St|Gf)/) {
				$grade_direction = $1 eq 'St' ? +1 : -1;
				last;
			    }
			}
			if ($grade_direction) {
			    @grade_symbol_pos = get_polyline_center($prex, $prey, $xx, $yy);
			    my $r = $comments_net->get_street_record("$prev_x,$prev_y",
								     "$x,$y");
			    if ($r && $r->[Strassen::NAME] =~ /(\d+)%/) {
				$grade = $1 * $grade_direction;
			    }
			    $grade_length = Strassen::Util::strecke
				([$prev_x,$prev_y],[$x,$y]);
			}
		    }
		}
		if ((defined $grade &&
		     (($grade_length >= $grade_minimum_short_length && abs($grade) >= $grade_minimum) ||
		      ($grade_length < $grade_minimum_short_length && abs($grade) >= $grade_minimum_short))) ||
		    (!defined $grade && defined $grade_direction)) {
		    $c->createImage
			(@grade_symbol_pos,
			 -image => ((defined $grade_direction && $grade_direction > 0) || (defined $grade && $grade > 0) ? $steigung_photo : $gefaelle_photo),
			 -anchor => 's',
			 -tags => ['route', "route-$nr"],
			);

		    if (defined $grade) {
			outline_text($c,
				     @grade_symbol_pos,
				     -font => $font{'small'},
				     -text => float_prec($grade*100, 1) . '%',
				     -tags => ['route', "route-$nr"],
				     -outlinewidth => 1,
				     -anchor => 'nw');
		    }
		}
	    }

	    # Format einer Etappe von @bikepower_all_time
	    # 0: Zeit fr die jeweilige Etappe
	    # 1: Gegenwindgeschwindigkeit (crosswind mit eingerechnet)
	    # 2: Lnge der Etappe
	    # 3: Hhe des Etappenstartpunktes
	    # 4: Steigung der Etappe
	    # 5: Kalorienverbrauch
	    my @etappe_def = ($bikepwr_time_etappe, $wind, $etappe,
			      $prev_hoehe, $grade, $bikepwr_cal_etappe);
	    push(@{$bikepwr_all_time[$i]}, \@etappe_def);
	    # XXX bikepwr_all_time in dieser Form
	    # ist eigentlich ineffizient, da nur
	    # die Zeit fr die verschiedenen "Power"s unterschiedlich ist,
	    # die anderen Daten aber alle gleich.
	}
    }

    if (defined %active_speed_power &&
	$active_speed_power{Type} eq "speed") {
	my $i = $active_speed_power{Index};
	if (!$nr) {
	    $route_time[$nr] = 0;
	} else {
	    $route_time[$nr-1] = 0 if !defined $route_time[$nr-1];
	    $route_time[$nr]
	      = $route_time[$nr-1] + ($etappe / 1000) / $speed[$i] * 3600;
	}
	if (%ampeln && $ampeln{"$x,$y"}) {
	    $route_time[$nr] += $lost_time_per_ampel{X}; # XXX F ...
	}
    }

    my $col;
    if ($coloring eq 'power' && defined $v_rel) {
	if    ($v_rel >= 2)    { $col = $wind_colors{-2}->[WIND_COLOR_NAME] }
	elsif ($v_rel >= 1.3)  { $col = $wind_colors{-1}->[WIND_COLOR_NAME] }
	elsif ($v_rel >= 0.77) { $col = $wind_colors{0}->[WIND_COLOR_NAME] }
	elsif ($v_rel >= 0.5)  { $col = $wind_colors{1}->[WIND_COLOR_NAME] }
	else                   { $col = $wind_colors{2}->[WIND_COLOR_NAME] }
    } elsif ($wind && $coloring eq 'wind') {
	$col = $wind_colors{$hw}->[WIND_COLOR_NAME];
    } elsif ($coloring =~ /^(wind|power)$/) {
	$col = 'red';
    } else {
	$col = $coloring; # red oder blue
    }
    $c->itemconfigure($curr_line, -fill => $col) if defined $col;

    if (!$nr) {
	$route_distance[0] = 0;
    } else {
	$route_distance[$nr-1] = 0 if !defined $route_distance[$nr-1];
	$route_distance[$nr]   = $route_distance[$nr-1] + $etappe;
    }

## DEBUG_BEGIN
#benchend();
## DEBUG_END	   

    1;
}

### AutoLoad Sub
sub get_route_color {
    my($value, $min_value, $max_value, $min_index, $max_index) = @_;
#    my $r = $wind_color{$min_value}
}

### AutoLoad Sub
sub set_flag {
    my($type, $x, $y, $leaveold) = @_;
    $c->delete($type . 'flag') unless $leaveold;
    if ($do_flag{$type} && $flag_photo{$type}) {
	if ($type eq 'start' && !defined $x) {
	    ($x, $y) = @{$coords[0]};
	} elsif ($type eq 'ziel') {
	    return if (@coords < 2);
	    ($x, $y) = @{$coords[-1]};
	} elsif ($type eq 'via') {
	    require BBBikeVia; # XXX should not be necessary
	    BBBikeVia::show_via_flags();
	    return;
	}
	# XXX $nr may or may not be meaningful here
	$c->createImage($x, $y, -image => $flag_photo{$type},
			-tags => ['route', "route-$nr", $type . 'flag']);
    }
}

sub skalarprodukt {
    my($a1, $a2, $b1, $b2) = @_;
    $a1*$b1 + $a2*$b2;
}

# Eingabe: Gerade mit zwei Endpunkten (Q und R) und Punkt P
# Ausgabe: Fupunkt des Lotes vom Punkt auf die Gerade
sub fusspunkt {
    my($q1, $q2, $r1, $r2, $p1, $p2) = @_;
    my($a1, $a2) = ($r1-$q1, $r2-$q2); # Richtungsvektor berechnen
    my $a_sqr = skalarprodukt($a1, $a2, $a1, $a2);
    return undef if $a_sqr == 0;
    my $zaehler = skalarprodukt($p1-$q1, $p2-$q2, $a1, $a2);
    my $t_f = $zaehler / $a_sqr;
    ($q1 + $t_f * $a1, $q2 + $t_f * $a2);
}

### AutoLoad Sub
sub recalc_bikepwr {
    $power_cache = {};
    for(my $i = 0; $i <= $#power; $i++) {
	$bikepwr_time[$i] = 0;
	$bikepwr_cal[$i] = 0;
	foreach (@{$bikepwr_all_time[$i]}) {
	    my $wind  = $_->[1];
	    my $grade = $_->[4];
	    my($v, $C) = bikepwr_get_v($wind, $i, $grade, $power_cache);
	    my $bikepwr_time_etappe = ($_->[2] / $v);
	    $bikepwr_time[$i] += $bikepwr_time_etappe;
	    my $bikepwr_cal_etappe = ($bikepwr_time_etappe
				      ? $C*($bikepwr_time_etappe/3600)
				      : 0);
	    $bikepwr_cal[$i] += $bikepwr_cal_etappe;
	    $_->[0] = $bikepwr_time_etappe;
	    $_->[5] = $bikepwr_cal_etappe;
	}
    }
    undef $power_cache;
}

### AutoLoad Sub
sub set_corresponding_power {
    @power = ();
    for(my $i = 0; $i<=$#speed; $i++) {
	my $bp_speed = new BikePower;
	$bp_speed->given('v');
	$bp_speed->velocity($speed[$i]/3.6);
	$bp_speed->calc;
	push @power, int($bp_speed->power);
    }
    if (!@power) {
	@power = (50, 100);
    }
}

### AutoLoad Sub
sub redraw_path {
    destroy_delayed_restack();
    IncBusy($top);
    eval {
	my @oldcoords = @coords;
	my @oldrealcoords = @realcoords;
	my @oldsearchroutepoints = @search_route_points; # hack
	resetroute();
	$power_cache = {};
	my $i;
	for($i = 0; $i <= $#oldcoords; $i++) {
	    addpoint_xy(@{$oldrealcoords[$i]}, @{$oldcoords[$i]});
	}
	@search_route_points = @oldsearchroutepoints;
	undef $power_cache;
	set_flag('via');
	set_flag('ziel');
	updatekm();
	restack_delayed();
    };
    DecBusy($top);
}

# Einfaches Umdrehen der Route (kein echter Rckweg!)
### AutoLoad Sub
sub reverse_route {
    destroy_delayed_restack();
    IncBusy($top);
    eval {
	my @newcoords = reverse @coords;
	my @newrealcoords = reverse @realcoords;
	@search_route_points = reverse @search_route_points;
	resetroute();
	$power_cache = {};
	my $i;
	for($i = 0; $i <= $#newcoords; $i++) {
	    addpoint_xy(@{$newrealcoords[$i]}, @{$newcoords[$i]});
	}
	undef $power_cache;
	set_flag('via');
	set_flag('ziel');
	updatekm();
	if ($show_strlist) {
	    show_route_strname();
	}
	restack_delayed();
    };
    warn __LINE__ . ": $@" if $@;
    DecBusy($top);
}

# Echte Berechnung des Rckwegs
### AutoLoad Sub
sub way_back {
    return if @search_route_points < 2;
    @search_route_points = reverse @search_route_points;
    for(my $i=$#search_route_points-1; $i >= 0; $i--) {
	$search_route_points[$i+1]->[SRP_TYPE] = $search_route_points[$i]->[SRP_TYPE];
    }
    $search_route_points[0]->[SRP_TYPE] = POINT_MANUELL;
    re_search(-undo => 0);
    update_route_strname();
}

### AutoLoad Sub
sub way_back_gui {
    IncBusy($top);
    eval { way_back() };
    warn $@ if $@;
    DecBusy($top);
}

sub delete_route {
    reset_button_command();
    if (@inslauf_selection || @ext_selection) {
	require BBBikeAdvanced;
	reset_selection();
    }
    update_route_strname(); # XXX => hook
    if ($map_mode =~ m{^(MM_VIA_MOVE
		       |MM_GOAL_MOVE
		       |MM_VIA_ADD
		       |MM_VIA_ADD_THEN_MOVE
		       |MM_VIA_DEL
		      )$}x) {
	set_map_mode(MM_SEARCH);
    }

    Hooks::get_hooks("del_route")->execute;
}

### XXX problems, see above
#  sub delete_route_gui_toggle {
#      my $menu_index = shift;
#      delete_route();
#      $top->Subwidget(PopupMenu)->entryconfigure
#  	($menu_index,
#  	 -label => M"Route wiederherstellen (Undo)",
#  	 -command => sub { get_undo_route_gui_toggle($menu_index) }
#  	);
#  }

#  sub get_undo_route_gui_toggle {
#      my $menu_index = shift;
#      get_undo_route();
#      $top->Subwidget(PopupMenu)->entryconfigure
#  	($menu_index,
#  	 -label => M"Route lschen",
#  	 -command => sub { delete_route_gui_toggle($menu_index) }
#  	);
#  }

# Hierfr nicht Autoload verwenden, weil es sonst *langsam* wird!
sub bikepwr_get_v { # Resultat in m/s
    my($wind, $i, $grade) = @_;
    if (!defined $bp_obj) {
	die "bp_obj ist nicht definiert";
    }
    $grade = 0 if !defined $grade;
    if (defined $power_cache and
	exists $power_cache->{$wind}{$i}{$grade}) {
	return @{ $power_cache->{$wind}{$i}{$grade} };
    }
    $bp_obj->grade($grade);
    $bp_obj->headwind($wind);
    $bp_obj->power($power[$i]);
    $bp_obj->calc();
    my $v = $bp_obj->velocity;
    my $C = $bp_obj->consumption;
    if (defined $power_cache) {
	$power_cache->{$wind}{$i}{$grade} = [$v, $C];
    }
    ($v, $C);
}

# lscht den letzten Punkt der Route aus @coords und Routenlinie
### AutoLoad Sub
sub dellast {
    my $no_update = shift;
    if (@realcoords) {
	if ($bikepwr) {
	    for(my $i=0; $i <= $#power; $i++) {
		my $etappe_def = pop(@{$bikepwr_all_time[$i]});
		if (ref $etappe_def eq 'ARRAY') {
		    $bikepwr_time[$i] -= $etappe_def->[0];
		    $bikepwr_cal[$i]  -= $etappe_def->[5];
		}
	    }
	    #for(my $i=0; $i <= $#speed; $i++) {
	    #XXX $bikepwr_cal_spd[$i]  -= $etappe_def->[6];
	    #}
	}
	@act_search_route = (); # XXX performance hit bei langen Strecken
	pop @coords;
	my $ref = pop @realcoords;
	my $x = $ref->[0];
	my $y = $ref->[1];
	my $xy = "$x,$y";
	if (@realcoords) {
	    # Fhrstrecken ausschlieen
	CHECK_NO_FERRY: {
		if ($net) {
		    my $xy0 = join(",", @{$realcoords[-1]});
		    my $name = $net->{Net2Name}{$xy0}{$xy} ||
			       $net->{Net2Name}{$xy}{$xy0};
		    if (defined $name && $name =~ /^Fhre /) {
			last CHECK_NO_FERRY;
		    }
		}

		$strecke -= sqrt(sqr($realcoords[-1]->[0] - $x) +
				 sqr($realcoords[-1]->[1] - $y));
	    }
	}

	# Via lschen, und zwar im aktuellen und im vorherigen Punkt ???
	if (@search_route_points) {
	    my $last_via = $search_route_points[-1]->[SRP_COORD];
	    if ($xy eq $last_via) {
		pop @search_route_points;
	    }
	}

	$c->delete("route-$nr");
	$nr--;
	unless ($no_update) {
	    update_flags_and_route();
	}
    }
}

sub update_flags_and_route {
    set_flag('via');
    set_flag('ziel');
    updatekm();
    if (!@coords) {
	undef $search_route_flag;
	search_route_mouse(1);
    }
    update_route_strname();
}

### AutoLoad Sub
sub dellast_selection {
    if (@inslauf_selection) {
	pop @inslauf_selection;
	if ($use_clipboard) {
	    $c->clipboardClear;
	    $c->clipboardAppend(" " . join(" ", @inslauf_selection));
	}
    }
}

# bis zum letzten Via lschen
### AutoLoad Sub
sub deltovia {
    return if !@realcoords || !@search_route_points;
    # Zuerst wird berprft, ob der letzte Punkt ein Via-Punkt ist. In
    # diesem Fall wird diese Tatsache ignoriert und der Punkt wird
    # gelscht.
    my $via = $search_route_points[-1]->[SRP_COORD];
    my($x, $y) = @{ $realcoords[-1] };
    my $xy = "$x,$y";
    if ($xy eq $via) {
	dellast();
    }
    return if !@realcoords;
    return if (!@search_route_points);
    $via = $search_route_points[-1]->[SRP_COORD];
    for(my $i = $#realcoords; $i >= 0; $i--) {
	my($x, $y) = @{ $realcoords[$i] };
	my $xy = "$x,$y";
	if ($xy eq $via) {
	    update_flags_and_route();
	    return;
	} else {
	    dellast(1);
	}
    }
}

# Ausgabe der aktuellen Routenlnge
sub updatekm {
    return if !@realcoords;

    my $lost_time_s;
    if (%ampeln) {
	my $ampel_count = 0;
	foreach (@realcoords) {
	    if ($ampeln{$_->[0].",".$_->[1]}) {
		$ampel_count++;
	    }
	}
	if ($ampel_count == 0) {
	    $ampelstatus_label_text = M"Keine Ampeln";
	} else {
	    $lost_time_s = $ampel_count*$lost_time_per_ampel{X}; # XXX F ...
	    $ampelstatus_label_text =
		"$ampel_count " .
		    ($ampel_count > 1 ? M"Ampeln" : M"Ampel") .
			" (-" . s2ms($lost_time_s) . " min)";
	}
    } else {
	$ampelstatus_label_text = "";
    }

    my $lost_time_tragen_s = 0;
    my $lost_time_narrowpassage_s = 0;
    if (%sperre_tragen || %sperre_narrowpassage) {
	my $tragen_count = 0;
	foreach (@realcoords) {
	    my $c = $_->[0].",".$_->[1];
	    if (exists $sperre_tragen{$c}) {
		$lost_time_tragen_s += $sperre_tragen{$c};
		$tragen_count++;
	    } elsif (exists $sperre_narrowpassage{$c}) {
		$lost_time_narrowpassage_s += $sperre_narrowpassage{$c};
		# XXX don't count
	    }
	}
	if ($lost_time_tragen_s) {
	    $ampelstatus_label_text .=
		"\n" .
		    Mfmt("%dx tragen", $tragen_count) .
			" (-" . s2ms($lost_time_tragen_s) . " min)";
	}
    }

    my @time;
    for(my $i = 0; $i <= $#speed; $i++) {
	# XXX implement something similar for "power", too!
	if ($kopfstein_count->{"speed"}[$i]) {
	    make_handicap_net();
	    make_qualitaet_net();
	    $time[$i] = 0;
	    if ($#realcoords > 0) {
		for(my $ii=0; $ii<$#realcoords; $ii++) {
		    my $s = Strassen::Util::strecke($realcoords[$ii],$realcoords[$ii+1]);
		    my @etappe_speeds = $speed[$i];
		    if ($qualitaet_s_net && (my $cat = $qualitaet_s_net->{Net}{join(",",@{$realcoords[$ii]})}{join(",",@{$realcoords[$ii+1]})})) {
			push @etappe_speeds, $qualitaet_s_speed{$cat}
			    if defined $qualitaet_s_speed{$cat};
		    }
		    if ($handicap_s_net && (my $cat = $handicap_s_net->{Net}{join(",",@{$realcoords[$ii]})}{join(",",@{$realcoords[$ii+1]})})) {
			push @etappe_speeds, $handicap_s_speed{$cat}
			    if defined $handicap_s_speed{$cat};
		    }
		    $time[$i] += ($s/1000)/min(@etappe_speeds);
		}
	    }
	} else {
	    $time[$i] = ($strecke / 1000) / $speed[$i];
	}
    }
    my $dir_strecke =
      sqrt(sqr($realcoords[0]->[0] - $realcoords[-1]->[0]) +
	   sqr($realcoords[0]->[1] - $realcoords[-1]->[1]));
    if ($unit_km eq 'm') {
	$act_value{Km} = sprintf "%d", $scale_coeff * $strecke;
    } else {
	$act_value{Km} = float_prec($scale_coeff * $strecke/1000, 1);
    }
    $act_value{Percent} = ($dir_strecke != 0
			   ? do {
			       my $p = int(($strecke/$dir_strecke)*100)-100;
			       # wenn 1000% erreicht sind, ist es sicher
			       # eine Rundfahrt, und da ist eine Prozent-
			       # angabe unsinnig
			       $p < 1000 ? $p : "";
			   }
			   : "");
    for(my $i = 0; $i <= $#speed; $i++) {
	my $time = $time[$i] +
	  (defined $lost_time_s && $ampel_count->{"speed"}[$i]
	   ? $lost_time_s/3600 : 0);
	$time += ($lost_time_tragen_s+$lost_time_narrowpassage_s)/3600;
	$act_value{Time}->[$i] = h2hm($time) . " h";
    }

    if ($bikepwr) {
	for(my $i = 0; $i <= $#power; $i++) {
	    my $h = int($bikepwr_time[$i]/3600);
	    my $m = int(($bikepwr_time[$i] - $h*3600) / 60);
	    my $time = $bikepwr_time[$i] +
	      (defined $lost_time_s && $ampel_count->{"power"}[$i]
	       ? $lost_time_s : 0);
	    $time += ($lost_time_tragen_s+$lost_time_narrowpassage_s)/3600;
	    $act_value{PowerTime}->[$i] = s2hm($time) . " h";
	    if (!$edit_mode && !$edit_normal_mode) {
		$calories_power[$i] = float_prec($bikepwr_cal[$i], 1);
	    } else {
		$calories_power[$i] = undef;
	    }
	}
#XXX
# 	for(my $i = 0; $i <= $#speed; $i++) {
# 	    if (!$edit_mode && !$edit_normal_mode) {
# 		$calories_speed[$i] = float_prec($bikepwr_cal_spd[$i], 1);
# 	    } else {
# 		$calories_speed[$i] = undef;
# 	    }
# 	}
    }

    # XXX hier?
    Hooks::get_hooks("new_route")->execute;
}

# lscht die Route (Liste und Linie)
sub resetroute {
    $strecke = 0;
    $act_value{Km} = "";
    $act_value{Percent} = "";
    for(my $i = 0; $i <= $#speed; $i++) {
	$act_value{Time}->[$i] = "";
	#XXX $bikepwr_cal_spd[$i] = 0;
    }
    @realcoords = @coords = @search_route_points = ();

    if ($bikepwr) {
	for(my $i = 0; $i <= $#power; $i++) {
	    @{$bikepwr_all_time[$i]} = ();
	    $bikepwr_time[$i] = 0;
	    $bikepwr_cal[$i] = 0;
	    $act_value{PowerTime}->[$i] = "";
	}
    }

    $ampelstatus_label_text = "";
    $c->delete('route');
    $nr = -1;
    $next_is_undo = 0;
    @act_search_route = ();
    update_route_strname();

    if (@inslauf_selection || @ext_selection) {
	require BBBikeAdvanced;
	reset_selection();
    }

}

sub reset_undo_route {
    if (@realcoords) {
	save_route_to_register(0);
    }

    resetroute();
}

### AutoLoad Sub
sub get_undo_route {
    get_route_from_register(0);
}

### AutoLoad Sub
sub save_route_to_register {
    my($register) = @_;
    my $r = {};
    $r->{RealCoords}        = [@realcoords];
    $r->{SearchRoutePoints} = [@search_route_points];

    if ($bikepwr) {
	for(my $i = 0; $i <= $#power; $i++) {
	    if (defined $bikepwr_all_time[$i]) {
		@{ $r->{BikepwrAllTime}[$i] } = @{ $bikepwr_all_time[$i] }
	    }
	    $r->{BikepwrTime}[$i] = $bikepwr_time[$i];
	    $r->{BikepwrCal}[$i]  = $bikepwr_cal[$i];
	}
# 	for(my $i = 0; $i <= $#speed; $i++) {
# 	    $r->{BikepwrCalSpd}[$i]  = $bikepwr_cal_spd[$i];
# 	}

    }
    $r->{Nr} = $nr;

    $save_route{$register} = $r;
}

# Return false if there is no route in this register.
### AutoLoad Sub
sub get_route_from_register {
    my($register) = @_;
    if (!$save_route{$register}) {
	return 0;
    }
    my $r = $save_route{$register};

    @realcoords       = @{ $r->{RealCoords}     };
    realcoords2coords();
    @search_route_points = @{ $r->{SearchRoutePoints} };
    restore_search_route_points();

    if ($bikepwr) {
	for(my $i = 0; $i <= $#power; $i++) {
	    if (defined $r->{BikepwrAllTime}[$i]) {
		@{ $bikepwr_all_time[$i] } = @{ $r->{BikepwrAllTime}[$i] }
	    }
	    $bikepwr_time[$i] = $r->{BikepwrTime}[$i];
	    $bikepwr_cal[$i]  = $r->{BikepwrCal}[$i];
	}
# 	for(my $i = 0; $i <= $#speed; $i++) {
# 	    $bikepwr_cal_spd[$i]  = $r->{BikepwrCalSpd}[$i];
# 	}
    }
    $nr = $r->{Nr};

    redraw_path();
    update_route_strname();

    1;
}

sub restore_search_route_points {
    if ($net) {
	for (@search_route_points) {
	    add_new_point($net, $_->[SRP_COORD], -quiet => 1);
	}
    }
}

sub set_canvas_scale {
    my $s = shift;
    $scale = $s;
    eval { set_canvas_scale_XS($s) };
    create_transpose_subs();
}

### AutoLoad Sub
sub scalecanvas {
    my($c, $scalefactor, $x, $y, %args) = @_;
    my(@oldx) = $c->xview;
    my(@oldy) = $c->yview;
    my($xwidth) = $oldx[1]-$oldx[0];
    my($ywidth) = $oldy[1]-$oldy[0];
    my($sr_x0, $sr_y0, $sr_x1, $sr_y1) = ($Tk::VERSION == 800.017
					  ? $c->cget(-scrollregion)
					  : @{$c->cget(-scrollregion)});
    my($rx,$ry);
    if (defined $x && defined $y) {
	($rx, $ry) = ($c->rootx + $c->widgetx($x),
		      $c->rooty + $c->widgety($y));
    }

    # Initialisieren (muss als erstes kommen)
    show_zoomrect() if $scalefactor < 1 and not $args{-fast};

    IncBusy($top);
    eval {
	my $old_scale = $scale;
	set_canvas_scale($scale * $scalefactor);
	$c->scale('all', 0, 0, $scalefactor, $scalefactor);
	calc_mapscale();
	scale_width($c, $scale, $old_scale);
	change_category_visibility($c, $scale, $old_scale);

	foreach (@scrollregion) { $_ *= $scalefactor }
	$c->configure(-scrollregion => \@scrollregion);
	foreach (@coords) {
	    $_->[0] *= $scalefactor;
	    $_->[1] *= $scalefactor;
	}
	foreach (@route_strnames) {
	    $_->[1] *= $scalefactor;
	    $_->[2] *= $scalefactor;
	}

	scale_maps($scalefactor);

	if (defined $x && defined $y) {
	    # preserve position under cursor
	    $c->scroll_canvasxy_to_rootxy($x*$scalefactor,$y*$scalefactor,$rx,$ry);
	} else {
	    # in die Mitte des vorherigen Ausschnitts positionieren
	    $c->xview('moveto' => $oldx[0]+($xwidth-$xwidth/$scalefactor)/2);
	    $c->yview('moveto' => $oldy[0]+($ywidth-$ywidth/$scalefactor)/2);
	}

	overview_update();
    };
    warn $@ if $@;
    DecBusy($top);

    # Zoomrect starten
    show_zoomrect(1) if $scalefactor < 1 and not $args{-fast};

    Hooks::get_hooks("after_resize")->execute($scalefactor);
}

### AutoLoad Sub
sub scale_width {
    my($c, $scale, $old_scale) = @_;

# XXX scale obst (mehrere Icon-Gren)
    foreach my $type
	(qw(s-BAB sBAB-BAB s-HH s-B s-H s-N s-NN
	    SBAB-BAB-out s-HH-out s-B-out s-H-out s-N-out s-NN-out
	    rw
	    w-W w-W0 w-W1 w-W2 w-W-out w-W0-out w-W1-out w-W2-out wr
	    l l-out u b r pp p z g gP gD fz
	    sperre0 sperre1 sperre1s sperre2)) {
	eval {
	CHANGE: {
		my $new_width = get_line_width($type, $scale);
		if (defined $old_scale) {
		    my $old_width = get_line_width($type, $old_scale);
		    last CHANGE if ($new_width == $old_width);
		}
		if ($type =~ /^(sperre|fz)/) {
		    # special handling to filter out images:
		    foreach my $item ($c->find("withtag", $type)) {
			$c->itemconfigure($item, -width => $new_width)
			    unless $c->type($item) eq 'image';
		    }
		} elsif ($type =~ /^w-.*-out$/) {
		    foreach my $item ($c->find("withtag", $type)) {
			$c->itemconfigure($item, -width => $new_width)
			    unless $c->type($item) eq 'polygon';
		    }
		} else {
		    $c->itemconfigure($type, -width => $new_width);
		}
	    }
	};
	if ($@) {
	    warn "Error while configuring $type in scale_width: $@";
	}
    }
    foreach my $sperre_type (qw(sperre1 sperre1s sperre2)) {
	my $new_width = get_line_width($sperre_type);
	my $old_width = get_line_width($sperre_type, $old_scale);
	if ($new_width != $old_width) {
	    foreach my $item ($c->find("withtag", $sperre_type)) {
		if ($c->type($item) ne 'image') {
		    $c->itemconfigure
			($item,
			 -fill => ($new_width == 0
				   ? undef : $category_color{$sperre_type}));
		}
	    }
	}

	##XXX Works, but maybe it's better to put the code snippets of
	##plot_sperre into strings to be evaled, used in plot_sperre
	##and re-used here.
 	if ($sperre_type =~ /^sperre[12]/) {
 	    my $new_length = get_line_length($sperre_type);
	    my $old_length = get_line_length($sperre_type, $old_scale) * $scale/$old_scale;
	    if ($old_length) { # XXX when may $old_length be 0?
		my $f = $new_length / $old_length;
		foreach my $item ($c->find("withtag", $sperre_type)) {
		    if ($c->type($item) ne 'image') {
			my($x1,$y1,$x2,$y2) = $c->coords($item);
			my($xm,$ym) = (($x2+$x1)/2, ($y2+$y1)/2);
			my $xd1 = $x1-$xm;
			my $xd2 = $x2-$xm;
			my $yd1 = $y1-$ym;
			my $yd2 = $y2-$ym;
			$c->coords($item,
				   $xm+$xd1*$f, $ym+$yd1*$f,
				   $xm+$xd2*$f, $ym+$yd2*$f,
				  );
		    }
 		}
 	    }
	}
    }

    foreach (qw(lsa-X lsa-B lsa-F lsa-Zbr rest kn vf)) {
	$c->itemconfigure($_ . '-fg', -image => get_symbol_scale($_, $scale));
    }
    foreach (qw(e)) {
	$c->itemconfigure($_ . '-img', -image => get_symbol_scale($_, $scale));
    }

    # XXX ... nur ndern, falls sich die Skalierung ndert... (wie oben)
    # XXX arrowshape von sperre1 ndern
    my %arg = get_symbol_scale('b');
    $c->itemconfigure('b-bg', -width => $arg{-width});
    $c->itemconfigure('r-bg', -width => $arg{-width});
    $c->itemconfigure("b-fg",
		      -text => (defined $arg{-font} ? 'S' : ''),
		      (defined $arg{-font} ? (-font => $arg{-font}) : ()),
		     );
    $c->itemconfigure("r-fg",
		      -text => (defined $arg{-font} ? 'R' : ''),
		      (defined $arg{-font} ? (-font => $arg{-font}) : ()),
		     );
    %arg = get_symbol_scale('u');
    $c->itemconfigure('u-bg', -width => $arg{-width});
    $c->itemconfigure("u-fg",
		      -text => (defined $arg{-font} ? 'U' : ''),
		      (defined $arg{-font} ? (-font => $arg{-font}) : ()),
		     );
    foreach my $tag ($c->find('withtag', 'u-bg')) {
	my($x1,$y1,$x2,$y2) = $c->coords($tag);
	# work around 800.0_16-to-be bug
	if (ref $x1 eq 'ARRAY') { ($x1,$y1,$x2,$y2) = @{ $c->coords($tag) } }
	my $xm = ($x2-$x1)/2+$x1;
	$c->coords($tag, $xm-$arg{-width}/2, $y1, $xm+$arg{-width}/2, $y2);
    }
    # rearrange outline_text
    # XXX performance is quite bad (about 0.6s for all U+S-Bahnhfe)
## DEBUG_BEGIN
#benchbegin("Repositioning labels");
## DEBUG_END	   
    foreach my $item ($c->find(withtag => 'outlmaster')) {
	my($x,$y) = $c->coords($item);
	my $outline_width = 1;
	my $outl_i;
	for ($c->gettags($item)) {
	    if (/^outlmaster-width-(\d+)/) {
		$outline_width = $1;
	    } elsif (/^outlmaster-(\d+)/) {
		$outl_i = $1;
	    }
	}
	if (defined $outl_i) {
	    # XXX the second version is a hack, but faster
#	    foreach my $slave ($c->find(withtag => "outlslave-$outl_i")) {
	    foreach my $slave ($item-(4*$outline_width)..$item-1) {
		# assuming last tag is outldata_$x_$y tag
		my @outldata = split /_/, (($c->gettags($slave))[-1]);
		$c->coords($slave, $x+$outldata[1],$y+$outldata[2]);
	    }
	}
    }
## DEBUG_BEGIN
#benchend();
## DEBUG_END	   

    foreach my $item ($c->find(withtag => 'strnr')) {
	my $master = ($c->gettags($item))[2];
	$master =~ s/^strnr-//;
	my(@bbox) = $c->bbox($master);
	$c->coords($item, $bbox[0]-2,$bbox[1]-2,$bbox[2]+2,$bbox[3]+2);
    }

    for my $o_cat (MIN_ORT_CAT .. MAX_ORT_CAT) {
	my $font = get_orte_label_font($o_cat);
	$c->itemconfigure("O$o_cat", -font => $font);
    }

    while(my($name,$scalecommand) = each %scalecommand) {
	warn "Scale for $name...\n";
	$scalecommand->($name, $c, $scale, $old_scale);
    }
}

### AutoLoad Sub
sub change_place_visibility {
    my($c, $new_scale) = @_;

    # XXX genaue Version fr dash patches rauskriegen
    return if $Tk::VERSION < 800.021;

    $new_scale = $scale unless defined $new_scale;
    if ($place_category eq 'auto') {
	my $eff_place_category;
	if      ($new_scale > 0.5) {
	    $eff_place_category = 0;
	} elsif ($new_scale > 0.25) {
	    $eff_place_category = 1;
	} elsif ($new_scale > 0.18) {
	    $eff_place_category = 2;
	} elsif ($new_scale > 0.125) {
	    $eff_place_category = 3;
	} elsif ($new_scale > 0.03125) {
	    $eff_place_category = 4;
	} else {
	    $eff_place_category = 5;
	}

	if ($eff_place_category > 0) {
	    for my $cat (0 .. $eff_place_category-1) {
		$c->itemconfigure("O$cat", -state => "hidden");
		$c->itemconfigure("OP$cat", -state => "hidden");
	    }
	}
	for my $cat ($eff_place_category .. 5) {
	    $c->itemconfigure("O$cat", -state => "normal");
	    $c->itemconfigure("OP$cat", -state => "normal");
	}
    }
}

### AutoLoad Sub
sub change_label_visibility {
    my($c, $new_scale, $old_scale) = @_;

    # XXX genaue Version fr dash patches rauskriegen
    return if $Tk::VERSION < 800.021;
    $new_scale = $scale unless defined $new_scale;
    my @tags = qw(b-label u-label v-fg);
    if ($old_scale >= 1.5 && $new_scale <= 1.5) {
	# make hidden
	for (@tags) { $c->itemconfigure($_, -state => "hidden") }
    } elsif ($old_scale < 1.5 && $new_scale >= 1.5) {
	# make visible
	for (@tags) { $c->itemconfigure($_, -state => "normal") }
    }
}

### AutoLoad Sub
sub change_category_visibility {
    my($c, $scale, $old_scale) = @_;

    change_place_visibility($c, $scale);
    change_label_visibility($c, $scale, $old_scale);

return 1;
#XXXXXXXXXXXX enable
# use tag_invisible for plotstr/plotp
# insert a checkbutton fot auto_visible
# str_restrict: don't set restriction on StrassenNetz
    for my $tag (keys %tag_visibility) {
	my $old_def = $tag_invisible{$tag};
	if ($scale <= $tag_visibility{$tag}) {
	    $tag_invisible{$tag} = 1;
	} else {
	    $tag_invisible{$tag} = 0;
	}
	if (defined $old_def && $old_def != $tag_invisible{$tag}
	    && $auto_visible) {
	    if ($tag =~ /^([^-]+-[^-]+)/) {
		pending(1, "replot-$1");
	    }
	}
    }
}

sub get_index_by_scale {
    my $myscale = shift;
    if ($myscale < 0.5) {
	0;
    } elsif ($myscale < 1) {
	1;
    } elsif ($myscale < 2) {
	2;
    } elsif ($myscale < 5) {
	3;
    } elsif ($myscale < 10) {
	4;
    } else {
	5;
    }
}

sub get_line_width {
    my($tag, $myscale) = @_;
    $myscale = $scale if !defined $myscale;

    my $is_outline = ($tag =~ /-out$/);
    my $add_outline = ($is_outline
		       ? 2 : ($tag eq 'pp' || $tag eq 'p' ? 1 : 0));
    my $index = get_index_by_scale($myscale);
    if ($is_outline && !exists $line_width{$tag}) {
	$tag =~ s/-out$//;
    }
    $line_width{(exists $line_width{$tag} ? $tag : 'default')}->[$index]
      + $add_outline;
}

sub get_line_length {
    my($tag, $myscale) = @_;
    $myscale = $scale if !defined $myscale;

    my $index = get_index_by_scale($myscale);
    $line_length{(exists $line_length{$tag} ? $tag : 'default')}->[$index];
}

sub get_symbol_scale {
    my($tag, $myscale) = @_;
    $myscale = $scale if !defined $myscale;
    my $mod = $small_icons ? 2 : 1;
    if ($tag eq 'lsa-X') {
	if ($myscale > 4*$mod) {
	    return $ampel_photo;
	} elsif ($scale >= 2*$mod) {
	    return $ampel_klein_photo;
	} elsif ($scale >= 0.5*$mod) {
	    return $ampel_klein2_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'lsa-F') {
	if ($myscale > 4*$mod) {
	    return $ampelf_photo;
	} elsif ($scale >= 2*$mod) {
	    return $ampelf_klein_photo;
	} elsif ($scale >= 0.5*$mod) {
	    return $ampelf_klein2_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'lsa-B') {
	if ($myscale > 4*$mod) {
	    return $andreaskr_photo;
	} elsif ($scale >= 2*$mod) {
	    return $andreaskr_klein_photo;
	} elsif ($scale >= 0.5*$mod) {
	    return $andreaskr_klein2_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'lsa-Zbr') {
	if ($myscale >= 4*$mod) {
	    return $zugbruecke_photo;
	} elsif ($scale >= 1*$mod) {
	    return $zugbruecke_klein_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'kn') {
	if ($myscale > 4*$mod) {
	    return $kneipen_photo;
	} elsif ($scale >= 1*$mod) {
	    return $kneipen_klein_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'e') {
	if ($myscale > 1*$mod) {
	    return $ferry_photo;
	} elsif ($scale >= 0.25*$mod) {
	    return $ferry_klein_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'rest') {
	if ($myscale > 4*$mod) {
	    return $essen_photo;
	} elsif ($scale >= 1*$mod) {
	    return $essen_klein_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'b') {
	if ($myscale > 4*$mod) {
	    return (-width => 20, -font => "Helvetica -18");
	} elsif ($myscale >= 1*$mod) {
	    return (-width => 14, -font => ($os eq 'win' ? "Helvetica -14 bold" : "6x13bold"));
	} elsif ($scale >= 0.5*$mod) {
	    return (-width => 10, -font => ($os eq 'win' ? "Helvetica -10 bold" : "5x7"));
	} elsif ($scale >= 0.2*$mod) {
	    return (-width => 6, -font => undef);
	} else {
	    return (-width => 3, -font => undef);
	}
    } elsif ($tag eq 'u') {
	if ($myscale > 4*$mod) {
	    return (-width => 18, -font => "Helvetica -18");
	} elsif ($myscale >= 1*$mod) {
	    return (-width => 13, -font => ($os eq 'win' ? "Helvetica -14 bold" : "6x13bold"));
	} elsif ($scale >= 0.5*$mod) {
	    return (-width => 9, -font => ($os eq 'win' ? "Helvetica -10 bold" : "5x7"));
	} elsif ($scale >= 0.2*$mod) {
	    return (-width => 6, -font => undef);
	} else {
	    return (-width => 3, -font => undef);
	}
    } elsif ($tag eq 'vf') {
	if ($myscale > 2*$mod) {
	    return $vorfahrt_photo;
	} elsif ($scale >= 0.5*$mod) {
	    return $vorfahrt_klein_photo;
	} else {
	    return undef;
	}
    }
}

sub scale_maps {
    my $scalefactor = shift;
    if (defined $map_img || @map_surround_img) {
	my($width, $height);
	for my $img ($map_img, @map_surround_img) {
	    if (defined $img) {
		($width, $height) = ($img->width, $img->height);
		last;
	    }
	}
	if (defined $width) {
	    my @maps = $c->find(withtag => 'map');
	    for my $map_i (@maps) {
		my @map_coords = $c->coords($map_i);
		if ($c->type($map_i) eq 'image') {
		    eval {
			my $p = $c->itemcget($map_i, "-image");
			$p->delete;
		    }; warn $@ if $@;
		}
		$c->delete($map_i);
		@map_coords = ($map_coords[0]+$width*$scalefactor/2,
			       $map_coords[1]+$height*$scalefactor/2);
		# @map_coords zeigt jetzt auf die Mitte der Karte ...
		eval {
		    local $map_surround = 0;
		    getmap(@map_coords); # Karte neu zeichnen (richtig skaliert)
		}; warn $@ if $@;
	    }
	}
    }
}

# Zentriert entweder auf eine Strae oder Koordinaten oder auf die Mitte
# Berlins.
### AutoLoad Sub
sub center_best {
    if (defined $center_on_str && $center_on_str !~ /^\s*$/) {
	choose_from_plz(-str   => $center_on_str);
    } elsif (defined $center_on_coord && $center_on_coord !~ /^\s*$/) {
	choose_from_plz(-coord => $center_on_coord);
    } elsif ($city_obj && $city_obj->can("center")) {
	$c->center_view(transpose(split /,/, $city_obj->center));
    } else {
	$c->center_view;
    }
}

# Zentriert auf den Anfang der aktuellen Route
### AutoLoad Sub
sub center_begin_of_route {
    $c->center_view($coords[0]->[0], $coords[0]->[1]);
}

# Zentriert auf den Anfang der aktuellen Route und verschiebt zum
# letzten Punkt der Route hin,
### AutoLoad Sub
sub center_whole_route {
    $c->see($coords[0]->[0], $coords[0]->[1],
	    $coords[-1]->[0], $coords[-1]->[1],
	   );
}

# Zoomt den Ausschnitt so, da minx/miny und maxx/maxy in den Ecken stehen.
# Wenn keine Argumente angegeben sind, werden die Minimal/Maximalwerte der
# aktuellen Route genommen.
### AutoLoad Sub
sub zoom_view {
    my($minx, $miny, $maxx, $maxy);
    if (@_) {
	($minx, $miny, $maxx, $maxy) = @_;
    } elsif (!@coords) {
	return;
    } else {
	foreach (@coords) {
	    if (!defined $minx || $_->[0] < $minx) { $minx = $_->[0] }
	    if (!defined $maxx || $_->[0] > $maxx) { $maxx = $_->[0] }
	    if (!defined $miny || $_->[1] < $miny) { $miny = $_->[1] }
	    if (!defined $maxy || $_->[1] > $maxy) { $maxy = $_->[1] }
	}
    }

    my(@corner) = $c->get_corners;
    my $c_w = ($corner[2]-$corner[0]);
    my $c_h = ($corner[3]-$corner[1]);
    my($r_w, $r_h) = ($maxx-$minx, $maxy-$miny);
    $c->center_view($r_w/2+$minx, $r_h/2+$miny);
    # XXX ls/pt-Version
    if ($r_w > 0 and $r_h > 0) {
	my $asp_x = $c_w/$r_w;
	my $asp_y = $c_h/$r_h;
	if ($asp_x < $asp_y) {
	    scalecanvas($c, $asp_x/1.1); # 10% Luft lassen
	} else {
	    scalecanvas($c, $asp_y/1.1);
	}
    }
}

# XXX move to CanvasUtil.pm ???
sub Tk::Canvas::smooth_scroll {
    my($c, $tox, $toy, %args) = @_;
    if ($use_smooth_scroll && !$args{NoSmoothScroll}) {
	my($fromx, $fromy) = (($c->xview)[0], ($c->yview)[0]);
	my $step = 10;
	my($deltax, $deltay) = (($tox-$fromx)/$step,
				($toy-$fromy)/$step);
	for (1 .. $step) {
	    $c->xview('moveto' => $fromx + $deltax * $_);
	    $c->yview('moveto' => $fromy + $deltay * $_);
	    $c->idletasks;
	}
    } else {
	$c->xview('moveto' => $tox);
	$c->yview('moveto' => $toy);
    }
}

# Diese Funktion geht von einer korrekten dpi-Einstellung fr den
# Bildschirm und quadratischen Dots aus.
# Rckgabewert: Der Teil hinter dem Doppelpunkt.
sub calc_mapscale_nenner {
    my($mx1) = transpose(0, 0);
    my($mx2) = transpose(1000, 1000);
    my $nenner = (($mx2-$mx1)/$top_dpmm/$scale_coeff);
    if ($nenner == 0) { $nenner = 0.00000001 }
    $nenner = abs(int(1_000_000 / $nenner));
    $nenner;
}

# side-effect: this also sets $mapscale
sub calc_mapscale {
    my $nenner = calc_mapscale_nenner();
    $mapscale = "1:$nenner";
    $nenner;
}

### AutoLoad Sub
sub show_zoomrect {
    my($i) = @_;
    if (!defined $i) {
	$c->delete('zoomrect');
	if (defined $zoomrect_after) {
	    $zoomrect_after->cancel;
	}
	my @c = $c->get_corners;
	$c->createLine(@c[0,1, 0,3, 2,3, 2,1, 0,1],
		       -tags => 'zoomrect',
		      );
    } elsif ($i > 3*2) {
	$c->delete('zoomrect');
	undef $zoomrect_after;
    } else {
	$c->itemconfigure('zoomrect',
			  -fill => ($i % 2 == 1 ? 'blue' : 'red'));
	$zoomrect_after = $c->after(300, sub { show_zoomrect($i+1) });
    }
}

### AutoLoad Sub
sub show_mark {
    my($i, %args) = @_;
    $i = 0 if !defined $i;
    if ($i == 0 and $showmark_after) {
	$showmark_after->cancel;
	undef $showmark_after;
    }
    my @stipple = ('gray12', 'gray25', 'gray50', 'gray75');
    my $col = $i/8; # color ...
    my $j   = $i%8; # stage ...
    if ($col > 5 && !$args{'-endlessmark'}) {
	$c->delete('show');
	undef $showmark_after;
    } else {
	$c->itemconfigure('show',
  			  -fill => ($col % 2 == 1 ? 'blue' : 'red'));
	if ($j < 4) {
	    $c->itemconfigure('show',
			      -stipple => $stipple[$j]);
	} elsif ($j == 4) {
	    $c->itemconfigure('show',
			      -stipple => undef);
	} else {
	    $c->itemconfigure('show',
			      -stipple => $stipple[8-$j]);
	}
	unless ($steady_mark) {
	    $showmark_after = $c->after(150, sub { show_mark($i+1, %args) });
	} else {
	    $c->itemconfigure('show',
			      -stipple => undef);
	}
    }
}

## DEBUG_BEGIN
#BEGIN{mymstat("75% BEGIN");}
## DEBUG_END

### AutoLoad Sub
sub show_overview {
    my $new    = shift;

    my $overview_top = $toplevel{"overview"};

    if ($overview_top && $overview_top->{CoordSystem} ne $coord_system) {
	$new = 1;
    }
    if (defined $overview_top and Tk::Exists($overview_top)) {
	if ($new) {
	    $overview_top->destroy;
	    delete $toplevel{"overview"};
	}
    }

    if (defined $overview_top && Tk::Exists($overview_top)) {
	if (!$show_overview) {
	    $overview_top->withdraw;
	} else {
	    $overview_top->deiconify;
	    $overview_top->raise;
	}
	return;
    }

    $overview_top = $top->Toplevel(-title => M"bersicht",
				   -class => "Bbbike Overview",
				  );
    $overview_top->OnDestroy(sub { $show_overview = 0; });
    $toplevel{"overview"} = $overview_top;
    set_as_toolwindow($overview_top);
    $overview_top->{CoordSystem} = $coord_system;
    # Try to set the overview to the right bottom corner of the main
    # window:
    my($w,$h) = (int($top->width/3), int($top->height/3));
    if (1) {
	my($x,$y) = ($sy->rootx - $w - 4*2, $sx->rooty - $h - 20 - 4);
	geometry($overview_top,$x,$y,$w,$h);
    } else { # XXX del
    if (!@max_extends) {
	warn "Should not happen: no defined max_extends";
	$overview_top->geometry("${w}x$h-0-0");
    } else {
	my(@want_extends) = ($top->x+$top->width, $top->y+$top->height,
			     $w, $h);

	crop_geometry(\@want_extends, \@max_extends);
	if ($want_extends[GEOMETRY_HEIGHT] < $h) {
	    $want_extends[GEOMETRY_HEIGHT] = $h;
	    $want_extends[GEOMETRY_Y]      = "-0";
	} else {
	    $want_extends[GEOMETRY_Y] =~ s/^/+/;
	}
	if ($want_extends[GEOMETRY_WIDTH] < $w) {
	    $want_extends[GEOMETRY_WIDTH] = $w;
	    $want_extends[GEOMETRY_X]     = "-0";
	} else {
	    $want_extends[GEOMETRY_X] =~ s/^/+/;
	}
	my $geom = "$want_extends[GEOMETRY_WIDTH]x$want_extends[GEOMETRY_HEIGHT]" . "$want_extends[GEOMETRY_X]$want_extends[GEOMETRY_Y]";
	$overview_top->geometry($geom);
    }
    } ##XXX <--- delete until here

    show_overview_populate($overview_top);
}

sub show_overview_clean_and_populate {
    my $overview_top = shift;
    for ($overview_top->children) {
	$_->destroy;
    }
    show_overview_populate($overview_top);
}

sub show_overview_populate {
    my $overview_top = shift;
    my $withdraw_sub = sub { $overview_top->withdraw;
			     $show_overview = 0 };
    $overview_top->protocol('WM_DELETE_WINDOW', $withdraw_sub);

    # Canvas. Create scrollbars manually, so arrow_update can be called
    $overview_canvas = $overview_top->Canvas
	(-xscrollincrement => 15, # XXX check values
	 -yscrollincrement => 15,
	 -bg => $map_bg,
	);

    my($overview_width, $overview_height);
    if ($coord_system eq 'standard') {
	$overview_width = $normal_scrollregion/DEFAULT_SCALE*
	    ($show_overview_mode eq 'brb' ? $small_scale : $medium_scale);
	$overview_height = $overview_width;
	$overview_canvas->configure
	    (-scrollregion => [-$overview_width, -$overview_width,
			       $overview_width,  $overview_width]
	    );
    } else {
	my @s = $coord_system_obj->scrollregion;
	# XXX show_overview_mode beachten
	@s = (transpose_medium(@s[0, 1]),
	      transpose_medium(@s[2, 3]));
	$overview_width  = ($s[2]-$s[0])/2;
	$overview_height = ($s[3]-$s[1])/2;
	$overview_canvas->configure(-scrollregion => [@s]);
    }

    $overview_canvas->createLine(0,0,0,0,-tags => 'zoomrect');
    $overview_top->gridColumnconfigure(0, -weight => 1);
    $overview_top->gridRowconfigure(0, -weight => 1);
    $overview_canvas->grid(-row => 0, -column => 0, -sticky => 'eswn');
    my $sy = $overview_top->Scrollbar(-command => ["yview", $overview_canvas]);
    $sy->grid(-row => 0, -column => 1, -sticky => 'ns');
    my $sx = $overview_top->Scrollbar(-orient => 'horiz',
				      -command => ["xview", $overview_canvas]);
    $sx->grid(-row => 1, -column => 0, -sticky => 'ew');

    my $center_coords;
    if ($city_obj && $city_obj->can("center")) {
	$center_coords = [ split /,/, $city_obj->center ];
    } else {
	$center_coords = [8581,12243]; # Fallback: Brandenburger Tor
    }

    my $arrow_update = sub {
	$overview_canvas->delete('berlinarrow');
	require Geometry;
	my($cx1,$cy1,$cx2,$cy2) = $overview_canvas->get_corners;
	# Ersten Schnittpunkt (inneres Rechteck) ermitteln
	# Die Mitte ist (0,0) (ca. Berlin-Moabit).
	my($ix1,$iy1) = Geometry::get_intersection
	    ($cx1+($cx2-$cx1)/2, $cy1+($cy2-$cy1)/2, 0,0,
	     $cx1+15,$cy1+15,$cx2-15,$cy2-15);
	if (defined $ix1 and defined $iy1) {
	    # zweiten Schnittpunkt ermitteln (aktuelle Canvasgrenze)
	    my($ix2,$iy2) = Geometry::get_intersection($ix1,$iy1,0,0,
						       $cx1,$cy1,$cx2,$cy2);
	    if (defined $ix2 and defined $iy2) {
		my $anti_transpose = ($show_overview_mode eq 'brb'
				      ? \&anti_transpose_small
				      : \&anti_transpose_medium);
		# Distance to center (in Berlin: Brandenburger Tor)
		my $entf = Strassen::Util::strecke
		    ([$anti_transpose->($ix1,$iy1)],
		     $center_coords);
		$overview_canvas->createLine
		    ($ix1,$iy1,$ix2,$iy2,
		     -arrow => "last",
		     -width => 2,
		     -fill => "red",
		     -tags => 'berlinarrow');
		$overview_canvas->createText
		    ($ix1, $iy1,
		     -anchor => BBBikeCalc::opposite_direction(BBBikeCalc::line_to_canvas_direction
							       ($ix1,$iy1,$ix2,$iy2)),
		     -text => "Berlin\n".sprintf("%d km", $entf/1000),
		     -fill => "red",
		     -font => $font{'small'},
		     -tags => ['berlinarrow','berlinarrowlabel']);
	    }
	}
    };

    $overview_canvas->configure(-yscrollcommand =>
				sub {
				    $sy->set(@_);
				    $arrow_update->();
				},
                                -xscrollcommand =>
				sub {
				    $sx->set(@_);
				    $arrow_update->();
				},
    );

    # Mode button
    my $mode_button = $overview_top->Button
	(-font => $font{'small'},
	 -padx => 0, -pady => 0,
	 -highlightthickness => 0,
	 -takefocus => 0,
	 -command => sub {
	     $show_overview_mode =
		 ($show_overview_mode eq 'b' ? 'brb' : 'b');
#	     $overview_top->after(10, sub { show_overview(1) });
	     $overview_top->after(10, sub { show_overview_clean_and_populate($overview_top) });
	 });
    $mode_button->place("-x" => 2, "-y" => 2);
    if ($show_overview_mode eq 'brb') {
	$mode_button->configure(-text => "=> Berlin");
    } else {
	$mode_button->configure(-text => "=> Brandenburg");
    }

    my $ts = ($show_overview_mode eq 'brb'
	      ? \&transpose_small
	      : \&transpose_medium);
    my($km100_pixel) = ($ts->(100000,0))[0] - ($ts->(0,0))[0];

    # Radar button
    if ($advanced) {
    my $radar_onoff = 0;
    my $radar_button;
    my $show_radar_image;
    $radar_button = $overview_top->Checkbutton
      (-font => $font{'small'},
       -indicatoron => 0,
       -padx => 0,
       -pady => ($os eq 'win' ? 0 : 1), # for Checkbuttons 1, for Buttons 0 (why?)
       -highlightthickness => 0,
       -takefocus => 0,
       -text => 'Radar',
       -variable => \$radar_onoff,
       -command => sub {
	   $radar_button->after(50, $show_radar_image);
       }
      );
    $show_radar_image = sub {
	if ($radar_image) {
	    eval q{ $radar_image->delete };
	}
	$overview_canvas->delete('radarimage');
	return if !$radar_onoff;

	IncBusy($top);
	$progress->Init(-label => M"Radarschirm");
	eval {
	    require FURadar;
	    $FURadar::progress = $progress;
	    $FURadar::VERBOSE = $verbose;
#	       $FURadar::use_map = ($show_overview_mode eq 'brb'
#				    ? 'FURadar2' : 'FURadar');
	    $FURadar::use_map = 'FURadar2'; # the only left...
	    # XXXX use fetch and cache routine
	    my $origimgfile = FURadar::fetch();
#XXX	    my $origimgfile = FURadar::latest_dwd();
	    if ($origimgfile) {
		my $time = (stat($origimgfile))[STAT_MODTIME];
		my $imgfile = FURadar::interesting_parts
		    ($origimgfile,
		     -km100pixel => $km100_pixel);
		if (-r $imgfile) {
		    $radar_image = $overview_canvas->Photo(-file => $imgfile);
		    my($xoff,$yoff) = ($show_overview_mode eq 'brb'
				       ? (3,20)
				       : $ts->(0,0));
		    $overview_canvas->createImage
			($xoff, $yoff,
			 -image => $radar_image,
			 -tags => 'radarimage');
		    foreach my $raise (qw(g gP gD O o)) { # XXX evtl. andere Tags auch raisen
			$overview_canvas->raise($raise);
		    }
		}
		if ($time) {
		    $balloon->attach($radar_button,
				     -msg => scalar localtime $time);
		}
	    }
	};
	warn __LINE__ . ": $@" if $@;
	$progress->Finish;
	DecBusy($top);
    };
    $radar_button->configure(-selectcolor => $radar_button->cget(-background));
    $radar_button->place("-x" => 2+2+$mode_button->reqwidth, "-y" => 2);
    }

    # Zeichnen von Gewssern, S-Bahnen, Straen in der
    # bersichtskarte
    foreach my $abk (qw(w b s)) {
	local(%str_outline, %str_name_draw, $wasserumland, $wasserstadt,
	      %str_far_away, %str_restrict, %p_draw);
	if ($overview_draw{$abk}) {
	    $str_outline{$abk} = 0;
	    $p_draw{'pp'} = 0;
	    my %args;
	    if ($abk eq 'w') {
		my $ws_low = eval { Strassen->new("wasserstrassen-lowres") };
		if ($ws_low) {
		    $args{-object} = $ws_low;
		} else {
		    for my $cat (qw(W1 W2 F:W)) {
			$str_restrict{$abk}->{$cat} = 1;
		    }
		    for my $cat (qw(W0 W)) {
			$str_restrict{$abk}->{$cat} = 0;
		    }
		    $wasserumland = $wasserstadt = 1;
		    $str_far_away{$abk} = 1;
		}
		$str_name_draw{$abk} = 0;
	    } elsif ($abk eq 's') {
		$str_restrict{$abk}->{'HH'} = 1;
	    }

	    plot('str',$abk,
		 Canvas => $overview_canvas,
		 Width  => 1,
		 %args,
		);
	}
    }

    $progress->InitGroup;
    for my $abk (qw(g gD)) {
	plot('str',$abk,
	     Canvas => $overview_canvas,
	     ($abk eq 'g' && $coord_system ne 'standard' ? (Filename => "plz-orig") : ()),
	    );
    }
    {
	# schner wr's mit local(), aber geht nicht so ohne weiteres
	my $orte_far_away_orig = $p_far_away{'o'};
	#XXX del: my $overlap_label_orig = $no_overlap_label{'o'};
	$p_far_away{'o'} = 1;
	#XXX del: $no_overlap_label{'o'} = 0; # XXX leider langsam
	plotorte(Canvas        => $overview_canvas,
		 PlaceCategory => 4,
		 AllSmall      => 1,
		 Shortname     => 1,
		 NoOverlapLabel => 0,
		);
	$p_far_away{'o'} = $orte_far_away_orig;
	#XXX del: $no_overlap_label{'o'} = $overlap_label_orig;

	if ($show_overview_mode eq 'b') {
	    plotorte(Canvas        => $overview_canvas,
		     PlaceCategory => 0,
		     AllSmall      => 1,
		     Shortname     => 1,
		     NameDraw      => 1,
		     -municipality => 1,
		     -type         => 'oo'
		    );
	}
    }
    $progress->FinishGroup;
    $overview_canvas->raise("zoomrect");
    $overview_top->bind('<q>' => $withdraw_sub);
    $overview_top->bind('<Q>' => sub { &$withdraw_sub;
				       $overview_top->destroy
				   });
    my $real_canvas = $overview_canvas;
    my $scroll_lock;
    my $set_scroll_lock = sub {
	$scroll_lock = $overview_canvas->after(100,
					       sub { undef $scroll_lock });
    };
    my $button_pressed;
    my $refresh_sub;
    my($delta_x_fraction, $delta_y_fraction) = (0.5, 0.5);
    $refresh_sub =
      sub {
	  my($w, $initial) = @_;
	  my $e = $w->XEvent;
	  if (!defined $button_pressed) {
	      $button_pressed = $overview_canvas->repeat
		(100, sub { $refresh_sub->($w, 0); });
	  }
	  return if $scroll_lock;
	  my($x, $y) = ($e->x, $e->y);
	  my($xx, $yy) = ($overview_canvas->canvasx($x),
			  $overview_canvas->canvasy($y));
	  if ($initial) {
	      my(@c) = $overview_canvas->bbox('zoomrect');
	      if ($xx >= $c[0] && $xx <= $c[2] &&
		  $yy >= $c[1] && $yy <= $c[3]) {
		  # Click in rect, record initial position.
		  # This code is necessary to avoid jumps on initial click.
		  $delta_x_fraction = ($xx-$c[0])/($c[2]-$c[0]);
		  $delta_y_fraction = ($yy-$c[1])/($c[3]-$c[1]);
	      }
	  }
	  my $real_canvas_width  = $real_canvas->width;
	  my $real_canvas_height = $real_canvas->height;
	  # XXX ist noch etwas ruckartig ... kleinere units,
	  # intelligenteres Handling!
	  my $pad = 10;
	  if ($x < $pad) {
	      $overview_canvas->xview(scroll => -1, 'units');
	      $set_scroll_lock->();
	  }
	  if ($y < $pad) {
	      $overview_canvas->yview(scroll => -1, 'units');
	      $set_scroll_lock->();
	  }
	  if ($x > $real_canvas_width-$pad) {
	      $overview_canvas->xview(scroll => +1, 'units');
	      $set_scroll_lock->();
	  }
	  if ($y > $real_canvas_height-$pad) {
	      $overview_canvas->yview(scroll => +1, 'units');
	      $set_scroll_lock->();
	  }
	  my(@oldx) = $c->xview;
	  my(@oldy) = $c->yview;
	  my($xwidth) = $oldx[1]-$oldx[0];
	  my($ywidth) = $oldy[1]-$oldy[0];
	  if ($coord_system ne 'standard') {
	      ($xx, $yy) = anti_transpose_medium($xx, $yy); # XXX brb mode!!!
	      $c->center_view($xx, $yy);
	  } else {
	      $c->xview(moveto => (($xx+$overview_width)/($overview_width*2)
				   - $xwidth*$delta_x_fraction)
		       );
	      $c->yview(moveto => (($yy+$overview_height)/($overview_height*2)
				   - $ywidth*$delta_y_fraction)
		       );
	  }
      };

    $real_canvas->Tk::bind('<ButtonPress-1>'  => sub {
			       my $w = shift;
			       $refresh_sub->($w, 1, @_)
			   });
    $real_canvas->Tk::bind('<B1-Motion>' => sub {
			       my $w = shift;
			       $refresh_sub->($w, 0, @_)
			   });
    $real_canvas->Tk::bind
      ('<ButtonRelease-1>'
       => sub {
	   if (defined $button_pressed) {
	       $button_pressed->cancel();
	       undef $button_pressed;
	   }
	   ($delta_x_fraction, $delta_y_fraction) = (0.5, 0.5);
       });

    {
	my $gain = 1;
	$real_canvas->CanvasBind('<2>',
				 [sub {
				      my($w,$x,$y) = @_;
				      $w->scan('mark',$x,$y);
				  },Tk::Ev('x'),Tk::Ev('y')]);
	$real_canvas->CanvasBind('<B2-Motion>',
				 [sub {
				      my($w,$x,$y) = @_;
				      $w->scan('dragto',$x,$y,$gain);
				  },Tk::Ev('x'),Tk::Ev('y')]);
    }

    # Scrolling korrigieren (auf Mitte setzen)
    my(@oldx) = $overview_canvas->xview;
    my(@oldy) = $overview_canvas->yview;
    my($xwidth) = $oldx[1]-$oldx[0];
    my($ywidth) = $oldy[1]-$oldy[0];
    $overview_canvas->xview('moveto' => (1-$xwidth)/2);
    $overview_canvas->yview('moveto' => (1-$ywidth)/2);

    overview_update();

    # Scrollbar-Navigation per Cursortasten
    $overview_top->bind
      ('<Up>'    => sub { $real_canvas->yview(scroll => -1, 'units') });
    $overview_top->bind
      ('<Down>'  => sub { $real_canvas->yview(scroll => 1, 'units') });
    $overview_top->bind
      ('<Left>'  => sub { $real_canvas->xview(scroll => -1, 'units') });
    $overview_top->bind
      ('<Right>' => sub { $real_canvas->xview(scroll => 1, 'units') });
}

### AutoLoad Sub
sub delete_overview {
    my $overview_top = $toplevel{"overview"};
    if (defined $overview_top && Tk::Exists($overview_top)) {
	$overview_top->destroy;
    }
    eval q{ $radar_image->delete };

    delete $toplevel{"overview"};
    # Done already in OnDestroy: $show_overview = 0;
}

### AutoLoad Sub
sub overview_update {
    return if !$overview_canvas || !Tk::Exists($overview_canvas);
    my @a = $c->get_corners;
    my @c;
    my $i;
    my $ts = ($show_overview_mode eq 'brb'
	      ? \&transpose_small
	      : \&transpose_medium);
    for($i = 0; $i < $#a; $i+=2) {
	push @c, $ts->(anti_transpose($a[$i], $a[$i+1]));
    }
    $overview_canvas->coords('zoomrect', @c[0,1, 0,3, 2,3, 2,1, 0,1]);
    my($midx, $midy) = (($c[2]-$c[0])/2+$c[0],
			($c[3]-$c[1])/2+$c[1]);

    if (!$overview_canvas->is_visible($midx, $midy)) {
	$overview_canvas->center_view($midx, $midy);
    }
}

##### Suche #####################################################
sub search_route {
    my($start, $ziel, $via_arr, $continue, %args) = @_;
    return if $in_search;
    $in_search++;
    my(@via) = @$via_arr if defined $via_arr;

    destroy_delayed_restack();

    IncBusy($top, %busy_watch_args);
    eval {
	status_message("");
	# XXX $str_draw{'r'} ueberprfen, wenn im RB-Mode
	if (!$net and ($str_draw{'s'} || $str_draw{'l'})) { make_net() }
	warn "Suche von <$start> bis <$ziel>" . (@via ? " via <@via>" : "")
	  if $verbose;
	my %extra_args;
	if (keys %ampeln) {
	    if ($ampel_optimierung) {
		$extra_args{Ampeln} =
		  {Net     => \%ampeln,
		   Penalty => $lost_strecke_per_ampel};
	    } elsif ($optprefs{'Ampeln'}) {
		$extra_args{Ampeln} =
		  {Net     => \%ampeln,
		   Penalty => optprefs2penalty($optprefs{'Ampeln'})*100};
	    } # XXX
	    if ($abbiege_optimierung) {
		$extra_args{Abbiegen} = {Penalty => $abbiege_penalty,
					 Order   => {'NN' => 0,
						     'N' => 1,
						     'H' => 2,
						     'HH' => 3,
						     'BAB' => 3, # XXX
						     'B' => 4}};
	    }
	    # XXX optprefs
	}

	# Qualitt, Handicap und temporre Handicaps
	foreach my $def ({OptSwitch	 => \$qualitaet_s_optimierung,
			  OptName	 => 'Qualitt',
			  Speed          => \%qualitaet_s_speed,
			  MakeNet	 => \&make_qualitaet_net,
			  CatPrefix	 => 'Q',
			  ExtraArgsName	 => 'Qualitaet',
			 },
			 {OptSwitch	 => \$handicap_s_optimierung,
			  OptName	 => 'Sonstige Beeintrchtigungen',
			  Speed          => \%handicap_s_speed,
			  MakeNet	 => \&make_handicap_net,
			  CatPrefix	 => 'q',
			  ExtraArgsName	 => 'Handicap',
			 },
			) {
	    my $opt = $ {$def->{OptSwitch}};
	    my $optname = $def->{OptName};
	    if ($opt || (defined $optname && $optprefs{$optname})) {
		my $speed = $def->{Speed};
		my $makenet = $def->{MakeNet};
		my $catprefix = $def->{CatPrefix};
		my $net = $makenet->();
		my $penalty;
		if ($opt) {
		    foreach (0 .. 4) {
			next if !defined $speed->{$catprefix . "$_"};
			$penalty->{$catprefix . "$_"} =
			    max_speed($speed->{$catprefix . "$_"});
		    }
		} else {
		    foreach (0 .. 4) {
			next if !defined $penalty->{$catprefix . "$_"};
			# XXX
			$penalty->{$catprefix . "$_"} =
			    optprefs2penalty($optprefs{$def->{OptName}}) * $_;
		    }
		}
		$extra_args{$def->{ExtraArgsName}} =
		    {Net => $net,
		     Penalty => $penalty,
		    };
	    }
	}

	if ($strcat_optimierung || $optprefs{'Kategorie'}) {
	    # XXX wenn L zugeschaltet wird, mu strcat_net aktualisiert werden
	    if (!$strcat_net) {
		if ($multistrassen) {
		    $strcat_net = new StrassenNetz $multistrassen;
		} elsif ($str_obj{'s'}) {
		    $strcat_net = new StrassenNetz $str_obj{'s'};
		}
		if ($strcat_net) {
		    $strcat_net->make_net_cat;
		}
	    }
	    if ($strcat_net) {
		my $penalty;
		if ($strcat_optimierung) {
		    foreach (keys %strcat_speed) {
			$penalty->{$_} = max_speed($strcat_speed{$_});
		    }
		} else {
# 		my %strcat_def = (B  => HH => 100,
#    H  => 100,
#    N  => 100,
#    NN => 100);
# 		foreach (keys %strcat_speed) {
# 		    # XXX
# 		    $penalty->{"Q$_"} = optprefs2penalty($optprefs{'Kategorie'})* $_;
# 		}
		}
		$extra_args{Strcat} =
		  {Net => $strcat_net,
		   Penalty => $penalty,
		  };
	    }
	}
	if ($radwege_optimierung) {
	    if (!$radwege_net) {
		my $radwege_exact = new Strassen "radwege_exact";
		$radwege_net = new StrassenNetz $radwege_exact;
		$radwege_net->make_net_cat(-obeydir => 1);
		# add all other streets do not have cycle paths ...
		while(my($p1,$hash) = each %{ $net->{Net} }) {
		    while(my($p2,$entf) = each %$hash) {
			if (!exists $radwege_net->{Net}{$p1}{$p2}) {
			    $radwege_net->{Net}{$p1}{$p2} = "RW0";
			    $radwege_net->{Net}{$p2}{$p1} = "RW0";
			}
		    }
		}
	    }
	    my $penalty;
	    foreach (keys %radwege_speed) {
		$penalty->{$_} = max_speed($radwege_speed{$_});
	    }

	    $extra_args{Radwege} =
	      {Net => $radwege_net,
	       Penalty => $penalty,
	      };
	}

	if ($N_RW_optimization) {
	    # XXX check if $N_RW_net is up-to-date with respect to its
	    # sources, or whether a new $N_RW_net should be build
	    if (!$N_RW_net) {
		my $s = $multistrassen ? $multistrassen : $str_obj{'s'};
		if (!$s) {
		    warn "Can't get streets object, ignore N_RW optimization";
		} else {
		    $N_RW_net = new StrassenNetz $s;
		    $N_RW_net->make_net_cyclepath(Strassen->new("radwege_exact"), 'N_RW');
		}
	    }
	    if ($N_RW_net) {
		my $penalty = { "H"    => 4,
				"H_RW" => 1,
				"N"    => 1,
				"N_RW" => 1 };
		$extra_args{RadwegeStrcat} =
		    {Net => $N_RW_net,
		     Penalty => $penalty,
		    };
	    }
	}

	if ($green_optimization) {
	    # XXX check if $green_net is up-to-date with respect to its
	    # sources, or whether a new $green_net should be build
	    if (!$green_net) {
		$green_net = new StrassenNetz(Strassen->new("green"));
		$green_net->make_net_cat;
	    }
	    my $penalty = ($green_optimization == 2
			   ? { "green0" => 3,
			       "green1" => 2,
			       "green2" => 1,
			     }
			   : { "green0" => 2,
			       "green1" => 1.5,
			       "green2" => 1,
			     }
			  );
	    $extra_args{Green} =
		{Net => $green_net,
		 Penalty => $penalty,
		};
	}

	if ($unlit_streets_optimization) {
	    if (!$unlit_streets_net) {
		$unlit_streets_net = new StrassenNetz(Strassen->new("nolighting"));
		$unlit_streets_net->make_net_cat;
	    }
	    my $penalty = { "NL" => 4,
			  };
	    $extra_args{UnlitStreets} =
		{Net => $unlit_streets_net,
		 Penalty => $penalty,
		};
	}

	if ($steigung_optimierung) {
	    if (!$steigung_net) {
		$steigung_net = new StrassenNetz Strassen->new;
		$steigung_net->make_net_steigung($net, \%hoehe);
	    }
	    my $penalty;
	    my $act_power;
	    if ($active_speed_power{Type} eq 'power') {
		$act_power = $power[$active_speed_power{Index}];
	    } else {
		$act_power = speed2power($speed[$active_speed_power{Index}]);
	    }
	    if (!defined $steigung_penalty_env{ActPower} ||
		$steigung_penalty_env{ActPower} != $act_power) {
		$steigung_penalty = {};
	    }
	    $steigung_penalty_env{ActPower} = $act_power;
	    $extra_args{Steigung} =
	      {Net => $steigung_net,
	       Penalty => $steigung_penalty,
	       PenaltySub => sub { steigung_penalty($_[0], $act_power) },
	      };
	}
	if (!$sperre{'tragen'}) {
	    $extra_args{Tragen} = 1;
	}
	$extra_args{Velocity} = get_active_speed()/3.6; # should be m/s
	# XXX Bislang noch keine Mglichkeit auer /tmp/add.pl, um
	# $aufschlag zu setzen.
	# Der Alternativ-Strecken-Code braucht noch viel Arbeit. Als
	# erstes sollte ein Start/Ziel-Punkt, der zwischen zwei
	# Kreuzungen/Kurvenpunkten liegt, hchstens einmal! durchfahren
	# werden.
	if ($aufschlag != 0 && $aufschlag != 1) {
	    $extra_args{Aufschlag} = $aufschlag;
	    $extra_args{All}       = 1;
	}
	# XXX weitere mgliche Optimierungen:
	# (benutzungspflichtige) Radwege
	# verkehrsberuhigte Zonen => 6 .. 20 km/h
	# Fugngerampeln: Abbremsen auf 10 km/h und gleich wieder hoch
	# Kreuzungen (Neben/Haupt, Haupt/Haupt ohne Ampel)
	# Berufsverkehr (Stau auf groen Straen => 15 .. 20 km/h)
	if ($search_stat) {
	    $extra_args{Stat} = 1;
	}
	if ($search_visual) {
	    $extra_args{'VisualSearch'} = {'Canvas' => $c,
					   'Transpose' => \&transpose,
					   'Delay' => 0.1,
				       };
	}
	if (%global_search_args) {
	    while(my($k,$v) = each %global_search_args) {
		$extra_args{$k} = $v;
	    }
	}
	if (keys %penalty_subs) {
	    # Note: the %penalty_subs should only multiply $p, not add to
	    # if there are more than one penalty sub!
	    $extra_args{UserDefPenaltySub} = sub {
		my($p, $next_node, $last_node) = @_;
		while(my($k,$v) = each %penalty_subs) {
		    $p = $v->($p, $next_node, $last_node);
		}
		$p;
	    };
	}

	make_net() if (!$net);
	foreach my $ref (\$start, \$ziel) {
	    if (!$net->reachable($$ref)) {
		add_new_point($net, $$ref); # XXX ja?
	    }
	}
	my(@res) = $net->search($start, $ziel, %extra_args);

	if (!@res) {
	    die M"Keine Strecke gefunden.\n";
	}

	my @path = @{ $res[StrassenNetz::RES_PATH] };
 	my $old_nr;
 	if ($continue) {
 	    save_route_to_register('cont'); # if $max_list > 0;
 	    $old_nr = $#coords;
 	} else {
	    # XXX shouldn't be necessary!!!
	    my($save_start) = $search_route_points[0]; # XXX used to be [SRP_COORD]?!
 	    if (!exists $args{-undo} || $args{-undo}) {
		reset_undo_route();
	    } else {
		resetroute();
	    }
	    push @search_route_points, $save_start;
 	}
# 	my(@res);
# 	$power_cache = {};
# 	for(my $i=$max_list; $i>=0; $i--) {
# 	    my $res_ref = $res_list[$i];
# 	    next if (!ref $res_ref or !@$res_ref);
# 	    @res = @$res_ref;
 	    foreach my $p (@path) {
 		my($x, $y) = @$p;
 		addpoint_xy($x, $y, transpose($x, $y));
 	    }
 	    undef $power_cache;
 	    updatekm();
# 	    if ($max_list > 0) {
# 		save_route_to_register($i+1);
# 		resetroute();
# 		get_route_from_register('cont');
# 	    }
# 	}
# 	get_route_from_register(1) if $max_list > 0;
	# continue with best route (but do not continue if the route was deleted before and @act_search_route is empty)
	if ($continue && @act_search_route) {
	    push @act_search_route,
		$net->route_to_name([@path], -startindex => $old_nr); # XXX is wrong (?): +1);
	} else {
	    # Use @realcoords instead of @path, in case it is continued,
	    # but with an empty @act_search_route before
	    @act_search_route = $net->route_to_name([@realcoords], -startindex=>0);
	}
	if (@path) {
	    push @search_route_points, [join(",", @{ $path[-1] }),
					POINT_SEARCH];
	}
	print "Route: ", join(", ", map { $_->[0] } @act_search_route), "\n"
	  if $verbose;
	if (exists $args{-caller} && $args{-caller} eq 'chooseort') {
	    zoom_view() if ($zoom_new_route_chooseort);
	} else {
	    zoom_view() if ($zoom_new_route);
	}
	if ($auto_show_list) {
	    $show_strlist = 1;
	    show_route_strname();
	}
	set_flag('via');
	set_flag('ziel');
	restack_delayed();
    };
    my $err = $@;
    $in_search = 0;
    DecBusy($top);
    status_message($err, 'err') if ($err);
}

# Wiederholung der Suche (evtl. mit neuen Parametern)
### AutoLoad Sub
sub re_search {
    my(%args) = @_;
    return if @search_route_points < 2;
    IncBusy($top, %busy_watch_args);
    eval {
	my(@old_search_route_points) = @search_route_points;
	@search_route_points = $old_search_route_points[SRP_COORD];
	for(my $i=0; $i<$#old_search_route_points; $i++) {
	    my $p1 = $old_search_route_points[$i];
	    my $p2 = $old_search_route_points[$i+1];
	    if ($p2->[SRP_TYPE] eq POINT_MANUELL) {
		addpoint_xy(split(/,/, $p2->[SRP_COORD]));
		push @search_route_points, [@$p2];
	    } else {
		search_route
		    ($p1->[SRP_COORD], $p2->[SRP_COORD],
		     undef, ($i == 0 ? '' : 'cont'),
		     (exists $args{-undo} ? (-undo => $args{-undo}) : ()),
		    );
	    }
	}
    };
    my $err = $@;
    DecBusy($top);
    die $err if $err;
}

sub re_search_gui {
    re_search(@_);
    update_route_strname();
}

# Steigung mu als Tausendfaches angegeben werden.
### AutoLoad Sub
sub steigung_penalty {
    my($steigung, $act_power) = @_;
    my $frac = ($steigung/1000+0.08)/(0.08*2);
    max_speed(power2speed($act_power, -grade => $steigung/1000));
}

### AutoLoad Sub
sub route_strname_on_map {
    my $xadd_anchor = $xadd_anchor_type->{'route'};
    my $yadd_anchor = $yadd_anchor_type->{'route'};

    require Tk::StippleLine;

    foreach my $def (@route_strnames) {
	my($str, $x, $y, $inx, $entf) = @$def;
	$str = $str .= " ($entf)" if defined $entf and $do_route_strnames_km;
	my(@tags) = ('route',
		     "route-" . $inx,
		     'routename');
	my $returnanchor;
	if (draw_text_intelligent
	    ($c, $x, $y,
	     -text => $str,
	     -tags => [@tags],
	     -abk => ['route','routename'],
	     -checktagindex => 'all',
	     -xadd => $xadd_anchor,
	     -yadd => $yadd_anchor,
	     -returnanchor => \$returnanchor,
	    )) {
	    Tk::StippleLine::create
	      ($c, $x, $y,
	       $x+$xadd_anchor->{$returnanchor},
	       $y+$yadd_anchor->{$returnanchor},
	       -fill => 'black',
	       -width => 2,
	       -tags => [@tags]);
	} else {
	    $c->createText($x, $y, -text => $str,
			   -anchor => 'w',
			   -tags => [@tags]);
	}
    }
}

### AutoLoad Sub
sub get_act_search_route {
    my @search_route;
    if (!@act_search_route) {
	if (@realcoords) {
	    make_net() if !$net;
	    @search_route = $net->route_to_name([@realcoords],-startindex=>0);
	}
    } else {
	@search_route = @act_search_route;
    }
    \@search_route;
}

### AutoLoad Sub
sub show_route_strname {
    require Tk::HList;

    my $t;
    my $withdraw_sub;
    if (defined $toplevel{strlist} && Tk::Exists($toplevel{strlist})) {
	if (!$show_strlist) {
	    $toplevel{strlist}->withdraw;
	} else {
	    my $was_withdrawn = $toplevel{strlist}->state ne "normal";
	    $toplevel{strlist}->deiconify;
	    # raise nur ausfhren, wenn es wirklich was zu sehen gibt
	    #$toplevel{strlist}->raise;

	    #XXX maybe combine with code below
	    if ($was_withdrawn && eval {require Tk::Placement; 1; }) {
		# XXX use placer also for other toplevels --- replace
		# all Popup(@popup_style) calls?
		warn "Use Tk::Placement, yet experimental..." if $devel_host;
		Tk::Placement::placer($toplevel{strlist}, -screen => $c,
				      -addx => 20, -addy => 25, # XXX for fvwm
				     );
	    }

	}
    } else {
	$toplevel{strlist} = $top->Toplevel(-title => M"Aktuelle Route",
				      -class => "Bbbike Routeinfo");
	set_as_toolwindow($toplevel{strlist});
	$withdraw_sub = sub { $toplevel{strlist}->withdraw;
			      $show_strlist = 0 };
	$toplevel{strlist}->protocol('WM_DELETE_WINDOW', $withdraw_sub);
	$t = $toplevel{strlist};
    }

    undef @route_info;
    if (defined $t) {
	$t->SelectionOwn;
	# XXX maxbytes beachten
	$t->SelectionHandle(sub { route_info_to_text() });
    }

    my($bf, $f1);
    if (defined $t) {
	$bf = $t->Frame->pack(-fill => 'x', -side => "bottom");
	$f1 = $t->Frame->pack(-fill => 'x', -side => "bottom");
	$t->Label(-textvariable => \$ampelstatus_label_text,
		  -anchor => 'w',
		  -justify => "left")->pack(-fill => 'x', -side => 'bottom');
    }

    if (!Tk::Exists($route_strname_lbox)) {
	if (!defined $t) {
	    die "No route_strname_lbox?!";
	}
	$route_strname_lbox = $t->Scrolled
	  ('HList',
	   -header => 1,
	   -columns => 5,
	   -selectmode => 'extended',
	   -scrollbars => 'osoe',
	   -width => 68, # XXX
	  )->pack(-expand => 1, -fill => 'both');
	$route_strname_lbox->header('create', 0, -text => M"Lnge");
	$route_strname_lbox->header('create', 1, -text => M"Gesamt");
	$route_strname_lbox->header('create', 2, -text => M"Richtung");
	$route_strname_lbox->header('create', 3, -text => M"Strae");
	$route_strname_lbox->header('create', 4, -text => "");
#	$route_strname_lbox->header('create', 5, -text => M"Zeit");
    } else {
	$route_strname_lbox->delete('all');
    }

    if ($do_route_strnames_comments && !$do_route_strnames_compact) {
	$route_strname_lbox->header('configure', 4, -text => M"Kommentar");
    } else {
	$route_strname_lbox->header('configure', 4, -text => M"");
    }

    undef $show_route_start;
    undef $show_route_ziel;
    undef @route_strnames;
    my(@search_route) = @{ get_act_search_route() };

    if (@search_route) {

	if ($do_route_strnames_orte) {
	    if (!$nearest_orte) {
		$nearest_orte = new_from_strassen Kreuzungen
		                                  Strassen => _get_orte_obj();
		$nearest_orte->make_grid;
	    }
	}

	if ($do_route_strnames_comments) {
	    if (!$comments_net) {
		make_comments_net();
	    }
	}

	$route_strname_lbox->configure
	  (-command => sub {
	       my $i = shift;
	       if (defined $search_route[$i][4] and
		   ref $search_route[$i][4] eq 'ARRAY') {
		   my @line_coords;
		   foreach my $nr ($search_route[$i][4][0]+1 ..
				   $search_route[$i][4][1]+1) {
		       my @coords = $c->coords("route-$nr");
		       push @line_coords, [ @coords ] if @coords;
		   }
		   mark_street(-coords => \@line_coords,
			       -clever_center => 1,
			      ) if @line_coords;
	       }
	   });

	# max angle meaning straight forward
	use constant ROUTE_STRAIGHT_ANGLE => 30;

	if ($do_route_strnames_compact) {
	    @search_route = $net->compact_route(\@search_route,
						-routestraightangle => ROUTE_STRAIGHT_ANGLE,
					       );
	}	    

	my $ges_entf = 0;
	my($next_entf, $ges_entf_s, $next_winkel, $next_richtung)
	  = ("", "", undef, "");
	my($aggr_begin_dist, $aggr_streets) = (0, "");
	my $aggr_dir = undef;
	my $last_str;
	my ($out_dist, $out_total_dist, $out_dir, $out_str);
	my $out_dist_add;
	my %seen_comments;
	for(my $i = 0; $i <= $#search_route; $i++) {
	    my($str, $index_arr);
	    my($entf, $winkel, $richtung)
	      = ($next_entf, $next_winkel, $next_richtung);
	    my $entf_s;
	    ($str, $next_entf, $next_winkel, $next_richtung, $index_arr)
	      = @{$search_route[$i]};
	    my $route_strnames_index;
	    if ($str ne '...' &&
		(!defined $last_str || $last_str ne $str)) {
		$last_str = $str;
		$str = Strassen::strip_bezirk($str);
		if (!defined $show_route_start) {
		    $show_route_start = $str;
		}
		$show_route_ziel = $str;
		if (ref $index_arr eq 'ARRAY' &&
		    defined $index_arr->[0] &&
		    defined $coords[$index_arr->[0]] &&
		    defined $coords[$index_arr->[0]+1]) {
		    my($x, $y) = ($coords[$index_arr->[0]]->[0],
				  $coords[$index_arr->[0]]->[1]);
		    push @route_strnames, [$str, $x, $y, $index_arr->[0]];
		    $route_strnames_index = $#route_strnames;
		}
	    }

	    if ($i > 0) {
		if (!$winkel) { $winkel = 0 }
		$winkel = int($winkel/10)*10;
		if ($winkel < ROUTE_STRAIGHT_ANGLE) {
		    $richtung = "";
		} else {
		    my $artikel = (!defined $Msg::lang || $Msg::lang =~ /^(|de)$/
				   ? Strasse::de_artikel($str)
				   : "=>");
		    $richtung =
		      ($winkel <= 45 ? M"halb" : '') .
			($richtung eq 'l' ? M"links" : M"rechts") . " " .
			  "($winkel) " . $artikel;
		}

		if ($do_route_strnames_orte) {
		    my($nearest_ort_xy) =
			$nearest_orte->nearest_loop
			    ($realcoords[$index_arr->[0]]->[0],
			     $realcoords[$index_arr->[0]]->[1],
			     IncludeDistance => 1);
		    if ($nearest_ort_xy) {
			my $ort = $nearest_orte->get_first($nearest_ort_xy->[0]);
			# XXX evtl. Ort-Kat fr 1000 beachten
			my $in_bei = ($nearest_ort_xy->[1] <= 1000
				      ? M"in" : M"bei");
			$richtung = "$in_bei " .
			            (Strassen::split_ort($ort))[0] .
				    ": $richtung";
		    }
		}

		$ges_entf += $entf;
		$ges_entf_s = "(" . m2km($ges_entf) . ")";
		$entf_s = M("nach")." ".m2km($entf, 3, 2);
		if (defined $route_strnames_index) {
		    $route_strnames[$route_strnames_index]->[4]
		      = m2km($ges_entf);
		}
	    } elsif (@coords > 1) {
		my $compass = uc(BBBikeCalc::canvas_translation(BBBikeCalc::line_to_canvas_direction
								(@{ $coords[0] }, @{ $coords[1] })));
		if (defined $Msg::lang && $Msg::lang =~ /^en/) {
		    $compass =~ s/([NESW])/{N => 'north',
					    E => 'east',
					    S => 'south',
					    W => 'west'}->{$1}/gei;
		    $richtung = $compass . "ward";
		} else {
		    $richtung = M("nach")." ".$compass;
		}
	    }

##XXX del:
# 	    if ($do_route_strnames_compact) {
# #		$aggr_dist += $entf if defined $entf;
# 		if (!defined $aggr_dir) {
# 		    $aggr_dir = $richtung;
# 		}
# 		if (!defined $aggr_begin_dist) {
# 		    $aggr_begin_dist = $entf;
# 		    $out_dist_add = 0;
# 		} else {
# 		    $out_dist_add += $entf;
# 		}
# 		if ($aggr_streets ne '') {
# 		    $aggr_streets .= ", ";
# 		}
# 		$aggr_streets .= $str;
# 		if (!defined $next_winkel ||
# 		    $next_winkel < ROUTE_STRAIGHT_ANGLE) {
# 		    next;
# 		}
# 		($out_dist, $out_dir, $out_str)
# 		    = ($aggr_begin_dist > 0 ? M("nach")." ".m2km($aggr_begin_dist, 3, 2) : "",
# 		       $aggr_dir,
# 		       $aggr_streets);
# 		($aggr_begin_dist, $aggr_streets) = (undef,"");
# 		undef $aggr_dir;
# 	    } else {
		($out_dist, $out_dir, $out_str)
		    = ($entf_s, $richtung, $str);
		if (defined $out_dist_add) {
		    $out_dist += $out_dist_add;
		    undef $out_dist_add;
		}
#XXX del:	    }
	    $out_total_dist = $ges_entf_s;

	    $route_strname_lbox->add($i, -text => $out_dist);
	    $route_strname_lbox->itemCreate($i, 1, -text => $out_total_dist);
	    $route_strname_lbox->itemCreate($i, 2, -text => $out_dir);
	    $route_strname_lbox->itemCreate($i, 3, -text => $out_str);

	    my $etappe_comment = "";
	    if ($do_route_strnames_comments && $comments_net &&
		!$do_route_strnames_compact) {
		my @comments;
		for my $i ($index_arr->[0] .. $index_arr->[1]) {
		    my($etappe_comment) = $comments_net->get_point_comment([@realcoords], $i, \%seen_comments);
		    push @comments, $etappe_comment if defined $etappe_comment;
		}
		$etappe_comment = join("; ", @comments) if @comments;
	    }
	    $route_strname_lbox->itemCreate($i, 4, -text => $etappe_comment);
	    push @route_info, [($out_dist||""), ($out_total_dist||""),
			       $out_dir || "", $out_str || ""];
	}
	$ges_entf_s = "(" . m2km($ges_entf+$next_entf) . ")";
	my $i = $#search_route + 1;
	$route_strname_lbox->add($i, -text => M("nach")." ".m2km($next_entf, 3, 2));
	$route_strname_lbox->itemCreate($i, 1, -text => "$ges_entf_s");
	$route_strname_lbox->itemCreate($i, 2, -text => M"angekommen!");
	push @route_info, [M("nach")." ".m2km($next_entf, 3, 2),
			   $ges_entf_s, M"angekommen!", ""];

	my(@children) = $route_strname_lbox->info('children');
	my $last_i = $children[-1];
	for(my $j = $i+1; $j<=$last_i; $j++) {
	    $route_strname_lbox->delete($j);
	}
	if ($do_route_strnames) {
	    $c->delete("routename");
	    route_strname_on_map(\@route_strnames);
	}
	$toplevel{strlist}->raise;
    } else {
	$route_strname_lbox->add(0, -text => M"Keine Route");
    }

    return if !defined $t;

    my $do_route_strnames_sub = sub {
	$c->delete("routename");
	if ($do_route_strnames) {
	    route_strname_on_map(\@route_strnames);
	}
    };
    my $cb1 = $f1->Checkbutton(-text => M"Straennamen an der Route",
			       -variable => \$do_route_strnames,
			       -font => $font{'small'},
			      )->pack(-side => 'left');
    my $cb2 = $f1->Checkbutton(-text => M"km-Angaben",
			       -variable => \$do_route_strnames_km,
			       -command => $do_route_strnames_sub,
			       -font => $font{'small'},
			      )->pack(-side => 'left');
    my $cb2_enabler = sub {
	$cb2->configure(-state => $do_route_strnames ? "normal" : "disabled");
    };
    $cb2_enabler->();
    $cb1->configure(-command => sub {
			$cb2_enabler->();
			$do_route_strnames_sub->();
		    });

    $f1->Checkbutton(-text => M"Kompakt",
		     -variable => \$do_route_strnames_compact,
		     -command => \&show_route_strname,
		     -font => $font{'small'},
		    )->pack(-side => 'left');
    if ($advanced) { # XXX funktioniert noch nicht so schoen intuitiv...
	$f1->Checkbutton(-text => M"Orte einbinden",
			 -variable => \$do_route_strnames_orte,
			 -command => \&show_route_strname,
			 -font => $font{'small'},
			)->pack(-side => 'left');
    }
    $f1->Checkbutton(-text => M"Kommentare",
		     -variable => \$do_route_strnames_comments,
		     -command => \&show_route_strname,
		     -font => $font{'small'},
		    )->pack(-side => 'left');

    my $endb = $bf->Button(Name => 'end',
			   -command => $withdraw_sub,
			  )->pack(-side => 'left');
    $bf->Button
      (-text => M"Sichern",
       -command => sub {
	   my($file) = $bf->getSaveFile
	       (($os eq 'win' ? (-defaultextension => '.TXT') : ()),
		-title => M"Route sichern",
		-initialdir => $tmpdir,
	       );
	   return if !defined $file;
	   if ($os eq 'win' and $file !~ /\.txt$/i) {
	       $file .= '.TXT';
	   }
	   make_backup($file);
	   if (open(ROUTE, ">$file")) {
	       print ROUTE route_info_to_text();
	       close ROUTE;
	   } else {
	       status_message
		   (Mfmt("Schreiben auf <%s> nicht mglich: %s", $file, $!),
		    'err');
	   }
       },
      )->pack(-side => 'left');
    # If there is a txt => palm converter and a palm transfer program,
    # then show this button:
    require BBBikePalm;
    if (can_create_and_transfer_palm_docs()) {
	create_palm_button($bf)->pack(-side => 'left');
    }
    my $print_text_sub = sub {
	my $font = shift;
	if (!$show_route_start) { $show_route_start = "???" }
	if (!$show_route_ziel)  { $show_route_ziel = "???" }
	if ($^O eq 'MSWin32' && defined &Win32Util::start_txt_print) {
	    require POSIX;
	    my $temp = POSIX::tmpnam(); # XXX it never gets deleted
	    $temp =~ tr{/}{\\};
	    $temp =~ s/\.$//;
	    $verbose and warn "Using $temp as the temp file for hardcopying\n";
	    open(TMP, ">$temp") or status_message("Can't write to $temp: $!", "die");
	    print TMP Mfmt("Route von %s bis %s",
			   $show_route_start, $show_route_ziel), "\n";
	    print TMP route_info_to_text();
	    close TMP;
	    Win32Util::start_txt_print($temp);
	    $tmpfiles{$temp}++;
        } else { # try pdflatex, then postscript, on Windows first Route::PDF
	    my @try_order = qw(pdflatex postscript routepdf);
	    if ($os eq 'win') {
		@try_order = qw(routepdf pdflatex postscript);
	    }
	TRY: {
		for my $try (@try_order) {
		    if ($try eq 'pdflatex') {
			last TRY if print_text_pdflatex(route_info_to_latex());
		    } elsif ($try eq 'postscript') {
			print_text_postscript
			    (route_info_to_text(),
			     -columns => 1,
			     -header => Mfmt("Route von %s bis %s",
					     $show_route_start, $show_route_ziel),
			     -font => $font,
			    );
		    } elsif ($try eq 'routepdf') {
			print_route_pdf();
		    }
		}
	    }
	}
    };
    my $db;
    $db = $bf->Button
      (-text => M"Drucken",
       -command => sub { $print_text_sub->($ps_fixed_font||"Courier7") },
      )->pack(-side => 'left');
    $bf->Button
      (-text => M"Mail",
       -command => sub {
	   if (@route_info) {
	       $show_route_start = "???" unless $show_route_start;
	       $show_route_ziel  = "???" unless $show_route_ziel;
	       enter_send_mail
		 (Mfmt("BBBike-Route von %s bis %s",
		       $show_route_start, $show_route_ziel),
		  -data => route_info_to_text());
	   }
       })->pack(-side => 'left');
    if ($advanced && $devel_host) {
	# Fax::Send is only a private unsupported module...
	$bf->Button
	    (-text => M"Fax",
	     -command => sub {
		 if (@route_info) {
		     $show_route_start = "???" unless $show_route_start;
		     $show_route_ziel  = "???" unless $show_route_ziel;
		     enter_send_fax
			 (Mfmt("BBBike-Route von %s bis %s",
			       $show_route_start, $show_route_ziel),
			  -data => route_info_to_text());
		 }
	     })->pack(-side => 'left');
    }
    $t->bind('<Up>'   => sub { $route_strname_lbox->yview(scroll => -1,
							  'units') });
    $t->bind("<Down>" => sub { $route_strname_lbox->yview(scroll => 1,
							  'units') });
    $endb->focus;
    #$t->Popup(@popup_style);

    my $was_withdrawn = $t->state ne "normal";
    if ($was_withdrawn) {
	if (eval {require Tk::Placement; 1; }) {
	    # XXX use placer also for other toplevels --- replace
	    # all Popup(@popup_style) calls?
	    warn "Use Tk::Placement, yet experimental...";
	    Tk::Placement::placer($t, -screen => $c,
				  -addx => 20, -addy => 25, # XXX for fvwm
				 );
	} else {
	    $t->withdraw;
	    my($x,$y) = ($top->rootx+$top->width-10, $top->rooty+$top->height-30);
	    $t->idletasks;
	    $x -= $t->reqwidth;
	    $y -= $t->reqheight;
	    $x = 0 if ($x < 0);
	    $y = 0 if ($y < 0);
	    $t->geometry("+$x+$y");
	    $t->deiconify;
	}
    }
}

sub route_info_to_text {
    my $text = sprintf("%-14s %-10s %-26s %s\n",
		       M"Lnge", M"Gesamt", M"Richtung", M"Strae");
    $text .= "-" x 70 . "\n";
    $text .= join "", map { sprintf("%-14s %-10s %-26s %s\n", @$_) } @route_info;
    $text;
}

sub _get_route_title {
    my $route_name = "BBBike-Route";
    if (defined $show_route_start and
	defined $show_route_ziel) {
	my $start = Strasse::short(Strassen::strip_bezirk($show_route_start), 3); # Start besser abkrzen --- ist meist immer der Gleiche
	my $ziel  = Strasse::short(Strassen::strip_bezirk($show_route_ziel), 2);
	$route_name = "BBBike: $start-$ziel";
    }
    $route_name;
}

sub route_info_to_html {
    my $html_route_name = _get_route_title();
    eval {
	require HTML::Entities;
	HTML::Entities::encode_entities($html_route_name);
    };
    warn $@ if $@;
    my $html = "<html><head><title>$html_route_name</title></head><body>";
    $html .= join "", map { sprintf(" %s %s<br>\n%s <b>%s</b><br><br>\n", @$_) } @route_info;
    $html .= "</body></html>";
    $html;
}

# More tweaking could be done (other font face/size, real wide margins...)
sub route_info_to_latex {
    my $route_title = _get_route_title();
    # escape for latex missing XXX
    my $latex = <<'EOF';
\documentclass[10pt]{article}
\usepackage[latin1]{inputenc}
\usepackage[widemargins]{a4}
\usepackage{german}
\usepackage{supertabular}
\pagestyle{empty}
% Tip from http://www.mackichan.com/index.html?techtalk/579.htm~mainFrame
% and http://www.faqs.org/faqs/de-tex-faq/part10/ (10.2.2)
\usepackage{helvet}
\renewcommand{\familydefault}{\sfdefault}
\sloppy
\begin{document}
EOF
    $latex .= "\\section*{$route_title}\n";
    $latex .= <<'EOF';
\begin{supertabular}{lllp{8cm}}
EOF
    $latex .= join(" & ", M"Lnge", M"Gesamt", M"Richtung", M"Strae") . "\\\\\n";
    $latex .= "\\hline \\\\\n";

    $latex .= join "", map {
	join(" & ", map { s/=>/\$\\rightarrow{}\$/g; $_ } @$_) . "\\\\\n"
    } @route_info;
    $latex .= <<'EOF';
\end{tabular}
\end{document}
EOF
    $latex;
}

sub update_route_strname {
    if (defined $toplevel{strlist} && Tk::Exists($toplevel{strlist})) {
	show_route_strname();
    }
}

sub add_custom_layers_to_net {
    my($net_source, $net_source_abk) = @_;
    while(my($abk,$val) = each %custom_net_str) {
	if ($val) { # XXX del? && $abk =~ /^L\d/) {
	    eval {
		if (!$str_obj{$abk}) {
		    $str_obj{$abk} = new Strassen $str_file{$abk};
		}
		push @$net_source, $str_obj{$abk};
		push @$net_source_abk, $abk;
	    };
	    warn "Cannot get Strassen for $abk: $@" if $@;
	}
    }
}

sub make_net {
    my(%args) = @_;
    IncBusy($top);
    $progress->Init(-label => M("Berechnen des Straennetzes")."...",
		    -dependents => $c,
		    -visible => 1,
		   );

    my $user_dels;
    if ($net && $net->{_Deleted}) { # remember user dels
	require Data::Dumper;
	# clone:
	$user_dels = eval substr(Data::Dumper::Dumper($net->{_Deleted}), 7);
    }

    undef $qualitaet_s_net;
    undef $handicap_s_net;
    undef $strcat_net;
    undef $radwege_net;
    undef $N_RW_net;
    undef $green_net;
    undef $unlit_streets_net;
    undef $steigung_net;

    eval {
	my(@net_source, @net_source_abk);
	if ($net_type eq "r") {
	    if (!$str_obj{'r'}) {
		$str_obj{'r'} = new Strassen $str_file{'r'};
	    }
	    push @net_source,     $str_obj{'r'};
	    push @net_source_abk, 'r';
	} elsif ($net_type eq "us" || $net_type eq 'rus') {
	    my @abk = ($net_type eq 'us' ? qw(u b) : qw(u b r));
	    foreach (@abk) {
		if (!$str_obj{$_}) {
		    $str_obj{$_} = new Strassen $str_file{$_};
		}
		push @net_source,     $str_obj{$_};
		push @net_source_abk, $_;
	    }
	} elsif ($net_type eq 'wr') {
	    if (!$str_obj{'wr'}) {
		$str_obj{'wr'} = Strassen->new($str_file{'wr'});
	    }
	    push @net_source, $str_obj{'wr'};
	    push @net_source_abk, 'wr';
	} elsif ($net_type eq 'custom') {
	    add_custom_layers_to_net(\@net_source, \@net_source_abk);
	} else {
	    if ($str_obj{'l'}) {
		push @net_source,     $str_obj{'l'};
		push @net_source_abk, 'l';
	    }
	    if ($str_obj{'s'}) {
		my $is_restricted = 0;
#XXX use new_copy_restricted
		foreach (keys %{$str_restrict{'s'}}) {
		    if ($str_restrict{'s'}->{$_} == 0 &&
			$str_restrict{'s'} ne 'P') { # Pltze
			$is_restricted = 1;
			last;
		    }
		}
		if ($is_restricted) {
		    my $restr_str = new Strassen;
		    $str_obj{'s'}->init;
		    while(1) {
			my $ret = $str_obj{'s'}->next;
			last if !@{$ret->[Strassen::COORDS]};
			next if !$str_restrict{'s'}->{$ret->[Strassen::CAT]};
			$restr_str->push($ret);
		    }
		    $restr_str->{File} = $str_obj{'s'}->file;
		    $restr_str->{Id}   = $str_obj{'s'}->id . "_restr_" . join("_", keys %{$str_restrict{'s'}});
		    push @net_source,     $restr_str;
		    push @net_source_abk, 's';
		} else {
		    if ($str_obj{'s'}) {
			push @net_source,     $str_obj{'s'};
			push @net_source_abk, 's';
		    }
		}
	    }
	    while(my($token, $bool) = each %add_net) {
		next if !$bool;
		if ($token eq 'custom') {
		    add_custom_layers_to_net(\@net_source, \@net_source_abk);
		} else {
		    $str_obj{$token} = Strassen->new($str_file{$token})
			if !$str_obj{$token};
		    push @net_source, $str_obj{$token};
		    push @net_source_abk, $token;
		}
	    }
	    if (!@net_source) { # XXX n
		my(@str_types) = ('s');
		if ($args{'-l_add'}) {
		    push @str_types, 'l';
		}
		foreach my $str_type (@str_types) {
		    cache_decider_init();
		    my $str = new Strassen $str_file{$str_type};
		    if (cache_decider() && $coord_system eq 'standard') {
			$str_obj{$str_type} = $str;
		    }
		    push @net_source,     $str;
		    push @net_source_abk, $str_type;
		}
	    }
	}

	if (@net_source == 0) {
	    die "Netz kann nicht berechnet werden, keine Sourcen";
	} elsif (@net_source == 1) {
	    $net = new StrassenNetz $net_source[0];
	} else {
	    $multistrassen = new MultiStrassen @net_source;
	    $net = new StrassenNetz $multistrassen;
	}

	$net->source(@net_source);
	$net->source_abk(@net_source_abk);

	my $make_net_all = sub {
	    if (defined $global_search_args{Algorithm} &&
		$global_search_args{Algorithm} =~ /^C-A\*-2/) {
		$net->use_data_format($StrassenNetz::FMT_MMAP);
	    } else {
		$net->use_data_format($StrassenNetz::FMT_HASH);
	    }
	    $net->make_net(Progress => $progress,
			   UseCache => 0,
			  );

	    if ($net_type eq "s") {
		my @sperre_type;
		foreach ('einbahn', 'einbahn-strict', 'sperre', 'tragen', 'wegfuehrung') {
		    push @sperre_type, $_ if $sperre{$_};
		}
		if (@sperre_type) {
		    eval {
			$net->make_sperre($sperre_file,
					   Type => \@sperre_type);
		    }; warn $@ if $@;
		}
		if ($sperre{'Q3'}) {
		    eval {
			$net->make_sperre("qualitaet_s", Type => ['Q3']);
			if ($str_obj{'l'}) {
			    $net->make_sperre("qualitaet_l", Type => ['Q3']);
			}
		    }; warn $@ if $@;
		}
		if ($use_faehre) {
		    $net->add_faehre($str_file{'e'});
		}
	    } elsif ($net_type eq 'us' || $net_type eq 'rus') {
		my @abk = ($net_type eq 'us' ? qw(u b) : qw(u b r));

		my $sperre_s = MultiStrassen->new(map { $p_file{"sperre_$_"} } @abk);
		$net->make_sperre($sperre_s, Type => "sperre");

		my @bhf_source;
		foreach (@abk) {
		    if (!$p_obj{$_}) {
			$p_obj{$_} = new Strassen $p_file{$_};
		    }
		    push @bhf_source, $p_obj{$_};
		}
		my $bhf_obj = new MultiStrassen @bhf_source;
		$handicap_s_net = StrassenNetz->new(Strassen->new);
		my $h_net = $handicap_s_net->{Net} = {};
		$net->add_umsteigebahnhoefe
		    ($bhf_obj, -addmapfile => 'umsteigebhf',
		     -cb => sub {
			 my($self, $p1, $p2, $entf, $name) = @_;
			 $h_net->{$p1}{$p2} = "q4"; # XXX just a hack to see some results... A best solution is to use the forthcoming penalty solution for the Marathon
		     });
	    } elsif ($net_type eq 'wr') {
		# nothing special here...
	    }
	};

	if ($use_mldbm) {
	    eval {
		warn "Trying MLDBM cache...\n";
		$net->load_net_mldbm;
		warn "OK!\n";
	    };
	    if ($@) {
		$make_net_all->();
		eval {
		    warn "Saving MLDBM cache...\n";
		    $net->save_net_mldbm;
		    warn "OK!\n";
		};
		warn __LINE__ . ": $@" if $@;
	    }
	} else {
	    $make_net_all->();
	}

	if ($verbose) {
	    warn $net->statistics;
	}
	status_message("");
	delete $pending{'recalc-net'};
    };
    status_message($@, 'err') if ($@);

    if ($user_dels) {
	restore_user_dels($net, $user_dels);
    }

    $progress->Finish;
    DecBusy($top);
}

sub make_qualitaet_net {
    if (!$qualitaet_s_net) {
	eval {
	    $qualitaet_s_net = StrassenNetz->new
		(MultiStrassen->new(Strassen->new("qualitaet_s"),
				    Strassen->new("qualitaet_l")));
	    $qualitaet_s_net->make_net_cat;
	};
	if ($@ && !$no_original_datadir) {
	    status_message($@, "info");
	}
    }
    $qualitaet_s_net;
}

sub make_handicap_net {
    if (!$handicap_s_net) {
	eval {
	    my @s = (Strassen->new("handicap_s"),
		     Strassen->new("handicap_l"),
		    );
	    if ($temporary_handicap_s) {
		push @s, $temporary_handicap_s;
	    }
	    $handicap_s_net = StrassenNetz->new(MultiStrassen->new(@s));
	    $handicap_s_net->make_net_cat;
	};
	if ($@ && !$no_original_datadir) {
	    status_message($@, "info");
	}
    }
    $handicap_s_net;
}

sub make_comments_net {
    if (!$str_obj{"comm"}) {
	$str_obj{'comm'} = _get_comments_obj();
#XXX del:	$str_obj{"comm"} = Strassen->new("comments");
    }
    if ($str_obj{"comm"}) {
	$comments_net = new StrassenNetz $str_obj{"comm"};
	$comments_net->make_net_cat(-net2name => 1,
				    -multiple => 1,
				    -obeydir => 1);
    }
}

# User definable blockings
sub load_user_dels {
    my $file = shift || "$bbbike_configdir/userdels.bbd";
    $net->load_user_deletions
	($file,
	 -oncallback  => sub { set_usercross_image(@_) }, #XXX do not duplicate
	 -offcallback => sub { # XXX do not duplicate
	     my($xy1,$xy2) = @_;
	     $c->delete("delnet-$xy1-$xy2");
	     $c->delete("delnet-$xy2-$xy1");
	 },
	);
    _restore_cursor();
}

sub _save_umask (&) {
    my $code = shift;
    my $old_umask;
    eval {
	$old_umask = umask;
    };
    eval {
	$code->();
    };
    my $err = $@;
    if (defined $old_umask) {
	umask $old_umask;
    }
    die $err if $err;
}

sub save_user_dels {
    my $file = shift || "$bbbike_configdir/userdels.bbd";
    my(%args) = @_;
    _save_umask {
	umask 022;
	$net->save_user_deletions($file, %args);
    };
}

sub restore_user_dels {
    my($net, $user_dels) = @_;
    # restore user deletions
    while(my($k1,$v1) = each %$user_dels) {
	while(my($k2,$v2) = each %$v1) {
	    my $ok;
	    if (exists $net->{Net}{$k1}{$k2}) {
		$net->{_Deleted}{$k1}{$k2} = $net->{Net}{$k1}{$k2};
		$ok++;
	    }
	    if (exists $net->{_Deleted}{$k1}{$k2}) {
		$ok++;
	    }
	    if (exists $net->{Net}{$k2}{$k1}) {
		$net->{_Deleted}{$k2}{$k1} = $net->{Net}{$k2}{$k1};
		$ok++;
	    }
	    if (exists $net->{_Deleted}{$k2}{$k1}) {
		$ok++;
	    }
	    if ($ok) {
		$net->del_net($k1, $k2, 2);
		# image still exists (well it should)
	    } else {
		$c->delete("delnet-$k1-$k2");
		$c->delete("delnet-$k2-$k1");
	    }
	}
    }
}

sub delete_user_dels {
    my(%args) = @_;

    if ($args{-force} ||
	$top->messageBox(-message => M"Alle benutzerdefinierten Sperrungen lschen?",
			 -type => "YesNo",
			 -icon => "question") =~ /^yes/i) {
	$net->remove_all_from_deleted(sub {
					  my($xy1,$xy2) = @_;
					  $c->delete("delnet-$xy1-$xy2");
					  $c->delete("delnet-$xy2-$xy1");
				      });
	_restore_cursor();
    }
}

# Return "x,y"
sub set_coords_str {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] eq 'p' or $tags[0] eq 'pp' or $tags[0] =~ /^lsa/) {
	$tags[1];
    } elsif ($tags[0] =~ /^[sSlL]$/ ||
	     $add_net{fz} && $tags[0] eq 'fz'
	     # XXX weitere Ausnahmen fr $add_net{is} etc. definieren
	    ) {
	my($pos, @points) = nearest_line_points_mouse($c, @tags);
	make_net() if !$net;
	if ($net->can("adjust_to_nearest")) {
	    $points[0] = [ split /,/,
			   $net->adjust_to_nearest(join ",", @{$points[0]})
			 ];
	} else {
	    $net->add_net($pos, @points);
	}
	my($x, $y) = @{$points[0]};
	Route::_coord_as_string([$x,$y]);
    } else {
	my($item, @tags) = find_below($c, qw/s l p pp lsa/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, s noch l sollte nicht vorkommen!";
    }
}

### AutoLoad Sub
sub set_coords_rbahn {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] =~ /^r-[bf]g/) {
	$tags[1];
    } else {
	my($item, @tags) = find_below($c, qw/r-bg r-fg/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, o, s noch l sollte nicht vorkommen!";
    }
}

### AutoLoad Sub
sub set_coords_usbahn {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] =~ /^[ub]-[bf]g/) {
	$tags[1];
    } else {
	my($item, @tags) = find_below($c, qw/u-bg b-bg u-fg u-bg/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, o, s noch l sollte nicht vorkommen!";
    }
}

### AutoLoad Sub
sub set_coords_bahn {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] =~ /^[ubr]-[bf]g/) {
	$tags[1];
    } else {
	my($item, @tags) = find_below($c, qw/u-bg b-bg u-fg u-bg r-bg r-fg/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, o, s noch l sollte nicht vorkommen!";
    }
}

### AutoLoad Sub
sub set_coords_wasserrouten {
    my($c, @tags) = @_;
    if ($tags[0] eq 'wr') {
	my($pos, @points) = nearest_line_points_mouse($c, @tags);
	make_net() if !$net;
	if ($net->can("adjust_to_nearest")) {
	    $points[0] = [ split /,/,
			   $net->adjust_to_nearest(join ",", @{$points[0]})
			 ];
	} else {
	    $net->add_net($pos, @points);
	}
	my($x, $y) = @{$points[0]};
	Route::_coord_as_string([$x,$y]);
    } else {
	my($item, @tags) = find_below($c, qw/wr/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, s noch l sollte nicht vorkommen!";
    }
}

# Return "x,y"
### AutoLoad Sub
sub set_coords_custom {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] =~ /^L\d$/) {
	my($pos, @points) = nearest_line_points_mouse($c, @tags);
	make_net() if !$net;
	if ($net->can("adjust_to_nearest")) {
	    $points[0] = [ split /,/,
			   $net->adjust_to_nearest(join ",", @{$points[0]})
			 ];
	} else {
	    $net->add_net($pos, @points);
	}
	my($x, $y) = @{$points[0]};
	Route::_coord_as_string([$x,$y]);
    } else {
	my($item, @tags) = find_below_rx($c, ['^L\d'], [0]);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
    }
}

### AutoLoad Sub
sub user_edit_street {
    if (!$net) {
	make_net();
    }
    status_message("Can't make net", "die") if !$net;
    my(@click_items) = ($net_type eq 's'
			? qw(s l)
			: ($net_type =~ /^(r|us|rus)$/
			   ? map { $_ eq 's' ? 'b' : $_ } split //, $net_type
			   : ($net_type eq 'wr'
			      ? qw(wr)
			      : warn "Unhandled net type $net_type"
			     )
			  )
		       );
    if ($net_type eq 's' && $use_faehre) {
	push @click_items, "e";
    }
    my($item, @tags) = find_below($c, @click_items);
    if (defined $item) {
	my($pos, @points) = nearest_line_points_mouse($c, @tags);
	my($xy1,$xy2) = (join(",",@{$points[1]}), join(",",@{$points[2]}));
	$net->toggle_deleted_line
	    ($xy1,$xy2,
	     sub {
		 my($xy1,$xy2) = @_;
		 set_usercross_image($xy1,$xy2)
	     },
	     sub {
		 my($xy1,$xy2) = @_;
		 $c->delete("delnet-$xy1-$xy2");
		 $c->delete("delnet-$xy2-$xy1");
		 _restore_cursor();
	     });
    }
}

### AutoLoad Sub
sub set_usercross_image {
    my($xy1,$xy2) = @_;
    if (!$usercross_photo) {
	$usercross_photo =
	    load_photo($top, 'usercross.' . $default_img_fmt);
    }
    my($x1,$y1,$x2,$y2) = (split(/,/,$xy1), split(/,/,$xy2));
    my($midx,$midy) = (int(($x2-$x1)/2+$x1), int(($y2-$y1)/2+$y1));
    ($midx,$midy) = transpose($midx, $midy);
    $c->createImage($midx+2,$midy-1,
		    -image => $usercross_photo,
		    -tags => ["delnet", "delnet-$xy1-$xy2"]);
}

### AutoLoad Sub
sub _restore_cursor {
    if ($c->{SavedCursor}) {
	$c->set_cursor($c->{SavedCursor});
	undef $c->{SavedCursor};
    }
}

sub set_cursor {
    my $type = shift;
    if (!defined $type) {
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
	status_message('');
    } elsif (exists $cursor{$type}) {
	if (exists $cursor_mask{$type}) {
	    #$c->configure(-cursor =>
	    $c->set_cursor(['@' . $cursor{$type},
			    $cursor_mask{$type},
			    'black', 'white']);
	} else {
	    #$c->configure(-cursor =>
	    $c->set_cursor(['@' . $cursor{$type}, 'black']);
	}
    } else {
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
    }
    if (defined $type && $type eq 'start') {
	status_message(M"Start auswhlen");
    } elsif (defined $type && $type eq 'ziel') {
	status_message(M"Ziel auswhlen");
    }
}

### AutoLoad Sub
sub set_cursor_data {
    my $data = shift;
    my $tmpfile = "$tmpdir/cursor.$$.xbm";
    if (open(C, ">$tmpfile")) {
        print C $data;
	close C;
	#$c->configure(-cursor => ['@' . $tmpfile, 'black']);
	$c->set_cursor(['@' . $tmpfile, 'black']);
	unlink $tmpfile;
    } else {
	warn "Can't set cursor data with file $tmpfile: $!";
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
    }
}

### AutoLoad Sub
sub set_route_start_street {
    my $street = shift;
    my $coord = choose_from_plz(-str => $street,
				-noshow => 0);
    set_route_start($coord) if $coord;
}

### AutoLoad Sub
sub set_route_ziel_street {
    my $street = shift;
    my $coord = choose_from_plz(-str => $street,
				-noshow => 1);
    set_route_ziel($coord) if $coord;
}

# Setzt den Start-Punkt der Route
# Eingabe ist "$x,$y" (realcoords)
# XXX viel Redundanz mit search_route_mouse!
### AutoLoad Sub
sub set_route_start {
    my $xy = shift;
    return if !defined $xy;
    my $search_route_start = $xy;

    if (!$net) { make_net() }

    if (!$net->reachable($search_route_start)) {
	my $new_search_route_start = $net->fix_coords($search_route_start);
	if (!$new_search_route_start) {
	    $top->bell;
	    status_message(M"Der Startort ist nicht erreichbar", 'warn');
	    undef $search_route_start;
	    return; #goto CLEANUP;
	} else {
	    $search_route_start = $new_search_route_start;
	}
    }

    resetroute();

    # XXX vielleicht sollte man das unabhngige Setzen von Start/Ziel
    # ermglichen (z.B. zuerst Ziel, dann Start auswhlen). Z.Zt.
    # mu $search_route_ziel undefiniert werden.
    #XXXundef $search_route_ziel;
    $search_route_flag = 'ziel';
    my($x, $y) = transpose(split(/,/, $search_route_start));
    set_flag('start', $x, $y);
    set_cursor('ziel');

    @search_route_points = [$search_route_start, POINT_MANUELL];

    return;
}

# Setzt den Ziel-Punkt der Route
# Eingabe ist "$x,$y"
# XXX viel Redundanz mit search_route_mouse_cont!
### AutoLoad Sub
sub set_route_ziel {
    my $xy = shift;
    my(%args) = @_;
    return if !defined $xy;

#XXX dieser Teil ist halbnotwendig, falls der Startpunkt manuell
# gesetzt wurde und nearest_line_points aufgerufen werden muss.
# Allerdings funktioniert nearest_line_points anscheinend nicht ohne
# gemaltes Straennetz, wohingegen die Telefonbuch-Straen-Auswahl
# ganz gut ohne gemaltes Straennetz funktioniert.
# Deshalb vorerst disabled.
#
#     if (@realcoords) {
# 	if ($net->reachable
# 	    (Route::_coord_as_string($realcoords[$#realcoords]))) {
# 	    $search_route_start
# 	      = Route::_coord_as_string($realcoords[$#realcoords]);
# 	}
# 	my($tx, $ty) = transpose(@{$realcoords[$#realcoords]});
# 	my($pos, @points) = nearest_line_points_xy($tx, $ty);
# 	if (@points) { # XXX wirklich?
# 	    $net->add_net($pos, @points);
# 	    $search_route_start = Route::_coord_as_string($points[0]);
# 	} else {
# 	    addpoint_inter();
# 	    return;
# 	    #		$search_route_start = $search_route_ziel;
# 	}
#     }

#     my $this_search_route_start = $search_route_ziel;
#     if (!defined $this_search_route_start) {
# 	$this_search_route_start = $search_route_start;
# 	if (!defined $this_search_route_start) {
# 	    return;
# 	}
#     }

    my $this_search_route_start = $search_route_points[-1]->[SRP_COORD];
    return if (!defined $this_search_route_start);
    my $search_route_ziel = $xy;

    if (!$net) { make_net() }

    if (!$net->reachable($search_route_ziel)) {
	my $new_search_route_ziel = $net->fix_coords($search_route_ziel);
	if (!$new_search_route_ziel) {
	    $top->bell;
	    status_message(M"Der Zielort ist nicht erreichbar", 'warn');
	    undef $search_route_ziel;
	    return; #goto CLEANUP;
	} else {
	    $search_route_ziel = $new_search_route_ziel;
	}
    }
    # XXX nicht ntig? my($x, $y) = transpose(split(/,/, $search_route_ziel));
    search_route($this_search_route_start, $search_route_ziel,
		 undef, 'cont', %args);
    update_route_strname();
}

sub search_route_mouse {
    my $by_button = shift;
    $map_mode = MM_SEARCH;
    if (!$search_route_flag) {
	$search_route_flag = 'start';

	if (!$lowmem) {
	    if ($net_type eq "s") {
		if (!$net and ($str_draw{'s'} || $str_draw{'l'})) {
		    make_net();
		}
	    }
	    # XXX $str_draw{'r'} ueberprfen, wenn im RB-Mode
	    $net->reset if ($net);
	} else {
	    warn M"`Straennetz neu berechnen' vor Suche anklicken!\n";
	}

	set_cursor('start');
	return;
    } elsif ($search_route_flag eq 'start') {
	if ($by_button) {
	    undef $search_route_flag;
	    goto CLEANUP;
	}
	my $search_route_start = set_coords($c);
	return if !defined $search_route_start;

	if (!$net->reachable($search_route_start)) {
	    $top->bell;
	    status_message(M"Der Startort ist nicht erreichbar", 'warn');
	    undef $search_route_start;
	    return; #goto CLEANUP;
	}
	$search_route_flag = 'ziel';
	my($x, $y) = transpose(split(/,/, $search_route_start));
	set_flag('start', $x, $y);
	set_cursor('ziel');
	@search_route_points = [$search_route_start, POINT_MANUELL];
	return;
    } else { # ziel
	if ($by_button) {
	    undef $search_route_flag;
	    goto CLEANUP;
	}
	my $search_route_ziel = set_coords($c);
	return if !defined $search_route_ziel;
	if (!$net->reachable($search_route_ziel)) {
	    $top->bell;
	    status_message(M"Der Zielort ist nicht erreichbar", 'warn');
	    undef $search_route_ziel;
	    return; #goto CLEANUP;
	}
	status_message('');
	my $this_search_route_start = $search_route_points[-1]->[SRP_COORD];
	return if !defined $this_search_route_start;
	search_route($this_search_route_start, $search_route_ziel);

	# XXX duplicate code (see above)
	undef $search_route_flag;
	update_route_strname();
	search_route_mouse_cont();
	return;
    }

  CLEANUP:
    undef $search_route_flag;
    set_cursor(undef);
}

# Setzt das Suchen einer Route vom bisherigen Endpunkt fort.
# Der neue Zielpunkt wurde gerade per Maus angeklickt.
sub search_route_mouse_cont {
    if (!$search_route_flag) {
	# ??? Es existiert noch kein Startpunkt.
	$search_route_flag = 'ziel_cont';
	set_cursor('ziel');
	return;
    } else {
	my $this_search_route_start;
	if (!$net) { make_net() } # Netz wird neu berechnet
	if (@realcoords) { # Es existieren bereits Punkte in der Route.
	    if ($net->reachable
		(Route::_coord_as_string($realcoords[-1]))) {
		# Der vorherige Zielpunkt ist direkt erreichbar (Punkt
		# existiert in der Datenbank)
		$this_search_route_start
		    = Route::_coord_as_string($realcoords[-1]);
	    } else {
		# Wann tritt dieser Fall auf?
		warn "In search_route_mouse_cont, 2nd case";
		my($tx, $ty) = transpose(@{$realcoords[-1]});
		my($pos, @points) = nearest_line_points_xy($tx, $ty);
		if (@points) { # XXX wirklich?
		    $net->add_net($pos, @points);
		    $this_search_route_start = Route::_coord_as_string($points[0]);
		    @{$realcoords[-1]} = @{$points[0]}; # XXXX workaround
		    # der aber nicht stimmt, wenn der letzte Punkt ber
		    # freehand eingegeben wurde ...
		    # sigh, der ganze search_route_mouse_cont-Kram braucht eine
		    # krftige berarbeitung ... :-(
		} else {
		    addpoint_inter();
		    return;
		}
	    }
	}
	my $search_route_ziel = set_coords($c);
	return if !defined $search_route_ziel;
	if (!$net->reachable($search_route_ziel)) {
	    $top->bell;
	    status_message(M"Der Zielort ist nicht erreichbar", 'warn');
	    #$search_route_ziel = $this_search_route_start;
	    #undef $search_route_start;
	    return; #goto CLEANUP;
	}
	status_message('');
	search_route($this_search_route_start, $search_route_ziel,
		     undef, 'cont');

	update_route_strname();
    }
  CLEANUP:
}

sub plugin_menu {
    my $opbm = shift;
    $opbm->command(-label => M"Plugin laden",
		   -command => sub {
		       my($file) = $top->getOpenFile
			   (-title => M("Plugin laden"),
			    -filetypes => [[M"Perl-Module" => '.pm'],
					   [M"Alle Dateien" => '*']],
			   );
		       if (defined $file) {
			   load_plugin($file);
		       }
		   });
    $opbm->command(-label => M"Alle Plugins zeigen",
		   -command => sub {
		       require BBBikePlugin;
		       BBBikePlugin::find_all_plugins($FindBin::RealBin, $top);
		   });
}

sub menu_entry_up_down {
    my($menu, $tag_group) = @_;
    my(@tags) = @$tag_group;
    $menu->separator;
    my $x; # dummy
    $menu->radiobutton(-label => M"oben zeichnen",
		       -variable => \$x,
		       -command => sub {
			   foreach (@tags) { special_raise($_, 0) }
			   restack();
		       });
    $menu->radiobutton(-label => M"normal",
		       -variable => \$x,
		       -command => sub {
			   foreach (@tags) { special_normal($_, 0) }
			   restack();
		       });
    $menu->radiobutton(-label => M"unten zeichnen",
		       -variable => \$x,
		       -command => sub {
			   foreach (reverse @tags) { special_lower($_, 0) }
			   restack();
		       });
}

sub menu_entry_choose_ort {
    my($menu, $abk, %args) = @_;
    if (exists $str_attrib{$abk}) {
	$menu->checkbutton(-label => $str_attrib{$abk}->[ATTRIB_PLURAL],
			   -variable => \$str_draw{$abk},
			   -command => sub { plot('str',$abk); },
			   (defined $args{'-accelerator'} ?
			    (-accelerator => $args{'-accelerator'}) :
			    (),
			   ),
			  );
	my %str_args;
	if (exists $args{'-strchooseortargs'}) {
	    %str_args = %{$args{'-strchooseortargs'}};
	}
	$menu->command(-label => Mfmt("%s auswhlen", $str_attrib{$abk}->[ATTRIB_SINGULAR]),
		       -command => sub { choose_ort('s', $abk, %str_args) });
	if ($args{'-strextrachoosemenuaction'}) {
	    $args{'-strextrachoosemenuaction'}->();
	}
	if (0) { # XXX Habe ich schon seit Jahren nicht genutzt!
	    $menu->command
	      (-label => Mfmt("Liste der %s neu erstellen",
			      $str_attrib{$abk}->[ATTRIB_PLURAL]),
	       -command => sub { choose_ort('s', $abk, -rebuild => 1,
					    %str_args) });
	    $menu->command
	      (-label => Mfmt("Update der %s", $str_attrib{$abk}->[ATTRIB_PLURAL]),
	       -command => sub { undef $str_obj{$abk};
				 plot('str',$abk);
			     });
	    $menu->command
	      (-label => Mfmt("Schnelles Update der %s",
			      $str_attrib{$abk}->[ATTRIB_PLURAL]),
	       -command => sub { plot('str',$abk, FastUpdate => 1); });
	}
	if ($advanced) {
	    $menu->command
	      (-label => "Lazy drawing",
	       -command => sub {
		   $str_draw{$abk} = 1 - $str_draw{$abk};
		   plot('str',$abk, -lazy => 1);
	       });
	}
	if ($args{'-strblockings'}) {
	    my $sperre_abk = 'sperre_'.$abk;
	    $menu->checkbutton
		(-label => M"gesperrte Strecken",
		 -variable => \$p_draw{$sperre_abk},
		 -command => sub {
		     plot_sperre($p_file{$sperre_abk},
				 -abk => $sperre_abk);
		 },
		);
	}
    }

    if (exists $p_attrib{$abk} && exists $str_attrib{$abk}) {
	$menu->separator;
    }

    if (exists $p_attrib{$abk}) {
	$menu->checkbutton(-label => $p_attrib{$abk}->[ATTRIB_PLURAL],
			   -variable => \$p_draw{$abk},
			   -command => sub { plot('p',$abk) },
			   (defined $args{'-accelerator_p'} ?
			    (-accelerator => $args{'-accelerator_p'}) :
			    (),
			   ),
			  );
	my %p_args;
	if (exists $args{'-pchooseortargs'}) {
	    %p_args = %{$args{'-pchooseortargs'}};
	}
	$menu->command(-label => Mfmt("%s auswhlen", $p_attrib{$abk}->[ATTRIB_SINGULAR]),
		       -command => sub { choose_ort('p', $abk, %p_args) });
	if ($args{'-pextrachoosemenuaction'}) {
	    $args{'-pextrachoosemenuaction'}->();
	}
	if (0) { # XXX Habe ich schon seit Jahren nicht genutzt!
	    $menu->command
	      (-label => Mfmt("Liste der %s neu erstellen", $p_attrib{$abk}->[ATTRIB_PLURAL]),
	       -command => sub { choose_ort('p', $abk, -rebuild => 1) });
	    $menu->command
	      (-label => Mfmt("Update der %s", $p_attrib{$abk}->[ATTRIB_PLURAL]),
	       -command => sub { undef $p_obj{$abk};
				 plot_point($abk);
			     });
	    $menu->command
	      (-label => Mfmt("Schnelles Update der %s",
			      $p_attrib{$abk}->[ATTRIB_PLURAL]),
	       -command => sub { plot('p',$abk, FastUpdate => 1); });
	}
	if ($advanced) {
	    $menu->command
	      (-label => "Lazy drawing",
	       -command => sub {
		   $p_draw{$abk} = 1 - $p_draw{$abk};
		   plot('p',$abk, -lazy => 1);
	       });
	}
    }
}

# bindet ein Men an die rechte Taste
sub menuright {
    my($b, $menu) = @_;
    $b->bind('<ButtonPress-3>' => sub {
		 if (0) { # old code XXX
		     $menu->Popup(-popover => $b,
				  -popanchor => 'n',
				  -overanchor => 's',
				 );
		 } else {
		     my $e = $b->XEvent;
		     my $X = $e->X;
		     my $Y = $e->Y;
		     $menu->Post($X,$Y);
		 }
	     }
	    );
}

sub menuarrow {
    my($b, $menu, $col, %args) = @_;
    return if !menuarrow_unmanaged($b, $menu, %args);
    if (defined $col) {
	$b->grid(-row => $curr_row+1, -column => $col, -sticky => 'nesw');
    } else {
	my(@packargs) = (exists $args{'-pack'} ? @{$args{'-pack'}} : ());
	$b->pack(@packargs);
    }
}

sub menuarrow_unmanaged {
    my($b, $menu, %args) = @_;
    return 0 if !$menuarrow_photo;
    $b->configure(-menu => $menu);
    $b->configure
      (-image => $menuarrow_photo,
       -takefocus => 1,
       -highlightthickness => 1,
       -indicatoron => 0,
       -bd => ($small_icons ? 0 : 2),
       -padx => 0,
       -pady => 0,
      );

    my $menulabel;
    if (defined $args{'-menulabel'}) {
	$menulabel = $args{'-menulabel'};
    } else {
	for my $inx (0 .. $menu->index('last')) {
	    if ($menu->type($inx) !~ /^(separator|tearoff)$/) {
		$menulabel = eval q{$menu->entrycget($inx, -label)};
		last if defined $menulabel;
	    }
	}
    }
    if (defined $menulabel and $menulabel ne '') {
	(my $balloonlabel = $menulabel) =~ s/~//;
	$balloon->attach($b, -msg => M("Men")." $balloonlabel...");
    }
    $menu->{BBBike_Menulabel} = $menulabel if !defined $menu->{BBBike_Menulabel};
    $menu->{BBBike_Special}   = $args{-special};
    $b->bind('<ButtonPress-3>' => sub { $b->ButtonDown });
    1;
}

# error categories:
#  info: never pops up a dialog: either writes to stderr or to the
#        status bar if available
#  warn: warn with a dialog
#  err:  error with a dialog
#  die:  error with a dialog and die afterwards
sub status_message {
    my($msg, $err) = @_;
    if (!defined $err || $err =~ /^info/ || !$use_dialog) {
	if (!defined $progress) {
	    if (defined $err && $err eq 'info-stack-trace') {
		require Carp;
		Carp::cluck($msg);
	    } else {
		warn "$msg\n";
	    }
	} else {
	    $msg =~ s/\n+\z//;
	    $status_label->configure(-text => $msg);
	    if ($msg =~ /\n/) {
		set_status_button
		    (-text => "OK",
		     -command => sub {
			 status_message("", "info");
		     });
	    } else {
		remove_status_button();
	    }
	}
    } else {
	# warn or error
	if (!$top) {
	    warn "$msg\n";
	} else {
	    my %args = (-title  => ($err eq 'warn' ? 'Warnung' : 'Fehler'),
			-text   => $msg,
			-bitmap => ($err eq 'warn' ? 'warning' : 'error'),
			-background => Tk::NORMAL_BG,
			-highlightbackground => Tk::NORMAL_BG,
		       );
	    $splash_screen->Destroy if $splash_screen; undef $splash_screen;
	    if ($status_message_dialog && Tk::Exists($status_message_dialog)) {
		## Do not reconfigure existing dialog because of the
		## (still!) two-seconds hang
		#$status_message_dialog->configure(%args);
		$status_message_dialog->destroy;
	    }# else {
		my $Dialog = "Dialog";
		if (eval { require Tk::LongDialog; 1 }) {
		    $Dialog = "LongDialog";
		} else {
		    require Tk::Dialog;
		}
		$status_message_dialog = $top->$Dialog(%args);
	    #}
	    $status_message_dialog->Show;
	}
    }
    if (defined $err && $err eq 'die') { # also die
	require Carp;
	Carp::confess($msg);
    }
}

sub set_status_button {
    my(%args) = @_;
    $status_button->grid(-column => $status_button_column,
			 -row => 0);
    if (!$args{-command}) {
	die "-command missing";
    }
    my $cmd = $args{-command};
    $args{-command} = sub {
	$cmd->();
	remove_status_button();
    };
    $status_button->configure(%args);
}

sub remove_status_button {
    if ($status_button->manager) {
	$status_button->configure(-text => "", -command => \&Tk::NoOp);
	$status_button->gridForget;
    }
}

sub add_new_point {
    my $net   = shift;
    my $point = shift;
    my(%args) = @_;
    my($rx, $ry) = split(/,/, $point);
    my($tx, $ty) = transpose($rx, $ry);
    my($pos, @points) = nearest_line_points_xy($tx, $ty);
    # Korrektur des mittleren Punktes
    $points[1] = [$rx, $ry];
    if (@points) {
	$net->add_net($pos, @points);
    }
    unless ($args{'-quiet'}) {
	if (!$net->reachable($point)) {
	    status_message(Mfmt("Der Punkt <%s> existiert im Netz nicht und kann auch nicht erzeugt werden", $point), "die");
	}
    }
    join(",", @{ $points[1] });
}

sub nearest_line_points_xy {
    my($x, $y) = @_;
    my $start;
    my %seen;
    my $stage = 'closest';
    my @find;
    my $find_i;
my $safe_loop = 0; #XXX
    while (1) {
die "too many loops, please report, line " . __LINE__ if ($safe_loop++ > 100);
	my $find;
	if ($stage eq 'closest') {
	    $find = $c->find('closest', $x, $y, 0, $start);
	    if (defined $find and $find ne '') {
		if (exists $seen{$find}) {
		    $stage = 'overlapping';
		    next;
		}
	    }
	} elsif ($stage eq 'overlapping') {
	    if (!@find) {
		@find = $c->find('overlapping', $x-2, $y-2, $x+2, $y+2);
		$find_i = 0;
	    }
	    return undef if $find_i > $#find;
	    $find = $find[$find_i];
	    $find_i++;
	}
	my @tags = $c->gettags($find);
        if ($net_type eq "r") {
	    if ($tags[0] eq 'r') {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} elsif ($net_type eq "us") {
	    if ($tags[0] =~ /^[ub]$/) {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} elsif ($net_type eq "rus") {
	    if ($tags[0] =~ /^[ubr]$/) {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} elsif ($net_type eq 'wr') {
	    if ($tags[0] eq 'wr') {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} else {
	    if ($tags[0] =~ /^[sSlL]$/ && !grep { /^[sSlL]-label/ } @tags) {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	}
	if ($stage eq 'closest') {
	    $start = $find;
	    $seen{$find}++;
	}
    }
}

sub nearest_line_points_mouse {
    my($c, @tags) = @_;
    my $e = $c->XEvent;
    my($x, $y) = ($c->canvasx($e->x), $c->canvasy($e->y));
    @tags = $c->gettags('current') if !@tags;
    if (grep { /-label/ } @tags) { # ignore labels
	(undef, @tags) = find_below_rx($c, [q{.}], undef, [q{current}, q{-label}]);
    }
    nearest_line_points($x, $y, @tags);
}

# Input arguments:
#   x/y: current canvas coordinates
#   tags: tags of the current canvas item
# Output:
#   ($index, middlepoint(new), firstpoint, secondpoint)
#   points are real coordinates
sub nearest_line_points {
    my($x, $y, @tags) = @_;
    my(@realcoords, @coords);
    if (defined $tags[3] && $tags[3] =~ /^(.+)-(\d+)$/) {
	my($type, $index) = ($1, $2);
	my $s;
	$s = $str_obj{$type};
	if (!defined $s) {
	    if (exists $str_file{$type}) {
		# XXX better: create a function type_to_filename
		my $filename = get_strassen_file($str_file{$type});
		$str_obj{$type} = new Strassen $filename;
		$s = $str_obj{$type};
	    }
	    if (!defined $s) {
		die "Streets not defined for type $type, Filename is $str_file{$type} XXX";
	    }
	} else {
	    $s->reload;
	}
	my $ret = $s->get($index);
	if ($ret and @{$ret->[Strassen::COORDS]}) {
	    # Erste Methode. $str_width wird von 2 bis 4 inkrementiert
	    # (hngt von der Breite der Straen ab).
	    for my $str_width (2 .. 4) {
		my $i;
		my($lastxx, $lastyy, $lastrx, $lastry);
		for($i = 0; $i <= $#{$ret->[Strassen::COORDS]}; $i++) {
		    if ($ret->[Strassen::COORDS][$i] =~ /^(?:[A-Z])?(-?\d+(?:\.\d*)?),(-?\d+(?:\.\d*)?)$/) {
			my($rx, $ry) = ($1, $2);
			my($xx, $yy) = transpose($rx, $ry);
			push @realcoords, $rx, $ry;
			push @coords, transpose($xx, $yy);
			if (defined $lastxx &&
			    (($x >= $lastxx-$str_width &&
			      $x <= $xx+$str_width) ||
			     ($x >= $xx-$str_width     &&
			      $x <= $lastxx+$str_width)) &&
			    (($y >= $lastyy-$str_width &&
			      $y <= $yy+$str_width) ||
			     ($y >= $yy-$str_width     &&
			      $y <= $lastyy+$str_width))) {
			    my($p1, $p2) = anti_transpose($x, $y);
			    my($fp1, $fp2) = fusspunkt($lastrx, $lastry,
						       $rx, $ry,
						       $p1, $p2);
# XXX Achtung! $index kann nicht gebraucht werden, wenn
# mit Multistrassen gearbeitet wird. Lsung?
# Zuordnung von Strassen-Indices auf Multistrassen-Indices?
#XXX			return ((defined $multistrassen ? undef : $index),
# XXX test it:
			    my(@points) = ([int_round($fp1), int_round($fp2)],
					   [$lastrx, $lastry],
					   [$rx, $ry]);
			    if ($net and
				$net->{Strassen}->isa('MultiStrassen')) {
			      SEARCH: {
				    for my $i (0 .. $#{$net->{SourceAbk}}) {
					if ($net->{SourceAbk}[$i] eq $type) {
					    $index +=
					      $net->{Strassen}{FirstIndex}[$i];
					    last SEARCH;
					}
				    }
				    warn "Can't find index for MultiStrassen...";
				    undef $index;
				}
			    }
			    return ($index, @points);
			} else {
			    ($lastxx, $lastyy) = ($xx, $yy);
			    ($lastrx, $lastry) = ($rx, $ry);
			}
		    } else {
			die "Can't parse coord: $ret->[Strassen::COORDS][$i]";
		    }
		}
	    }
 	}
	warn "nearest_line_points: failed 1st method
Tags are @tags
Type is $type
Index is $index

Try 2nd method...";
    } else {
	die "Can't find index from tags: @tags";
    }
    # 2. Methode. Die nchsten zwei Punkte in @coords werden einfach als
    # Nachbarn deklariert. Funktioniert ganz gut, es sei denn, die Strae
    # hat einen *sehr* kurvigen Verlauf (90-Kurven etc.).
    my(@coords_dist, $nearest_i);
    my $i;
    if ($#coords > 0) {
	for($i = 0; $i < $#coords; $i+=2) {
	    my($lx, $ly) = ($coords[$i], $coords[$i+1]);
	    push(@coords_dist,
		 Strassen::Util::strecke([$x, $y],
					 [$coords[$i], $coords[$i+1]]));
	    if (!defined $nearest_i or
		$coords_dist[$nearest_i] > $coords_dist[-1]) {
		$nearest_i = $#coords_dist;
	    }
	}
    }
    my @res = ([anti_transpose($x, $y)]);
    if (!defined $nearest_i) {
	die "No nearest point???";
    } elsif ($nearest_i == 0) {
	push(@res, [@realcoords[0..1]], [@realcoords[2..3]]);
    } elsif ($nearest_i == $#coords_dist) {
	my $last = $#coords_dist;
	push(@res,
	     [@realcoords[$last*2-2 .. $last*2-1]],
	     [@realcoords[$last*2   .. $last*2+1]]);
    } elsif ($coords_dist[$nearest_i-1] < $coords_dist[$nearest_i+1]) {
	push(@res,
	     [@realcoords[$nearest_i*2-2 .. $nearest_i*2-1]],
	     [@realcoords[$nearest_i*2   .. $nearest_i*2+1]]);
    } else {
	push(@res,
	     [@realcoords[$nearest_i*2   .. $nearest_i*2+1]],
	     [@realcoords[$nearest_i*2+2 .. $nearest_i*2+3]]);
    }
    (undef, @res);
}

sub city_settings {
    $str_draw{'l'}     = 0;
    $p_draw{'o'}       = 0;
    $p_far_away{'o'}   = 0;
    $str_far_away{'w'} = 0;
    $str_far_away{'l'} = 0;
    $str_regions{'l'}  = [];
    $wasserumland      = 0;
    pending(1, map { "replot-$_" } ("str-l", "p-o", "str-w", "str-l"));
}

sub region_settings {
    $str_draw{'l'}     = 1; # XXX set to str_draw{'s'}?
    $p_draw{'o'}       = 1;
    $p_far_away{'o'}   = 0;
    $str_far_away{'w'} = 0;
    $str_far_away{'l'} = 0;
    $str_regions{'l'}  = [];
    $wasserumland      = 1;
    pending(1, map { "replot-$_" } ("str-l", "p-o", "str-w", "str-l"));
}

sub jwd_settings {
    $str_draw{'l'}     = 1; # XXX set to str_draw{'s'}?
    $p_draw{'o'}       = 1;
    $p_far_away{'o'}   = 1;
    $str_far_away{'w'} = 1;
    $str_far_away{'l'} = 1;
    $str_regions{'l'}  = []; # XXX Sachsen-Anhalt?
    $wasserumland      = 1;
    pending(1, map { "replot-$_" } ("str-l", "p-o", "str-w", "str-l"));
}

# Definiert, wie die grafischen Objekte "gestapelt" werden sollen.
# Also ganz unten Gewsser und Flchen, dann Straen etc. und ganz oben
# Punkte wie Haltestellen, Orte und Kreuzungen.
# Allgemeine Flchen kommen unter Gewsser, damit man z.B. bei in
# Wldern gelegenen Seen nicht aufwendig ausschneiden muss.
# Ganz oben sind die mit "Custom draw" gezeichneten Strecken.
# Weitere Regeln: Labels von Orten sind unter anderen Ortspunkten (damit
# die Ortspunkte anwhlbar bleiben), dagegen sind Labels von Bahnhfen
# ber den Bahnhofspunkten und Bahnstrecken (mssen nicht anwhlbar sein).
# Development-Hilfen (fz) ganz oben anzeigen.
sub restack {
    my @real_order;
    @real_order = real_stack_order();

    foreach (@real_order) {
	$c->raise($_);
    }

    Hooks::get_hooks("after_change_stacking")->execute();
}

# gibt das aktuelle Stacking aus
sub real_stack_order {
    my @real_order;
    if (defined @set_stack_order) {
	return @set_stack_order;
    }

    push @real_order, @special_lower;
    foreach (@normal_stack_order) {
	if (!$special_lower{$_} && !$special_raise{$_}) {
	    push @real_order, $_;
	}
    }
    push @real_order, @special_raise;
    @real_order;
}

### AutoLoad Sub
sub real_type_stack_order {
    my @real_order = real_stack_order();
    my @res;
    my %seen;
    foreach my $type (@real_order) {
	$type =~ s/^([^-]*)-.*/$1/;
	if (!$seen{$type}) {
	    push @res, $type;
	    $seen{$type}++;
	}
    }
    @res;
}

### AutoLoad Sub
sub set_normal_stack_order {
    @set_stack_order = @normal_stack_order;
    %special_lower = ();
    %special_raise = ();
    restack();
}

### AutoLoad Sub
sub special_normal {
    my($abk, $delay) = @_;

    if (exists $special_lower{$abk}) {
	delete $special_lower{$abk};
	remove_from_array(\@special_lower, $abk);
    }

    if (exists $special_raise{$abk}) {
	delete $special_raise{$abk};
	remove_from_array(\@special_raise, $abk);
    }

    restack() unless $delay;
}

### AutoLoad Sub
sub special_raise {
    my($abk, $delay) = @_;

    if (exists $special_lower{$abk}) {
	delete $special_lower{$abk};
	remove_from_array(\@special_lower, $abk);
    }

    $special_raise{$abk}++;
    remove_from_array(\@special_raise, $abk);
    push @special_raise, $abk;

    restack() unless $delay;
}

### AutoLoad Sub
sub special_lower {
    my($abk, $delay) = @_;

    if (exists $special_raise{$abk}) {
	delete $special_raise{$abk};
	remove_from_array(\@special_raise, $abk);
    }
    $special_lower{$abk}++;
    remove_from_array(\@special_lower, $abk);
    unshift @special_lower, $abk;

    restack() unless $delay;
}

sub remove_from_array {
    my($a_ref, $val) = @_;
    for(my $i = 0; $i <= $#{$a_ref}; $i++) {
	if ($a_ref->[$i] eq $val) {
	    splice @$a_ref, $i, 1;
	    $i--;
	}
    }
}

sub destroy_delayed_restack {
    destroy_delayed_sub('restack');
}

sub fix_stack_order {
    my($abk) = @_;
    if (!grep { $_ eq $abk } @normal_stack_order) {
	push @normal_stack_order, $abk, "$abk-fg";
    }
}

### AutoLoad Sub
sub add_to_stack {
    my($abk, $how, $other_abk) = @_;
    return if (grep { $_ eq $abk } @normal_stack_order);
    my $i = 0;
    for (@normal_stack_order) {
	if ($_ eq $other_abk) {
	    if ($how eq 'after') {
		splice @normal_stack_order, $i+1, 0, $abk, "$abk-fg";
		return;
	    } elsif ($how eq 'before') {
		splice @normal_stack_order, $i, 0, $abk, "$abk-fg";
		return;
	    } else {
		die "Cannot handle $how in add_to_stack";
	    }
	}
	$i++;
    }
    push @normal_stack_order, $abk, "$abk-fg";
}

### AutoLoad Sub
sub remove_from_stack {
    my($abk) = @_;
    @normal_stack_order = grep { $_ ne $abk } @normal_stack_order;
}

sub restack_delayed {
    # Use the delaying only on slow systems. For fast systems,
    # delaying is disturbing for the interactivity.
    delayed_sub(\&restack, -busy => $slowcpu ? !$edit_mode && !$edit_normal_mode : 0,
		           -delay => $slowcpu ? 1000 : 300,
		           -name => 'restack');
}

sub destroy_delayed_sub {
    my $name = shift;
    if ($delayed_sub_timer{$name}) {
	$delayed_sub_timer{$name}->cancel;
	delete $delayed_sub_timer{$name};
    }
}

sub delayed_sub {
    my($sub, %args) = @_;
    my $ms   = $args{'-delay'} || 1000;
    my $name = $args{'-name'}  || "";
    my $busy = (defined $args{'-busy'} ? $args{'-busy'} : 1);
    destroy_delayed_sub($name);
    $delayed_sub_timer{$name} = $top->after
      ($ms, sub {
## DEBUG_BEGIN
#benchbegin("Delayed sub $name");
## DEBUG_END	   
	   IncBusy($top) if $busy;
	   eval {
	       $sub->();
	   };
	   warn __LINE__ . ": $@" if $@;
	   DecBusy($top) if $busy;
## DEBUG_BEGIN
#benchend();
## DEBUG_END	   
       });
}

### AutoLoad Sub
sub show_logo { # und About
    my $as_about = shift || '';
    return unless $use_logo || $as_about;

    my $logotop = redisplay_top($top, "about-$as_about",
				-title => ($as_about ? M('ber').' ' : '')
				. 'BBBike',
				-background => 'white');
    return if !defined $logotop;

    $logotop->optionAdd("*" . substr($logotop->PathName, 1)
			. "*background" => 'white', 'startupFile');
    $logotop->optionAdd("*" . substr($logotop->PathName, 1)
			. "*foreground" => 'blue3', 'startupFile');
    $logotop->transient($top) unless $as_about;
    my $ff = $logotop->Frame(-relief => ($as_about ? 'ridge' : 'flat'),
			     -bd => ($as_about ? 2 : 0),
			    )->pack(-fill => 'both', -expand => 1);
    my $f = $ff->Frame->pack(-side => 'left',
			     -fill => 'both', -expand => 1,
			     -padx => 4, -pady => 4,
			    );
    my $Button_or_Label = ($as_about ? "Button" : "Label");
    my $www_b =
	$f->$Button_or_Label
	    (-text =>
	     "$progname $VERSION\n" .
	     "(File Rev $PROG_REVISION)\n\n" .
	     M("Ein Informationssystem fr Radfahrer in Berlin") .
	     "\n\n 1995-2005 Slaven Rezic",
	     -wraplength => 230,
	     -font => $font{'bold'},
	     -padx => 5,
	     -pady => 0,
	     -highlightthickness => 0,
	     -relief => 'flat',
	     -borderwidth => 0,
	     ($as_about ?
	      (-command => sub {
		   require WWWBrowser;
		   WWWBrowser::start_browser($BBBike::BBBIKE_WWW);
	       },
	      ) : ())
	    )->pack(-fill => 'x');
    $balloon->attach($www_b, -msg => M"WWW-Version aufrufen")
	if $balloon;
    my $copying_b =
	$f->$Button_or_Label
	    (-text => M"Siehe auch die Datei COPYING",
	     -padx => 5,
	     -highlightthickness => 0,
	     -relief => "flat",
	     -borderwidth => 0,
	     ($as_about ?
	      (-command => sub { copying_viewer($logotop) }) : ()),
	    )->pack(-fill => "x");
    if ($as_about) {
	my $os_info = "OS: $^O";
	if ($os eq 'win') {
	    $os_info .= " (" . ($Config{'cc'} =~ /^gcc/
				? 'gcc' :
				($Config{'cc'} eq 'cl.exe'
				 ? 'Visual C'
				 : $Config{'cc'})) . ")";
	}
	# Are we running an emulation?
	if (is_in_path("uname")) {
	    chomp(my $real_os = `uname`);
	    if ($^O !~ /^$real_os$/i) {
		$os_info .= " (Real OS: $real_os)";
	    }
	}
	$f->Label(-text => "perl $]\nTk $Tk::VERSION\n$os_info",
		  -font => $font{'small'},
		  -justify => 'left',
		 )->pack(-anchor => 'w', -expand => 1,
			 -fill => 'x');
    }
    my $mail_b =
	$f->$Button_or_Label
	    (-text => $BBBike::EMAIL,
	     -padx => 5,
	     -pady => 0,
	     -relief => 'flat',
	     -borderwidth => 0,
	     -highlightthickness => 0,
	     ($as_about ?
	      (-command => sub {
		   if ($^O eq 'MSWin32') {
		       require Win32Util;
		       Win32Util::start_mail_composer($BBBike::EMAIL);
		   } else {
		       enter_send_mail(M"BBBike perl/Tk",
				       -to => $BBBike::EMAIL,
				      );
		   }
	       }) : ()),
	     -font => $font{'normal'})->pack(-fill => 'x');
    $balloon->attach($mail_b, -msg => M"Mail an den Autor schicken")
	if $balloon;

    $ff->Label(-image => $srtbike_photo
	      )->pack(-side => 'left', -anchor => "ne");
    if ($as_about) {
	my $okb = $logotop->Button(Name => 'ok',
				   -command => sub { hide_logo($as_about) },
				  )->pack(-anchor => 'c', -pady => 4);
	$logotop->bind('<Return>' => sub { $okb->invoke });
    } else {
	$logotop->transient($top);
    }
    $logotop->withdraw;
    $logotop->Popup(-popover => ($as_about ? 'cursor' : $top));
    $logotop->update; # damit der Inhalt sofort erscheint
}

### AutoLoad Sub
sub hide_logo {
    my $as_about = shift || '';
    my $t = $toplevel{"about-$as_about"};
    if (defined $t && Tk::Exists($t)) {
	$t->destroy;
	undef $toplevel{"about-$as_about"};
    }
}

### AutoLoad Sub
sub copying_viewer {
    my $top = shift;
    simple_file_viewer($top, "$FindBin::RealBin/COPYING",
		       -title => M"COPYING",
		       -class => "Bbbike Copyright",
		      );
}

### AutoLoad Sub
sub simple_file_viewer {
    my($top, $file, %args) = @_;
    my $title = $args{-title};
    my $class = $args{-class};
    if (open(C, $file)) {
	binmode C;
	my $t = $top->Toplevel
	    ((defined $title ? (-title => $title) : ()),
	     (defined $class ? (-class => $class) : ()),
	    );
	my $txt = $t->Scrolled("ROText", -scrollbars => "osoe")->pack(-fill => "both", -expand => 1);
	while(<C>) {
	    $txt->insert("end", $_);
	}
	close C;
	$t->Button(Name => 'close',
		   -command => sub { $t->destroy },
		  )->pack(-fill => "x", -expand => 1);
    } else {
	status_message(Mfmt("Die Datei %s kann nicht geffnet werden: %s",
			    $file, $!), "error");
    }
}

######################################################################
# Utilities ...

### AutoLoad Sub
sub usage {
    my($msg, $getopt_listref) = @_;
    my(@getopt_list) = @$getopt_listref;
    if (defined $msg) {
	$msg .= "\n";
    } else {
	$msg = '';
    }

    my @opt;
    my $i;
    for($i = 0; $i <= $#getopt_list; $i+=2) {
	if ($getopt_list[$i] =~ /([^!=]+)(!|=.)?$/) {
	    my $mod = $2 || '';
	    if ($mod eq '!') {
		push @opt, map { "[-[no]$_]" } split(/\|/, $1);
	    } else {
		push @opt, map { "[-$_$mod]" } split(/\|/, $1);
	    }
	} else {
	    push @opt, "[-$getopt_list[$i]]";
	}
    }
    die $msg . wrap("usage: $progname ", "\t", join(" ", @opt))
      . "\n";
}

### AutoLoad Sub
sub windrose { # funktioniert nur mit quadratischen Buttons
    my($senkrecht) = @_; # "Geschwindigkeit" des Scrollens
    my $e = $windrose_button->XEvent;
    my($x, $y) = ($e->x, $e->y);
    my($w, $h) = ($windrose_button->width, $windrose_button->height);
    $senkrecht = 1 unless defined $senkrecht;

    my $is_center = sub {
	my($x, $y) = @_;
	($x > $w*0.4 && $x < $w*0.6 &&
	 $y > $h*0.4 && $y < $h*0.6)
    };
    my $center_delay;

    if ($is_center->($x, $y) && !$center_delay) {
	$center_delay = $c->after
	  (1000, sub {
	       undef $center_delay;
	       my $e = $windrose_button->XEvent;
	       my($x, $y) = ($e->x, $e->y);
	       if ($is_center->($x, $y)) {
		   $c->center_view;
	       }
	   });
    } elsif ($x-0.25*$w < 0.5*$y) {
	if ($x-0.75*$w > -0.5*$y) {
	    my($y) = $c->yview;
	    $c->yview(scroll =>  $senkrecht, 'units'); # S
	} elsif ($x+0.5*$w > 2*$y) {
	    $c->yview(scroll => -$senkrecht, 'units'); # N
	    $c->xview(scroll => -$senkrecht, 'units'); # W
	} elsif ($x-1.5*$w > -2*$y) {
	    $c->yview(scroll =>  $senkrecht, 'units'); # S
	    $c->xview(scroll => -$senkrecht, 'units'); # W
	} else {
	    $c->xview(scroll => -$senkrecht, 'units'); # W
	}
    } else {
	if ($x-0.75*$w < -0.5*$y) {
	    $c->yview(scroll => -$senkrecht, 'units'); # N
	} elsif ($x+0.5*$w < 2*$y) {
	    $c->yview(scroll =>  $senkrecht, 'units'); # S
	    $c->xview(scroll =>  $senkrecht, 'units'); # E
	} elsif ($x-1.5*$w < -2*$y) {
	    $c->yview(scroll => -$senkrecht, 'units'); # N
	    $c->xview(scroll =>  $senkrecht, 'units'); # E
	} else {
	    $c->xview(scroll =>  $senkrecht, 'units'); # E
	}
    }
}

### AutoLoad Sub
sub check_font {
    my $font = shift;
    eval { $top->Label(-font => $font)->destroy };
    $@ eq '';
}

sub IncBusy {
    my($top, %args) = @_;
    return if !Tk::Exists($top);

    if (!$top->{'Busy'}) {
	if (eval q{ require Tk::InputO; 1 }) {
	    for my $t ($top, values(%toplevel)) {
		next if !Tk::Exists($t);
		next if $args{-except} && $args{-except}{$t};
		my $io = (Tk::Exists($t->{'BusyIO'})
			  ? $t->{'BusyIO'}
			  : $t->InputO);
		$io->configure(-cursor => (defined $args{-cursor} ? $args{-cursor} : 'watch'));
		$io->place('-x' => 0, '-y' => 0, -relwidth => 1, -relheight => 1);
		$io->idletasks;
		$t->{'Busy'} = 1;
		$t->{'BusyIO'} = $io;
	    }
	} else {
	    # see changes in TkChange.pm
	    $top->Busy(-recurse => 1, %args);
	}
    }
    $top->{'BusyCount'}++;
}

sub DecBusy {
    my($top) = @_;
    return if !Tk::Exists($top);
    $top->{'BusyCount'}-- if $top->{'BusyCount'} > 0;
    if ($top->{'BusyCount'} < 1) {
	if ($top->{'BusyIO'}) {
	    for my $t ($top, values(%toplevel)) {
		next if !Tk::Exists($t) ||
		        !Tk::Exists($t->{'BusyIO'});
		$t->{'BusyIO'}->placeForget;
	    }
	    delete $top->{'Busy'};
	} else {
	    $top->Unbusy;
	}
    }
}

#XXXX del: ist nicht mehr noetig
#### AutoLoad Sub
#sub ResetBusy {
#   my $top = shift;
#    return if !Tk::Exists($top);
#    $top->Unbusy;
#    $top->{'BusyCount'} = 0;
#}

### AutoLoad Sub
sub redisplay_top {
    my($top, $name, %args) = @_;
    my $force = delete $args{-force};
    my $deiconify = (exists $args{-deiconify} ? delete $args{-deiconify} : 1);
    my $raise     = (exists $args{-raise}     ? delete $args{-raise}     : 1);
    if (!exists $args{-class}) {
	$args{-class} = "Bbbike Window";
    }
    my $t = $toplevel{$name};
    my $exists = 0;
    if (defined $t && Tk::Exists($t)) {
	if ($force) {
	    $t->destroy;
	    delete $toplevel{$name};
	} else {
	    $exists = 1;
	}
    }
    if ($exists) {
	$t->deiconify if $deiconify;
	# win32 bentigt zustzliches raise
	$t->raise     if $raise;
	undef;
    } else {
	$toplevel{$name} = $top->Toplevel(%args);
	set_as_toolwindow($toplevel{$name});
	$toplevel{$name}->OnDestroy(sub { delete $toplevel{$name} });
	$toplevel{$name};
    }
}

sub pending {
    my($bool, @types) = @_;
    if ($bool) {
	foreach (@types) {
	    if (defined $immediate{$_}) {
		if ($immediate{$_} == 1) {
		    update($_);
		} elsif ($immediate{$_} == 2) {
		    $pending{$_}++;
		    delayed_sub(sub { update() }, -name => 'pending');
		}
	    } else {
		$pending{$_}++;
	    }
	}
    }
}

sub update {
    my $type = shift;
    my @types;
    if (defined $type) {
	@types = ($type);
    } else {
	@types = keys %pending;
    }
    foreach $type (@types) {
	if ($type =~ /^replot-(.*)-(.*)$/) {
	    my($str_p, $elem) = ($1, $2);
	    plot($str_p,$elem);
	} elsif ($type eq 'recalc-net') {
	    make_net();
	} else {
	    die "Unknown update type: $type";
	}
    }
}

### AutoLoad Sub
sub calc_ampel_optimierung {
    return if !$ampel_optimierung;
    if ($average_v == -1) {
	# manuelle Eingabe, keine Berechnung notwendig...
	status_message(Mfmt("Einstellungen: verlorene Strecke pro Ampel: %d m", $lost_strecke_per_ampel), "info");
    } else {
	require Ampelschaltung;
	my $speed = 20;
	if ($average_v != 0) {
	    $speed = $average_v;
	} else {
	    if ($active_speed_power{Type} eq 'speed') {
		$speed = $speed[$active_speed_power{Index}];
	    } elsif ($active_speed_power{Type} eq 'power' and $bikepwr) {
		my $bp_obj = new BikePower;
		$bp_obj->given('P');
		$bp_obj->power($power[$active_speed_power{Index}]);
		$bp_obj->calc;
		$speed = float_prec($bp_obj->velocity*3.6, 1);
	    }
	}
	my %res = Ampelschaltung::get_lost($speed, $beschleunigung);
	$lost_time_per_ampel{X} = $res{-zeit}; # XXX F
	$lost_strecke_per_ampel = $res{-strecke};
	status_message(Mfmt("Einstellungen fr %s km/h: verlorene Zeit pro Ampel: %s s, verlorene Strecke pro Ampel: %d m", $speed, float_prec($lost_time_per_ampel{X}, 1), $lost_strecke_per_ampel), "info"); # XXX F
    }
}

sub now_time_hires { Tk::timeofday() }

# evtl. utimes benutzen
sub cache_decider_init { $cache_decider_time = now_time_hires() }

sub cache_decider {
    die "cache_decider on empty cache_decider_time scalar"
      if !defined $cache_decider_time;
    my $now = now_time_hires();
    my $r = ($now - $cache_decider_time > $min_cache_decider_time);
    if ($verbose && $r) {
	warn "Using cache (" . ($now - $cache_decider_time) . " s)!\n";
    }
    undef $cache_decider_time;
    $r;
}

### AutoLoad Sub
sub add_last_loaded {
    my($file, $last_loaded_obj, $add_def) = @_;
    $add_def = "" if !defined $add_def;
    eval {
	require File::Spec;
	$file = File::Spec->canonpath($file);
	$file = File::Spec->rel2abs($file);
    };
    my $max = $last_loaded_obj->{Max} || 4; # maximale Anzahl in @last_loaded
    my $i;
    for($i = 0; $i <= $#{ $last_loaded_obj->{List} }; $i++) {
	my($file_part) = $last_loaded_obj->{List}->[$i] =~ /^([^\t]*)/;
	if ($file_part eq $file) {
	    splice @{ $last_loaded_obj->{List} }, $i, 1;
	    $i--;
	}
    }
    unshift @{ $last_loaded_obj->{List} }, $file . $add_def;
    splice @{ $last_loaded_obj->{List} }, $max
	if @{ $last_loaded_obj->{List} } > $max;
    update_last_loaded_menu($last_loaded_obj);
    if ($os eq 'win') {
        require Win32Util;
        Win32Util::add_recent_doc($file);
    }
}

sub load_last_loaded {
    my $last_loaded_obj = shift;
    undef @{ $last_loaded_obj->{List} };
    if (open(LAST, $last_loaded_obj->{File})) {
	while(<LAST>) {
	    chomp;
	    s/\r//g; # DOS-Newlines entfernen (kann passieren!)
	    push @{ $last_loaded_obj->{List} }, $_;
	}
	close LAST;
	update_last_loaded_menu($last_loaded_obj);
    }
}

sub save_last_loaded {
    my $last_loaded_obj = shift;
    if (@{ $last_loaded_obj->{List} } && open(LAST, ">$last_loaded_obj->{File}")) {
	print LAST join("\n", @{ $last_loaded_obj->{List} }), "\n";
	close LAST;
    }
}

sub update_last_loaded_menu {
    my $last_loaded_obj = shift;
    my $last_loaded_menu = $last_loaded_obj->{Menu};
    return unless $last_loaded_menu;
    if (!Tk::Exists($last_loaded_menu)) {
	die "XXX Can't update last loaded menu $last_loaded_menu";
    }
    $last_loaded_menu->delete(0, 'end');
    if (!@{ $last_loaded_obj->{List} }) {
	$last_loaded_menu->command(-label => "Flaschen leer",# kein M
				   -state => 'disabled',
				   -font => $font{'bold'});
    } else {
	$last_loaded_menu->command(-label => $last_loaded_obj->{Title},
				   -state => 'disabled',
				   -font => $font{'bold'});
	foreach my $_file (@{ $last_loaded_obj->{List} }) {
	    my($file, @args) = split /\t/, $_file;
	    $last_loaded_menu->command(-label => $file,
				       -command => [$last_loaded_obj->{Cb}, $file, @args],
				      );
	}
    }
}

### AutoLoad Sub
sub fast_settings {
    foreach (keys %init_str_draw) {
	$init_str_draw{$_} = 0;
	$str_outline{$_} = 0;
    }
    foreach (keys %init_p_draw) {
	$init_p_draw{$_} = 0;
    }
    $show_grade = 0;
    $use_logo  = 0;
    undef $center_on_str;
    undef $center_on_coord;
    $init_choose_street = 0;
    $autosave_opts = 0; # besser ist's
    $do_activate_temp_blockings = 0;
}

sub set_mouse_desc {
    if ($special_edit eq 'radweg') {
	$mouse_text[1] = M"Radweg editieren";
	$mouse_text[2] = M"Letzte Aktion wiederholen";
	$mouse_text[3] = '';
    } elsif ($special_edit eq 'ampel') {
	$mouse_text[1] = M"Ampel editieren";
	$mouse_text[2] = $mouse_text[3] = '';
    } else {
	$mouse_text[1] = M"Punkt zur Route hinzufgen\nmit Alt oder Shift: Mauscursor muss sich nicht ber einer Strae befinden";
	my $label = $b2_mode_desc{$b2_mode};
	if (defined $label) {
	    $mouse_text[2] = $label;
	} else {
	    $mouse_text[2] = "???";
	}
	if ($right_is_popup) {
	    $mouse_text[3] = M"Popup-Men";
	} else {
	    $mouse_text[3] = M"Gesamte Route lschen";
	}
    }
}

# Create the fontset for bbbike. Use $std_font as default normal font,
# or, if not defined, use the system default (e.g. from the option
# database). The fontset is stored to the global hash %font.
# $top is the main window.
sub set_fonts {
    my $std_font = shift;
    # backward compatibility with Tk 402:
    if ($Tk::VERSION <= 402.004) {
	set_fonts_402();
    } else {
	# XXX check it under all platforms!
	my $get_std_font = sub {
	    my $std_font = $top->optionGet('font', 'Font');
	    if (!defined $std_font || $std_font eq '') {
		my $l = $top->Label;
		$std_font = $l->cget(-font);
		if ($^O eq 'MSWin32') {
		    # XXX Force usage of Arial, otherwise "MS Sans
		    # Serif" is used on my system which is not nicely
		    # scalable.
		    my(%std_font) = $l->fontActual($std_font);
		    $std_font = $top->fontCreate(-family => 'Arial',
						 -size => $std_font{-size});
		}
		$l->destroy;
	    }
	    $std_font;
	};

	my $font_from_user = 0; # true, if from options or set interactively
	my $font_size_from_user = 0;
	if (!defined $std_font || $std_font eq '') {
	    # $font_family, $font_size, $font_weight from cmdline
	    if (defined $font_family && $font_family ne "" && !$kde) {
		if (!defined $font_size) {
		    my $std_font = $get_std_font->();
		    $font_size = $top->fontActual($std_font, '-size');
		} else {
		    $font_size_from_user = 1;
		}
		$font_from_user = 1;
		my(%a) = (-family => $font_family);
		if (defined $font_size && $font_size =~ /^-?\d+$/) {
		    $a{-size} = $font_size;
		}
		if (defined $font_weight && $font_weight ne '') {
		    $a{-weight} = $font_weight;
		}
		eval {
		    $std_font = $top->fontCreate(%a);
		};
		if ($@) {
		    my $err = $@;
		    $std_font = "helvetica 10";
		    warn Mfmt("Fehler beim Definieren des Zeichensatzes:\n" .
			      "%s\n" .
			      "Fallback auf den Zeichensatz <%s>.\n",
			      $err, $std_font) .
			 wrap("", "",
			      Mfmt("Dieser Fehler kann mglicherweise durch Korrigieren der Eintrge <fontfamily> und <fontheight> in <%s> oder <*font> in <~/.Xdefaults> behoben werden.",
				   catfile($bbbike_configdir, "config"))) .
			 "\n";
		}
		$top->optionAdd('*font' => $std_font, 'userDefault');
	    } else {
		$std_font = $get_std_font->();
	    }
	} else {
	    $font_from_user = $font_size_from_user = 1;
	}

	if ($std_font) {
	    $font{'normal'} = $top->fontCreate($top->fontActual($std_font));
	} else {
	    $font{'normal'} = $top->fontCreate;
	}

        my %normal_attr = $top->fontActual($font{'normal'});

        my $pt = $normal_attr{'-size'}; # points or pixels depending on Tk ver
	my $win_width = @want_extends ? $want_extends[GEOMETRY_WIDTH] : $top->width;
	if ($win_width <= 800 && abs($pt) >= 10 && !$font_size_from_user) {
## XXX This is evil: because the fontsize will be from time to time smaller
## if the use resizes below the limits and then above the limits.
## On the other side, this will result in too big fonts on small
## displays. Solution?
	    if ($win_width <= 320) {
		$pt = $pt*8/14;
	    } elsif ($win_width <= 640) {
 		$pt = $pt*10/14;
 	    } else {
 		$pt = $pt*12/14;
 	    }
 	    $top->fontConfigure($font{'normal'}, -size => sprintf("%.f", $pt));
 	    $top->optionAdd('*font' => $font{'normal'}, 'userDefault');
	}
	if ($os eq 'win') {
	    $top->optionAdd('*font' => $font{'normal'}, 'userDefault');
	}

	foreach (qw(veryhuge huge verylarge large bold
		    reduced small tiny fixed standard fix15)) {
	    $font{$_} = $top->fontCreate($top->fontActual($font{'normal'}));
	}

	my $minfs = sub {
	    my $fs = shift;
	    $fs = 6 if (abs($fs) < 6);
	    $fs;
	};

	$top->fontConfigure($font{'bold'},
			    -size => sprintf("%.f", $minfs->($pt)),
			    -weight => 'bold');
	$top->fontConfigure($font{'fix15'},
			    -size => ($small_icons ? -8 : -15));
	$top->fontConfigure($font{'tiny'},
			    -size => sprintf("%.f", $minfs->($pt*8/14)));
	$top->fontConfigure($font{'small'},
			    -size => sprintf("%.f", $minfs->($pt*10/14)));
	$top->fontConfigure($font{'reduced'},
			    -size => sprintf("%.f", $minfs->($pt*12/14)));
	$top->fontConfigure($font{'large'},
			    -size => sprintf("%.f", $minfs->($pt*18/14)));
	$top->fontConfigure($font{'verylarge'},
			    -size => sprintf("%.f", $minfs->($pt*24/14)));
	$top->fontConfigure($font{'huge'},
			    -size => sprintf("%.f", $minfs->($pt*28/14)));
	$top->fontConfigure($font{'veryhuge'},
			    -size => sprintf("%.f", $minfs->($pt*36/14)));
	$top->fontConfigure($font{'standard'},
			    -size => $standard_height,
			    -slant => 'roman',
			    -underline => 0,
			    -overstrike => 0);
	if (abs($pt) >= 8) {
	    $font{'fixed'}
		= sprintf("-*-$fixed_font_family-medium-r-normal--*-%d-*-*-m-*-iso8859-1", $pt*10);
	} else {
	    $font{'fixed'} = "5x7"; # XXX really necessary?
	}

	my %min_sizes =
	    ('helvetica'	       => [10,8],
	     'times'		       => [12,10],
	     'lucida'		       => [9,8],
	     'new century schoolbook'  => [9,8],
	     'fixed'		       => [7,7],
	    );

	# Resize if necessary, to prevent fonts from being too small.
	# This is from looking at readable fonts under the iPAQ. I found
	# that Lucida can produce the smallest readable fonts.
	while(my($k,$v) = each %font) {
	    next if $k eq 'fixed'; # This is not a named font, so ignore this.
	    my $family = $top->fontActual($v, '-family');
	    my $minsize = $min_sizes{$family};
	    $minsize = [10,8] if !defined $minsize;
	    if ($top->fontMetrics($v, "-linespace") < $minsize->[0]) {
		$top->fontConfigure($v, -size => -$minsize->[1]);
	    }
	}
    }

    @font = ();
    foreach (qw(tiny small reduced normal large verylarge huge veryhuge)) {
	push @font, $_;
    }
}

# Setzt Bild, falls vorhanden, andernfalls ein Label
sub image_or_text {
    my($image, $text) = @_;
    if (defined $image) {
	(-image => $image);
    } else {
	(-text => $text);
    }
}

# Doc?
### AutoLoad Sub
sub image_from_file {
    my($top, $file, %args) = @_;
    my $mimetype  = $args{'-mimetype'};
    my $colormode = $args{'-colormode'} || 'color';

    if ($file =~ /\.jpe?g$/i ||
	(defined $args{-mimetype} and $args{-mimetype} eq 'image/jpeg')) {
	eval { require Tk::JPEG };
	if ($@) {
	    return if !perlmod_install_advice('Tk::JPEG');
	}
    } elsif ($file =~ /\.png$/i ||
	     (defined $args{-mimetype} and $args{-mimetype} eq 'image/png')) {
	eval { require Tk::PNG };
	if ($@) {
	    return if !perlmod_install_advice('Tk::PNG');
	}
    }

    if ($colormode eq 'mono') {
	$top->Bitmap(-file => $file);
    } elsif ($colormode eq 'pixmap') {
	$top->Pixmap(-file => $file);
    } elsif ($colormode eq 'gray') {
	$top->Photo(-file => $file, -palette => 8);
    } else {
	$top->Photo(-file => $file);
    }
}

# Ldt ein Bild.
sub load_photo {
    my($top, $file, %args) = @_;
    return $photo{$file} if exists $photo{$file};
    my $photo;
    unless ($lowmem) {
	eval {
	    my @name = exists $args{-name} ? ($args{-name}) : ();
	    if ($file =~ /.xpm$/ && !$small_icons) {
		$photo = $top->Pixmap(@name, -file => Tk::findINC($file));
	    } else {
		$photo = $top->Photo(@name, -file => Tk::findINC($file));
	    }
	    if ($small_icons && $photo) {
		# XXX setting of @name missing
		my $small_photo = $top->Photo(-width => $photo->width/2,
					      -height => $photo->height/2);
		$small_photo->copy($photo, -subsample => 2, 2);
		$photo->delete;
		$photo = $small_photo;
	    }
	};warn $@ if $@;
    }
    if ($args{-persistent}) {
	$photo{$file} = $photo;
    }
    $photo;
}

sub load_cursor {
    my($def) = @_;
    return if $Tk::platform eq 'MSWin32'; # no support for custom cursors yet
    my $key = my $lang_def = $def;
    if ($def eq 'ziel') {
	$lang_def = M($def);
    }
    my $base = $lang_def . '_ptr.xbm';
    my $xbm = Tk::findINC($base);
    if (!defined $xbm) {
	warn Mfmt("Die Datei <%s> existiert nicht.", $base);
    } elsif (-r $xbm) {
	my $mask = Tk::findINC($lang_def . '_ptr_mask.xbm');
	if (-r $mask) {
	    $cursor{$key}      = $xbm;
	    $cursor_mask{$key} = $mask;
	}
    }
}

# do a correct isa call on scrolled widgets
sub subw_isa {
    my($w, $isa) = @_;
    if ($w->Subwidget('scrolled')) {
	$w = $w->Subwidget('scrolled');
    }
    $w->isa($isa);
}

# Callback bei einem Drop-Vorgang.
# Die Datei wird per load_save_route() geladen.
### AutoLoad Sub
sub accept_drop {
    my($c, $seln) = @_;
    my $filename;
    my @targ = $c->SelectionGet('-selection'=>$seln,'TARGETS');
    foreach (@targ) {
	if (/FILE_NAME/) {
	    $filename = $c->SelectionGet('-selection'=>$seln,'FILE_NAME');
	    last;
	}
	if ($os eq 'win' && /STRING/) {
	    $filename = $c->SelectionGet('-selection'=>$seln,$_);
	    last;
	}
    }
    if (defined $filename) {
	if ($filename =~ /\.bbd/i) {
	    plot_layer('str', $filename);
	} else {
	    load_save_route(0, $filename);
	}
    }
}


# Return the start and goal streets of the current route
### AutoLoad Sub
sub get_route_description {
    my $text = "";
    my @search_route = @{ get_act_search_route() };
    if (@search_route) {
	$text = $search_route[0][StrassenNetz::ROUTE_NAME] . " - " . $search_route[-1][StrassenNetz::ROUTE_NAME];
    }
    $text;
}

# Return the approximated center of the polyline.
# Coordinates of the polygon are supplied in @koord (flat list of x and y
# values).
### AutoLoad Sub
sub get_polyline_center {
    my(@koord) = @_;
    my $len = 0;
    for(my $i=2; $i<$#koord; $i+=2) {
	$len += Strassen::Util::strecke([@koord[$i-2,$i-1]],
					[@koord[$i,  $i+1]]);
    }
    my $len0 = 0;
    for(my $i=2; $i<$#koord; $i+=2) {
	$len0 += Strassen::Util::strecke([@koord[$i-2,$i-1]],
					 [@koord[$i,  $i+1]]);
	if ($len0 > $len/2) {
	    # XXX ungenau, besser machen!
	    return (($koord[$i-2]-$koord[$i])/2+$koord[$i],
		    ($koord[$i-1]-$koord[$i+1])/2+$koord[$i+1]);
	}
    }
    warn "Fallback for get_polyline_center, should not happen. Coords are @koord";
    (($koord[2]-$koord[0])/2+$koord[0],
     ($koord[3]-$koord[1])/2+$koord[1]);
}

### AutoLoad Sub
sub get_bbox_area {
    my($item) = @_;
    my(@bbox) = $c->bbox($item);
    abs(($bbox[2]-$bbox[0]) * ($bbox[3]-$bbox[1]));
}

# Erzeugt eine Backupdatei
### AutoLoad Sub
sub make_backup {
    my $file = shift;
    if (-e $file) {
	if (-f $file) {
	    my $backup = "$file~";
	    rename $file, $backup;
	} else {
	    status_message(Mfmt("%s ist keine gltige Datei, kein Backup.",
				$file),
			   'err');
	}
    }
}

use your qw($StrassenNetz::VERBOSE $Strassen::VERBOSE $wettermeldung2::VERBOSE
	    $Tk::SRTProgress::VERBOSE $Fahrinfo::VERBOSE
	    $Telefonbuch::VERBOSE $GfxConvert::VERBOSE $Hooks::VERBOSE
	    $FURadar::VERBOSE);

# Setzt die VERBOSE-Variable in den geladenen Modulen
### AutoLoad Sub
sub set_verbose {
    Strassen::set_verbose($verbose);
    $wettermeldung2::VERBOSE  = $verbose;
    $Tk::SRTProgress::VERBOSE = $verbose;
    $Fahrinfo::VERBOSE        = $verbose;
    $Telefonbuch::VERBOSE     = $verbose;
    $GfxConvert::VERBOSE      = $verbose;
    $Hooks::VERBOSE           = $verbose;
    $FURadar::VERBOSE         = $verbose;
    $PLZ::VERBOSE             = $verbose;
}

# crops the array in $want_extends to the limits in $extends
sub crop_geometry {
    my($want_extends, $extends) = @_;

    # right/bottom limits
    my $x = $want_extends->[GEOMETRY_X] =~ /^-/ ?
	$top->screenwidth - $want_extends->[GEOMETRY_WIDTH] + $want_extends->[GEOMETRY_X] :
	    $want_extends->[GEOMETRY_X];
    my $y = $want_extends->[GEOMETRY_Y] =~ /^-/ ?
	$top->screenheight - $want_extends->[GEOMETRY_HEIGHT] + $want_extends->[GEOMETRY_Y] :
	    $want_extends->[GEOMETRY_Y];
    my($maxx) = $want_extends->[GEOMETRY_WIDTH] + $x;
    my($maxy) = $want_extends->[GEOMETRY_HEIGHT] + $y;

    if ($x < $extends->[GEOMETRY_X]) {
	$want_extends->[GEOMETRY_X] = $extends->[GEOMETRY_X];
    }
    if ($y < $extends->[GEOMETRY_Y]) {
	$want_extends->[GEOMETRY_Y] = $extends->[GEOMETRY_Y];
    }
    if ($x + $want_extends->[GEOMETRY_WIDTH] > $extends->[GEOMETRY_WIDTH]) {
	$want_extends->[GEOMETRY_WIDTH] = $extends->[GEOMETRY_WIDTH] - $x;
    }
    if ($y + $want_extends->[GEOMETRY_HEIGHT] > $extends->[GEOMETRY_HEIGHT]) {
	$want_extends->[GEOMETRY_HEIGHT] = $extends->[GEOMETRY_HEIGHT] - $y;
    }
}

sub parse_geometry_string {
    my $geometry = shift;
    my @extends = (0, 0, 0, 0);
    if ($geometry =~ /([-+]?\d+)x([-+]?\d+)/) {
	$extends[GEOMETRY_WIDTH] = $1;
	$extends[GEOMETRY_HEIGHT] = $2;
    }
    if ($geometry =~ /([-+]\d+)([-+]\d+)/) {
	$extends[GEOMETRY_X] = $1;
	$extends[GEOMETRY_Y] = $2;
    }
    @extends;
}

# Alternative way to set geometry.
sub geometry {
    my($t, @extends) = @_;
    my $geometry = "$extends[GEOMETRY_WIDTH]x$extends[GEOMETRY_HEIGHT]";
    $extends[GEOMETRY_X] = "+$extends[GEOMETRY_X]" if $extends[GEOMETRY_X] !~ /^[+-]/;
    $extends[GEOMETRY_Y] = "+$extends[GEOMETRY_Y]" if $extends[GEOMETRY_Y] !~ /^[+-]/;
    $geometry .= $extends[GEOMETRY_X] . $extends[GEOMETRY_Y];
    $t->geometry($geometry);
}

sub fix_geometry {
    my $geom_string = shift || $top->geometry;
    my(@extends) = parse_geometry_string($geom_string);
    $extends[GEOMETRY_HEIGHT] += ($top->wrapper)[1];
    if ($^O eq 'MSWin32') {
        # This seems to be necessary at least on a Win98 machine
        # or maybe only on systems where wrapper[1] returns 0?
        # 20 should probably be replaced by the value of $SM_CYCAPTION, see Win32Util (19 on this system)
        $extends[GEOMETRY_HEIGHT] += 20; # get titlebar height (?) by API functions XXX
    }
    "$extends[GEOMETRY_WIDTH]x$extends[GEOMETRY_HEIGHT]" .
	"+$extends[GEOMETRY_X]+$extends[GEOMETRY_Y]"
}

# check if the toplevel is too large and resize, if appropriate
sub toplevel_checker {
    my($t) = @_;
    $t->update;
    my($sw,$sh) = ($t->screenwidth, $t->screenheight);
    my($x,$y,$w,$h) = ($t->x, $t->y, $t->width, $t->height);
    $w = $sw if ($w > $sw);
    $h = $sh if ($h > $sh);
    $x = 0 if ($x+$w > $sw || $x < 0);
    $y = 0 if ($y+$h > $sh || $y < 0);
    $t->geometry($w."x".$h."+$x+$y");
}

sub get_polar_location_of_route_end {
    return undef if !@realcoords;
    require Karte::Polar;
    my($px,$py) = $Karte::Polar::obj->standard2map(@{ $realcoords[-1] });
    "$px,$py";
}

sub my_popup {
    my $t = shift;
    $t->withdraw;
    $t->Popup(@popup_style);
}

sub optedit {
    my(%args) = @_;
    my $opt_edit = $top->{GetoptEditor};
    if (Tk::Exists($opt_edit)) {
	$opt_edit->raise;
	if ($args{-page}) {
	    $opt->raise_page($args{-page});
	}
	return;
    }
    $opt_edit =	$opt->option_editor
	($top,
	 ($transient ? (-transient => $top) : ()),
	 (!defined $ENV{LANG} || $ENV{LANG} =~ /^de/ ?
	  (-string => {optedit => "Optionseditor",
		       undo => "Undo",
		       lastsaved => "Zuletzt gespeichert",
		       save => "Speichern",
		       defaults => "Voreinstellungen",
		       ok => "Ok",
		       oksave => "Ok",
		       apply => "Anwenden",
		       cancel => "Abbrechen",
		       helpfor => "Hilfe fr",
		      }
	  ) : ()),
	 -buttons => ['oksave',
		      #'defaults', # XXX defaults or not defaults???
		      #could be misleading, users might think that the
		      #defaults just apply to the displayed page
		      'cancel'],
	 %args, # e.g. -page
	);
    $top->{GetoptEditor} = $opt_edit;
}

sub export_visible_map {
    my($fmt, $outfile) = @_;

    if (!defined $outfile) {
	$outfile = $top->getSaveFile
	    (-defaultextension => ".$fmt",
	     -title => Mfmt('%s-Datei sichern', uc($fmt)),
	     -initialdir => $save2_path);
    }
    return if !defined $outfile;
    $save2_path = dirname $outfile;

    $top->raise;
    $top->update;

    IncBusy($top);
    eval {
	my $in_fmt;
	my $tmpfile;
	my $bgcolor = sprintf('#%02x%02x%02x', map { $_/256 } $c->rgb($c->cget(-background)));
	my $NNcolor = sprintf('#%02x%02x%02x', map { $_/256 } $c->rgb($category_color{N}));
	my %args =
	    (-mapcolor =>
	     {# Swap colors to avoid non-white background
	      $bgcolor => '#ffffff',
	      $NNcolor => $bgcolor,
	     },
	     -res => $ps_image_res,
	     -autocrop => 1,
	    );

	my $post_processing_needed = 1;

	require BBBikePrint; # for using_rotated_fonts
	if ((using_rotated_fonts() || 
	     $use_xwd_if_possible
	    ) and
	    $Tk::platform eq 'unix'
	    and
	    is_in_path("xwd")
	   ) {

	    $args{-rotate} = -90 if $orientation eq 'portrait';

	    $in_fmt = "xwd";
	    if ($fmt ne 'xwd') {
		require GfxConvert;
		GfxConvert::check($in_fmt, $fmt, $tmpfile, $outfile, %args);
	    } else {
		$post_processing_needed = 0;
	    }

	    $tmpfile = "/tmp/bbbike.$$.xwd";
	    $tmpfiles{$tmpfile}++;

	    my $deiconify_subs = withdraw_toplevels();
	    $top->raise;
	    $top->update;
	    system("xwd", "-out", "$tmpfile", "-id", $c->id);
	    $_->() for (@$deiconify_subs);
	    $top->bell;

	} else {

	    $args{-rotate} = -90 if $orientation eq 'landscape';
	    $in_fmt = "ps";

	    if ($fmt ne 'ps') {
		require GfxConvert;
		GfxConvert::check($in_fmt, $fmt, $tmpfile, $outfile, %args);
	    } else {
		$post_processing_needed = 0;
	    }

	    die M"Der Export wurde unterbrochen."
		if slow_postscript_generation();

	    $tmpfile = create_postscript($c,
					 -colormode => 'color',
					 -rotate => 1,
					 -scale_a4 => 0,
					);
	    if (!defined $tmpfile) {
		die M"Temporre Postscript-Datei kann nicht erstellt werden.";
	    }
	}

	if (!$post_processing_needed) {
	    mv($tmpfile, $outfile);
	} else {
	    require GfxConvert;
	    # -mapcolor wandelt die Farbe der Nebenstraen
	    # (tk: grey99/ps: 0.9 0.9 0.9) nach wei um und setzt die
	    # Hintergrundfarbe von wei auf die Hintergrundfarbe des
	    # Canvases
	    GfxConvert::convert
		    ($in_fmt, $fmt, $tmpfile, $outfile,
		     %args,
		    );
	    $tmpfiles{$tmpfile}++;
	}
    };
    my $err = $@;
    DecBusy($top);
    if ($err) {
	status_message($err, 'err');
    }
}

sub slow_postscript_generation {
    return $os eq 'win' &&
	$top->messageBox(-icon => "question",
			 -message => M"Die PostScript-Erzeugung ist unter Windows langsam. Soll trotzdem fortgesetzt werden?",
			 -type => "YesNo") !~ /yes/i;
}

sub start_process {
    my($token, $gather_command, $action_command) = @_;
    if (defined $processes{$token}) {
	status_message(M("Der Prozess $token luft noch (PID $processes{$token}) XXX"), "die");
	# XXX Abschiessen blabla
    }
    if (!$Config{d_fork}) {
	status_message(M("fork ist nicht verfuegbar XXX"), "die");
    }
    require Symbol;
    my $rdr = Symbol::gensym();
    my $wtr = Symbol::gensym();
    pipe($rdr, $wtr);
    my $pid = fork;
    if (!defined $pid) {
	status_message(M("Der Process konnte nicht gestartet werden."), "die");
    }
    if ($pid == 0) {
	# child
	close $rdr;
warn "gather command";
	my $result = $gather_command->();
warn "print result $result to $wtr";
#	select $wtr; $| = 1;
	print $wtr $result;
warn "printed";
	close $wtr;
warn "closed";
	sleep 99999;
	CORE::exit(0);
    }
    close $wtr;
    $processes{$token} = $pid;
    $top->fileevent($rdr, "readable", sub {
warn "readable";
			local $/ = undef;
			my $result = <$rdr>;
warn "got $result";
			close $rdr;
			$processes{$token} = undef;
warn "do action";
			$action_command->($result)
			    if $action_command;
		    });
}

sub get_strassen_file {
    my $file = shift;
    $file . ($edit_mode_flag ? "-orig" : "");
}

sub get_strassen_obj {
    my $file = shift;
    my $object;
    if ($edit_mode_flag) {
	$object = eval { Strassen->new(get_strassen_file($file)) };
    }
    if (!$object) {
	$object = Strassen->new($file); # fallback to non-orig file, if necessary
    }
    $object;
}

sub get_any_strassen_obj {
    my($linetype, $type) = @_;
    my $object;
    if ($linetype =~ /^s/) {
	if ($type eq 'w') {
	    $object = _get_wasser_obj(get_strassen_file($str_file{$type}));
	} elsif ($type eq 'l') {
	    $object = _get_landstr_obj();
	} elsif ($type eq 'comm') {
	    $object = _get_comments_obj();
	} else {
	    $object = get_strassen_obj($str_file{$type});
	}
    } else {
	$object = get_strassen_obj($p_file{$type});
    }
    $object;
}

sub handle_global_directives {
    my($s_or_file, $abk) = @_;
    my $glob_dir;
    if (!ref $s_or_file) {
	$glob_dir = Strassen->get_global_directives($s_or_file);
    } else {
	$glob_dir = $s_or_file->get_global_directives;
    }
    return if !$glob_dir;
    my %accept_global_hash_directives = map{($_,1)}
	qw(line_width line_length line_arrow
	   str_color outline_color
	   category_size category_color category_width category_image
	   category_stipple);
    my %accept_global_hashref_directives = map{($_,1)}
	qw(str_attrib p_attrib);
    # XXX scrollregion
    while(my($directive, $vals) = each %$glob_dir) {
	my($key, $val) = $directive =~ /^([^\.]+)\.([^\.]+)/;
	next if !defined $key;
	if ($accept_global_hash_directives{$key}) {
	    no strict 'refs';
	    ${$key}{$val} = $vals->[0];
	} elsif ($accept_global_hashref_directives{$key}) {
	    no strict 'refs';
	    ${$key}->{$val} = $vals->[0];
	}
    }
}

sub withdraw_tearoff_menus {
    my($toplevel) = @_;
    my @deiconify_subs;
    for my $w ($toplevel->children) {
	if (Tk::Exists($w) && $w->isa("Tk::Menu") && $w->state eq 'normal') {
	    $w->withdraw;
	    push @deiconify_subs, sub { $w->deiconify if Tk::Exists($w) };
	}
    }
    @deiconify_subs;
}

sub withdraw_toplevels {
    my $deiconify_subs = [ withdraw_tearoff_menus($top) ];
    $top->Walk
	(sub {
	     my($w) = @_;
	     if (Tk::Exists($w) && $w->isa("Tk::Toplevel") &&
		 $w->state eq 'normal') {
		 $w->withdraw;
		 push @$deiconify_subs, sub { $w->deiconify if Tk::Exists($w) };
		 push @$deiconify_subs, withdraw_tearoff_menus($w);
	     }
	 });
    $deiconify_subs;
}

sub set_as_toolwindow {
    my($win, $parent) = @_;
    if ($transient) {
        if (0 && $Tk::platform eq 'MSWin32' && $Tk::VERSION >= 804) {
	    # XXX using -topmost seems to be mandatory, but is ugly,
	    # because the window is also topmost to other apps
	    $win->attributes(-toolwindow => 1, -topmost => 1);
        } else {
	    $parent = $top if !$parent;
	    $win->transient($parent);
        }
    }
}

## DEBUG_BEGIN
#BEGIN{mymstat("100% BEGIN");}
## DEBUG_END

package bbbike; # HACK for autosplit
