xref: /dports/german/BBBike/BBBike-3.18/bbbike

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

#
# Author: Slaven Rezic
#
# Copyright (c) 1995-2012 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;

## Additional files for perl2exe.
## NOTE: This list is not maintained anymore.
#perl2exe_include Tk/Checkbutton.pm

## This works theoretically with 5.8.x, but there's a possible
## endless loop which is solved in 5.10.0, see rt perl #41442
## XXX Nope: still an endless loop with debian's perl 5.10.0
## To reproduce: start bbbike, and add landstra�en layer
#if ($] >= 5.010 || $] >= 5.008009) {
#    eval q{ use open ':locale' }; if ($] >= 5.008 && $@) { warn $@ }
#}

BEGIN {
    if ($Devel::Trace::TRACE) {
	$Devel::Trace::TRACE = 0;
	warn <<EOF;
**********************************************************************
* NOTE: Turning -d:Trace off
*       You can turn it again on in the ptksh using
*
*         \$Devel::Trace::TRACE = 1;
*
**********************************************************************
EOF
    }
}

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;
    # save cmdline arguments; Tk::ProgressSplash would eat
    # X11-specific options (maybe a bug there?)
    my @save_ARGV = @ARGV; @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 = 'normal';
	    # $splashtype = 'fast'; not used anymore: too unstable,
	    # fails with MSWin32, failures also seen on Linux x86_64
	    # systems.
	    $splash_screen = Tk::ProgressSplash->Show
		(-splashtype => $splashtype,
		 "$FindBin::RealBin/images/bbbike_splash.xpm",
		 240, 90, "BBBike", 1);
	}; warn $@ if $@;
    }
    @ARGV = @save_ARGV;
    if ($nosplash) { $use_logo = 0 }

    local $^W;
    $^W = 0 if $^O eq 'MSWin32'; # to avoid "no such signal" warnings

    {
	use vars qw(@SIGTRAP_SIGNALS);
	@SIGTRAP_SIGNALS = qw(USR1 INFO);
	# Activate with CTRL-T on BSD systems. Possibly dangerous if forked
	# processes are active, but works fine with -server option.
	my $siginfo_handler = sub {
	    # Cannot use warn or STDERR because of Tk::Stderr interference
	    require Carp;
	    local $| = 1;
	    print Carp::longmess("Pid $$ currently"), "\n";
	};
	$SIG{$_} = $siginfo_handler for @SIGTRAP_SIGNALS;
    }
    ## Does not play well with Tk::Stderr, so do not use it anymore
    #eval 'use sigtrap ("stack-trace", @SIGTRAP_SIGNALS)'; warn $@ if $@;

    ## Not a good idea: setting this means that $? is always -1
    #$SIG{CHLD} = 'IGNORE';

    $booting = 1;
}

use Config;

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

use BBBikeGlobalVars 1.012;

# 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
BEGIN {
    %autouse_func =
	('BBBikeMail'	=> [qw(enter_send_mail)],
	 'Text::Wrap'	=> [qw(wrap)],
	 'File::Copy'	=> [qw(copy mv)],
	 'BBBikeGPS'
	 => [qw(gps_interface draw_gpsman_data do_draw_gpsman_data)],
	 'BBBikeWeather'
	 => [qw(wetter_dir_exists ignore_weather reset_wind update_weather
		show_weather_db parse_wetterline analyze_wind)],
	 'BBBikeHeavy'
	 => [qw(start_followmouse stop_followmouse
		string_eval_die load_plugins load_plugin layer_editor
		getmap get_file_or_url get_user_agent get_uncached_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 make_temp make_unique_temp
		save_route_as_gpx save_route_as_kml
		restart_bbbike_hint
	      )],
	 #XXX problems with autouse! -> what problems?
	 'BBBikeEdit'
	 => [qw(insert_point_from_canvas create_relation_from_canvas
		ampeln_on_route radweg_open radweg_draw_canvas
	       )],
	 '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)],
	 'BBBikePrint'
	 => [qw(create_postscript print_postscript toggle_legend
		print_text_postscript print_text_pdflatex print_route_pdf
		view_pdf print_text_windows)],
	);
    while(my($k,$v) = each %autouse_func) {
	eval "use autouse $k => qw(" . join(" ", @$v) . ");";
	die "Can't autouse $k: $@" if $@;
    }
}

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

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

BEGIN {
    eval q{ use Tk; };
    if ($@) {
	if ($^C) {
	    die $@;
	} else {
	    warn $@;
	    if ($^O eq 'MSWin32' || -t STDIN) {
		warn "Please enter RETURN to exit.\n";
		<STDIN>;
	    }
	    CORE::exit(1);
	}
    }
}

# Add ...\c\bin directory for Strawberry Perl on Windows.
# This directory contains shared libraries e.g. libxml2.
# Also the ...\perl\bin may be missing.
if ($^O eq 'MSWin32' && $^X =~ m{(.*)(\\perl\\bin)\\}) {
    my $c_bin_dir = "$1\\c\\bin";
    my $perl_bin_dir = "$1$2";
    if (-d $c_bin_dir) {
	$ENV{PATH} .= ";$c_bin_dir";
    }
    if (-d $perl_bin_dir) {
	$ENV{PATH} .= ";$perl_bin_dir";
    }
}

#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 first clone s2hm_or_s);
use BBBikeTkUtil qw(pack_buttonframe);
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 offset_line);
## 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, @_) }';
    }
}

# XXX This is a hack until I decide how to do custom create_page best.
{
    package My::Tk::Getopt;
    use vars qw(@ISA);
    @ISA = ('Tk::Getopt');

    BEGIN { *M = \&main::M }

    sub _create_page {
	my $self = shift;
	my $current_top  = $_[2];
	if ($current_top eq lc(M("Strecken/Punkte"))) {
	    my $current_page = $_[0];
	    my $optnote      = $_[1];
	    $current_page = $optnote->{$current_top} if !defined $current_page;
	    my $optlist      = $_[3];

	    my %opt2opt;
	    for my $optdef (@{$optlist->{$current_top}}) {
		$opt2opt{$optdef->[0]} = $optdef;
	    }
	    #use Hash::Util qw(lock_keys); lock_keys %opt2opt;

	    $current_page->Label(
				 -text => M"Strecken und Punkte, die beim Start von BBBike\ngezeichnet werden sollen.",
				 -justify => 'left',
				)->pack(-anchor => 'w');
	    my $f = $current_page->Frame->pack(-anchor => 'w');
	    Tk::grid('x',
		     $f->Label(-text => "Berlin"), # XXX not for osm-data, there should be only one column here!
		     $f->Label(-text => M"Umland"),
		     $f->Label(-text => M"jwd"),
		    );
	    Tk::grid($f->Label(-text => M"Stra�en"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'str'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'landstr'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'landstrjwd'})),
	    );
	    Tk::grid($f->Label(-text => M("Orte")."/".M("Ortsteile")),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'ortsteil'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'ort'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'ortjwd'})),
		    );
	    Tk::grid($f->Label(-text => M"Gew�sser"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'wasserstadt'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'wasserumland'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'wasserjwd'})),
		    );

	    require Tk::Ruler;
	    $f->Ruler(-padx => 2)->rulerGrid(-columnspan => 4);

	    Tk::grid($f->Label(-text => M"Radwege"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'cyclepath'})), '-', '-');
	    Tk::grid($f->Label(-text => M"Radrouten"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'cycleroute'})), '-', '-');
	    Tk::grid($f->Label(-text => M"Gr�ne Wege"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'greenway'})), '-', '-');
	    Tk::grid($f->Label(-text => M("Ampeln")."/".M("Bahn�berg�nge")),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'ampel'})), '-', '-');
	    Tk::grid($f->Label(-text => M"F�hren"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'faehre'})), '-', '-');
	    Tk::grid($f->Label(-text => M"Fl�chen"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'flaeche'})), '-', '-');
	    Tk::grid($f->Label(-text => M"Sehensw�rdigkeiten"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'sehenswuerdigkeiten'})), '-', '-');
	    Tk::grid($f->Label(-text => M"Fragezeichen"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'fragezeichen'})), '-', '-');

	    $f->Ruler(-padx => 2)->rulerGrid(-columnspan => 4);

	    Tk::grid('x',
		     $f->Label(-text => M"Linien"),
		     $f->Label(-text => M"Bahnh�fe"),
		    );
	    Tk::grid($f->Label(-text => M"U-Bahn"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'ubahn'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'ubahnhof'})),
		    );
	    Tk::grid($f->Label(-text => M"S-Bahn"),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'sbahn'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'sbahnhof'})),
		    );
	    Tk::grid($f->Label(-text => M"Regionalbahn"), #XXX translation is missing
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'rbahn'})),
		     $f->Checkbutton(-variable => $self->varref($opt2opt{'rbahnhof'})),
		    );
	} else {
	    $self->SUPER::_create_page(@_);
	}
    }
}

## 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::loc %wettermeldung2::www_site
	    $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
	    $Tk::Config::xlib
	   );

*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

# BBBikeXS functions are optional, as there are pure-perl replacements
eval 'use BBBikeXS 0.09';

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

# $VERSION is the version of the BBBike distribution
$VERSION = $BBBike::VERSION;
# Since the migration to git $PROG_REVISION is meaningless. Previously
# it was constructed from the RCS version of this file.
$PROG_REVISION = '3.500';

# OS related
$progname = basename($0);
# Note that $ENV{HOST} is not generally available (or sometimes only
# as a shell variable with the same name), especially in my non-tcsh
# configurations.
$devel_host = ($ENV{HOST} && $ENV{HOST} =~ /^(biokovo|biokovo-amd64|mosor|vran|cabulja|cvrsnica|spiff|mom|devpc01|devpc01-debian)(\.|$)/i);
$os =   $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos' ? 'win'
      : $^O eq 'MacOS'				    	 ? 'mac'
      : 						   'unix';
$os_bsd = $^O =~ /bsd/i;

$^W = $devel_host; # $advanced also sets $^W, see below

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 < 800) {
    print STDERR Mfmt("Die Tk-Version ist veraltet (%s). M�glicherweise ist
BBBike trotzdem benutzbar. Empfohlen wird ein Upgrade auf Version 804.027 oder
besser.\n", $Tk::VERSION);
}

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

if ($os eq 'unix' && $Tk::VERSION >= 804.027001) {
    require Tk::MsgBox;
    import Tk::MsgBox 'as_default';
}

# OS compat
if ($os eq 'win') {
    require Win32Util;
} elsif ($^O eq 'darwin') {
    require MacOSXUtil;
}

my $terminal_encoding;
if ($os eq 'win') {
    require WinCompat;
    # XXX This encoding is maybe valid for Win98 (some?) command.com, what about other Windows?
    # XXX Unfortunately using encoding on STDERR
    # creates a segfault with ActivePerl Build 811 + Win98, so it's disabled...
    #$terminal_encoding = "cp850";
} else {
    local $^W = undef;
    if ("$ENV{LANG}$ENV{LC_ALL}" =~ /utf-?8/i) {
	$terminal_encoding = "utf8";
    }
}
if ($terminal_encoding && $] >= 5.008) {
    eval '
	binmode STDOUT, ":encoding($terminal_encoding)";
	binmode STDERR, ":encoding($terminal_encoding)";
    '; warn $@ if $@;
}

# enable DnD
use Tk::DropSite;

# 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 f�r den Edit-Mode XXX remove?
$medium_scale_edit = 0.02;
set_canvas_scale(DEFAULT_SCALE); # sets $scale
Karte::preload('Standard');
my $init_scale_massstab; # in 1:x form
$bbbike_route_ext = 'bbr';
$map_bg = 'grey85';
use vars qw($balloon_info_from_all_tags_closeenough);
$balloon_info_from_all_tags_closeenough = 3; # was 5, then 4

# Var section: street and point attributes
$init_str_draw{'s'} = 1;      # draw streets by default
for (qw(s l r b u w f v e z g gP gD gBO sBAB fz wr)) { $p_sub_draw{"pp-$_"} = 1} # this list should cover most keys of %str_file (but not the dependent ones like "comm" or "qs")
$init_p_draw{'lsa'} = 1;
$p_far_away{'o'} = 0;
$str_restrict{'s'}  = {qw(BAB 0 B 1 HH 1 H 1 NH 1 N 1 NN 1 Pl 0 Br 0)}; # Pl = places, Br = bridges
# NOTE: This is misused for getting all valid RBahn categories:
$str_restrict{'r'}  = {qw(RA 1 RB 1 RC 1 R 1 R0 0 RBau 0 RG 1 RP 0)};
$str_restrict{'b'}  = {qw(S 1 SA 1 SB 1 SC 1 S0 0 SBau 0 SBetrieb 0)};
$str_restrict{'u'}  = {qw(U 1 UA 1 UB 1 U0 0 UBau 0 UBetrieb 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?
# Should maybe go to Strassen::Cat?
$tunnel_qr = qr{^_?Tu_?$};
$roundabout_qr = qr{^(Mini)?Roundabout$};
# no $cat_rueck handling here
$complex_IMG_qr = qr/^IMG:([^|]+)(?:\|ANCHOR:([^|]+))?$/;
$viewangle_qr = qr{^View:([-+]?\d+):([-+]?\d+)}; # XXX duplicated in Strassen::Cat

# do not draw Steigung and Gef�lle 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;
$str_nr_draw{'sBAB'} = 1; # XXX sollte vielleicht umschaltbar sein?
# minimum width for "two-track" effect
$sBAB_two_track_width = 3;

$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 = "city";
$show_overview = $show_strlist = 0;
$show_calories = 0;
$use_hoehe = 1; # XXX kann im Programm nicht gesetzt werden
$steigung_optimierung = 0;
$green_optimization = 0;
$special_vehicle_rb = 'normal';
$grade_minimum_short_length = 100; # 100m gilt als kurz f�r 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;
$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 l�schen",
		);
# 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.
$mark_color_overview = 'blue'; # better than red because it does not conflict with Bundesstra�en
$gps_waypoints = 50;
$gps_waypointlength = 10;
$gps_waypointcharset = 'ascii';
$gps_needuniqueroutenumber = 0;

### Fonts
$standard_height = 12;
set_sans_serif_font_family();

### Images
@image_type_order = ('png', # best quality
		     'jpg', # 24bit, good quality XXX what about non-real world photo images?
		     'xpm', # small memory size (8bit pixmaps)
		     'gif',
		    );

###################################################################
$really_no_www = $os eq 'win'; # Trumpet und Win32Sock h�ngen zu lange, wenn es keine Verbindung gibt XXX aber moderne Windows nicht mehr, oder?
$no_map = !$devel_host && (!defined $ENV{USER} || $ENV{USER} !~ /^(eserte|rezic|srezic|slavenr)$/);
$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, # h�h? f�r Radfahrer?
		     'B'   => 140,
		   };
$lost_strecke_per_ampel = 50; # verlorene Strecke pro Ampel in m # XXX F ...?
%lost_time_per_ampel = ('X' => 15,
			'F' => 5,
			# B?
		       ); # verlorene Zeit pro Ampel in s
$average_v = 0;

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

@strcat_order = qw(B HH H NH N NN);
if (0) { # not enabled by default
    unshift @strcat_order, "BAB";
}

$steigung_penalty = {};
$strecke = 0;
$dim_color = '#999999';
$unit_s = '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 ???

# Do as early as possible to avoid warnings:
if (!$ENV{HOME} || !-d $ENV{HOME}) { # z.B. unter Win32
    $ENV{HOME} = $FindBin::RealBin;
}

# 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)],
	       );

## DEBUG_BEGIN
#BEGIN{mymstat("use vars f�r 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???)

# User directories (~/.bbbike, route directory, cache)
my $home = $ENV{HOME};
if ($os eq 'win') {
    $home = Win32Util::get_user_folder();
    if (-d $home) {
        $bbbike_configdir = catfile($home, "BBBike");
    }
}
if (!defined $bbbike_configdir) {
    $bbbike_configdir = defined $home ? catfile($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 = $home;

{
    # Hopefully robust determination of temporary directory
    die "\$bbbike_configdir is not set" if !defined $bbbike_configdir;
    my $cachedir = catfile($bbbike_configdir, "cache");
    if (!-d $cachedir) {
	mkdir $cachedir, 0700;
    }
    $cache_root = (-d $cachedir && -w $cachedir
		   ? $cachedir
		   : $tmpdir);
    $Karte::cache_root = $cache_root;
    $Strassen::Util::cachedir = $cache_root;
}

{
    for my $_testdir ('__SPEC__',
		      $ENV{TMPDIR},
		      ($^O eq 'MSWin32' ? ($ENV{TEMP}, $ENV{TMP}) : ()),
		      "/tmp",
		      "/temp",
		      '__CONFIG__',
		     ) {
	my $testdir = $_testdir;
	next if !defined $testdir;
	if ($_testdir eq '__SPEC__') {
	    $testdir = eval { require File::Spec; File::Spec->tmpdir };
	    next if !defined $testdir;
	} elsif ($_testdir eq '__CONFIG__') {
	    $testdir = catfile($bbbike_configdir, "tmp");
	    if (!-d $testdir) {
		mkdir $testdir, 0700;
	    }
	}

	if (-d $testdir && -w $testdir) {
	    $tmpdir = $testdir;
	    last;
	}
    }
    if (!defined $tmpdir) {
	$tmpdir = "/tmp";
	print STDERR M("Achtung: es konnte kein schreibbares tempor�res Verzeichnis gefunden werden. Unter Umst�nden sind einige Operationen nicht m�glich.") . "\n";
    }
}

# XXX $do_wwwmap stuff is sort-of obsolete. Remove completely?
Karte::preload('Berlinmap2000');
$do_wwwmap = (! $Karte::Berlinmap2000::obj ||
	      ! -e $Karte::Berlinmap2000::obj->fs_dir);
if ($devel_host) {
    $Karte::cache_root = "/usr/www/berlin";
}

# 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
	    delete_background_images
	  )) {
    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();

# at this point the $devel_host setting is valid (_set_public was maybe called)
if ($devel_host && !$public && !grep { "danger" eq $_ } @Strassen::Dataset::comments_types) {
    push @Strassen::Dataset::comments_types, "danger";
}
@comments_types = @Strassen::Dataset::comments_types;

if ($lowmem) {
    @image_type_order = ('xpm', 'gif', 'jpg', 'png');
}

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

use vars qw($city_obj $dataset_title);
if (!defined $city && !defined $datadir) {
    $city = "Berlin";
    $country = "DE";
}
if (defined $city) {
    require Geography;
    $city_obj = Geography->new($city, $country);
    if (!$city_obj) {
	die Mfmt("Kann keine passende Datei f�r Stadt=%s und Land=%s finden",
		 $city, (defined $country ? $country : M("(unbestimmt)")));
    }
    set_datadir($city_obj->datadir, -clearold => 1);
    %global_search_args = $city_obj->search_args;
    if ($city eq "Berlin") {
	$no_original_datadir = 0; # XXX Was bedeutet das genau?
	$dataset_title = undef;
    } else {
	$no_original_datadir = 1; # XXX Was bedeutet das genau?
	$dataset_title = $city . " " . $country;
    }
    if ($city_obj->scrollregion) {
	@scrollregion = $city_obj->scrollregion;
	$normal_scrollregion = $scrollregion[2]-$scrollregion[0];
	for (@scrollregion) { $_ *= $scale };
    }
} elsif ($datadir) {
    set_datadir($datadir, -clearold => 1);
    $no_original_datadir = 1;
    $dataset_title = $city_obj && $city_obj->{dataset_title} ? $city_obj->{dataset_title} : basename($datadir);
}
if (!$city_obj) {
    require Geography::Base;
    $city_obj = Geography::Base->new;
    warn "Fallback to unspecified city object...\n";
}

if ($city_obj->can("skip_features")) {
    %skip_features = map{($_,1)} $city_obj->skip_features;
}
# XXX nicer solution?
if ($city_obj->is_osm_source) {
    $sBAB_two_track_width = 9999; # effectively turning off
}

# define_item_attribs should be called after determining the $city
define_item_attribs();
generate_plot_functions();

if (!@scrollregion) {
    my $init_scrollregion = $Karte::Standard::init_scrollregion;
    $normal_scrollregion = $init_scrollregion*$scale;
    @scrollregion = ((-$normal_scrollregion) x 2,
		     ($normal_scrollregion)  x 2);
}

# XXX Henne-und-Ei-Problem: ich w�rde gerne Plotting-Defaults anhand der
# -city-Option setzen (z.B. Zeichnen der Landstra�en f�r OR). Problem:
# das initiale Setzen von %init_str geschieht auch w�hrend handle_options
# Ich br�uchte also eine Art pre_handle_options, um erst einmal die
# -city-Option herauszufischen und dann den Rest handhaben...

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

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

# XXX The MM_DRAG (move) button could be removed completely some day.
use vars qw($MM_DRAG_IS_OBSOLETE);$MM_DRAG_IS_OBSOLETE = 1;

$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?
# �berpr�fen ... 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;
}

# XXX DEL: all occurences of $XXX_use_old_R_symbol
use vars qw($XXX_use_old_R_symbol);
$XXX_use_old_R_symbol = 0; # !$devel_host; # Old ugly R symbol or "eisenbahn"

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;
## DEBUG_BEGIN
#mymstat("after update_weather");
## DEBUG_END
$wetter_route_update = 1;

# Always use Bikepower (e.g. mandatory for Steigungsoptimierung)
$bikepwr = 1;
if ($bikepwr) {
    eval {
	require BikePower;
    };
    if ($@) {
 	status_message(Mfmt("Kann BikePower nicht laden: %s", $@), 'err');
 	$bikepwr = 0;
    } else {
	if ($verbose && $BikePower::has_xs) {
	    print STDERR 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++;
	    }
	    print STDERR "Referenzgeschwidigkeit/-leistung $type $val wird ignoriert\n";
	} else {
	    print STDERR "Die Option -reference sollte im Format type:value sein, wobei type entweder speed oder power ist und value die entsprechende Geschwindigkeit in km/h oder Leistung in W\n";
	}
    }
}

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 ($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 Gr�nde, f�r CloseMainWin kein Escape zu nehmen
    # (damit k�nnen Vorg�nge abgebrochen werden). Verwendung von C-q,
    # weil das mittlerweile quasi-Standard (Gtk, Qt/KDE, Windows) 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");
	}
    }
    # This is the list of widgets with some "action" area (editable or
    # selectable). It seems that the consensus in the GUI world is to
    # have this widgets in a brighter color (like Tix, Gtk, Windows...).
    # Do it so.
    # Browse is for Tk::HistEntry::Browse
    for (qw(Browse Entry NumEntry Date*NumEntryPlain PathEntry
	    Listbox KListbox K2Listbox
	    TixHList HList Text ROText BrowseEntry.LabEntry SimpleHistEntry
	    ListboxSearchAnything
	   )) {
	if ($os eq 'win') {
	    $top->optionAdd("*$_.background", "SystemWindow", "startupFile");
	} else {
	    $top->optionAdd("*$_.background", "grey95", "startupFile");
	}
    }
    # Introduce a www browser-like cursor feeling:
    for (qw(Button Checkbutton Radiobutton Menubutton
	    FlatCheckbox FlatRadiobutton FireButton)) {
	$top->optionAdd("*$_.cursor", "hand2", "startupFile");
    }

    if (0) { # ... naja, m�sste ein Designer ran ... au�erdem with -tile nicht mehr unterst�tzt (?), und mit Windows ging's noch nie
	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");
    }
}

## DEBUG_BEGIN
#BEGIN{mymstat("after basic MainWindow setup BEGIN");} mymstat("after basic MainWindow setup");
## DEBUG_END

# 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
}

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

if (!defined $focus_policy) {
    if ($os eq 'unix') {
	#XXX $focus_policy = 'follow';
	$focus_policy = 'click';
    } else {
	$focus_policy = 'click';
    }
}

if ($focus_policy eq 'follow') {
    @popup_style = ('-popover', 'cursor');
    # This seems to be a good idea for all platforms, but
    # is dangerous where focus also means "raise" and the
    # toplevel is not marked as transient. Therefore
    # first check if this work OK and maybe always enable
    # in BBBike 3.16 XXX
    #
    # Another problem, the reason why I disabled this for now: if
    # the search window is redisplayed by hitting the "/"
    # key, then the focus is not set to the search field.
    #
    #$top->focusFollowsMouse;
} 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)
# * Zeichens�tze 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();

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

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

# Zeichens�tze
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) {
	print STDERR M("Die Fenstergr��e wird wegen ung�ltiger Werte nicht gesetzt: ")
	    . join(", ", @want_extends), "\n";
    } else {
	geometry($top, @want_extends);
	@want_extends = ();
    }
}

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 {
	print STDERR "Ung�ltiger Skalierungswert <$init_scale_massstab> wird ignoriert\n";
    }
}

$top->title("$progname $VERSION" .
	    ($dataset_title ? " [$dataset_title]" : "")
	   );

my $has_icon = 0;
my $set_toplevel_icon;
$srtbike_photo = load_photo($top, 'srtbike_solid');
$srtbike16_icon = load_photo($top, 'srtbike16'); # used in info window
if ($os eq 'win' || $^O eq 'cygwin') {
    # Prefer .ico
    my $icon;
    if ($Tk::VERSION >= 804.027 and
	$icon = $FindBin::RealBin.'/images/srtbike.ico' and
	-r $icon and
	eval {
	    $top->iconbitmap($icon);
	    1;
	}) {
	$has_icon = 1;
	$set_toplevel_icon = sub {
	    my $self = shift;
	    eval {
		$self->iconbitmap($icon);
	    };
	};
    } else {
	# srtbike32.* looks broken on Win98 and Vista,
	# and srtbike16.* looks broken on WinXP and Vista
	if ($ENV{OS} && $ENV{OS} eq 'Windows_NT') { # this seems to be the case for XP
	    $srtbike_icon = load_photo($top, 'srtbike32');
	} else {
	    $srtbike_icon = $srtbike16_icon;
	}
    }
} else {
    # 16x16 is the preferred size for mini-icons in KDE
    # works also for twm (however, a little bit tiny)
    $srtbike_icon = $srtbike16_icon;
    if ($srtbike_icon) {
	$top->iconmask('@' . $FindBin::RealBin . '/images/srtbike16_mask.xbm');
    }
}

if (!$has_icon) {
    # In ->Icon wird auch ein ->update durchgef�hrt:
    # XXX Unter Unix vielleicht darauf verzichten und iconimage stattdessen verwenden?
    # XXX Also set icon according to freedesktop specs.
    if (defined $srtbike_icon) {
	$top->Icon(-image => $srtbike_icon);
	$set_toplevel_icon = sub {
	    my $self = shift;
	    eval {
		$self->iconimage($main::srtbike_icon);
	    };
	};
    }
}

if ($devel_host && $set_toplevel_icon) {
    # every toplevel in app should get bbbike icon
    require Tk::Toplevel; # make sure it's loaded
    package Tk::Toplevel;
    *InitObject = *InitObject; # cease warnings
    *InitObject = sub {
	my($self,$args) = @_;
	$self->SUPER::InitObject($args);
	    # setting icon may fail in other mainwindows
	    $self->afterIdle(sub { $set_toplevel_icon->($self) });
    };
}

{
    # experimental...
    my $freedesktop_lib = "$ENV{HOME}/work/Tk-FreeDesktop-Wm/blib/lib";
    if (-d $freedesktop_lib) {
	if (!eval {
	    local @INC = ($freedesktop_lib, @INC);
	    require Tk::FreeDesktop::Wm;
	    my $fd = Tk::FreeDesktop::Wm->new(mw => $top);
	    $fd->set_wm_icon("$FindBin::RealBin/images/srtbike_mini.xpm");
	    1;
	}) {
	    warn "Cannot load Tk::FreeDesktop::Wm ($@), no NET icon support...";
	}
    }
}

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, 'raise splash');
}

# Define something else on X server bugs (e.g. "projecting")
$capstyle_round = "round";

# 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

# Zeichens�tze f�r Stra�ennamen
# 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))) {
    print STDERR "Der Normalzeichensatz in <$font_family> kann nicht gefunden werden, der Fallback wird verwendet...\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))) {
    print STDERR "Der Fettschriftzeichensatz in <$font_family> kann nicht gefunden werden, der Fallback wird verwendet...\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 =
  ('NN'  => $rot_font_sub,
   'N'   => $rot_font_sub,
   'NH'  => $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");
# Fix strangely colored Pod menu
$top->optionAdd("*pod*search*foreground" => 'black');
$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. Problems too solve: maybe icon too large for small screens/buttons; images should be transparent: {my $p=load_photo($top, "cross", -name => "cross");for(qw(close cancel)) { $top->optionAdd("*$_*compound","left"); $top->optionAdd("*$_*image","cross")}}
$top->optionAdd("*close*foreground"   => 'red');
$top->optionAdd("*close*text"         => M"Schlie�en");
$top->optionAdd("*end*foreground"     => 'green4');
$top->optionAdd("*end*text"           => M"Schlie�en");

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);

$top->optionAdd("*SmallBut*padX" => 1);
$top->optionAdd("*SmallBut*padY" => 1);

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 Klickfl�che �berdeckt.
	$balloon = $top->Balloon(-balloonposition => "mouse");
    };
}
if (!defined $balloon) {
    eval q{
	package Tk::FakeBalloon; # AUTOLOAD: ignore
	@Tk::FakeBalloon::ISA = qw(Tk::Label);
	Construct Tk::Widget "FakeBalloon";
	sub attach {}
	sub configure {}
	sub IsWidget { 0 } # for Tk::Exists
	package main;
	$balloon = $top->FakeBalloon;
    };
    warn $@ if $@;
}

## 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";
    };
}

# This is a hack to fix the background color of BrowseEntry's entry
# widget. Maybe something similar should go into official BrowseEntry?
# However, if this passes a "test phase" it should be available for
# all.
if ($devel_host) {
    require Tk::BrowseEntry;
    *Tk::MyBrowseEntry::oldPopulate = \&Tk::BrowseEntry::Populate;
    *Tk::BrowseEntry::Populate = sub {
	my $w = shift;
	Tk::MyBrowseEntry::oldPopulate($w, @_);
	$w->ConfigSpecs(-background=>['SELF']);
    };
}

## 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, 'create top') if $splash_screen;

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

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

use vars qw($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('Stra�e/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 => "^Stra�e/Strecke");

$km_frame = $top_frame->Frame(-relief => 'raised',
			      -bd => 1);
my $kmcb = $km_frame->Button
    (-textvariable => \$unit_s,
     -class => 'FlatBut',
     -command => sub { 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"Streckenl�nge");
$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');
$ampel_klein_grey_photo = load_photo($top, 'ampel_klein_grey');
$kopfstein_klein_photo      = load_photo($top, 'kopfstein_klein');
$kopfstein_klein_grey_photo = load_photo($top, 'kopfstein_klein_grey');
$star_photo             = load_photo($top, 'star');
$newlayer_photo		= load_photo($top, 'newlayer');

for(my $i = 0; $i <= $#speed; $i++) {
    my $ii = $i; # f�r 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'},
	     );

{
    my @weather_src;
    if (!$city_obj->is_osm_source) {
	@weather_src = (['uptodate' => M"aktuellste"],
			['dahlem2'],
			['dahlem1'],
			($devel_host && $advanced
			 ? (['wetterkarte' => 'Wetterkarte Berlin-Dahlem'],
			    ['metar-EDDT' => 'METAR Tegel'],
			    ['metar-EDDB' => 'METAR Sch�nefeld'],
			   )
			 : ()
			),
		       );
    } else {
	my $icao_file;
	if (-r "$datadir/icao_metar") {
	    $icao_file = "$datadir/icao_metar";
	} elsif (-r "$datadir/icao") {
	    $icao_file = "$datadir/icao";
	}
	if ($icao_file) {
	    eval {
		my $icao_s = Strassen->new_stream($icao_file);
		$icao_s->read_stream(sub {
					 my($r, undef, $line) = @_;
					 if (my($icao, $fullname) = $r->[Strassen::NAME] =~ m{^(\S+)\s+\((.*)\)}) {
					     push @weather_src, ["metar-$icao" => "METAR $fullname"];
					 } else {
					     warn "Cannot parse '$r->[Strassen::NAME]' at line $line in $datadir/icao\n";
					 }
				     });
	    };
	    warn $@ if $@;
	}
    }

    foreach (@weather_src) {
	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) },
	    );
    }
    if (@weather_src) {
	$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;
	 require BBBikeWeather;
	 BBBikeWeather::require_wettermeldung();
	 WWWBrowser::start_browser("http://$wettermeldung2::www_site{dahlem1}$wettermeldung2::loc{dahlem1}");
     }
    )->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, 'create iconframe') if $splash_screen;

do_iconframe() if $do_iconframe;
if ($standard_menubar) {
## DEBUG_BEGIN
#mymstat("before 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 dazugeh�rigen Men�s
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;
##### Stra�en #####
my $strasse_check;
my $strcm;
my $radwege_check_index;
my $qualitaet_check_index;
my $handicap_check_index;
my $sperre_check_index;
my $ampeln_check_index;
my $fragezeichen_check_index;
my $nolighting_check_index;
my $gruene_wege_check_index;
my $vorfahrt_check_index;
my $c_bpcm;
my $comments_all_check_index;
my $cycle_routes_check_index;
unless($skip_features{"strassen"}) {
    $strasse_photo = load_photo($misc_frame, 'strasse');
    $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"Stra�en");
    $ch->attach($strasse_check, -pod => "^\\s*Stra�en-Symbol");

    my $strcmb = $misc_frame->Menubutton;
    $strcmb->focus;
    $strcm = $strcmb->Menu(-title => M("Stra�en"));
    menu_entry_choose_ort
	($strcm, 's',
	 -accelerator => 'S',
	 -strchooseortargs =>
	 {'-markstartifactive' => 1,
	  (!$city_obj->is_osm_source
	   ? (-completelistbutton => sub { choose_from_plz(-interactive => 1) },
	      -completelistbuttonlabel => M"Alle Stra�en"
	     )
	   : ()
	  ),
	 },
	 -strextrachoosemenuaction =>
	 sub {
	     $strcm->cascade(-label => M('Erweiterte Auswahl').' ...');
	     my $ausm = $strcm->Menu(-title => M("Erweiterte Auswahl").' ...');
	     $strcm->entryconfigure('last', -menu => $ausm);
	     $ausm->command(-label => M"Volltextsuche",
			    -accelerator => "Ctrl-F",
			    -command => sub {
				require BBBikeAdvanced;
				search_anything();
			    });
	     $plzmcmd = $ausm->command
		 (-label => M"Komplette Stra�enliste",
		  -command => sub { choose_from_plz(-interactive => 1) });
	     if ($advanced) {
		 $ausm->command
		     (-label => M"Telefonbuch-Datenbank (Stra�e)",
		      -command => sub {
			  telefonbuch_dialog("str");
		      });
		 $ausm->command
		     (-label => M"Telefonbuch-Datenbank (Name)",
		      -command => sub {
			  telefonbuch_dialog("tel");
		      });
		 $ausm->command(-label => M"MySQL-DB",
				-command => sub {
				    push @INC, "$FindBin::RealBin/miscsrc";
				    eval {
					require TelbuchDBApprox;
					TelbuchDBApprox::tk_choose($top);
				    };
				    if ($@) {
					status_message($@, "die");
				    }
				});
	     }
	 },
	);
    $strcm->separator;
    if ($os ne 'win' || $advanced) {
	# No rotation on win possible.
	$strcm->checkbutton(-label => M"Stra�ennamen",
			    -variable => \$str_name_draw{'s'},
			    -command => sub {
				pending(1, 'replot-str-s');
			    },
			   );
    }
    $strcm->cascade(-label => M"Stra�enkategorien");
    {
	my $skm = $strcm->Menu(-title => M"Stra�enkategorien");
	$strcm->entryconfigure('last', -menu => $skm);
	my @l = ([M"wichtige Hauptstra�en", 'HH'],
		 [M"Hauptstra�en", 'H'],
		 ($devel_host || $city_obj->is_osm_source ? [M"wichtige Nebenstra�e", 'NH'] : ()), # XXX good name for this? Some osm records have the comment "Erg�nzungsstra�e mit besonderer Bedeutung"
		 [M"Nebenstra�en", 'N'],
		 [M"f�r Kfz gesperrte Stra�en", 'NN']);
	foreach (@l) {
	    my($label,$cat) = @$_;
	    $skm->checkbutton
	      (-label => $label,
	       -variable => \$str_restrict{'s'}->{$cat},
	       -command => sub {
		   pending(1, 'replot-str-s');
	       },
	      );
	}
	if ($advanced) {
	    $skm->separator;
	    $skm->checkbutton
		(-label => M"Autobahnen/Kfz-Stra�en",
		 -variable => \$str_draw{'sBAB'},
		 -command => sub {
		     plot("str", "sBAB",
			  -filename => get_strassen_file("strassen_bab"));
		 },
		);
	}

    }
    $strcm->checkbutton(-label => M"Radwege",
			-variable => \$str_draw{'rw'},
			-command => sub { plot('str','rw')},
			-accelerator => 'Shift-R',
		       );
    $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');
	       },
	      );
	}
    }

    my $create_comment_layers_cb = sub {
	my($menu, $type, %cb_args) = @_;
	my $label = $comment_cat_labels{$type} || $type;
	my $def = 'comm-' . $type;
	$menu->checkbutton
	    (-label => $label,
	     -variable => \$str_draw{$def},
	     -command => sub {
		 my $file  = get_strassen_file("comments_" . $type);
		 plot('str', $def, Filename => $file);
	     },
	     %cb_args,
	    );
    };

    unless ($skip_features{"radroute"}) {
	$create_comment_layers_cb->($strcm, "route", -accelerator => 'Shift-Y');
	$cycle_routes_check_index = $strcm->index('last');
	$strcm->command(-label => M"Radroute ausw�hlen",
			-command => sub {
			    choose_ort(qw(s comm-route),
				       -markstartifactive => 1);
			});
    }

    $strcm->checkbutton(-label => M"Einbahn-/gesperrte Stra�en",
			-variable => \$p_draw{'sperre'},
			-command => sub { plot_sperre() },
			-accelerator => 'G',
		       );
    $sperre_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Ampeln",
			-variable => \$p_draw{'lsa'},
			-command => sub { plot('p','lsa') },
			-accelerator => 'A',
		       );
    $ampeln_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Stra�enqualit�t",
			-variable => \$str_draw{'qs'},
			-command => sub { plot('str','qs') },
			-accelerator => 'Shift-Q',
		       );
    $qualitaet_check_index = $strcm->index('last');
    $strcm->cascade(-label => M"Qualit�tskategorien");
    {
	my $qm = $strcm->Menu(-title => M"Qualit�tskategorien");
	$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 Beeintr�chtigungen",
			-variable => \$str_draw{'hs'},
			-command => sub { plot('str','hs') },
			-accelerator => 'Shift-H',
		       );
    $handicap_check_index = $strcm->index('last');
    unless ($skip_features{"nolighting"}) {
	$strcm->checkbutton(-label => M"Unbeleuchtete Stra�en",
			    -variable => \$str_draw{'nl'},
			    -command => sub { plot('str','nl') },
			    -accelerator => 'Shift-N',
			   );
	$nolighting_check_index = $strcm->index('last');
    }
    unless ($skip_features{"green"}) {
	$strcm->checkbutton(-label => M"Gr�ne Wege",
			    -variable => \$str_draw{'gr'},
			    -command => sub { plot('str','gr') },
			    -accelerator => 'Shift-G',
			   );
	$gruene_wege_check_index = $strcm->index('last');
    }
    unless ($skip_features{"vorfahrt"}) {
	$strcm->checkbutton(-label => M"Vorfahrt",
			    -variable => \$p_draw{'vf'},
			    -command => sub { plot('p','vf') },
			    -accelerator => 'Shift-V',
			   );
	$vorfahrt_check_index = $strcm->index('last');
    }

    $strcm->cascade(-label => M"Kommentare");
    {
	$c_bpcm = $strcm->Menu(-title => M"Sonstige");
	$strcm->entryconfigure("last", -menu => $c_bpcm);
	my @used_types;
	foreach my $type (@comments_types) {
	    next if $type =~ /^(cyclepath|mount|route|ferry)$/; # handled elsewhere
	    if (!$advanced) {
		# kfzverkehr: poor presentation
		# scenic: almost no data
		next if $type =~ /^(kfzverkehr|scenic)$/;
	    }
	    $create_comment_layers_cb->($c_bpcm, $type);
	    push @used_types, $type;
	}
	$c_bpcm->separator;
	my $str_draw_all = 0;
	$c_bpcm->checkbutton
	    (-label => M("Alle"),
	     -variable => \$str_draw_all,
	     -command => sub {
		 my $onoff = $str_draw_all;
		 $progress->InitGroup;
		 for my $type (@used_types) {
		     my $def = 'comm-' . $type;
		     $str_draw{$def} = $onoff;
		     plot('str', $def, Filename => get_strassen_file("comments_" . $type));
		 }
		 $progress->FinishGroup;
	     },
	     -accelerator => 'Shift-C',
	    );
	$comments_all_check_index = $c_bpcm->index('last');
    }

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

    # XXX the mount file is very problematic at the moment; do not show it to the normal user until everything's fixed! See StrassenNetz.pm and steigung_stat. Also, I think comments_mount is not used for Steigungsoptimierung, so don't puzzle the user about this.
    if ($devel_host) {
	$strcm->checkbutton
	    (-label => M"Steigungen",
	     -variable => \$str_draw{'mount'},
	     -command => \&plot_mount,
	    );
    }
    if (1) {
	$strcm->checkbutton(-label => M"Fragezeichen",
			    -variable => \$str_draw{'fz'},
			    -command => sub { plot('str','fz') },
			    -accelerator => '?',
			   );
	$fragezeichen_check_index = $strcm->index('last');
    }
    $strcm->checkbutton(-label => M"Outline zeichnen",
			-variable => \$str_outline{'s'},
			-command => sub {
			    pending(1, 'replot-str-s');
			},
		       );
    menu_entry_up_down($strcm, $tag_group{'str_s'});
    menuright($strasse_check, $strcm);
    menuarrow($strcmb, $strcm, $col++, -special => 'LAYER');
}
##### Landstra�en #####
my $landstrasse_check;
my $lstrcm;
my $radwege_l_check_index;
my $qualitaet_l_check_index;
my $handicap_l_check_index;
my $land_jwd_check_index;
unless ($skip_features{"landstrassen"}) {
    $landstrasse_photo =
      load_photo($misc_frame, 'landstrasse');
    $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"Landstra�en");
    $ch->attach($landstrasse_check, -pod => "^\\s*Landstra�en-Symbol");

    my $lstrcmb = $misc_frame->Menubutton;
    $lstrcm = $lstrcmb->Menu(-title => M"Landstra�en");
    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');
			 },
			);
    unless ($skip_features{wideregion}) {
	$lstrcm->checkbutton(-label => M"Landstra�en jwd zeichnen",
			     -variable => \$str_far_away{'l'},
			     -command => sub {
				 pending(1, 'replot-str-l');
			     },
			     -accelerator => 'Shift-L',
			    );
	$land_jwd_check_index = $lstrcm->index('last');
    }
    $lstrcm->checkbutton(-label => M"Stra�ennamen",
			 -variable => \$str_name_draw{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
		       );
    $lstrcm->checkbutton(-label => M"Stra�ennummern",
			 -variable => \$str_nr_draw{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
		       );
    $lstrcm->checkbutton(-label => M"Stra�enqualit�t",
			 -variable => \$str_draw{'ql'},
			 -command => sub { plot('str','ql') },
			 -accelerator => 'Shift-Q',
			);
    $qualitaet_l_check_index = $lstrcm->index('last');
    $lstrcm->checkbutton(-label => M"Sonstige Beeintr�chtigungen",
			 -variable => \$str_draw{'hl'},
			 -command => sub { plot('str','hl') },
			);
    $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',
			);
    $radwege_l_check_index = $lstrcm->index('last');
    menu_entry_up_down($lstrcm, $tag_group{'str_l'});
    menuright($landstrasse_check, $lstrcm);
    menuarrow($lstrcmb, $lstrcm, $col++, -special => 'LAYER');
}

##### Orte #####
my $ort_check;
my $ocm;
my $ort_jwd_check_index;
unless ($skip_features{"orte"}) {
    $ort_photo = load_photo($misc_frame, 'ort');
    $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;
    $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');
			    },
			   );
	}
    }
    unless ($skip_features{wideregion}) {
	$ocm->checkbutton(-label => M"Orte jwd zeichnen",
			  -variable => \$p_far_away{'o'},
			  -command => sub {
			      pending(1, 'replot-p-o');
			  },
			  -accelerator => 'Shift-O',
			 );
	$ort_jwd_check_index = $ocm->index('last');
    }
    $ocm->separator;
    $ocm->cascade(-label => M"Schriftgr��e");
    {
	my $m = $ocm->Menu(-title => M"Ort-Schriftgr��e");
	$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 #####
my $ubahn_check;
unless ($skip_features{"u-bahn"}) {
    $ubahn_photo = load_photo($misc_frame, 'ubahn');
    $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 Zug�nge",
		       -variable => \$p_draw{'u_bg'},
		       -command => sub {
			   plot('p', 'u_bg');
		       },
		      );
    $ubcm->separator;
    foreach ($skip_features{"vbb"} ? ["Strecken in Betrieb", "UA"] :
	     ([M"VBB-Zone Berlin A", 'UA'],
	      [M"VBB-Zone Berlin B", 'UB'],
	     ),
	     [M"nur Betriebsfahrten", "UBetrieb"],
	     [M"in Bau", 'UBau'],
	     [M"stillgelegt", 'U0'],
	    ) {
	my($label,$cat) = @$_;
	$ubcm->checkbutton(-label => $label,
			   -variable => \$str_restrict{'u'}->{$cat},
			   -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 #####
my $sbahn_check;
unless ($skip_features{"s-bahn"}) {
    $sbahn_photo = load_photo($misc_frame, 'sbahn');
    $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 Zug�nge",
		       -variable => \$p_draw{'b_bg'},
		       -command => sub {
			   plot('p', 'b_bg');
		       },
		      );
    $sbcm->separator;
    foreach ($skip_features{"vbb"} ? ["Strecken in Betrieb", "SA"] :
	     ([M"VBB-Zone Berlin A", 'SA'],
	      [M"VBB-Zone Berlin B", 'SB'],
	      [M"VBB-Zone Berlin C", 'SC'],
	     ),
	     [M"nur Betriebsfahrten", "SBetrieb"],
	     [M"in Bau", 'SBau'],
	     [M"stillgelegt", 'S0'],
	    ) {
	my($label,$cat) = @$_;
	$sbcm->checkbutton(-label => $label,
			   -variable => \$str_restrict{'b'}->{$cat},
			   -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 #####
my $rbahn_check;
unless ($skip_features{"r-bahn"}) {
    if ($XXX_use_old_R_symbol) {
	$rbahn_photo = load_photo($misc_frame, 'rbahn');
    } else {
	$rbahn_photo = load_photo($misc_frame, 'eisenbahn15');
    }
    $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 ($skip_features{"vbb"} ? ["Strecken in Betrieb", "R"] :
	     ([M"VBB-Zonen Berlin A und B", 'RB'],
	      [M"VBB-Zone Berlin C", 'RC'],
	      [M"au�erhalb Berlin ABC", 'R'],
	     ),
	     [M"stillgelegt", 'R0'],
	     [M"in Bau", 'RBau'],
	     [M"G�terbahnen/Verbindungsstrecken", 'RG'],
	     [M"Parkbahnen/Kleinbahnen", 'RP'],
	    ) {
	my($label,$cat) = @$_;
	$rbcm->checkbutton(-label => $label,
			   -variable => \$str_restrict{'r'}->{$cat},
			   -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');
}
##### Ferries #####
unless ($skip_features{'faehren'}) {
    $ferry_photo = load_photo($misc_frame, 'ferry');
    my $ferry_check = $misc_frame->$Checkbutton
      (image_or_text($ferry_photo, 'F'),
       -variable => \$str_draw{'e'},
       -command => sub { plot('str','e') },
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($ferry_check, -msg => M"F�hren");
    my $ferrycmb = $misc_frame->Menubutton;
    my $ferrycm = $ferrycmb->Menu(-title => M"F�hren");
    menu_entry_choose_ort($ferrycm, 'e',
			  -pchooseortargs => {'-markstartifactive' => 1},
			 );
    menuright($ferry_check, $ferrycm);
    menuarrow($ferrycmb, $ferrycm, $col++,
	      -menulabel => M"F�hren", -special => 'LAYER');
}
##### Gew�sser #####
my $wasser_check;
my $wasserumland_check_index;
my $wcm;
unless ($skip_features{"wasser"}) {
    $wasser_photo = load_photo($misc_frame, 'wasser');
    $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"Gew�sser");
    $ch->attach($wasser_check, -pod => "^\\s*Gew�sser-Symbol");
    my $wcmb = $misc_frame->Menubutton;
    $wcm = $wcmb->Menu(-title => M"Gew�sser");
    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 Gew�sser",
		      -variable => \$str_name_draw{'w'},
		      -command => sub {
			  $str_name_draw{'i'} = $str_name_draw{'w'};
			  pending(1, 'replot-str-w');
		      },
		     );
    unless ($skip_features{"wasserumland"}) {
	$wcm->checkbutton(-label => M"Gew�sser in der Stadt zeichnen",
			  -variable => \$wasserstadt,
			  -command => sub {
			      pending(1, 'replot-str-w');
			  },
			 );
	$wcm->checkbutton(-label => M"Gew�sser im Umland zeichnen",
			  -variable => \$wasserumland,
			  -command => sub {
			      pending(1, 'replot-str-w');
			  },
			  -accelerator => 'Shift-W',
			 );
	$wasserumland_check_index = $wcm->index('last');
	unless ($skip_features{"wideregion"}) {
	    $wcm->checkbutton(-label => M"Gew�sser 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');
}
##### Fl�chen #####
my $flaechen_check;
unless ($skip_features{"flaechen"}) {
    $flaechen_photo = load_photo($misc_frame, 'flaechen');
    $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 Fl�chen");
    $ch->attach($flaechen_check, -pod => "^\\s*Fl�chen-Symbol");
    my $fcmb = $misc_frame->Menubutton;
    my $fcm = $fcmb->Menu(-title => M"sonstige Fl�chen");
    menu_entry_choose_ort($fcm, 'f', -accelerator => 'F');
    $fcm->checkbutton(-label => M"Namen der Fl�chen",
		      -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 => $str_attrib{g}->[ATTRIB_PLURAL],
		      -variable => \$str_draw{'g'},
		      -command => sub { plot('str','g') });
    if ($advanced && $devel_host) {
	$fcm->checkbutton(-label => $str_attrib{gBO}->[ATTRIB_PLURAL],
			  -variable => \$str_draw{'gBO'},
			  -command => sub { plot('str', 'gBO') });
	$str_name_draw{"gBO"} = 1; # force drawing of labels
	$fcm->checkbutton(-label => defined $city && $city eq 'Berlin' ? M"Berliner Ortsteilnamen" : M"Ortsteilnamen",
			  -variable => \$str_name_draw{'gBO'},
			  -command => sub {
			      pending(1, 'replot-str-gBO');
			  },
			 );
    }
    if (defined $city && $city eq 'Berlin') {
	$fcm->checkbutton(-label => M"Grenzen von Potsdam",
			  -variable => \$str_draw{'gP'},
			  -command => sub { plot('str','gP') });
    }
    $fcm->checkbutton(-label => M"Staatsgrenzen",
		      -variable => \$str_draw{'gD'},
		      -command => sub { plot('str','gD') });
    $fcm->checkbutton(-label => M"Grenz�berg�nge",
		      -variable => \$p_draw{'GU'},
		      -command => sub { plot('p', 'GU') },
		     );

    menu_entry_up_down($fcm, $tag_group{'str_f'});
    menuright($flaechen_check, $fcm);
    menuarrow($fcmb, $fcm, $col++, -special => 'LAYER');
}
##### Sehensw�rdigkeiten, Kneipen etc. #####
my $sehenswuerdigkeiten_check;
unless ($skip_features{"sehenswuerdigkeiten"}) {
    $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"Sehensw�rdigkeiten etc.");
    $ch->attach($sehenswuerdigkeiten_check, -pod => "^\\s*Sehensw�rdigkeiten-Symbol");
    my $knmb = $misc_frame->Menubutton;
    my $knm = $knmb->Menu(-title => M"Sehensw�rdigkeiten etc.",
		       -disabledforeground => $wb->cget(-foreground));

    $knm->checkbutton(-label => M"Sehensw�rdigkeiten",
		      -variable => \$str_draw{'v'},
		      -command => sub { plot('str','v') });
    $knm->command(-label => M"Sehensw�rdigkeit ausw�hlen",
		  -command => sub { choose_ort(qw(s v),
					       -markstartifactive => 1) });
    $knm->checkbutton(-label => M"Namen der Sehensw�rdigkeiten",
		      -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;

    $knm->command(-label => M"Pers�nliche Orte",
		  -command => sub {
		      require BBBikePersonal;
		      BBBikePersonal::dialog();
		  });

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

    if ($advanced || $city_obj->is_osm_source) {
	my @try_kneipen_list = qw(kn rest ki);
	my @kneipen_list;
	foreach my $f (@try_kneipen_list) {
	    if (-f "$datadir/$p_file{$f}") {
		push @kneipen_list, $f;
	    }
	}
	if (@kneipen_list) {
	    $knm->separator;
	    if (!$city_obj->is_osm_source) {
		$knm->command(-label => M("Nicht mehr gepflegt").":",
			      -state => 'disabled',
			      -font => $font{'bold'},
			     );
	    }
	    foreach my $f (@kneipen_list) {
		if (-f "$datadir/$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 ausw�hlen", $p_attrib{$f}->[ATTRIB_SINGULAR]),
				  -command => sub { choose_ort('p', $f) });
		}
	    }
	}
    }

    #XXXX menu_entry_up_down($knm, $tag_group{'str_f'});
    menuright($sehenswuerdigkeiten_check, $knm);
    menuarrow($knmb, $knm, $col++, -special => 'LAYER');
}
##### Zus�tzliche 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"Zus�tzliche Kartenebenen");
    $ch->attach($newlayer_label, -pod => "^\\s*Zus�tzliche Kartenebenen");
    my $nlmb = $misc_frame->Menubutton;
    my $nlm = $nlmb->Menu(-title => M"Zus�tzliche 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"Zus�tzliche Kartenebenen";
#	$opbm->entryconfigure('last', -menu => $cusm);
# 	$cusm->command(-label => M"Zus�tzliche Layer",
# 		       -state => 'disabled',
# 		       -font => $font{'bold'});
	$cusm->command(-label => M"Stra�en-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"Stra�en/Punkte ausw�hlen",
		       -command => sub {
			   require BBBikeAdvanced;
			   choose_from_additional_layer() });
	$cusm->cascade(-label => M("Letzte ge�ffnete Layer")."...");
	{
	    my $m = $cusm->Menu(-title => M("Letzte ge�ffnete Layer")."...");
	    $cusm->entryconfigure("last", -menu => $m);
	    $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 => ($devel_host ? 20 : 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 l�schen",
		       -command => sub {
			   require BBBikeAdvanced;
			   delete_additional_layer() });
	if ($devel_host) {
	    $cusm->command(-label => M"Layer in �bersichtskarte zeichnen",
			   -command => sub {
			       require BBBikeAdvanced;
			       tk_draw_layer_in_overview();
			   });
	}
	$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 f�r Layer vergr��ern",
		       -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->cascade(-label => M("Letzte ge�ffnete Tracks/Waypoints")."...");
	{
	    my $m = $cusm->Menu(-title => M("Letzte ge�ffnete Tracks/Waypoints")."...");
	    $cusm->entryconfigure("last", -menu => $m);
	    $last_loaded_tracks_obj =
		{
		 List => [],
		 File => "$main::bbbike_configdir/last_tracks",
		 Menu => $m,
		 Title => M("Letzte Tracks").":",
		 Cb => sub {
		     my($file, %args) = @_;
		     my %draw_args;
		     if ($args{-serialized}) {
			 eval {
			     require Storable;
			     require MIME::Base64;
			     %draw_args = %{ Storable::thaw(MIME::Base64::decode_base64($args{-serialized})) };
			 };
			 warn $@ if $@;
		     }

		     require BBBikeGPS;
		     BBBikeGPS::do_draw_gpsman_data($top, $file, %draw_args);
		 },
		 Max => ($devel_host ? 20 : 12),
		};
	    load_last_loaded($last_loaded_tracks_obj);
	}
	$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);
    }

###### Vergr��ern #####
    my $mapscale_plus_photo = load_photo($misc_frame, 'viewmag+');
    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"Vergr��ern");
    $ch->attach($mapscale_plus_button, -pod => "^\\s*Vergr��ern-Symbol");
    $col++;

###### Verkleinern #####
    my $mapscale_minus_photo = load_photo($misc_frame, 'viewmag-');
    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"Ma�stab");
    $ch->attach($scale_button, -pod => "^\\s*Ma�stab-Feld");
    $default_mapscale = calc_mapscale();
    $col++;

##### �bersichtskarte
    my $berlin_overview_small_photo
      = load_photo($top, 'berlin_overview_small');
    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');
    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');
    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,
		      -accelerator => "Shift-S",
		     );
    $sbm->cascade(-label => M('Route l�schen'));
    my $sbm_reset_menu_index = $sbm->index("last");

    $sbm->command(-label => M"Route wiederherstellen (Undo)",
		  -command =>\&get_undo_route,
		  -accelerator => 'Ctrl-Z');
    $sbm->command(-label => M"Suche wiederholen",
		  -command => \&re_search_gui);
    $sbm->command(-label => M"R�ckweg",
		  -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 Stra�enliste 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"Stra�ennetz neu berechnen",
		      -command => sub {
			  make_net();
			  read_sperre_tragen() unless $lowmem; # XXX should be called automatically, maybe?
		      });
	$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;
    }

    unless ($skip_features{"hoehe"}) {
	$sbm->checkbutton(-label => M"Steigungen/Gef�lle zeigen",
			  -variable => \$show_grade);
    }
    $sbm->cascade(-label => M('Einf�rben der Route').' ...');
    {
	my $fbm = $sbm->Menu(-title => M('Einf�rben 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,
			 );
	$fbm->checkbutton(-label => M"unterhalb liegend",
			  -variable => \$route_below,
			  -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');
    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 Stra�en 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 Stra�en *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"Aktuelle Sperrungen");
    {
	my $am = $sb2m->Menu(-title => M"Aktuelle Sperrungen");
	$sb2m->entryconfigure('last', -menu => $am);
	$am->checkbutton
	    (-label => M"Aktuelle Sperrungen zeichnen und beachten",
	     -variable => \$show_active_temp_blockings,
	     -command => sub {
		 activate_temp_blockings($show_active_temp_blockings);
	     },
	    );
	$am->command(-label => M"In dieser Session aktive Sperrungen",
		     -command => sub {
			 show_blockings();
		     });
	$am->command
	    (-label => M"Auffrischen der aktuellen Sperrungen",
	     -command => sub {
		 gui_activate_temp_blockings();
	     },
	    );
	if ($advanced) {
	    $am->separator;
	    $am->command
		(-label => M"Aktuelle und zuk�nftige Sperrungen zeichnen",
		 -command => sub {
		     $show_active_temp_blockings = 1;
		     activate_temp_blockings($show_active_temp_blockings, -from => time);
		 },
		);
	    $am->command
		(-label => M"Speichern f�r temp_blockings",
		 -command => sub {
		     require BBBikeEdit;
		     BBBikeEdit::temp_blockings_editor();
		 }
		);
	    $am->separator;
	    $am->command
		(-label => M"Sperrungen zeichnen f�r Datum",
		 -command => \&active_temp_blockings_for_date_dialog,
		);
	    $am->command
		(-label => M"Fr�here und zuk�nftige Sperrungen zeichnen",
		 -command => sub {
		     $show_active_temp_blockings = 1;
		     activate_temp_blockings($show_active_temp_blockings, -from => 0);
		 },
		);
	}
    }
    $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', 'X_cursor');
			  });
	$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);
			  }
		      });
	$bdm->command(-label => M"Alle l�schen",
		      -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');
		      },);
    unless ($skip_features{faehren}) {
	$sb2m->checkbutton(-label => M"F�hren verwenden",
			   -variable => \$use_faehre,
			   -command => sub {
			       pending(1, 'recalc-net');
			   },
			  );
    }
    $sb2m->separator;
    $sb2m->checkbutton(-label => M"Stra�enqualit�t-Optimierung",
		      -variable => \$qualitaet_s_optimierung,
		     );
    $sb2m->checkbutton(-label => M"Stra�enkategorie-Optimierung",
		       -variable => \$strcat_optimierung,
		       -command => sub {
			   if ($strcat_optimierung) {
			       $N_RW_optimization = 0;
			       $N_RW1_optimization = 0;
			   }
		       },
		     );
    $sb2m->checkbutton(-label => M"Optimierung der sonstigen Beeintr�chtigungen",
		      -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;
			       $N_RW1_optimization = 0;
			   }
		       }
		      );
    $sb2m->checkbutton(-label => M"Hauptstra�en ohne Radwege/Busspuren meiden",
		       -variable => \$N_RW_optimization,
		       -command => sub {
			   if ($N_RW_optimization) {
			       $radwege_optimierung = 0;
			       $strcat_optimierung = 0;
			       $N_RW1_optimization = 0;
			   }
		       }
		      );
    $sb2m->checkbutton(-label => M"Hauptstra�en ohne Radwege meiden",
		       -variable => \$N_RW1_optimization,
		       -command => sub {
			   if ($N_RW1_optimization) {
			       $radwege_optimierung = 0;
			       $strcat_optimierung = 0;
			       $N_RW_optimization = 0;
			   }
		       }
		      );
    unless ($skip_features{"green"}) {
	$sb2m->cascade(-label => M("Gr�ne Wege")."...");
	my $gwm = $sb2m->Menu(-title => M"Gr�ne 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->cascade(-label => M("Unterwegs mit")."...");
	my $umm = $sb2m->Menu(-title => M"Unterwegs mit");
	$sb2m->entryconfigure('last', -menu => $umm);
	$umm->radiobutton(-label => M"nichts weiter", # XXX expr?
			  -variable => \$special_vehicle_rb,
			  -value => 'normal', # used to be $special_vehicle="", but this does not work with Perl/Tk
			  -command => sub { pending(1, 'recalc-net') },
			 );
	$umm->radiobutton(-label => M"Anh�nger",
			  -variable => \$special_vehicle_rb,
			  -value => 'trailer',
			  -command => sub { pending(1, 'recalc-net') },
			 );
	$umm->radiobutton(-label => M"Kindersitz mit Kind",
			  -variable => \$special_vehicle_rb,
			  -value => 'childseat',
			  -command => sub { pending(1, 'recalc-net') },
			 );
    }
    unless ($skip_features{"nolighting"}) {
	$sb2m->checkbutton(-label => M"Unbeleuchtete Stra�en meiden",
			   -variable => \$unlit_streets_optimization,
			  );
    }
    if ($advanced) { # XXX
	unless ($skip_features{"tram"}) {
	    $sb2m->checkbutton(-label => M"Stra�enbahnschienen meiden",
			       -variable => \$tram_optimization,
			      );
	}
    }
    unless ($skip_features{"hoehe"}) {
	$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');
    my $strlist_button = $misc_frame2->$Checkbutton
	(image_or_text($strlist_photo, 'StrL'),
	 -variable => \$show_strlist,
	 -command => sub { 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  => sub { 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');
    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 l�schen");
    $ch->attach($reset_button, -pod => "^\\s*Route l�schen");
    my $resetmb = $misc_frame2->Menubutton;
    my $resetm = $resetmb->Menu(-title => M"Route l�schen");
    $resetm->command(-label => M"Gesamte Route l�schen",
		     -command => \&delete_route,
		     -accelerator => 'Ctrl-X',
		    );
    $resetm->command(-label => M"Letzten Punkt der Route l�schen",
		     -command => \&mouse_dellast,
		     -accelerator => '<-',
		    );
    $resetm->command(-label => M"Bis zum letzten Via l�schen",
		     -command => \&deltovia,
		     -accelerator => 'Del',
		    );
    menuright($reset_button, $resetm);
    menuarrow($resetmb, $resetm, $col, -menulabel => M"Route l�schen");
    $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');
    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"R�ckweg");
    $ch->attach($reverse_button, -pod => "^\\s*R�ckweg-Symbol");
    $col++;

    my $koord_photo = load_photo($misc_frame2, 'koord');
    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');
    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++;

if (!$MM_DRAG_IS_OBSOLETE) {
    my $drag_photo = load_photo($misc_frame2, 'movehand');
    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');
    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 ge�ffnete Routen",
	 -disabledforeground => $wb->cget(-foreground));
    menuright($load_button, $last_loaded_menu);
    menuarrow($last_loaded_mb, $last_loaded_menu, $col,
	      -menulabel => M"letzte ge�ffnete Routen",
	      -special   => "OPEN");
    $col++;

    my $save_photo = load_photo($misc_frame2, 'save');
    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 (['PDF',        'pdf'],
		     ['PNG',        'png'],
		     ['GIF',        'gif'],
		     ['JPEG',       'jpeg'],
		     ['PPM',        'ppm'],
		     ['Postscript', 'ps'],
		    ) {
	$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-Aufl�sung").' ...');
	    my $psm = $svm->Menu(-title => M("Postscript-Aufl�sung").' ...');
	    $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 (
		     # GPS
		     ['GPX (Track)', 'GPX/track'],
		     'GPX (Route)',
		     ($advanced ? ['KML (GoogleEarth)', 'KML/track'] : ()),
		     ['GPSMAN (Track)', 'GpsmanData'],
		     'GPSMAN (Route)',
		     ['G7toWin (ASCII)', 'G7toWin_ASCII'],
		     ['Waypoint+ (Track)', 'WaypointPlus'],

		     # map/gis
		     'bbd (BBBike data)',
		     ($advanced ? ('ESRI') : ()),
		     # XXX not yet ready: ($devel_host ? ('OVL (TOP50)') : ()),

		     # vector oriented
		     'PDF',
		     'XFig',
		     ($advanced ? ('SVG') : ()),

		     '-',
		     'GPS direkt',
		     [M('Route zu einem Garmin senden'), 'DirectGarmin'],
		     [M('Senden der Route zu einem Garmin simulieren'), 'DirectGarmin_Test'],
		     ($devel_host ? [M("Route mit gpsbabel senden"), "GpsbabelSend"] : ()),
		     ($devel_host ? [M("Route mit MapSource senden"), "MapSourceSend"] : ()),
		    ) {
	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/) {
	    $svm->command
		(-label => $fmt,
		 -command => \&save_route_as_bbd
		);
	} elsif ($fmt eq 'GPSMAN (Route)') {
	    $svm->command
		(-label => $fmt,
		 -command => sub {
		     gps_interface('BBBikeGPS::GpsmanRoute', -noloading => 1);
		 });
	} elsif ($fmt eq 'GPX (Route)') {
	    $svm->command
		(-label => $fmt,
		 -command => sub { save_route_as_optimized_gpx() },
		);
	} 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 (ref $fmt eq 'ARRAY') {
	    my($label, $module) = @$fmt;
	    if ($module =~ m{^GPX/(.*)$}) {
		my $as = $1;
		$svm->command
		    (-label => $label,
		     -command => sub { save_route_as_gpx(-as => $as) },
		    );
	    } elsif ($module =~ m{^KML/(.*)$}) {
		my $as = $1;
		$svm->command
		    (-label => $label,
		     -command => sub { save_route_as_kml(-as => $as) },
		    );
	    } elsif ($module =~ m{^(GpsbabelSend|MapSourceSend)$}) {
		$svm->command
		    (-label => $label,
		     -command => sub {
			 gps_interface('BBBikeGPS::'.$module, -noloading => 1);
		     });
	    } elsif ($module eq 'DirectGarmin') {
		$svm->command
		    (-label => $label,
		     -command => sub { send_route_to_gps() },
		     -accelerator => 'Ctrl-G',
		    );
	    } else {
		$svm->command
		    (-label => $label,
		     -command => sub { gps_interface($module) },
		    );
	    }
	} else {
	    warn "XXX SHOULD NOT HAPPEN XXX";
	}
    }

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

    my $print_photo = load_photo($misc_frame2, 'printer');
    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');
    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');
    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 ausf�hren:
    if ($advanced && $devel_host) {
	$opbm->command(-label => M("Konfigurations-Wizard"),
		       -command => sub { require Wizards;
					 config_wizard($top);
				     });
	$opbm->separator;
    }
    if (0) {
	# The portrait/landscape switch is never active. But keep the
	# code nevertheless, maybe it will be useful one day if we
	# have turnable screen support (but maybe it will be never
	# needed)
        $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->();
			   });
    }
    if (!$city_obj->is_osm_source) { # no scope with osm data
	$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"n�heres Umland",
			  -command => \&region_settings);
	    unless ($skip_features{wideregion}) {
		$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 => \&c_balloon_update,
				 );
	    }
	}
    }
    $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 { change_font() },
      );
    $opbm->checkbutton(-label => M"gedrehte Zeichens�tze",
		       -variable => \$use_font_rot);
    $opbm->checkbutton(-label => M"St�ndige Markierung",
		       -variable => \$steady_mark,
		      );
    $opbm->command(-label => M"Markierung l�schen",
		   -command => \&delete_markers,
		  );
    $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 bi�chen hacky (weiter unten)
	foreach my $def ([M"Auf Anfrage aktualisieren", 0],
			 [M"Ausgabe sofort aktualisieren", 1],
			 [M"Ausgabe verz�gert 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 m��ten 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);

    if (!$city_obj->is_osm_source) {
	$opbm->command
	    (-label => M"Daten-Update �ber das Internet",
	     -command => \&update_via_internet,
	    );
    }

    $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 { gui_start_bbbike_server() },
		      );
    }

    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');
    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("doc/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("doc/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/doc/bbbike.html";
	   require WWWBrowser;
	   WWWBrowser::start_browser($url);
       });
    if ($advanced) {
	$hpbm->cascade
	    (-label => M("Mehr Dokumentation")." ...");
	my $m2 = $hpbm->Menu(-title => M("Mehr Dokumentation")." ...");
	$hpbm->entryconfigure("last", -menu => $m2);
	for my $doc_def (["doc/links.pod", M"Linkliste"],
			 ["doc/watchsites.org", M"Watchsites"],
			 ["doc/qualitaetskategorien.html", M"Qualit�tskategorien"],
			 ["doc/HOWTO_edit_bbbike_data.html", M"Daten in BBBike editieren"],
			 ["doc/bbd.pod", M"Beschreibung des bbd-Formats"],
			 ["doc/tests.pod", M"Manuelle Testanweisung"],
			) {
	    my($file, $label) = @$doc_def;
	    my $full_path = $FindBin::RealBin . "/" . $file;
	    $m2->command
		(-label => $label,
		 -command => sub {
		     if ($file =~ m{\.pod$}) {
			 eval {
			     require Tk::Pod;
			 };
			 if ($@) {
			     perlmod_install_advice('Tk::Pod');
			 } else {
			     eval {
			         my $pod = $top->Pod(-file => $full_path,
						     -title => $label);
				 set_as_toolwindow($pod);
				 $toplevel{"pod-$label"} = $pod;
			     };
			     if ($@) {
				 status_message($@, "die");
			     }
			 }
		     } elsif ($file =~ m{\.org$}) {
			 require BBBikeAdvanced;
			 start_emacsclient("$FindBin::RealBin/$file");
		     } else {
			 require WWWBrowser;
			 my $url = "file:$full_path";
			 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",
					 );
				 });
    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');
	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("before 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("before iconframe: bindings");
## DEBUG_END
    bind_nomod($top, "<s>" => sub { $strasse_check->invoke}) if $strasse_check;
    bind_nomod($top, "<l>" => sub { $landstrasse_check->invoke }) if $landstrasse_check;
    bind_nomod($top, "<o>" => sub { $ort_check->invoke }) if $ort_check;
    bind_nomod($top, "<u>" => sub { $ubahn_check->invoke }) if $ubahn_check;
    bind_nomod($top, "<b>" => sub { $sbahn_check->invoke }) if $sbahn_check;
    bind_nomod($top, "<r>" => sub { $rbahn_check->invoke }) if $rbahn_check;
    bind_nomod($top, "<w>" => sub { $wasser_check->invoke }) if $wasser_check;
    bind_nomod($top, "<f>" => sub { $flaechen_check->invoke }) if $flaechen_check;
    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 $lstrcm && defined $radwege_l_check_index;
		   }
		   if ($str_draw{'s'} || $str_draw{'rw'} || !$str_draw{'l'}) {
		       $strcm->invoke($radwege_check_index) if $strcm && defined $radwege_check_index;
		   }
	       });
    bind_nomod($top, "<a>" => sub { $strcm->invoke($ampeln_check_index) }) if $strcm && defined $ampeln_check_index;
    bind_nomod($top, "<g>" => sub { $strcm->invoke($sperre_check_index) }) if $strcm && defined $sperre_check_index;
    bind_nomod($top, "<Q>" => sub {
		   # XXX hmmm... nicht gerade ideal. Beispiel: Landstra�en
		   # sind aktiv, Q, Stra�en werden aktiv gemacht, Q
		   # togglet jetzt genau entgegengesetzt...
		   if ($str_draw{'l'} || $str_draw{'ql'}) {
		       $lstrcm->invoke($qualitaet_l_check_index) if $lstrcm && defined $qualitaet_l_check_index;
		   }
		   if ($str_draw{'s'} || $str_draw{'qs'} || !$str_draw{'l'}) {
		       $strcm->invoke($qualitaet_check_index) if $strcm && defined $qualitaet_check_index;
		   }
	       });
    bind_nomod($top, "<H>" => sub {
		   # XXX hmmm... nicht gerade ideal. Beispiel: Landstra�en
		   # sind aktiv, H, Stra�en werden aktiv gemacht, H
		   # togglet jetzt genau entgegengesetzt...
		   if ($str_draw{'l'} || $str_draw{'hl'}) {
		       $lstrcm->invoke($handicap_l_check_index) if $lstrcm && defined $handicap_l_check_index;
		   }
		   if ($str_draw{'s'} || $str_draw{'hs'} || !$str_draw{'l'}) {
		       $strcm->invoke($handicap_check_index) if $strcm && defined $handicap_check_index;
		   }
	       });
    bind_nomod($top, '<N>' => sub { $strcm->invoke($nolighting_check_index) })
	if defined $nolighting_check_index;
    bind_nomod($top, '<G>' => sub { $strcm->invoke($gruene_wege_check_index) })
	if defined $gruene_wege_check_index;
    bind_nomod($top, '<C>' => sub { $c_bpcm->invoke($comments_all_check_index) })
	if defined $comments_all_check_index;
    bind_nomod($top, '<V>' => sub { $strcm->invoke($vorfahrt_check_index) })
	if defined $vorfahrt_check_index;
    bind_nomod($top, "<question>" => sub {
	$strcm->invoke($fragezeichen_check_index)
    })
	if defined $fragezeichen_check_index;
    bind_nomod($top, "<Y>" => sub { $strcm->invoke($cycle_routes_check_index) }) if $strcm && defined $cycle_routes_check_index;

    bind_nomod($top, "<L>" => sub { $lstrcm->invoke($land_jwd_check_index) }) if $lstrcm && defined $land_jwd_check_index;
    bind_nomod($top, "<O>" => sub { $ocm->invoke($ort_jwd_check_index) }) if $ocm && defined $ort_jwd_check_index;
    bind_nomod($top, "<W>" => sub { $wcm->invoke($wasserumland_check_index) }) if $wcm && defined $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) {
	next if !$w;
	enter_leave_bind_for_help($w, [M"Option umschalten", '', M"Men�"]);
    }

} # do_iconframe

$splash_screen->Update(0.3, 'load photos') if $splash_screen;

##### sonstige Bilder #####
## DEBUG_BEGIN
#mymstat("before 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;
{
    # Re-shuffle bindtags: the "Tk::Canvas" tag is moved from 1st to
    # 2nd position. A better solution would be to use a separate class
    # for the map canvas.
    my @c_bindtags = $c->bindtags;
    @c_bindtags = @c_bindtags[1,0,2..$#c_bindtags];
    $c->bindtags([@c_bindtags]);
}

$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 ("<Shift-5>", "<B1-5>") {
    $c->Tk::bind($_ => sub { $c->xviewScroll(+1,"units") });
}
for ("<Shift-4>", "<B1-4>") {
    $c->Tk::bind($_ => sub { $c->xviewScroll(-1,"units") });
}
$c->Tk::bind('<Control-4>' => sub { scalecanvas_from_canvas_event($c, 2); Tk->break; });
$c->Tk::bind('<Control-5>' => sub { scalecanvas_from_canvas_event($c, 0.5); Tk->break; });

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']
			 )
	  );
	print STDERR M("Datei-DND wird akzeptiert") . "\n" if $verbose;
    };
    warn __LINE__ . ": $@" if $@ && $verbose;
}

# erst hier setzen, weil die Hintergrundfarbe von -xrm und dem Window-System
# abh�ngt
$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,
	 -labelfont => $font{'reduced'},
	)->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_type = $indicator_frame->Label
	    (-text => '', -relief => 'sunken')
		->pack(-side => "left");
	$edit_mode_indicator = $indicator_frame->$Checkbutton
	    (-text => 'EDIT',
	     -variable => \$edit_mode_flag,
	     -command => sub {
		 set_edit_mode();
	     })->pack(-side => "left");
	gui_set_edit_mode($edit_mode);
    }
    $balloon->configure(-statusbar => $status_label);
}

use constant UPDATE_FRAC_BEFORE_PLOTTING => 0.4;
use constant UPDATE_FRAC_AFTER_PLOTTING => 0.7;

$splash_screen->Update(UPDATE_FRAC_BEFORE_PLOTTING, 'start plotting') if $splash_screen;

##### initiales Zeichnen ######################################
## DEBUG_BEGIN
#BEGIN{mymstat("before init draw BEGIN");} mymstat("before init draw");
## DEBUG_END
$progress->InitGroup;

######################################################################
# Custom Cursors
# Load it before possible use, e.g. in set_edit_mode
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'];
}
######################################################################

# Read as early as possible; to prevent inconsinstencies especially in lazy mode
read_ampeln() unless $lowmem;

if (defined $set_mode && $set_mode eq 'edit') {
    require BBBikeAdvanced;
    set_edit_mode(1);
    $init_p_draw{pp} = 1;
}
# XXX hack: if any of $wasserstadt/umland/... is set, then
# $init_str_draw{w} should also be set
if ($wasserstadt || $wasserumland || $str_far_away{w}) {
    $init_str_draw{w} = 1;
}
my $_update_steps = ((scalar keys %init_str_draw) +
		     (scalar keys %init_p_draw));
my $_update_i = 0;
foreach (keys %init_str_draw) {
    $str_draw{$_} = $init_str_draw{$_};
    eval {
	plot('str',$_)   if $str_draw{$_};   # Strecken plotten
    };
    if ($@ && !$no_original_datadir) {
	die $@;
    }
    $splash_screen->Update((($_update_i++)/$_update_steps)*(UPDATE_FRAC_AFTER_PLOTTING - UPDATE_FRAC_BEFORE_PLOTTING)+UPDATE_FRAC_BEFORE_PLOTTING, "plot str $_")
	if $splash_screen;
}
foreach (keys %init_p_draw) {
    $p_draw{$_} = $init_p_draw{$_};
    eval {
	plot('p',$_)     if $p_draw{$_};     # Punkte (z.B. Ampeln) zeichnen
    };
    if ($@ && !$no_original_datadir) {
	die $@;
    }
    $splash_screen->Update((($_update_i++)/$_update_steps)*(UPDATE_FRAC_AFTER_PLOTTING - UPDATE_FRAC_BEFORE_PLOTTING)+UPDATE_FRAC_BEFORE_PLOTTING, "plot p $_")
	if $splash_screen;
}
# H�hen einlesen
read_hoehe()  if $show_grade || $steigung_optimierung || $use_hoehe;
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 && !(defined $set_mode && $set_mode eq 'edit')) {
    search_route_mouse(1);
}

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

$splash_screen->Update(UPDATE_FRAC_AFTER_PLOTTING, 'finished plotting') if $splash_screen;

set_bindings();

$splash_screen->Update(0.8, 'after plotting') 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();
if ($top->{initial_iconic}) {
    $top->iconify; # may be necessary to undo ->withdraw
} else {
    $top->deiconify;
}

scrollregion_best();

# XXX should be after deiconify, otherwise center does not work (?)
center_best();

$splash_screen->Update(0.9, 'finalization') 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 w�re es, wenn mit "use" die aktuelle Zeit des Moduls
    # aufgezeichnet werden k�nnte. So beschr�nke ich mich auf
    # minutenweise �berpr�fen, 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 unterst�tzt kein fork etc.
    require BBBikeServer;
    BBBikeServer::create_server($top);
}

if ($turbo) {
    bbbikelazy_init();
}

if (defined $initial_plugins && $initial_plugins ne "") {
    load_plugins([split /,/, $initial_plugins]);
}

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

if ($splash_screen) {
    $splash_screen->Update(1, 'destroying splash');
    $splash_screen->Destroy;
    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 $@;
}

if ($init_with_edittools) {
    require BBBikeEdit;
    BBBikeEdit::init_with_edittools();
}

$booting = 0;

# Call this after creating the main window, otherwise
# bbbike -xrm '*Desk:...'
# does not work.
$top->afterIdle(sub {
		    $top->command([$^X, $0]);
		});

MainLoop unless $ENV{BBBIKE_TEST_PERFORMANCE};

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

sub update_via_internet {
    if ($devel_host && $ENV{HOST} !~ /^devpc01/) {
	status_message("Kein Update auf biokovo/cabulja/vran/cvrsnica/spiff m�glich!", "die");
	die;
    }
    my $Dialog = LongOrNormalDialog();
    my $d = $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 k�nnen 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',
	 -background => Tk::NORMAL_BG,
	 -highlightbackground => Tk::NORMAL_BG,
	 -buttons => [M"Ja", M"Nein"]);
    if ($Dialog eq 'LongDialog') {
	$d->configure(-height => 10);
    }
    if ($d->Show eq M"Ja") {
	require Update;
	Update::bbbike_data_update();
    }
}

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;
	my $reqwidth = $w->reqwidth;
	# Special handling for Place/Street label: it shrinks as necessary.
	if ($w == $hslabel_frame && $reqwidth > $top->width/3) {
	    $reqwidth = $top->width/3;
	}
	$width += $reqwidth;
	if ($gridslaves{$w}) {
	    $w->gridForget;
	}
	if ($width <= $top->width) {
	    $w->grid(-row => 0,
		     -column => $col,
		     -sticky => 'nsew'); # XXX
	} elsif ($devel_host) { # XXX only for debugging, remove one day
	    require Data::Dumper;
	    warn "No space for widget\n" .
		Data::Dumper->new([$w->class, $w->PathName],[qw(class pathname)])->Indent(1)->Useqq(1)->Dump .
			" with i=$i, $width <= " . $top->width;
	}
    }
}

# Berechnet das Layout des Symbol-Frames (das die Icons enth�lt) 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';
	    }
	}
    }
}

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"Stra�en",	var => \$init_str_draw{'s'}],
	 ['landstr','!',0,	alias=>[qw(landstrasse landstrassen)],
	  label => M"Landstra�en",	var => \$init_str_draw{'l'}],
	 ['landstrjwd','!',0,
	  label => M"Landstra�en 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-Bahnh�fe",	var => \$init_p_draw{'b'}],
	 ['ubahn','!',1,
	  label => M"U-Bahnlinien",	var => \$init_str_draw{'u'}],
	 ['ubahnhof','!',1,
	  label => M"U-Bahnh�fe",	var => \$init_p_draw{'u'}],
	 ['rbahn','!',0,
	  label => M"R-Bahnlinien",	var => \$init_str_draw{'r'}],
	 ['rbahnhof','!',0,
	  label => M"R-Bahnh�fe",	var => \$init_p_draw{'r'}],
	 ['wasser','!',1,	alias=>[qw(gewaesser)],
	  label => M"Gew�sser",	var =>\$init_str_draw{'w'}],
	 ['wasserstadt','!',1,
	  label => M"Gew�sser in der Stadt", var => \$wasserstadt],
	 ['wasserumland','!',0,
	  label => M"Gew�sser im Umland", var => \$wasserumland], # XXX auch init!
	 ['wasserjwd','!',0,
	  label => M"Gew�sser jwd", var => \$str_far_away{'w'}],
	 ['faehre','!',0,	alias=>[qw(faehren)],
	  label => M"F�hren",	var => \$init_str_draw{'e'}],
	 ['flaeche','!',1,	alias=>[qw(flaechen)],
	  label => M"Fl�chen",	var => \$init_str_draw{'f'}],
	 ['ort','!',0,	alias=>[qw(orte)],
	  label => M"Orte",	var => \$init_p_draw{'o'}],
	 ['ortsteil','!',0,	alias=>[qw(ortsteile)],
	  label => M"Ortsteile",var => \$init_str_draw{'gBO'}],
	 ['ortjwd','!',0,
	  label => M"Orte jwd",	var => \$p_far_away{'o'}],
	 ['sehenswuerdigkeiten','!',0,
	  label => M"Sehensw�rdigkeiten", var => \$init_str_draw{'v'}],
	 ['cyclepath', '!',0,	alias => [qw(radweg radwege)],
	  label => M"Radwege",	var => \$init_str_draw{'rw'}],
	 ['cycleroute', '!',0,	alias => [qw(radroute radrouten)],
	  label => M"Radrouten", var => \$init_str_draw{'comm-route'}],
	 ['greenway', '!',0,	alias => [qw(gruenerweg gruenewege)],
	  label => M"Gr�ne Wege", var => \$init_str_draw{'gr'}],
	 ['ampel','!',1,	alias=>[qw(ampeln|lsa)],
	  label => M"Ampeln zeichnen", var => \$init_p_draw{'lsa'}],
	 ['fragezeichen','!',0,
	  label => M"Fragezeichen",	var => \$init_str_draw{'fz'}],

	 M"Plot-Attribute",
	 ['outline','!',0,
	  label => M"Outline zeichnen", var => \$all_outline],
	 ['lsamaybe','!',undef, nogui => 1, # XXX remove this option???
	  label => M"unsichere Ampeln", var => sub { $str_restrict{'lsa'} = {qw(? 1 X 0 B 0 F 0)} }],
	 ['plothoehe','!',0,
	  label => M"H�henangaben zeichnen",	var => \$init_p_draw{'hoehe'}],
	 ['showgrade','!',1,
	  label => M"Anzeige der Steigungen/Gef�lle", var => \$show_grade],
	 ['grademinimum','=f',0.01, # ab 1% Steigungen/Gef�lle zeigen
	  label => M"minimal angezeigte Steigung",	var => \$grade_minimum],
	 ['grademinimumshort','=f',0.02, # kurze St�cke erst ab 2% zeigen
	  label => Mfmt("minimale Steigung (kurze Strecken bis %dm)", $grade_minimum_short_length),	var => \$grade_minimum_short],
	 ['strname','!',0,
	  label => M"Stra�ennamen plotten",	var => \$str_name_draw{'s'}],
	 ['ubahnname','!',1,
	  label => M"Namen von U-Bahnh�fen anzeigen", var => \$p_name_draw{'u'}],
	 ['sbahnname','!',1,
	  label => M"Namen von S-Bahnh�fen 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"Gew�ssernamen 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 Stra�e zentrieren", var => \$center_on_str],
	 ['centerc','=s',undef,
	  label => M"Beim Starten auf Koordinaten zentrieren",
	  widget => sub {
	      my($self, $frame, $opt) = @_;
	      my $vref = $self->varref($opt);
	      my $f2 = $frame->Frame;
	      $f2->Entry(-textvariable => $vref)->pack(-side => "left");
	      $f2->Button(-text => M"Aktueller Kartenausschnitt",
			  -command => sub {
			      my(@corner) = $c->get_corners;
			      my $c_w = ($corner[2]-$corner[0]);
			      my $c_h = ($corner[3]-$corner[1]);
			      $$vref = join ",", map { int } anti_transpose($corner[0]+$c_w/2, $corner[1]+$c_h/2);
			  })->pack(-side => "left");
	      $f2;
	  },
	  var => \$center_on_coord],
	 ['center2c','=s',undef, # XXX currently not really used, but some day may be used together with center_view2
	  nogui => 1,
	  var => \$center_on_coord2],
	 ['choosestreet','!',1,
	  label => M"Beim Starten Stra�enauswahl 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 Stra�endaten",
	  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 Zeichens�tze", 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"Zeichensatzgr��e", var => \$font_size,
	  longhelp => M"Negative Gr��en sind in Pixeln, positive in Points",
	 ],
	 ['labelfontheight','=i',10,
	  alias => [qw(labelfontsize)],
	  label => M"Zeichensatzgr��e f�r Labels", var => \$label_font_size,
	  longhelp => M"Negative Gr��en sind in Pixeln, positive in Points",
	 ],
	 ['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, nogui => 1,
	  label => M"X11-Skalierung", var => \$scaling],
	 ['visual','=s',undef, nogui => 1,
	  label => M"Visual", var => \$visual],
	 ['scale','=s',undef,
	  label => M"Skalierung", nogui => 1,
	  var => \$init_scale_massstab,
	 ],
	 ['coloring','=s','red',
	  label => M"Einf�rben der Route", var => \$coloring,
	  choices => [qw(red blue black power wind)]],
	 ['', '', '-'],
	 ['overviewwasser','!',1,
	  label => M"�bersichtskarte mit Gew�ssern", var => \$overview_draw{'w'}],
	 ['overviewsbahn','!',0,
	  label => M"�bersichtskarte mit S-Bahnen", var => \$overview_draw{'b'}],
	 ['overviewrbahn','!',0,
	  label => M"�bersichtskarte mit Regionalbahnen", var => \$overview_draw{'r'}],
	 ['overviewstr','!',0,
	  label => M"�bersichtskarte mit Hauptstra�en", var => \$overview_draw{'s'}],

	 M"GUI",
	 ['menu','!',1,	# XXX hier stand mal "menu|stdmenu|standardmenu" => aber Aliase werden anscheinend von Tk::GetOpt nicht unterst�tzt?!
	  label => M"Standard-Men�", var => \$standard_menubar,
	 'callback-interactive' => \&restart_bbbike_hint,
	 ],
	 ['balloon','!',1,
	  label => M"Balloons", var => \$use_balloon,
	 'callback-interactive' => \&restart_bbbike_hint,
	 ],
	 ['cballoon','=i',2,    # 0 = nie, 1 = auf der Route, 2 = immer
	  strict => 1,
	  choices => [[M"nie" => 0],
		      [M"nur auf der Route" => 1],
		      [M"�berall" => 2],
		     ],
	  callback => \&c_balloon_update,
	  label => M"Canvas balloons", var => \$use_c_balloon],
	 ['cballoonwait','=i',350,
	  label => M"Wartezeit f�r 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"Stra�enqualit�t beachten", var => \$qualitaet_s_optimierung],
	 ['qualitaetwerte','!',{Q0 => 100,
				Q1 => 25,
				Q2 => 18,
				Q3 => 13},
	  label => M"Stra�enqualit�t konfigurieren", var => \%qualitaet_s_speed,
	  nogui => 1],		# XXX Tk::Getopt can't handle this yet
	 ['kategorieoptimierung','!',0,
	  label => M"Stra�enkategorien beachten", var => \$strcat_optimierung],
	 ['kategoriewerte','!',{B  => 100,
				HH => 100,
				#BAB => 100,
				H  => 100,
				NH => 100,
				N  => 100,
				NN => 100},
	  label => M"Stra�enkategorien 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],#XXX N_RW vs. N_RW1 missing!
	 ['tram_optimization', '!', 0, var => \$tram_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"Gr�ne Wege bevorzugen", var => \$green_optimization,
	 ],
	 ['unbeleuchtetoptimierung', '!', 0, var => \$unlit_streets_optimization,
	  label => M"Unbeleuchtete Stra�en meiden"],
	 ['steigungoptimierung', '!', 0, var => \$steigung_optimierung,
	  label => M"Steigungsoptimierung"],
	 ['handicapoptimierung','!',0,
	  label => M"Sonstige Beeintr�chtigungen beachten", var => \$handicap_s_optimierung],
	 ['handicapwerte','!',{q0 => 100,
			       q1 => 25,
			       q2 => 18,
			       q3 => 13,
			       q4 => 5, # z.B. Fu�g�ngerzonen
			      },
	  label => M"Sonstige Beeintr�chtigungen konfigurieren", var => \%handicap_s_speed,
	  nogui => 1],		# XXX Tk::Getopt can't handle this yet
	 ['sperre','!',undef,		alias => [qw(gesperrt)],
	  label => M"Gesperrte Stra�en beachten", nogui => 1,
	  var => sub {
	      $sperre{'einbahn'} = $sperre{'sperre'} = $sperre{'wegfuehrung'} = 1;
	  },
	  savevar => \$sperre{'einbahn'},
	 ],
	 ['einbahn-strict','!',undef,
	  label => M"Alle Einbahnstra�en *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','!',1,
	  label => M"Aktuelle 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"F�hren verwenden", var => \$use_faehre],
	 ## Without bikepower things like Steigungsoptimierung do not work anymore
	 #['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],
	 (0&&$devel_host ?
	  (
	   ['wwwmap','!',undef,
	    label => M"Karten �bers WWW holen", var => \$do_wwwmap],
	   ['wwwcache','!',0,
	    label => M"Cache f�r WWW-Karten verwenden", var => \$use_wwwcache],
	  ) : ()
	 ),
	 ['proxy','=s', undef,
	  label => M"HTTP-Proxy (Format: http://host:port/)", var => \$proxy],
	 ['cachedir','=s',undef,
	  label => M"Cacheverzeichnis", subtype => 'dir',
	  var => \$cache_root],

	 M"GPS",
	 ['exporttxtmode','=i',EXPORT_TXT_SIMPLIFY_AUTO,
	  label => M"Vereinfachung von Routen",
	  longhelp => M"GPS-Ger�te k�nnen 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 Stra�ennamen"), EXPORT_TXT_SIMPLIFY_NAME],
		      [M("Abbiegevorg�nge"), EXPORT_TXT_SIMPLIFY_ANGLE],
		      [M("Abbiegevorg�nge/unterschiedliche Stra�ennamen"), 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,100,250],
	  label => M"Maximale Anzahl der GPS-Waypoints",
	  longhelp => M"Moderne Garmin-Ger�te wie der eTrex Vista HCx k�nnen 250 Waypoints pro Route verwenden,\netwas �ltere wie der eTrex Vista 50 Waypoints,\nw�hrend noch �ltere nur 20 Waypoints laden k�nnen\n",
	  var => \$gps_waypoints,
	 ],
	 ['gpswaypointlength','=i',10,
	  choices => [10, 14, 20],
	  label => M"Maximale L�nge von GPS-Waypoint-Namen",
	  longhelp => M"Typischerweise 10 bei �lteren Garmin-Ger�ten, aber neuere Ger�te k�nnen l�ngere Namen verwenden (eTrex Vista HCx z.B. offiziell 14 Zeichen, tats�chlich sogar 20 Zeichen)",
	  var => \$gps_waypointlength,
	 ],
	 ['gpswaypointcharset','=s','simpleascii',
	  label => 'Zeichensatz f�r Waypoints',
	  strict => 1,
	  choices => [['Nur Gro�buchstaben' => 'simpleascii'],
		      ['Gro�/Kleinbuchstaben' => 'ascii'],
		      ['Gro�/Kleinbuchstaben, Umlaute' => 'latin1'],
		     ],
	  var => \$gps_waypointcharset,
	 ],
	 ['gpswaypointsymbol','=i','',
	  label => M"Waypointsymbol",
	  longhelp => M"Garmin-Symbol-ID. Falls leer gelassen, wird das Summit-Symbol verwendet",
	  var => \$gps_waypointsymbol,
	 ],
	 ['gpsneeduniqueroutenumber','!',0,
	  label => M"GPS-Ger�t ben�tigt eindeutige Routennummern",
	  longhelp => M"Laut Garmin-Spezifikationen m�ssen �betragene Routen mit einer eindeutigen Routennummer versehen werden.\nExperimente haben aber gezeigt, dass die meisten (oder alle?) Garmin-Ger�te dieses nicht ben�tigen.",
	  var => \$gps_needuniqueroutenumber,
	 ],
	 ['gpsdevice','=s',($os eq 'win'   ? "USB" :
			    $os_bsd        ? '/dev/cuaa0' :
			    $^O eq 'linux' ? '/dev/ttyUSB0'
				           : '/dev/ttyS0'
			   ),
	  choices => (  $os eq 'win' ? ["USB", (map {  "COM$_" 			       } (1..4))]
		      : $os_bsd      ? [map {  "/dev/cuaa$_"		       } (0..3) ]
		      :                [map { ($_."0", $_."1", $_."2", $_."3") } ("/dev/ttyUSB", "/dev/usb/ttyUSB", "/dev/tts/USB", "/dev/ttyS") ]
		     ),
	  label => M"GPS-Device", var => \$gps_device],

	 M"Sonstiges",
	 ['kde','!',undef,
	  label => M"F�r KDE optimieren", var => \$run_under_kde],
	 ['handheld','!',undef,
	  label => M"F�r kleine Bildschirme optimieren", var => \$is_handheld,
	  longhelp => M"F�r kleine Bildschirme (Handhelds, PDAs, mobile Telefone) optimieren. Bei dieser Einstellung werden kleine Symbole verwendet und das normale Men� wird entfernt",
	 ],
	 ['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" (f�r GDF-Daten als Standard)
	  # "onlineoffice" (f�r Onlineoffice-Pr�sentationen)
	  nogui => 1, var => \$environment],
	 ['mldbm','!',0,
	  label => M"Verwendung von MLDBM",
	  longhelp => M"Die interne Stra�ennetz-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";
	  }
	 ],
	 ['edittools','!',undef,
	  label => M"Editierwerkzeuge beim Starten �ffnen",
	  nogui => 1, 	# XXX remove some day?
	  var => \$init_with_edittools,
	 ],
	 ['texteditor','=s',undef,
	  label => M"Externer Texteditor",
	  var => \$texteditor,
	  longhelp => M"M�gliche Werte sind vi (automatisch in einem xterm gestartet), emacsclient, gnuclient",
	 ],
	 ['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'}, nosave => 1, nogui => 1],
	 ['advanced','!',undef, var => \$advanced,
	  label => M"Advanced mode"],
	 ['public','!',undef, nogui => 1,
	  var => \&_set_public],
	 ['publicconfig','!',undef, nogui => 1,
	  var => \&_set_public],
	 ['configfile','=s',undef, nogui => 1], # used only in pre_check_arguments
	 ['v','!',0,	alias => [qw(verbose)],
	  label => M"Verbose", var => \$verbose,
	  longhelp => M"Die Variable \$verbose kann manuell auf 2 oder h�her gesetzt werden, um die Anwendung wortreicher zu machen"],
	 ['version','!',undef,
	  nogui => 1, var => sub {
	      my %git_info;
	      if (-r "$FindBin::RealBin/miscsrc/BBBikeGit.pm") {
		  require "$FindBin::RealBin/miscsrc/BBBikeGit.pm";
		  %git_info = BBBikeGit::git_info();
	      }
	      print("$progname $VERSION\n",
		    ($git_info{patchnum} ? "(patchnum $git_info{patchnum})\n" : ''),
		    "perl $]\nTk $Tk::VERSION\n",
		   );
	      CORE::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", # XXX Auf den PluginLister verweisen, wenn er fertig ist.
	  widget => sub {
	      my $self = shift;
	      my $frame = shift;
	      my(@args) = @_;
	      my $f = $frame->Frame;
	      $self->_string_widget($f, @args)->pack(-side => "left");
	      $f->Button(-text => M"Plugin-Lister",
			 -padx => 1,
			 -pady => 1,
			 -command => sub {
			     require BBBikePluginLister;
			     BBBikePluginLister::plugin_lister($top, $FindBin::RealBin);
			 })->pack(-side => "left");
	      $f;
	  },
	 ],
	 ['layers','=s',undef,
	  label => M"Zus�tzliche 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.4951);
    };
    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;
	pre_check_arguments(); # sets $public
#	$opt = Tk::Getopt->new
	$opt = My::Tk::Getopt->new
	    (-opttable => \@opttable,
	     -filename => defined $config_file ? $config_file : catfile($bbbike_configdir, ($public ? "config_publictest" : "config")),
	     -useerrordialog => 1,
	    );
	$opt->set_defaults;
	$opt->load_options if !$public || $public_config; # 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;
    }
}

sub _set_public {
    $public_test = 1;
    $advanced = 0;
    $devel_host = 0;
    $do_www = 0;
    $no_map = 1;
    $public = 1;
    $autosave_opts = 0;
    $lazy_plot = 0;
    undef $proxy;
    # Not in old standard Tk:
    if ($Tk::VERSION < 804) {
	$can_handle_image{png} = 0;
        $can_handle_image{jpg} = 0;
    }
}

sub c_balloon_update {
    if ($c_balloon && Tk::Exists($c_balloon)) {
	$c_balloon->configure(-show => $use_c_balloon);
    }
}

# Check for -public and -publicconfig options --- in this case do not
# load the config file.
sub pre_check_arguments {
    for(my $arg_i=0; $arg_i<=$#ARGV; $arg_i++) {
	my $arg = $ARGV[$arg_i];
	if ($arg eq '-public') {
	    $public = 1;
	} elsif ($arg eq '-publicconfig') {
	    $public = 1;
	    $public_config = 1;
	} elsif ($arg eq '-configfile') {
	    $config_file = $ARGV[$arg_i+1];
	    die "Expected argument for -configfile option" if !$config_file;
	    $arg_i++;
	}
    }
}

# 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 (<=> mi)
sub change_unit {
    my $new_unit = shift;
    if (defined $new_unit) {
	$unit_s = $new_unit;
    } elsif ($Msg::lang eq 'en') {
	$unit_s = ($unit_s eq 'km' ? 'mi' :
		   $unit_s eq 'mi' ? 'm' :
		   'km');
    } else {
	$unit_s = ($unit_s eq 'km' ? 'm' : 'km');
    }
    updatekm();
}

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

sub load_photos {
    # Note that some rarely used photos are loaded on-demand.
    $flag_photo{'start'} = load_photo($top, 'flag2_bl_centered');
    $flag_photo{'via'}   = load_photo($top, 'flag_via_centered');
    $flag_photo{'ziel'}  = load_photo($top, 'flag_ziel_centered');
    $ampel_photo         = load_photo($top, 'ampel');
    $ampel_klein2_photo  = load_photo($top, 'ampel_klein2');
    $ampelf_photo        = load_photo($top, 'ampelf');
    $ampelf_klein_photo  = load_photo($top, 'ampelf_klein');
    $ampelf_klein2_photo = load_photo($top, 'ampelf_klein2');
    $andreaskr_klein_photo = load_photo($top, 'andreaskr_klein');
    $andreaskr_klein2_photo= load_photo($top, 'andreaskr_klein2');
    $andreaskr_photo     = load_photo($top, 'andreaskr');
    $andreaskr_grey_klein_photo = load_photo($top, 'andreaskr_klein', -palette => 256);
    $andreaskr_grey_klein2_photo= load_photo($top, 'andreaskr_klein2', -palette => 256);
    $andreaskr_grey_photo       = load_photo($top, 'andreaskr', -palette => 256);
    $kreisverkehr_photo  = load_photo($top, 'kreisverkehr');
    $windrose2_photo     = load_photo($top, 'windrose2');
    $kneipen_photo       = load_photo($top, 'glas');
    $kneipen_klein_photo = load_photo($top, 'glas_klein');
    $essen_photo         = load_photo($top, 'essen');
    $essen_klein_photo   = load_photo($top, 'essen_klein');
    $kino_klein_photo    = load_photo($top, 'kino_klein');
    $steigung_photo      = load_photo($top, 'steigung');
    $gefaelle_photo      = load_photo($top, 'gefaelle');
    $inwork_photo        = load_photo($top, 'inwork_18');
    $inwork_klein_photo  = load_photo($top, 'inwork_12');
    $achtung_photo       = load_photo($top, 'achtung');
    $cal_photo           = load_photo($top, 'cal');
    $cal_questionmark_photo = load_photo($top, 'cal_questionmark');
    $clock_photo	 = load_photo($top, 'clock');
    $night_photo	 = load_photo($top, 'night');
    $ferry_photo         = load_photo($top, 'ferry')
	if !$ferry_photo;
    $ferry_klein_photo   = load_photo($top, 'ferry_klein');
    $ferry_mini_photo    = load_photo($top, 'ferry_mini');
    $zugbruecke_photo    = load_photo($top, 'zugbruecke');
    $zugbruecke_klein_photo
	= load_photo($top, 'zugbruecke_klein');
    $notrailer_photo     = load_photo($top, 'notrailer');
#XXX not yet necessary:
#    $blocked_photo       = load_photo($top, 'redcross');
}

sub set_default_geometry {
    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);
    } elsif ($^O eq 'darwin') {
	@max_extends = MacOSXUtil::client_window_region($top);
    } else {
	if (
	    # check for broken ->property on 64bit platforms
	    ($Tk::VERSION >= 804.027501 || $Config{longsize} == 4) &&
	    $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 hmmm, does not need to be necessary on gnome/metacity
	    #$max_extends[3]-=24; # XXX "
	}
    }
    if (!@max_extends) {
	# XXX guess width/height of wm borders and title bar
	@max_extends = (0, 0, $top->screenwidth-10, $top->screenheight-24);
    }

    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
    my @area_cats = qw(P W I Ae ex-Ae Forest Cemetery Orchard Green Sport Industrial Mine);
    %category_color =
	('NN' => '#bdffbd',
	 'N'  => 'grey98',
	 'NH' => '#ffffb0',     # noch blasseres gelb --- XXX �berhaupt unterscheidbar?
	 'H'  => '#ffff90', 	# blassgelb
	 'HH' => '#fff800', 	# kr�ftiges gelb
	 'BAB' => 'DarkBlue',
	 'B'  => 'red3',
	 # zweiter (pragmatischer) Versuch einer Qualit�tskategorisierung
	 # sehr guter Asphalt = guter Asphalt (genauere Kategorisierung nicht
	 # erforderlich)
	 # sehr gutes Kopfsteinpflaster = guter Asphalt		Q0
	 # gutes Kopfsteinpflaster      = m��iger Asphalt	Q1
	 # m��iges Kopfsteinpflaster    = schlechter Asphalt	Q2
	 # schlechtes Kopfsteinpflaster				Q3
	 'Q0' => 'DarkSeaGreen4',
	 'Q1' => 'YellowGreen',
	 'Q2' => 'gold',
	 'Q3' => 'red',
	 # sonstige Beeintr�chtigungen, die nicht auf schlechte Qualit�t zur�ckzuf�hren
	 # sind und nur die Geschwindigkeit reduzieren. Geschwindigkeitsreduktion
	 # wie bei Q.
	 'q0' => 'DarkSeaGreen4',
	 'q1' => 'YellowGreen',
	 'q2' => 'gold',
	 'q3' => 'red',
	 'q4' => '#c00000',
	 # sonstiges
	 'S'  => 'green3',	# S-Bahn
	 'SA' => 'green3',	# S-Bahn, Zone A
	 'SB' => 'green3',	# S-Bahn, Zone B
	 'SC' => '#008000', 	# S-Bahn, Zone C
	 'S0' => '#a0b0a0', 	# stillgelegte S-Bahn
	 'SBau' => '#a0b0a0', 	# S-Bahn in Bau
	 'SBetrieb' => 'green3', 	# S-Bahn, Betriebsfahrten
	 ## neues Farbschema an DB-Farben orientiert
	 ## nicht gut, da nicht gut von Bundesstra�en unterscheidbar
	 #     'RA' => '#bb171d',  # R-Bahn, Zone A
	 #     'RB' => '#bb171d',  # R-Bahn, Zone B
	 #     'RC' => '#bb171d', # R-Bahn, Zone C
	 #     'R'  => '#bb171d', # R-Bahn, au�erhalb
	 #     '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, au�erhalb
	 'R0' => '#a0b0a0', 	# stillgelegte R-Bahn
	 'RBau' => '#a0b0a0', 	# in Bau
	 'RG' => '#a0c8a0',	# G�terbahnen
	 'RP' => '#49c043',	# Parkbahnen...
	 'U'  => '#000080', 	# U-Bahn
	 'UA' => '#000080', 	# U-Bahn, Zone A
	 'UB' => '#000080', 	# U-Bahn, Zone B
	 'U0' => '#a0a0b0', 	# stillgelegte U-Bahn
	 'UBau' => '#a0a0b0', 	# U-Bahn in Bau
	 'UBetrieb' => '#000080', 	# U-Bahn, Betriebsfahrten
	 'W'  => '#bad5f7', 	# Gew�sser
	 'WR' => '#404080',	# Wasserrouten
	 'P'  => '#76c48b', 	# Parks
	 'Forest'  => '#66b47b', 	# W�lder
	 'Cemetery'  => '#70c085', 	# Friedh�fe
	 'Green' => '#76c48b', 	# sonstige Gr�nanlagen
	 'Orchard' => '#e8f8c8', 	# Kleing�rten (was #80ca94)
	 'Sport' => '#c8d898', 	# Sportanlagen (was #86d49b)
	 'Industrial' => '#d7b8c8',	# Industriegebiete
	 'Ae' => 'white',	# Flugh�fen
	 'ex-Ae' => 'white',	# ehemalige Flugh�fen
	 'Mine' => 'white',	# Tagebau, Bergbau
	 'F'  => 'grey99',	# sonstige Fl�chen
	 'SW' => 'red',		# Sehensw�rdigkeit
	 'Shop' => 'red',	# Einkaufszentrum, Markthalle
	 'Q'  => 'grey99',	# F�hre
	 'I'  => 'grey85',	# Inseln (wird sp�ter �berschrieben)
	 'Z'  => 'black',	# PLZ-Grenzen

	 'RW1' => 'SlateBlue',	# siehe Radwege.pm
	 'RW2' => '#00008b',   	# DarkBlue ist in der Win-Version undefiniert
	 'RW3' => '#80e599',	# fr�her LightBlue, jetzt fast green, da fast kein Unterschied zwischen Suggestiv-/Radstreifen
	 'RW4' => 'green',
	 'RW5' => 'orange',
	 'RW6' => 'yellow3',
	 'RW7' => 'green',
	 'RW8' => '#000060',
	 'RW9' => 'SlateBlue',
	 'RW10' => 'green',
	 'RW'  => 'SlateBlue',

	 'sperre0' => 'red',	# Tragen
	 'sperre1' => 'blue',	# Einbahnstra�en
	 'sperre1s' => '#b0b0ff',  # Einbahnstra�en (nur mit "einbahn-strict")
	 'sperre2' => 'red',	# voll gesperrt
	 'sperre3' => 'red',	# Wegf�hrung gesperrt

	 'IN' => 'violet',	# Industrieanlagen
	 'HB' => 'DarkViolet',	# Hafenanlagen
	 'BU' => '#c08080',    	# Built-up areas
	 'FO' => '#46b47b',    	# W�lder
	 '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 Stra�e
	 '-1' => '#00c000',
	 '+1' => '#c00000',
	 '+2' => '#800000', # (relativ) verkehrsreiche Stra�e

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

	 'radroute' => 'SlateBlue',

	 'X' => "red", # fallback color
	);
    for (qw(Q0 Q1 Q2 Q3 q0 q1 q2 q3 q4)) { # same colors for tendencies
	$category_color{$_."-"} = $category_color{$_};
	$category_color{$_."+"} = $category_color{$_};
    }
    for (1 .. 10) {
	$category_color{"RW".$_."?"} = $category_color{"RW".$_};
    }
    $layer_category_color{'e'}->{'CS'} = $category_color{'Q'};
    %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 RBau RG RP)) { $category_font_color{$_} = $category_font_color{"R"} }
    %category_font =
	(
	 'W'  => ($has_xft ? "$sans_serif_font_family:size=%d:matrix=1 -0.15 0 1" : "$sans_serif_font_family %d italic"),
	 'I'  => "$sans_serif_font_family %d italic",
	 'P'  => "$sans_serif_font_family %d",
	 'Ae' => "$sans_serif_font_family %d",
	 'ex-Ae' => "$sans_serif_font_family %d",
	);
    # all other area categories:
    for my $cat (@area_cats) {
	if (!exists $category_font{$cat}) {
	    $category_font{$cat} = $category_font{'P'};
	}
    }
    # 'above' categories share the same attributes like the non-'above' ones:
    for my $cat (@area_cats) {
	my $cat_above = $cat . 'above';
	if (!exists $category_color{$cat_above} && exists $category_color{$cat}) {
	    $category_color{$cat_above} = $category_color{$cat};
	}
	if (!exists $category_font{$cat_above} && exists $category_font{$cat}) {
	    $category_font{$cat_above} = $category_font{$cat};
	}
    }

    #$pp_color = '#008000'; # bad contrast with rbahn, not good with Bundesstra�e, but better with fragezeichen
    # second element is color for real crossing, but not yet activated
    #$pp_color = ['#800000', 'blue'];
    #$pp_color = '#800000'; # bad contrast with fragezeichen
    $pp_color = '#000080';

    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 =
	();

    # XXX use klein and klein2 versions, how? array/hash for different scalings?
    %category_image =
	('bg'  => "aufzug.gif", # bg=behindertengerecht
	 'bf'  => "rampe.gif", # bf=behindertenfreundlich
	);

    %category_stipple =
	(
	 'Cemetery' => 'crosses.xbm',
	 'Cemetery|religion:jewish' => 'stars_of_david.xbm',
	 'Cemetery|religion:muslim' => 'halfmoons.xbm',
	);

    %line_width =
	('s-NN'     => [1, 1, 2, 2, 4, 7],
	 's-N'      => [1, 1, 2, 2, 4, 7],
	 's-NH'     => [1, 1, 2, 3, 5, 8],
	 's-H'      => [1, 2, 3, 4, 6, 10],
	 's-HH'     => [1, 2, 3, 4, 6, 10],
	 's-B'      => [1, 2, 3, 4, 6, 10],
	 's-BAB'    => [1, 2, 3, 4, 6, 10],
	 'sBAB-BAB' => [1, 2, 3, 4, 6, 10],
	 '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],
	 'sperre3nocross' => [0, 0, 1, 1, 2, 3],
	 '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],
	 'comm-scenic-View' => [4, 7, 9, 12, 16, 20],
	 'u-UBetrieb' => [1, 1, 2, 3, 4, 6],
	 'b-SBetrieb' => [1, 1, 2, 3, 4, 6],
	 'default'  => [1, 2, 3, 4, 6, 10],
	);
    foreach (qw/NN N NH H HH B BAB/) {
	$line_width{"l-$_"} = [@{ $line_width{"s-$_"}}];
    }
    foreach (qw/sperre1s/) {
	$line_width{$_} = [@{ $line_width{"sperre1"}}];
    }
    foreach (qw/gBO gP gD/) {
	$line_width{$_} = [@{ $line_width{"g"}}];
    }
    my %narrow_comments_types = map {($_,1)} qw(tram misc mount kfzverkehr scenic);
    foreach (@comments_types) {
	if ($narrow_comments_types{$_}) {
	    $line_width{'comm-'.$_} = [1, 1, 1, 1, 2, 3];
	} else {
	    $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],
	 'comm-tram' => [2,6],
	 'mount'=> [5,2],
	 'e'    => [5,2],	# F�hren
	 'g'    => [8,5,2,5],	# Grenzen
	 'z'    => [8,5,2,5],	# PLZ-Grenzen
	 'sperre3' => [6,2],
	 'fz'   => [8,5],
	 'Tu'   => [4,5],	# Tunnel (addinfo)
	);
    %category_dash =
	('R0'   => [1,5],
	 'U0'   => [1,5],
	 'S0'   => [1,5],
	 'radroute' => [1,15],
	);
    %category_capstyle =
	('radroute' => 'round'); # XXX $capstyle_round not available at this time!
    foreach (qw/gBO gP gD/) {
	$line_dash{$_} = [@{ $line_dash{"g"}}];
    }
    foreach (grep { $_ !~ m{^(tram|ferry|cyclepath)$} } @comments_types) {
	$line_dash{"comm-".$_} = [@{ $line_dash{"comm"}}];
    }
    $line_dash{'comm-ferry'} = $line_dash{'e'};

    %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"}}];
    }

    %category_line_arrow =
	('PI' => 'last',
	 'P0' => 'last',
	);
    %category_line_shorten =
	('CP'  => 1,
	 'P0'  => 1,
	);
    %category_line_shorten_end =
	('CP2' => 1,
	 'PI'  => 1,
	);
    # Label size per category
    %category_size =
	('NN' => 7,
	 'N'  => 8,
	 'NH' => 9,
	 'H'  => 10,
	 'HH' => 10,
	 'B'  => 10,
	 'BAB'=> 10,
	 'W'  => 12);
    %category_point_size =
	('?' => 10,
	);
    %outline_color =
	('s' => 'grey70',
	 'l' => 'grey70',
	 'w' => 'blue4',
	 'i' => 'blue4',
	);
    %str_file =
	(# "primary"
	 '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",
	 'gBO'=> "berlin_ortsteile",
	 'e'  => 'faehren',
	 # dependent
	 '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',
	 # special
	 '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',
	 'GU'     => 'grenzuebergaenge',
	);

    # Feld-Elemente
    # 0: Bezeichnung, Singular
    # 1: Bezeichnung, Plural
    # 2: Linien (bool)
    # 3: (falls vorhanden) lange Bezeichnung
    %str_attrib =
	('s' => [M"Stra�e",      M"Stra�en",      0],
	 'l' => [M"Landstra�e",  M"Landstra�en",  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"Gew�sser",    M"Gew�sser",     0],
	 'f' => [M"Fl�che",      M"Fl�chen",      0],
	 'v' => [M"Sehensw�rdigkeit", M"Sehensw�rdigkeiten",      0],
	 'z' => [M"PLZ-Gebiet",  M"PLZ-Gebiete",  0],
	 'g' => [M"Grenze von Berlin", M"Grenze von Berlin",       0], # see below for override
	 'gP' => [M"Grenze von Potsdam", M"Grenze von Potsdam",       0],
	 'gD' => [M"Staatsgrenze", M"Staatsgrenze",       0],
	 'gBO' => [M"Berliner Ortsteil", M"Berliner Ortsteile", 0], # see below for override
	 'e' => [M"F�hre",       M"F�hren",       0],
	 'rw' => [M"Radweg",     M"Radwege", 0],
	 'qs' => [M"Stra�enqualit�t", M"Stra�enqualit�t", 0],
	 'ql' => [M"Stra�enqualit�t (Landstra�e)", M"Stra�enqualit�t (Landstra�e)", 0],
	 'hs' => [M"Sonst. Beeintr�chtigungen", M"Sonst. Beeintr�chtigungen", 0],
	 'hl' => [M"Sonst. Beeintr�chtigungen (Landstra�e)", M"Sonst. Beeintr�chtigungen (Landstra�e)", 0],
	 'nl' => [M"Unbeleuchtete Stra�e", M"Unbeleuchtete Stra�en", 0],
	 'gr' => [M"Gr�ner Weg", M"Gr�ne Wege", 0],
	 'comm' => [M"Kommentare", M"Kommentare", 0],
	 # XXX specific comm types?
	 'mount' => [M"Steigung", M"Steigungen", 0],
	 'wr'   => [M"Wasserroute", M"Wasserrouten", undef],
	 'fz'   => [M"Unbekannte Stra�e", M"Unbekannte Stra�en", 1],
	);
    if (!defined $city || $city ne 'Berlin') {
	$str_attrib{g}   = [M"Ortsgrenze",     M"Ortsgrenzen",     0];
	$str_attrib{gBO} = [M"Ortsteilgrenze", M"Ortsteilgrenzen", 0];
    }
    %p_attrib =
	('lsa'  => [M"Ampel",       M"Ampeln",       undef],
	 'u'    => [M"U-Bahnhof",   M"U-Bahnh�fe",   undef],
	 'u_bg' => [M"Fahrradfreundlicher Zugang (U-Bahn)",   M"Fahrradfreundliche Zug�nge (U-Bahn)",   undef],
	 'b'    => [M"S-Bahnhof",   M"S-Bahnh�fe",   undef],
	 'u_bg' => [M"Fahrradfreundlicher Zugang (S-Bahn)",   M"Fahrradfreundliche Zug�nge (S-Bahn)",   undef],
	 'r'    => [M"R-Bahnhof",   M"R-Bahnh�fe",   undef],
	 'r_bg' => [M"Fahrradfreundlicher Zugang (Regionalbahn)",   M"Fahrradfreundliche Zug�nge (Regionalbahn)",   undef],
	 'o'    => [M"Ort",         M"Orte",         undef],
	 'p'    => [M"Haltestelle", M"Haltestellen", undef],
	 'obst' => [M"Obst",        M"Obst",         undef],
	 'pl'   => [M"Platz/Br�cke",M"Pl�tze/Br�cken",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"H�henangabe", M"H�henangaben",  undef],
	 'personal' => [M"Pers�nlicher Ort", M"Pers�nliche Orte",  undef],
	 'GU'   => [M"Grenz�bergang", M"Grenz�berg�nge", undef],
	);
    %category_attrib =
	('UA' => [M"U-Bahn Zone A", undef, undef],
	 'UB' => [M"U-Bahn Zone B", undef, undef],
	 'U0' => [M"stillgelegte U-Bahn", undef, undef],
	 'UBau' => [M"U-Bahn in Bau", undef, undef],
	 'UBetrieb' => [M"U-Bahn, nur Betriebsfahrten", 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],
	 'S0' => [M"stillgelegte S-Bahn", undef, undef],
	 'SBau' => [M"S-Bahn in Bau", undef, undef],
	 'SBetrieb' => [M"S-Bahn, nur Betriebsfahrten", 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 au�erhalb Berlin ABC", undef, undef],
	 'R0' => [M"stillgelegte Bahnstrecke", M"stillgelegte Bahnstrecken", undef],
	 'RBau' => [M"Bahnstrecke in Bau", M"Bahnstrecken in Bau", undef],
	 'RG' => [M"G�terbahn/Verbindungsstrecke", M"G�terbahnen/Verbindungsstrecken", undef],
	 'RP' => [M"Park-/Kleinbahn", M"Park-/Kleinbahnen", undef],
	 'HH' => [M"wichtige Hauptstra�e", M"wichtige Hauptstra�en", undef],
	 'B'  => [M"Bundesstra�e", M"Bundesstra�en", undef],
	 'H'  => [M"Hauptstra�e", M"Hauptstra�en", undef],
	 'N'  => [M"Nebenstra�e", M"Nebenstra�en", undef],
	 'NH' => [M"wichtige Nebenstra�e", M"wichtige Nebenstra�en", undef],
	 'NN' => [M"f�r Kfz gesperrte Stra�e", M"f�r Kfz gesperrte Stra�en", undef],
	 'Pl' => [M"Platz", M"Pl�tze", undef],
	 'BAB'=> [M"Autobahn", M"Autobahnen", undef],
	 'P'  => [M"Park", M"Parks", undef],
	 'Forest' => [M"Wald", M"W�lder", undef],
	 'Cemetery' => [M"Friedhof", M"Friedh�fe", undef],
	 'Green' => [M"Gr�nanlage", M"Gr�nanlagen", undef],
	 'Orchard' => [M"Kleing�rten", M"Kleing�rten", undef],
	 'Sport' => [M"Sportanlage", M"Sportanlagen", undef],
	 'Industrial' => [M"Industriegebiet", M"Industriegebiete", undef],
	 'Mine' => [M"Tagebau", undef, undef],
	 'Ae' => [M"Flughafen", M"Flugh�fen", undef],
	 'ex-Ae' => [M"ehemaliger Flughafen", M"ehemalige Flugh�fen", 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"m��iger Belag", undef, undef,
		  M"m��iger Belag (schlechter Asphalt oder m��iges Kopfsteinpflaster)"],
	 'Q3' => [M"schlechter Belag", undef, undef,
		  M"schlechter Belag (Katzenkopfsteinpflaster oder unbefestigte Wege)"],
	 'q0' => [M"keine", undef, undef,
		  M"keine Beeintr�chtigungen"],
	 'q1' => [M"auf ca. 25 km/h", undef, undef,
		  M"Beeintr�chtigungen auf ca. 25 km/h"],
	 'q2' => [M"auf ca. 18 km/h", undef, undef,
		  M"Beeintr�chtigungen auf ca. 18 km/h"],
	 'q3' => [M"auf ca. 13 km/h", undef, undef,
		  M"Beeintr�chtigungen auf ca. 13 km/h"],
	 'q4' => [M"auf Schrittgeschwidigkeit", undef, undef,
		  M"Beeintr�chtigungen auf Schrittgeschwindigkeit"],

	 '6'  => [M"Gro�- oder Millionenstadt", M"Gro�- oder Millionenst�dte", undef],
	 '5'  => [M"Gro�stadt", M"Gro�st�dte", 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],
	 'Zbr'=> [M"Zugbr�cke", M"Zugbr�cken", undef],
	 'Br' => [M"Br�cke", M"Br�cken", undef],
	 'Tu' => [M"Tunnel", M"Tunnel", undef],
	 'CS' => [M"streckenbezogener Kommentar", M"streckenbezogene Kommentare", undef],
	 'CP' => [M"punktbezogener Kommentar (A-B-C)", M"punktbezogene Kommentare (A-B-C)", undef],
	 'CP2'=> [M"punktbezogener Kommentar (A-B)", M"punktbezogene Kommentare (A-B)", undef],
	 'PI' => [M"genaue Wegbeschreibung", undef, undef],
	 '-2' => [M"relativ sehr ruhiger Kfz-Verkehr", undef, undef],
	 '-1' => [M"relativ ruhiger Kfz-Verkehr", undef, undef],
	 '+1' => [M"relativ starker Kfz-Verkehr", undef, undef],
	 '+2' => [M"relativ sehr starker Kfz-Verkehr", undef, undef],
	 'St' => [M"Steigung", M"Steigungen", undef],
	 'Gf' => [M"Gef�lle", M"Gef�lle", undef],
	 'Z'  => [M"Grenze", M"Grenzen", undef],
	 'Q'  => [M"F�hre", M"F�hren", undef],
	 'green1' => [M"gr�ner Weg", M"gr�ne Wege", undef],
	 'green2' => [M"besonders gr�ner Weg", M"besonders gr�ne Wege", undef],
	 'HNR'=> [M"Hausnummer", M"Hausnummern", undef],
	 'NL' => [M"unbeleuchtete Stra�e", M"unbeleuchtete Stra�en", undef],
	 'SW' => [M"Sehensw�rdigkeit", M"Sehensw�rdigkeiten", undef],
	 'I'  => [M"Insel", M"Inseln", undef],
	 'W'  => [M"Gew�sser, nicht kategorisiert", undef, undef],
	 'W0' => [M"unwichtiges Gew�sser", undef, undef],
	 'W1' => [M"Gew�sser", undef, undef],
	 'W2' => [M"gr��eres Gew�sser", undef, undef],
	 'WR' => [M"Wasserroute", M"Wasserrouten", undef],
	 'radroute' => [M"Radroute", M"Radrouten", undef],
	);
    foreach my $cat (@area_cats) {
	my $cat_above = $cat . 'above';
	if (exists $category_attrib{$cat} && !exists $category_attrib{$cat_above}) {
	    $category_attrib{$cat_above} = $category_attrib{$cat};
	}
    }
    foreach (@Radwege::category_order) {
	if (defined $Radwege::category_code{$_}) {
	    $category_attrib{$Radwege::category_code{$_}} =
		[$Radwege::category_name{$_}, $Radwege::category_plural{$_}, undef];
	}
    }

    %obst_file =
	('apfel'   => 'apfel',
	 'kirsche' => 'kirsche',
	 'birne'   => 'birne',
	 'pflaume' => 'pflaume',
	);

    # f�r 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'} = " ";

    # f�r 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 (auch S-Bahn, R-Bahn etc.)
    # XXX This should be variable depending on the drawn icon (normal, klein, mini)
    $xadd_anchor_type->{'u'} = {'w' => 9, 'n' => 0, 'e' => -9, 's' => 0,
				'nw' => 5, 'sw' => 5};
    $yadd_anchor_type->{'u'} = {'w' => 0, 'n' => 9, 'e' => 0,  's' => -9,
				'nw' => 5, 'sw' => -5};
    $label_spaceadd{'u'} = "  ";

    # Sehensw�rdigkeiten (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'} = "  ";

    %tag_group =		# group related tags (for stacking)
	('str_s' => ['s-out', 'gr', 'rw',
		     's-NN', 's-N', 's-NH', 's-H', 's-HH', 's-B', 's-BAB', 'sBAB-BAB', 'sBAB-fg',
		     'comm', (map { "comm-$_" } @comments_types),
		     'nl', 'qs', 'hs', 'mount',
		     's-label-bg', 'sBAB-label-bg', 's-label', 'sBAB-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', 'i-label-bg', 'i-label'],
	 'str_f' => ['f', 'f-label-bg', 'f-label', 'f-Pabove'],
	 'str_g' => ['z', 'g', 'gBO', 'gP', 'gD', 'gBO-label-bg', 'gBO-label', 'GU-img'],
	 'p_kn'  => ['kn', 'kn-bg', 'kn-fg', 'ki', 'ki-bg', 'ki-fg', 'rest', 'rest-bg', 'rest-fg'],
	 'map'   => ['map'],
	 'route' => ['route'],
	 'v'     => ['v', 'v-fg'],
	 'e'     => ['e', 'e-img'],
	);

    # normale Reihenfolge f�r das �bereinanderlegen bei restack()
    #XXX labels sollten grunds�tzlich immer oben sein. Problematisch bei tag_groups
    # tags in the form '*...*' are special and used just as markers
    @normal_stack_order =
	(qw(map f w-out w i-out i f-Pabove *landuse* e e-img
	    gP gD z g gP gD gBO
	    s-out l-out show gr rw s-NN s-N s-NH s-H s-HH s-B s-BAB sBAB sBAB-BAB sBAB-fg l v
	    f-label-bg wr w-label-bg gBO-label-bg f-label w-label i-label gBO-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 GU-img
	    u-label r-label b-label
	    hoehe vf-bg sperre temp_sperre_s temp_sperre v-fg obst
	    fz *route* route gps_track comm),
	 (map { "comm-$_" } @comments_types),
	 qw(comm-route-label-bg comm-route-label qs hs ql hl mount nl delnet
	    crosshairs
	    O o p pl-fg vf-fg lsas lsa-bg lsa-fg lsas-t
	    pp kn-bg kn-fg ki-bg ki-fg rest-bg rest-fg
	    fz-label s-label-bg sBAB-label-bg s-label sBAB-label l-label-bg l-label
	    personal-fg personal-label ovl
	    gpsanimrect zoomrect),
	);
    %comment_cat_labels =
	(ferry => M"Informationen zu F�hren",
	 misc => M"Sonstige Kommentare",
	 path => M"Wegf�hrung",
	 route => M"Radrouten",
	 tram => M"Tram auf Fahrbahn",
	 kfzverkehr => M"Kommentare zum Kfz-Verkehr",
	 scenic => M"Sch�ne Strecken",
	 danger => M"Gef�hrliche Stellen",
	);
}

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/;
	    if (!$edit_normal_mode) { # we want to see everything in edit mode
	        return if first { $_ eq "igndisp" } @addinfo_hin;
	    }
	    my $this_color_hin = $cat_hin =~ /^\#/ ? $cat_hin :
		($layer_category_color{$abk} && $layer_category_color{$abk}{$cat_hin})
		|| $category_color{$cat_hin}
		|| $str_color{$abk} || 'white';
	    my $this_color_rueck = defined $cat_rueck ?
		($cat_rueck =~ /^\#/ ? $cat_rueck :
		 ($layer_category_color{$abk} && $layer_category_color{$abk}{$cat_rueck})
		 || $category_color{$cat_rueck}
		 || $str_color{$abk} || 'white') :
		     'white';
	    my $this_width_hin = ($layer_category_line_width{$abk} && $layer_category_line_width{$abk}{$cat_hin})
		 || $category_width{$cat_hin} || $default_width || 1;
	    my $this_width_rueck = defined $cat_rueck ?
		(($layer_category_line_width{$abk} && $layer_category_line_width{$abk}{$cat_rueck}) || $category_width{$cat_rueck} || $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_sub_draw{"pp-$abk"}||$p_sub_draw{"pp-all"})) {
			my($x, $y) = @coordlist[$#coordlist-1 .. $#coordlist];
			my $pp_cross_or_kurve_tag;
## This is not correct and therefore not used.
## The net should be plain without "gesperrt"/"oneway" bits.
# 			if ($net && $net->{Net}) {
# 			    if (scalar(keys(%{$net->{Net}{"$xx,$yy"}})) < 3) {
# 				$pp_cross_or_kurve_tag = "ppkvp";
# 			    } else {
# 				$pp_cross_or_kurve_tag = "ppcrs";
# 			    }
# 			}
			# keine Verwendung von _coord_as_string
			$c->createLine
			  ($x, $y, $x, $y,
			   -tags => ['pp', "$xx,$yy", undef, "pp-$abk",
				     ($pp_cross_or_kurve_tag ? $pp_cross_or_kurve_tag : ())],
			  );
		    }
		}
	    }
	    if (@coordlist > 0) {
		my $abk = $abk;
		my($mx,$my);
		my $image;
		my $anchor = "c";
		my $category = $cat_hin; # used for undirected things
		my $item; # canvas item drawn

		my $line_shorten_hin = ($layer_category_line_shorten{$abk} && $layer_category_line_shorten{$abk}{$cat_hin}) || $layer_line_shorten{$abk} || $category_line_shorten{$cat_hin} || $line_shorten{$abk};
		if (defined $line_shorten_hin) { # XXX no $cat_rueck handling
		    line_shorten(\@coordlist);
		} else {
		    my $line_shorten_end_hin = ($layer_category_line_shorten_end{$abk} && $layer_category_line_shorten_end{$abk}{$cat_hin}) || $layer_line_shorten_end{$abk} || $category_line_shorten_end{$cat_hin} || $line_shorten_end{$abk};
		    if (defined $line_shorten_end_hin) { # XXX no $cat_rueck handling
		        line_shorten_end(\@coordlist);
		    }
		}

	        if ($layer_category_image{$abk} && defined $layer_category_image{$abk}{$cat_hin}) {
		    $cat_hin = "IMG:$layer_category_image{$abk}{$cat_hin}";
	        } elsif (defined $category_image{$cat_hin}) {
		    $cat_hin = "IMG:$category_image{$cat_hin}";
	        }

		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;
			    for my $subdir ("images", "data") {
			        $f = maybe_expand_image_file($image, $str_file{$abk}, $subdir);
			        if ($f && -r $f) {
				    $photo{$image} = image_from_file($top, $f);
				    last;
			        }
			    }
			    if (!$photo{$image}) {
				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]);
		    }
		};

		my $draw_strname_for_area = sub {
		    my($name, $add) = split(/\|/, $strname);
		    $name = "" if !defined $name;
		    ## The addition is mostly for missing geographic context; not necessary when drawing
		    #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]|gBO)$/) {
		        $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);
		    }
		};

		my $draw_street_photo = sub {
			my($street_photo, $anchor, $delta, %opts) = @_;
			    my $addtag = delete $opts{-addtag};
			    my($mx,$my) = get_polyline_center(@coordlist);

			    if ($delta) {
				# atan2(y2-y1, x2-x1)
				my $ii = 2; # second point
				my $alpha = atan2($coordlist[$ii+1]-$coordlist[$ii-1], $coordlist[$ii]-$coordlist[$ii-2]);
				my $beta  = $alpha - pi()/2;
				my($dx, $dy) = (-$delta*cos($beta), -$delta*sin($beta));
				$mx += $dx;
				$my += $dy;
			    }

			    $c->createImage($mx,$my,
					    -anchor => $anchor,
					    -image => $street_photo,
					    # $abk-img or $abk-fg ?
					    -tags => [$abk,$strname,"$abk-img",
						      "$abk-" . $i,
						      ($addtag ? $addtag : ()),
						     ]);
			    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,
						   ($addtag ? $addtag : ()),
						  ],
					 -outlinewidth => 2,
					);
				}
			    }
		};

		if ($cat_hin =~ /^F:(.*)$/) { # Fl�che, no $cat_rueck handling here
		    $category = $1;
		    my($color, $rest) = split(/\|/, $category, 2);
		    my $stipple = ($layer_category_stipple{$abk} && $layer_category_stipple{$abk}{$category}) || $layer_stipple{$abk} || $category_stipple{$category};
		    if (defined $rest && $rest ne "") {
			if ($rest =~ $complex_IMG_qr) {
			    $image = $1;
			    $anchor = $2 if $2;
			} elsif (!defined $stipple) {
			    $stipple = $rest;
			}
		    }
		    if ($color eq 'I') { $abk = 'i' } # Inseln
		    $color = ($layer_category_color{$abk} && $layer_category_color{$abk}{$color}) || $category_color{$color} || $color;
		    $stipple = load_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 => $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}) {
			$draw_strname_for_area->();
		    }

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

		} elsif ($cat_hin =~ $complex_IMG_qr) {
		    my $img_spec = $1;
		    my $anchor = ($2 ? $2 : "c");
		    my $p;
		    my $img = maybe_expand_image_file($img_spec, $str_file{$abk}, "data");
		    if (!$img) {
			# XXX get_image_for_str is actually more powerful, and should maybe replace maybe_expand_image_file+image_from_file?
			$p = get_image_for_str($img_spec, $img_spec, $abk);
		    } else {
			$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) {
			$item = $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 { # points or lines
		    if (@coordlist == 2) { # point
			# 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
			    }
			} elsif ($achtung_photo && grep { $_ eq 'danger' } @addinfo_hin) {
			    $draw_street_photo->($achtung_photo, "c");
			} elsif ($abk eq 'w' && $cat_hin eq 'I' && $strname ne '') {
			    # only draw label
			    # XXX quick hack, really only needed for osm islands
			    my %args = (-text => $strname,
					-tags => ["i-label", $strname],
					(exists $category_font_color{$category} ? (-fill => $category_font_color{$category}) : ()),
				    	(exists $category_font{$category} ? (-font => $category_font{$category}) : ()),
					-font => sprintf($category_font{$cat_hin}, 10),
					-outlinewidth => 2);
			    outline_text($c, @coordlist, %args);
			    return;
			} elsif ($cat_hin =~ $roundabout_qr) {
			    $draw_street_photo->($kreisverkehr_photo, "c");
			} elsif ($cat_hin =~ $viewangle_qr) {
			    my($start,$extent) = ($1,$2);
			    my $radius = get_line_width("$abk-View");
			    my @coords = ((map { $_-$radius } @coordlist),
			    		  (map { $_+$radius } @coordlist));
			    my @common_args = (-outline => undef,
					       -fill => "red",
			    		       -tags => [$abk, $strname,
#XXX fix category from View:...:... to View?
						        "$abk-View", "$abk-" . $i,
						        @extra_tags],
					      );
			    if (abs($extent) < 30) {
			        $c->createArc(@coords, @common_args,
	       		    		      -start => $start,
			    		      -extent => $extent,
				             );
			    } else {
				my $delta = $extent > 0 ? 30 : -30;
				my $end   = $start + $extent;
				for(my $_start = $start; $extent > 0 ? $_start < $end : $_start > $end; $_start+=$delta) {
				    $c->createArc(@coords, @common_args,
						  -start => $_start,
						  -extent => $delta/2,
						 );
				}
			    }
			    return; # next loop
			}

			# dicken Punkt zeichnen
			my $width = $category_point_size{$cat_hin} || 5; # XXX skalieren
			$item = $c->createLine(@coordlist, @coordlist,
				       -fill => $this_color_hin,
				       -width => $width,
				       -capstyle => $capstyle_round,
				       -tags => [$abk, $strname,
						 $abk."-".$cat_hin, $abk."-".$i,
						 @extra_tags],
				      );
		    } else { # lines
			my @std_tags_hin = ($abk, $strname,$abk."-".$cat_hin,$abk."-".$i);
			my @std_tags_rueck;
			my $line_dash_hin = (exists $layer_category_line_dash{$abk} && $layer_category_line_dash{$abk}{$cat_hin}) || $layer_line_dash{$abk} || $category_dash{$cat_hin} || $line_dash{$abk};
			my $line_dash_rueck;
			my $line_capstyle_hin = (exists $layer_category_capstyle{$abk} && $layer_category_capstyle{$abk}{$cat_hin}) || $layer_line_capstyle{$abk} || $category_capstyle{$cat_hin} || $line_capstyle{$abk};
			my $line_capstyle_rueck;
			if ($cat_rueck) {
			    @std_tags_rueck = @std_tags_hin;
			    $std_tags_rueck[2] = "$abk-$cat_rueck";
			    $line_dash_rueck = (exists $layer_category_line_dash{$abk} && $layer_category_line_dash{$abk}{$cat_rueck}) || $layer_line_dash{$abk} || $category_dash{$cat_rueck} || $line_dash{$abk};
			    $line_capstyle_rueck = (exists $layer_category_capstyle{$abk} && $layer_category_capstyle{$abk}{$cat_rueck}) || $layer_line_capstyle{$abk} || $category_capstyle{$cat_rueck} || $line_capstyle{$abk};
			}
			my $stipple = ($layer_category_stipple{$abk} && $layer_category_stipple{$abk}{$category}) || $layer_stipple{$abk} || $category_stipple{$category};
			$stipple = load_stipple($stipple) if $stipple;
		        if (@addinfo_hin) { # ignore @addinfo_rueck for now
			    for my $addinfo_hin (@addinfo_hin) {
			        if ($addinfo_hin =~ $tunnel_qr) {
				    $line_dash_hin = $line_dash{"Tu"};
				    $line_dash_rueck = $line_dash_hin if defined $line_dash_hin;
				    draw_tunnel_entrance(\@coordlist, -width => $this_width_hin+4, -tags => \@std_tags_hin, -mounds => $addinfo_hin);
				} elsif ($addinfo_hin eq 'Br') {
				    draw_bridge(\@coordlist, -width => $this_width_hin+4, -tags => \@std_tags_hin);
				}
			    }
			}
			if (!$use_stippleline) {
			    undef $line_dash_hin;
			}
			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_hin ? (-dash => $line_dash_hin) : ()),
			       ($line_capstyle_hin ? (-capstyle => $line_capstyle_hin) : ()),
			       ($stipple ? (-stipple => $stipple) : ()),
			       (exists $layer_category_line_arrow{$abk} && exists $layer_category_line_arrow{$abk}{$cat_hin} ? (-arrow => $layer_category_line_arrow{$abk}{$cat_hin})
				: exists $layer_line_arrow{$abk} ? (-arrow => $layer_line_arrow{$abk})
				: exists $category_line_arrow{$cat_hin} ? (-arrow => $category_line_arrow{$cat_hin}) : ()),
			      );
			}
			if (defined $cat_rueck) {
			    my $delta = $this_width_hin/2; # XXX need a better rule for this
			    my($cl_hin,$cl_rueck) = offset_line(\@coordlist, $delta, $cat_hin ne '', $cat_rueck ne '');
			    for my $dir (1, -1) {
				my($cl, $this_color, $this_width, $cat, $std_tags, $line_dash, $line_capstyle);
				if ($dir == 1 && $cat_hin ne '') {
				    $this_color = $this_color_hin;
				    $this_width = $this_width_hin/2;
				    $cat        = $cat_hin;
				    $cl         = $cl_hin; # XXX del: [@coordlist];
				    $std_tags   = \@std_tags_hin;
				    $line_dash  = $line_dash_hin;
				    $line_capstyle = $line_capstyle_hin;
				} 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 = $#$cl_rueck-1; $cl_i >= 0; $cl_i-=2) {
					push @$cl, @{$cl_rueck}[$cl_i, $cl_i+1];
				    }
				    $std_tags   = \@std_tags_rueck;
				    $line_dash  = $line_dash_rueck;
				    $line_capstyle = $line_capstyle_rueck;
				} 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) : ()),
				     ($line_capstyle ? (-capstyle => $line_capstyle) : ()),
				     ($stipple ? (-stipple => $stipple) : ()),
				     #(exists $category_line_arrow{$cat} ? (-arrow => $category_line_arrow{$cat}) : ()),
				     # XXX Tk problem? bad rendering with capstyle=>"round" and arrow=>something
				     -arrow => ($line_capstyle && $line_capstyle eq 'round' ? "none" : "last"),
				    );

				# Draw an extra point indicating the point of action for CP/CP2 items
				if ($cat_hin =~ m{^( CP | CP2 | PI )$}x) {
				    my @center = $cat_hin eq 'CP' ? @{$cl}[2,3] : @{$cl}[0,1];
				    $c->createOval((map { $_-5 } @center), (map { $_+5 } @center), # XXX skalieren
					-outline => $this_color_hin,
					-width => 2,
					-tags => [@$std_tags, @extra_tags],
				    );
				}

			    }
			} elsif ($cat_hin eq 'Br') {
			    draw_bridge(\@coordlist, -width => $this_width_hin+4, -tags => \@std_tags_hin);
			} elsif ($cat_hin =~ $roundabout_qr) {
			    if ($edit_normal_mode) {
				$c->createLine(@coordlist,
					       -fill  => 'blue',
					       -width => 2,
					       -tags  => [@std_tags_hin, @extra_tags],
					       -dash  => [1,4],
					      );
				$draw_street_photo->($kreisverkehr_photo, "c");
			    } else {
				# ignore lined roundabouts in renderer
				return;
			    }
			} elsif ($cat_hin =~ $tunnel_qr) {
			    draw_tunnel_entrance(\@coordlist, -width => $this_width_hin+4, -tags => \@std_tags_hin, -mounds => $cat_hin);
			} else {
			    $item = $c->createLine
				(@coordlist,
				 -fill      => $this_color_hin,
				 -width     => $this_width_hin,
				 -joinstyle => 'bevel',
				 -tags      => [@std_tags_hin,
						@extra_tags],
				 ($stipple ? (-stipple => $stipple) : ()),
				 ($line_dash_hin ? (-dash => $line_dash_hin) : ()),
				 ($line_capstyle_hin ? (-capstyle => $line_capstyle_hin) : ()),
			         (exists $layer_category_line_arrow{$abk} && exists $layer_category_line_arrow{$abk}{$cat_hin} ? (-arrow => $layer_category_line_arrow{$abk}{$cat_hin})
				  : exists $layer_line_arrow{$abk} ? (-arrow => $layer_line_arrow{$abk})
				  : exists $category_line_arrow{$cat_hin} ? (-arrow => $category_line_arrow{$cat_hin}) : ()),
				);
			}

			if ($abk eq 'sBAB') { # thin grey line for "two track" effect
			    $c->createLine
				(@coordlist,
				 -fill      => 'lightgrey',
				 -width     => 1,
				 -joinstyle => 'bevel',
				 -tags      => [$abk, $strname, $abk."-fg",$abk."-".$i],
                                 ($line_dash_hin ? (-dash => $line_dash_hin) : ()),
			         # XXX??? ($line_dash_rueck ? (-capstyle => $line_dash_rueck) : ()),
				 -state	    => ($this_width_hin >= $sBAB_two_track_width ? 'normal' : 'hidden'),
				);
			}

		        if ($str_name_draw{$abk} && $category eq 'Z' && $item) {
			    $draw_strname_for_area->();
			}

			# no $cat_rueck support for names
			if ($str_name_draw{$abk}
			    && (($abk =~ /^[ls]/ &&
				 $abk ne 'sBAB' &&
				 ($cat_hin =~ /^[BH]/ ||
				  ($lazy_str{$abk} && $scale >= 10)
				 )) || 0) # nur Hauptstra�en zeichnen (wg. Performance
                                          # und �bersichtlichkeit), oder auch Nebenstra�en,
                                          # falls lazy_plot und kleiner Ma�stab
			   ) {
			    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;
			my $street_anchor = "nw";
			my $street_delta;
			my $street_addtag;
			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;
			    $street_anchor = "s";
			    $street_delta = $street_photo->width/2+2;
			} elsif ($abk eq 'comm-tram' || $abk eq 'nl') {
			    $street_photo = get_symbol_scale($abk);
			    $street_delta = 0; # XXX
			} elsif (@addinfo_hin # ignore @addinfo_rueck for now
				) {
			    for my $addinfo_hin (@addinfo_hin) {
			        if ($addinfo_hin eq 'inwork') {
				    $street_photo = get_symbol_scale('attrib-inwork');
				    $street_addtag = "attrib-inwork";
				} elsif ($addinfo_hin eq 'danger' && $achtung_photo) {
				    $street_photo = $achtung_photo;
				    $street_anchor = "c";
				}
			    }
			}
			if ($street_photo) {
			    $draw_street_photo->($street_photo, $street_anchor, $street_delta, -addtag => $street_addtag);
			}
		    }
		}
	    }
	};
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/;
	    if (!$edit_normal_mode) { # we want to see everything in edit mode
	        return if index($category, "::igndisp") >= 0;
	    }
	    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 ($layer_category_image{$abk} && defined $layer_category_image{$abk}{$category}) {
		$category = "IMG:$layer_category_image{$abk}{$category}";
	    } elsif (defined $category_image{$category}) {
		$category = "IMG:$category_image{$category}";
	    }
	DRAW_ITEM: {
	        if ($category =~ $complex_IMG_qr) {
		    my $photo = $1;
		    my $anchor = ($2 ? $2 : "c");
		    my($base) = ($photo =~ m|/| ? $photo =~ /([^\/]+)$/ : $photo);
		    $base = "p_$base";
		    my $p = get_image_for_p($base, $photo, $abk);
		    if ($p) {
		        $c->createImage($x, $y, -image => $p,
				        -anchor => $anchor,
					# $abk-img or $abk-fg? set both!
				        -tags => ["$abk-img", "$xx,$yy", $pointname, ($abk =~ /^L\d+$/ ? ("$abk-fg", "L-fg") : ())],
				       );
		        last; # we're done, only label drawing missing
		    }
		    warn "Can't find image $photo (3)";
	        }

	        if ($XXX_use_old_R_symbol && $abk eq 'r') {
		    my $length = $category =~ m{^(RP)$} ? $rbahn_length/2 : $rbahn_length;
		    $c->createLine($x-$length, $y, $x+$length, $y,
			           -tags => ["$abk-bg", "$xx,$yy", $pointname, "$abk-" . $category . "-bg"]);
		    if ($category !~ m{^(RP)$}) {
		        $c->createText($x, $y,
			               -tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . $category . "-fg"]);
		    }
	        } elsif ($abk =~ /^[ubr]$/) {
		    $c->createImage($x, $y, -tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . $category . "-fg"]);
	        } elsif ($abk eq 'lsa') {
		    my($rawcategory, @attribs) = split /::/, $category;
		    my @tags = ("$abk-fg", "$xx,$yy", $pointname,
			        "$abk-" . $rawcategory . "-fg",
			        $abk."-".$i);
		    # keine Verwendung von _coord_as_string
		    $c->createImage
		      ($x, $y,
		       -image => ($rawcategory eq 'B'
			          ? $andreaskr_photo
				  : $rawcategory eq 'B0'
				    ? $andreaskr_grey_photo
			            : $rawcategory eq 'Zbr'
				      ? $zugbruecke_photo
				      : $rawcategory eq 'F'
				        ? $ampelf_photo
			                : $ampel_photo
			         ),
		       -tags => \@tags,
		      );
		    if (@attribs) {
			for my $attrib (@attribs) {
			    if ($attrib eq 'inwork') {
				my $use_inwork_photo = get_symbol_scale('attrib-inwork');
				if ($use_inwork_photo) {
				    $c->createImage($x, $y,
					    	-anchor => 'nw',
					    	-image => $use_inwork_photo,
					    	-tags => [@tags,'attrib-inwork']);
				}
			    }
			}
		    }
		    $ampeln{"$xx,$yy"} = $rawcategory;
	        } elsif ($abk eq 'pl') {
		    $c->createLine($x, $y, $x, $y,
			           -tags => ["$abk-fg", "$xx,$yy", $pointname],
			          );
	        } elsif ($abk eq 'vf') {
		    my($rawcategory, $attribs) = split /::/, $category;
		    my @tags = ("$abk-fg", "$xx,$yy", "$abk-$rawcategory-fg", "$abk-$i");
		    if ($rawcategory eq 'Vf') {
			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])}));
		        $c->createImage($x2,$y2, -tags => \@tags);
			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");
		    } else {
		        $c->createImage($x,$y, -tags => \@tags);
		    }
	        } elsif ($abk =~ /^L(\d+)/) {
		    my $color = $category =~ /^\#/ ? $category : exists $layer_category_color{$abk} && exists $layer_category_color{$abk}{$category} ? $layer_category_color{$abk}{$category} : exists $category_color{$category} ? $category_color{$category} : undef;
		    my $width = ($layer_category_line_width{$abk} && $layer_category_line_width{$abk}{$category}) || $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 => $capstyle_round,
			           -width => $width,
			           -tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . $i]);
	        }
	    } # DRAW_ITEM
	    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 maybe_expand_image_file {
    my($imgfile, $datafile, $subdir) = @_;
    if (file_name_is_absolute($imgfile)) {
	return try_image_suffix($imgfile);
    }
    my $abs_img = try_image_suffix("$FindBin::RealBin/$subdir/$imgfile");
    if (defined $abs_img && -r $abs_img) {
	return $abs_img;
    }
    # relative to this file
    return try_image_suffix(dirname($datafile) . "/" . $imgfile);
}

# For an absolute image path without suffix try to find an existing
# image which is supported by the current configuration. Returns undef
# if nothing suitable could be found.
sub try_image_suffix {
    my($imgfile_without_suffix) = @_;
    return $imgfile_without_suffix if $imgfile_without_suffix =~ m{\.(png|jpg|xpm|gif|svg)$};
    for my $suffix (@image_type_order) {
	my $try_imgfile = $imgfile_without_suffix.".".$suffix;
	if (can_handle_image_suffix($suffix) && -r $try_imgfile) {
	    return $try_imgfile;
	}
    }
    undef;
}

# Return true if the supplied image suffix ("jpg", "gif" etc.) can be
# handled. The result is cached in the global %can_handle_image.
sub can_handle_image_suffix {
    my $suffix = shift;
    if (!defined $can_handle_image{$suffix}) {
	if ($suffix eq 'png') {
	    if (eval {
		die "Probably corrupt in my SiePerl distribution" if $os eq 'win' && $Tk::VERSION < 804;
		require Tk::PNG;
		1;
	    }) {
		$can_handle_image{$suffix} = 1;
	    } else {
		$can_handle_image{$suffix} = 0;
	    }
	} elsif ($suffix eq 'jpg') {
	    if (eval {
		die "Probably corrupt in my SiePerl distribution" if $os eq 'win' && $Tk::VERSION < 804;
		require Tk::JPEG;
		1;
	    }) {
		$can_handle_image{$suffix} = 1;
	    } else {
		$can_handle_image{$suffix} = 0;
	    }
	} elsif ($suffix eq 'svg') {
	    # Assume that a postprocessor will be run to create the
	    # real image
	    if (can_handle_image_suffix('png') && eval {
		require File::Temp;
		is_in_path('convert');
	    }) {
		$can_handle_image{$suffix} = 1;
	    } else {
		$can_handle_image{$suffix} = 0;
	    }
	} elsif ($suffix =~ m{^(gif|xpm)$}) { # Tk builtins
	    $can_handle_image{$suffix} = 1;
	} else {
	    die "Unhandled image suffix '$suffix'";
	}
    }
    $can_handle_image{$suffix};
}

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
		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 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!
    # XXX more missing, typically everything with a label is transparent
    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 gBO-label-bg gBO-label
		l-label-bg l-label
		u-label b-label r-label fz-label show O),
	     (map { ("comm-$_-label", "comm-$_-label-bg") } @comments_types),
	    ) {
	std_transparent_binding($_);
    }
    # spezielle Bindings f�r 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) {
		     save_cursor();
		     set_cursor("addnet", "tcross");
		 }
	     });
    $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
	if ($MM_DRAG_IS_OBSOLETE) {
	    $c->bind($_, "<ButtonRelease-1>" => \&set_route_point);
	} else {
	    $c->bind($_, "<ButtonPress-1>" => \&set_route_point);
	}
    }

    # Stack in tkstadtware f�r dragging angucken! XXX
    $c->CanvasBind("<1>" => sub {
		       if ($MM_DRAG_IS_OBSOLETE) {
			   my $e = $c->XEvent;
			   ($canvas_drag_x, $canvas_drag_y) = ($e->x, $e->y);
			   $c->scan('mark', $canvas_drag_x, $canvas_drag_y);
			   $maybe_canvas_drag = 1;
		       }

		       if ($map_mode =~ /^BBBike/) {
			   my $button_callback = $map_mode . '::button';
			   if (defined &$button_callback) {
			       my $e = $c->XEvent;
			       my $ret = eval $button_callback.'($_[0], $e)';
			       die $@ if $@;
			       return if $ret; # otherwise fallthrough to MM_DRAG
			   }
		       } 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{((?:file|https?)://\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"));
			   }
		       }

		       # XXX duplicated code, see above
		       if ($map_mode eq MM_DRAG) {
			   my $e = $c->XEvent;
			   ($canvas_drag_x, $canvas_drag_y) = ($e->x, $e->y);
			   $c->scan('mark', $canvas_drag_x, $canvas_drag_y);
			   $maybe_canvas_drag = 1;
		       }
		   });
    $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 if $map_mode ne MM_DRAG && !$MM_DRAG_IS_OBSOLETE;
		       my $e = $c->XEvent;
		       my($e_x, $e_y) = ($e->x, $e->y);
		       # Start drag only if the user has moved a certain
		       # distance (3 pixels here). This is because clicking
		       # the mouse may involve a small motion movement.
		       return if ($maybe_canvas_drag &&
				  Strassen::Util::strecke([$canvas_drag_x, $canvas_drag_y],[$e_x, $e_y]) < 3);
		       $maybe_canvas_drag = 0;
		       $c->scan('dragto', $e_x, $e_y, 1);
		       if (!$c->{SavedCursor}) {
			   save_cursor();
			   set_cursor('movehand','fleur');
		       }
		       $in_canvas_drag = 1;
		   });
    $c->CanvasBind('<ButtonRelease-1>' => sub {
		       restore_cursor();
		       $in_canvas_drag = 0;
		   });

    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 l�schen",
			     -command => sub { delete_route() },
			    );
	$popup_menu->command(-label => M"Suche wiederholen",
			     -command => \&re_search_gui,
			    );
	$popup_menu->command(-label => M"R�ckweg",
			     -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 ($map_mode eq MM_DRAG || $MM_DRAG_IS_OBSOLETE) {
	    my $e = $c->XEvent;
	    ($canvas_drag_x, $canvas_drag_y) = ($e->x, $e->y);
	    $c->scan('mark', $canvas_drag_x, $canvas_drag_y);
	    $maybe_canvas_drag = 1;
	}

	if ($alt_set_route_point{$map_mode}) {
	    return $alt_set_route_point{$map_mode}->(@_);
	}
	my($rx,$ry);
	if ($map_mode eq MM_BUTTONPOINT) {
	   ($rx,$ry) = freerec_sub(@_);
	}
	freedraw_sub($_[0],$rx,$ry);
## 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 { scalecanvas_from_canvas_event($c, 2) });
    }
    for my $kp ('minus', 'KP_Subtract') {
	$top->bind("<$kp>" => sub { scalecanvas_from_canvas_event($c, 0.5) });
    }

    $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('<Control-g>' => sub { send_route_to_gps() });
    $top->bind('<Key-colon>' => sub {  my $e = $c->XEvent;
				       my(%args);
				       if ($e) {
					   my ($x, $y) = ($c->canvasx($e->x),
							  $c->canvasy($e->y));
					   $args{-preserveposition} = [$x,$y];
				       }
				       enter_scale(%args);
				   });

    $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();
	       });
    ## XXX Duplicate binding!
    #$top->bind("<Control-R>" => sub {
    #		   require BBBikeAdvanced;
    #		   reload_new_modules();
    #	       });
    bind_nomod($top, "<S>" => sub {
		   set_map_mode(MM_SEARCH);
	       });
    bind_nomod($top, "<U>" => sub {
		   $map_mode = MM_USEREDIT;
		   set_cursor('delnet', 'X_cursor');
	       });
    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("<Control-Key-x>" => \&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') });

    # Cycling through toplevels
    $top->bind("all", "<Control-Tab>" => sub { focus_next_toplevel(); Tk->break });
    $top->bind(".", "<Control-Tab>" => sub { });
    $top->bind("all", "<Control-Shift-Tab>" => sub { focus_prev_toplevel(); Tk->break });
    $top->bind(".", "<Control-Shift-Tab>" => sub { });

}

sub focus_next_toplevel { _focus_nextprev_toplevel(+1) }
sub focus_prev_toplevel { _focus_nextprev_toplevel(-1) }

sub _focus_nextprev_toplevel {
    my($dir) = @_;
    my @all_toplevels = grep { Tk::Exists($_) && $_->state eq "normal" } ($top, values(%toplevel));
    my $current_toplevel = $top->focusCurrent->toplevel;
    my $new_i;
    for(my $i=0; $i<=$#all_toplevels;$i++) {
	if ($all_toplevels[$i] == $current_toplevel) {
	    $new_i = $i + $dir;
	    last;
	}
    }
    if (!defined $new_i) {
	$new_i = 0;
	warn "cannot find current toplevel <$current_toplevel> in list <@all_toplevels>, fallback to main window <$top>";
    } else {
	if ($new_i < 0) {
	    $new_i = $#all_toplevels;
	} elsif ($new_i > $#all_toplevels) {
	    $new_i = 0;
	}
    }
    $all_toplevels[$new_i]->raise;
    # ->focus between toplevels does not seem to work under cygwin/x
    $all_toplevels[$new_i]->focus;
}

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','crosshair');
    } elsif ($map_mode eq MM_INFO) {
#XXX	$map_mode_deactivate->() if $map_mode_deactivate;
	set_cursor('info','circle');
#XXX	undef $map_mode_deactivate;
    } elsif ($map_mode eq MM_DRAG) {
	set_cursor('movehand','fleur');
    } 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, Fl�chen
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) {
	# Need to check if *all* items under the cursor are the same, as we
	# create the balloon text from *all* canvas items. This uses some
	# logic found in balloon_info_from_all_tags
	use vars qw($old_current_str_items);
	$old_current_str_items = "" if !defined $old_current_str_items;
	my $closeenough = $balloon_info_from_all_tags_closeenough;
	$c->bind($tag, '<Any-Motion>' => sub {
		     my($c) = @_;
		     my $e = $c->XEvent;
		     my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
		     my(@items) = $c->find(overlapping =>
					   $xx-$closeenough, $yy-$closeenough,
					   $xx+$closeenough, $yy+$closeenough);
		     my $new_current_str_items = join(" ", @items);
		     if ($new_current_str_items ne $old_current_str_items) {
			 enterstr($c);
			 $old_current_str_items = $new_current_str_items;
		     } else {
			 $c_balloon->Track;
		     }
		 });
    }
}

# unter den Tags nachgucken, ob es eine Stra�e zum Anzeigen gibt
# ("durchsichtige" Tags)
sub std_transparent_binding {
    # Motion statt Enter, da sich die Stra�e 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 >= 2) {
		     # XXX before each $c_ballon->Popup should be this line (maybe move into sub?):
		     if ($leave_after) { $leave_after->cancel; undef $leave_after }
		     if (1) { $str = balloon_info_from_all_tags($c) }
		     if (defined $str) { $c_balloon->Popup($str); } # XXX if defined
		 }
	     });
    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($w, $ax, $ay) = @_;
    my($xx, $yy);
    if (defined $ax && defined $ay) {
	($xx, $yy) = transpose($ax, $ay);
    } else {
	my($e) = $w->XEvent;
	($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
	($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 l�schen
sub mouse_dellast {
    if ($special_edit ne '') {
	eval $special_edit . '_edit_mouse3(@_)';
	die $@ if $@;
    } else {
	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 {
    return if $in_canvas_drag;
    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 ($MM_DRAG_IS_OBSOLETE) {
	$c->scan('mark', $e->x, $e->y);
    }
    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;
	my($rx,$ry) = buttonpoint(undef,undef,$item);
	freedraw_sub($_[0],$rx,$ry);
    } 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) = @_;
    use constant SMALLER_TABLES => 0.7;
    my $do_round = 0;
    my($type, $image, $nr);
    if ($city_obj->can("parse_street_type_nr")) {
	($type, $nr, $do_round, $image) = $city_obj->parse_street_type_nr($strname);
    }
    if (!defined $type) {
	# XXX handling of multiple street numbers? e.g. "F1, R1" or "B2/B5"?
	($type,$nr) = Strasse::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]);
	    # XXX make public if
	    # XXX * I find a way of resizing for larger scales
	    # XXX * I should check the legal status of all these logos
	    if ($devel_host && defined $image && (my $p = get_image("strnr_$type", $datadir."/comments_route_img/$image"))) {
		$c->createImage
		    ($midx,$midy,-image => $p,
		     -tags => "$abk-label"); # no strnr (only for images) and strnr-$item here
	    } else {
		my($item, $r_item);
		# XXX It seems that at least the BAB number is off by maybe half a pixel,
		# but it's not possible in Tk to set subpixel positions.
		$item = $c->createText
		    ($midx,$midy,
		     -text => ($type =~ /^(B|BAB|DK|DW)$/ ? "" : $type) . (defined $nr ? $nr : ""),
		     -font => $scale < SMALLER_TABLES ? $font{'tiny'} : $font{'normal'},
		     -fill => ($do_round             ? 'white'  :
			       $type =~ /^(BAB|DK)$/ ? 'white'  :
			       $type =~ /^(F|R)$/    ? 'green4' :
			       'black'),
		     -tags => "$abk-label"); # no strnr (only for images) and strnr-$item here
		my(@bbox) = $c->bbox($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"],
			);
		} elsif ($type =~ m{^( B | BAB | DK | DW)$}x) {
		    my $size = $scale < SMALLER_TABLES ? 16 : 32;
		    my $p;
		    # prefer png because of alpha
		    if ($type eq 'B' || $type eq 'DW') {
			$p = get_image("strnr_B$size", "bundesstrasse_table_$size.png");
		    } elsif ($type eq 'BAB') {
			$p = get_image("strnr_BAB$size", "bab_table_$size.png");
		    } elsif ($type eq 'DK') {
			$p = get_image("strnr_DK$size", "droga_krajowa_table_$size.png");
		    }
		    if ($p) {
			# Manually corrected (-1/-1) to look with my standard font
			# (lucida sans ...)
			$r_item = $c->createImage(int(($bbox[2]+$bbox[0])/2) - ($size > 16 ? 1 : 0),
						  int(($bbox[3]+$bbox[1])/2) - ($size > 16 ? 1 : 0),
						  -image => $p,
						  -tags => ["$abk-label-bg", "strnr", "strnr-$item"],
						 );
		    } else {
			# XXX fallback to createRectangle below
			warn "Cannot get image for strnr_" . $type . $size;
		    }
		} 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 f�r 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) {
	print STDERR Mfmt("Aktuelles Datenverzeichnis ist %s\n", $datadir);
    }

    my $metafile = "$newdir/meta.dd";
    if (-r $metafile) {
	require Geography::FromMeta;
	$city_obj = Geography::FromMeta->load_meta($metafile);
    }

    # XXX The polar_coord_hack for osm2bbd
    if (-e "$datadir/Karte/Polar.pm") {
	lib->import($datadir);
    }
}

# Beendet die Anwendung. Bei Bedarf werden Konfigurationsdateien gesichert.
# Tempor�re Dateien werden gel�scht.
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;
}

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

# Ver�ndern 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 (keys %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 f�r 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();
}

sub get_reference_journey_time {
    my $key = $active_speed_power{Type} eq 'power' ? 'PowerTimeSeconds' : 'TimeSeconds';
    $act_value{$key}->[$active_speed_power{Index}];
}

# Erzeugt den String f�r 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 });
    my_popup($t);
}

# Dialog zum Eingeben des Mapscales
### AutoLoad Sub
sub enter_scale {
    my(%args) = @_;
    my($x,$y) = @{ $args{-preserveposition} || [] };
    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"Ma�stab");
    return if !defined $t;
    $t->Label(-text => M"Ma�stab 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, $x, $y);
		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. M�glicher Grund: es wird auf
			# eine Tie-Variable zugegriffen, die
			# anscheinend schon zerst�rt ist (?), bzw.
			# deren Tie-Objekt zerst�rt 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';
    my @EntryArgs = ();
    eval {
	require Tk::NumEntry;
	$Entry = 'NumEntry';
	@EntryArgs = (-minvalue => 1);
    };
    my @act_page;
    $act_page[0] = $nb->add("q", -label => M"Stra�enqualit�t");
    my $gridy = 0;
    $act_page[0]->Label(-text => M"Stra�enqualit�t",
		     -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,
					   @EntryArgs,
					  );
	$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;

    {
	require Tk::Optionmenu;
	my $name2inx =
	    {M"egal" => 0,
	     M"Kopfsteinpflaster und schlechte Fahrbahnen vermeiden" => 1,
	     M"nur sehr gute Bel�ge bevorzugen (rennradtauglich)" => 2,
	     M"freie Eingabe" => 3,
	    };
	my $default = M"freie Eingabe";
	my $o = $act_page[0]->Optionmenu
	    (-options => [sort { $name2inx->{$a} <=> $name2inx->{$b} } keys %$name2inx],
	     -variable => \$default,
	     -command => sub {
		 my $inx = $name2inx->{$default};
		 my $speed = get_active_speed();
		 if ($inx == 0) {
		     while(my($k,$v) = each %var) {
			 $var{$k} = $speed;
		     }
		 } elsif ($inx == 3) {
		     # no op
		 } else {
		     my $velocity_kmh = $speed;
		     # Taken from bbbike.cgi
		     my %penalty;
		     my %max_limit;
		     if ($inx == 2) { # rennradtauglich
			 %penalty = ( "Q0" => 1,
				      "Q1" => 1.2,
				      "Q2" => 1.6,
				      "Q3" => 2 );
			 %max_limit = ( Q1 => $velocity_kmh / 25,
					Q2 => $velocity_kmh / 16,
					Q3 => $velocity_kmh / 10 );
		     } else {
			 %penalty = ( "Q0" => 1,
				      "Q1" => 1,
				      "Q2" => 1.5,
				      "Q3" => 1.8 );
			 %max_limit = ( Q1 => $velocity_kmh / 25,
					Q2 => $velocity_kmh / 18,
					Q3 => $velocity_kmh / 13 );
		     }
		     my $min_limit = $velocity_kmh / 5;
		     for my $q (keys %max_limit) {
			 if ($penalty{$q} < $max_limit{$q}) {
			     $penalty{$q} = $max_limit{$q};
			 }
		     }
		     if ($velocity_kmh > 5) {
			 for my $q (keys %penalty) {
			     if ($penalty{$q} > $min_limit) {
				 $penalty{$q} = $min_limit;
			     }
			 }
		     }

		     while(my($k,$v) = each %penalty) {
			 $var{$k} = int($speed/$v);
		     }
		 }
	     }
	    )->grid(-row => $gridy,
		    -column => 0,
		    -sticky => 'w');
    }

    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"Stra�enkategorien",
-createcmd => sub {
    $gridy = 0;
    $act_page[1]->Label(-text => M"Stra�enkategorien",
		     -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 no BAB here!
    for (qw(HH H NH N NN)) {
	my $i = $_;
	next if $_ eq 'NH' && !$city_obj->is_osm_source && !$devel_host; # XXX maybe only restrict in edit mode???
	$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,
				     @EntryArgs,
				    );
	# 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 w�rde ich die [Name => Wert]-Notation von Optionmenu
	# verwenden wollen, aber das geht nicht :-(
	my $name2inx =
	    {M"Nur Hauptstra�en" => 0,
	     M"Hauptstra�en bevorzugen" => 1,
	     M"Alle Stra�en ber�cksichtigen" => 2,
	     M"Nebenstra�en bevorzugen" => 3,
	     M"Nur Nebenstra�en" => 4,
	    };
	my $default = M"Alle Stra�en ber�cksichtigen";
	my $o = $act_page[1]->Optionmenu
	  (-options => [sort { $name2inx->{$a} <=> $name2inx->{$b} } keys %$name2inx],
	   -variable => \$default,
	   -command => sub {
	       my $i = 0;
	       # XXX BAB
	       # XXX should be relative to current speed, like in cgi!
	       # XXX rethink penalty for NH, maybe like in cgi!
	       for (qw(HH H NH N NN)) {
		   $var2{$_} = [[100,100,100,1,1],
				[100,100,100,12,12],
				[100,100,100,100,100],
				[12,12,100,100,100],
				[1,1,100,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,
				     @EntryArgs,
				    );
	# 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 $N_RW1_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=>1,$N_RW_cb=>1,$N_RW1_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"Hauptstra�en ohne Radwege/Busspuren meiden",
	 -variable => \$N_RW_optimization,
	 -command => sub {
	     if ($N_RW_optimization) {
		 $radwege_optimierung = 0;
		 $strcat_optimierung = 0;
		 $N_RW1_optimization = 0;
		 change_state_all($act_page[2], $radwege_optimierung,
				  {$cb3=>1,$N_RW_cb=>1,$N_RW1_cb=>1});
	     }
	 },
	)->grid(-row => $gridy++,
		-column => 0,
		-sticky => "w");
    $N_RW1_cb = $act_page[2]->Checkbutton
	(-text => M"Hauptstra�en ohne Radwege meiden",
	 -variable => \$N_RW1_optimization,
	 -command => sub {
	     if ($N_RW1_optimization) {
		 $radwege_optimierung = 0;
		 $strcat_optimierung = 0;
		 $N_RW_optimization = 0;
		 change_state_all($act_page[2], $radwege_optimierung,
				  {$cb3=>1,$N_RW_cb=>1,$N_RW1_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. Beeintr�chtigungen");
    $gridy = 0;
    $act_page[4]->Label(-text => M"Sonst. Beeintr�chtigungen",
		     -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,
					   @EntryArgs,
					  );
	$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;
				 }
				 # special: B == HH
				 $strcat_speed{"B"} = $strcat_speed{"HH"};
				 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 f�r 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"Qualit�t", M"schlechte Qualit�t vermeiden", M"schlechte Qualit�t bevorzugen"],
	     [M"Kategorie", M"Hauptstra�en vermeiden", M"Nebenstra�en vermeiden"],
	     [M"Radwege", M"Radwege vermeiden", M"Radwege bevorzugen"],
	     [M"Steigung", M"Steigungen vermeiden", M"Steigungen bevorzugen"]);

# Kategorie: B/HH: 3, H: 2, NH/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);

	    # Qualit�tsoptimierung
#  	    foreach (0 .. 3) {
#  	    $qualitaet_s_speed{"Q
#  	    $qualitaet_s_optimierung = ($optprefs{Qualit�t} != 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"Zur�cksetzen",
		-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 f�r 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 f�r 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 f�r die max. Geschwindigkeit, die auf der
# jeweiligen Stra�e (wegen Belag, Kategorie ...) gefahren werden kann.
### AutoLoad Sub
sub max_speed {
    my($speed_belag) = @_;
    my $speed_radler = get_active_speed();
    if ($speed_belag <= 0) {
	require Carp;
	Carp::cluck("Division by zero protection");
	return $speed_radler;
    }
    ($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; # f�r alle F�lle
    }
    $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

# L�dt bzw. speichert eine Route
### AutoLoad Sub
sub load_save_route {
    my($save, $file, %args) = @_;
    status_message("");
    my $path;
    my $ext = $bbbike_route_ext;
    my $interactively_selected_filename = 0;
    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"GPSMan-Tracks", ['.tracks','.trk']],
			      [M"GPSMan-Routen", ['.rte']],
			      [M"G7toWin", ['.g7t', '.G7T']],
			      [M"MPS-Tracks", ['.mps', '.MPS']],
			      [M"Alle Dateien",  '*']]),
	     ));
	return if !defined $file;
	$oldpath = dirname $file;
	$interactively_selected_filename = 1;
    }
    if (!-f $file && !file_name_is_absolute($file)) { # unvollst�ndiger 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) if $interactively_selected_filename;
	    @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) if $interactively_selected_filename;
	}
    }
}

### AutoLoad Sub
sub save_route_as_bbd {
    require Route;
    require Route::Heavy;
    my $file = $top->getSaveFile(-defaultextension => '.bbd');
    return unless defined $file;
    my $tmpfile = "$tmpdir/bbbike-$<-$$.bbr";
    load_save_route(1, $tmpfile);
    my $s = Route::as_strassen($tmpfile,
			       name => "Route",
			       cat => "X",
			       fuzzy => 0,
			      );
    if (!$s) {
	status_message("Fataler Fehler: $tmpfile l�sst sich nicht konvertieren", "die");
    }

    $s->write($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 Ausf�hren von %s ist mit dem Code %s fehlgeschlagen", "bbr2bbd", $?), "die") if $? != 0;
	system("$FindBin::RealBin/miscsrc/bbd2esri", $tmpfile2, "-o", $file);
	status_message(Mfmt("Das Ausf�hren von %s ist mit dem Code %s fehlgeschlagen", "bbd2esri", $?), "die") if $? != 0;
    }; warn $@ if $@;
    unlink $tmpfile2;
    unlink $tmpfile1;
}

### AutoLoad Sub
sub save_route_as_optimized_gpx {
    gps_interface('BBBikeGPS::GPXRoute', -noloading => 1);
}

### AutoLoad Sub
sub send_route_to_gps {
    if (!@{ get_act_search_route() }) {
	status_message(M"Keine Route", "infodlg");
	return;
    }
    if ($os eq 'win') {
	# Assume that the windows distribution has gpsbabel bundled,
	# so always prefer this one
	require GPS::Gpsbabel;
	if (GPS::Gpsbabel->gpsbabel_available) {
	    gps_interface('BBBikeGPS::GpsbabelSend', -noloading => 1);
	} else {
	    require BBBikeGPS;
	    if (GPS::BBBikeGPS::MapSourceSend->has_mapsource) {
		gps_interface('BBBikeGPS::MapSourceSend', -noloading => 1);
	    } else {
		if ($gps_device ne 'USB' && eval { require GPS::DirectGarmin; 1 }) {
		    gps_interface('DirectGarmin');
		} else {
		    my $recommended_path = GPS::Gpsbabel->gpsbabel_recommended_path;
		    my $download_location = GPS::Gpsbabel->gpsbabel_download_location;
		    # XXX use hypertext_widget
		    status_message(<<EOF, "die");
Das Programm gpsbabel wird zur �bertragung zum GPS-Ger�t ben�tigt und muss noch installiert werden. gpsbabel gibt es hier zum Download:
$download_location

Die heruntergeladene .zip-Datei sollte im Verzeichnis
$recommended_path
ausgepackt werden.
EOF
		}
	    }
	}
    } else {
	gps_interface('DirectGarmin');
    }
}

# 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 && -s $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'};
	}
    }
    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 H�h?
#    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;
	if (defined $file) {
	    $p_file{$abk} = $file;
	    delete $p_obj{$abk};
	}
    } else {
	$str_draw{$abk} = 1;
	if (defined $file) {
	    $str_file{$abk} = $file;
	    delete $str_obj{$abk};
	}
    }
    plot($type, $abk, %args);
    if ($type eq 'p' && $p_draw{$abk}) {
	$most_recent_p_layer = $abk;
    } elsif ($type eq 'str' && $str_draw{$abk}) {
	$most_recent_str_layer = $abk;
    }
    $abk;
}

# XXX
# h�heres 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 'region'
		      ? \&transpose_small
		      : \&transpose_medium);
    }

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

    # alte Tags l�schen
    if (!$std || !$args{FastUpdate} || !$str_draw{$abk}) {
	$c->delete($abk);		# evtl. alte Koordinaten l�schen
	$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 l�schen
	$c->delete("i");
	$c->delete("i-out");
	$c->delete("i-label");
	$c->delete("i-label-bg");
    }

    if ($std && !$str_draw{$abk}) {
	if ($lazy_str{$abk}) {
	    bbbikelazy_remove_data("str", $abk);
	}
	status_message(Mfmt("Layer <%s> entfernt", exists $str_attrib{$abk} ? $str_attrib{$abk}->[ATTRIB_PLURAL] : $abk), "info");
	return;
    }
    # A hack to get overview canvas plots deleted
    if (exists $args{Canvas} && exists $args{-draw} && !$args{-draw}) {
	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 f�r <%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??? -> wahrscheinlich nicht! XXX
#     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});
	$dont_set_cache = ($coord_system ne 'standard');
    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 'e') {
	    $str = _get_ferry_obj();
	} elsif ($abk eq 'comm') {
	    $str = _get_comments_obj();
	} elsif ($abk eq 'fz') {
	    $str = _get_fragezeichen_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
	       ) {
		# f�r 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) {
	status_message(Mfmt("Layer <%s> gezeichnet", exists $str_attrib{$abk} ? $str_attrib{$abk}->[ATTRIB_PLURAL] : $abk), "info");
	return bbbikelazy_add_data("str", $abk, $str, \%args);
    }

    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) {
	    print STDERR M("Diff-Ausgabe wird nicht verwendet"), "\n" if $verbose;
	    $c->delete($abk);		# evtl. alte Koordinaten l�schen
	    $c->delete("pp-$abk");
	} else {
	    if ($verbose) {
		print STDERR M("Diff-Ausgabe wird verwendet"), "\n";
		print STDERR Mfmt("Anzahl der neu zu zeichnenden Stra�en: %d", scalar @{$new_str->data}), "\n";
		print STDERR Mfmt("Anzahl der zu l�schenden Stra�en: %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_list, $ignore, $ignore_list) = _set_restrict($abk);

    my %category_color = %category_color;
    if ($abk =~ /^g(|[PD])$/ && !$std) {
	$category_color{Z} = '#9e9e9e';
    }

    my $default_width = get_line_width($abk) || 4;
    if (defined $args{Width}) { $default_width = $args{Width} }
    my %category_width; # XXX the global category_width is ignored!!! should be changed
    {
	my $scale = (exists $args{Canvas}
		     ? ($show_overview_mode eq 'region'
			? $small_scale
			: $medium_scale)
		     : $scale);
	%category_width = _set_category_width($abk, $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 = decide_stippleline($abk);

    destroy_delayed_restack();

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

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

    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') &&
	    !$conv &&
	    defined &BBBike::fast_plot_str) {
	    eval {
		die if $str->isa("Strassen::Storable");
		# Wenn outline nicht definiert ist, dann wird es
		# eigenm�chtig gesetzt. Die XS-Routine ist daf�r 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_list) {
		    push @args, $restrict_list;
		} else {
		    push @args, undef;
		}
		push @args, \%category_width;
		if (@$ignore_list) {
		    push @args, $ignore_list;
		} 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 $draw_sub = eval $plotstr_draw_sub;
	string_eval_die($@, $plotstr_draw_sub) 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; # f�r 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 '$abk' took %.3fs\n", Tk::Time_So_Far()-$bench
	    if $verbose;

      PLOTSTR_CONT:
	$c->itemconfigure('pp',
			  -capstyle => $capstyle_round,
			  -width => 5,
			 );
	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 "eval called before line " . __LINE__ . ": $@" if ($@);
    $progress->Finish;
    DecBusy($top);
}

sub _set_restrict {
    my($abk) = @_;
    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 $@;
	}
    }
    ($restrict, \@restrict, $ignore, \@ignore);
}

#XXX %category_width wird nicht skaliert...
sub _set_category_width {
    my($abk, $this_scale) = @_;
    $this_scale = $scale if !defined $this_scale;
    my %category_width;
    foreach (keys %line_width) {
	if (/^$abk-(.*)/) {
	    my $cat = $1;
	    $category_width{$cat} = get_line_width($_, $this_scale);
	}
    }
    %category_width;
}

sub decide_stippleline {
    my($abk) = @_;
    if ($Tk::VERSION < 800.016) {
	if (exists $line_dash{$abk} || exists $layer_line_dash{$abk} || exists $layer_category_line_dash{$abk}) {
	    require Tk::StippleLine;
	    return 1;
	} else {
	    return 0;
	}
    }
    return 3; # signal that -dash exists or is needed
}

# 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 Stra�en und Einbahnstra�en.
# XXX gesperrte Wegf�hrungen 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
	status_message(Mfmt("Layer <Sperrungen> entfernt"), "info");
	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');
	}

	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 $width3_nocross = get_line_width('sperre3nocross');
	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 Vergr��ern 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;
	if ($args{FastUpdate}) {
	    my($new_str, $todelref);
	    ($new_str, $todelref, $indexmap) = $str->diff_orig(-clonefile => 1);
	    if (!defined $new_str) {
		print STDERR M("Diff-Ausgabe wird nicht verwendet") if $verbose;
		$c->delete($abk);		# evtl. alte Koordinaten l�schen
		$c->delete("pp-$abk");
	    } else {
		if ($verbose) {
		    print STDERR M("Diff-Ausgabe wird verwendet"), "\n";
		    print STDERR Mfmt("Anzahl der neu zu zeichnenden Objekte: %d", scalar @{$new_str->data}), "\n";
		    print STDERR Mfmt("Anzahl der zu l�schenden Objekte: %d", scalar @$todelref), "\n";
		}
		foreach (@$todelref) {
		    $c->delete("$abk-$_");
		}
		$str = $new_str;
		$diffed_str = 1;
		$gesperrt = $str;
	    }
	}

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

	my $use_inwork_photo = get_symbol_scale('attrib-inwork');

	$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;
            @kreuzungen = map { $conv->($_) } @kreuzungen
		if $conv;

	    my($icon_x, $icon_y, $icon_anchor);
	    my $sub_cat;
	    my($cat,$addinfo) = $ret->[Strassen::CAT] =~ m{^(.*?)(?:::?(.*))?$};
	    my @addinfo = $addinfo ? split(':', $addinfo): ();
	    my %addinfo = map {($_,1)} @addinfo;
	    if (!$edit_normal_mode) { # we want to see everything in edit mode
	        next if $addinfo{'igndisp'};
	    }
	    if ($cat eq StrassenNetz::BLOCKED_CARRY) {
		if ($width0) { # gr��er 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;
		my $tags = [$abk, $sub_cat, $ret->[Strassen::NAME], $abk.'-'.$pos];
		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 => $tags,
			);
		}
		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 => $tags,
			);
		}
		if ($addinfo{'trailer=no'} && $notrailer_photo) {
		    my($xm,$ym) = ($x+$cos1-$sin1, $y+$cos1+$sin1);
		    $c->createImage($xm,$ym,
				    -anchor => 'nw',
				    -image => $notrailer_photo,
				    -tags => $tags);
		}
		($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 => (!$is_nocross ? $width3 : $width3_nocross),
		     (!$is_nocross ? (-arrow => 'last',
				      -arrowshape => [4,6,3],
				      -smooth => 1,
				      -fill => 'red',
				     )
		                   : (-fill => '#ff4500',
				     )
		     ),
		     ($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];
		}
		my $tags = [$abk, $sub_cat,
			    $ret->[Strassen::NAME], $abk.'-'.$pos];

		my $plot_one = sub {
		    my($p_ref, $inx) = @_;
		    my($x1,$y1) =
			transpose(@{Strassen::to_koord1($p_ref->[$inx])});
		    my($x2,$y2) =
			transpose(@{Strassen::to_koord1($p_ref->[$inx+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 => $tags,
				      );
		    } elsif ($cat eq StrassenNetz::BLOCKED_COMPLETE) {
			# $c->createImage($xm,$ym,
			# 	    -image => $blocked_photo,
			# 	    -tags => $tags);
			$c->createLine($xm-$length2, $ym-$length2,
				       $xm+$length2, $ym+$length2,
				       -fill => $fill2,
				       -width => $width2,
				       -tags => $tags);
			$c->createLine($xm-$length2, $ym+$length2,
				       $xm+$length2, $ym-$length2,
				       -fill => $fill2,
				       -width => $width2,
				       -tags => $tags);
		    }

		    my @anchors = qw(nw sw ne se);

		    # Add an additional icon
		    for my $check (['inwork', $use_inwork_photo],
				   ['night',  $night_photo],
				   ['clock',  $clock_photo],
				   ['tempmaybe', $cal_questionmark_photo],
				   ['temp',   $cal_photo], # should be last
				  ) {
			my($addinfo, $photo) = @$check;
			if ($addinfo{$addinfo} && $photo) {
			    $c->createImage($xm,$ym,
					    -anchor => shift(@anchors),
					    -image => $photo,
					    -tags => [@$tags,"attrib-$addinfo"]);
			    last;
			}
		    }

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

		if ($advanced) { # XXX decide one day if this should be the default
		    # "Sparse plotting": only one symbol between a
		    # crossing-limited hop.
		    my @hops = split_by_crossings(@kreuzungen);
		    for my $hop (@hops) {
			my $inx;
			if ($cat eq StrassenNetz::BLOCKED_ONEWAY ||
			    $cat eq StrassenNetz::BLOCKED_ONEWAY_STRICT) {
			    $inx = $#{$hop}-1;
			} elsif ($cat eq StrassenNetz::BLOCKED_COMPLETE) {
			    $inx = int($#{$hop}/2);
			} else {
			    # may happen for "q4" entries from temp-blockings
			    $inx = 0; # dummy, to avoid warnings
			}
			$plot_one->($hop, $inx);
		    }
		} else {
		    # Plot symbol on every segment in the line
		    for my $inx (0 .. $#kreuzungen-1) {
			$plot_one->(\@kreuzungen, $inx);
		    }
		}
	    }

	    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);
    status_message(Mfmt("Layer <Sperrungen> gezeichnet"), "info");
    Hooks::get_hooks("after_plot")->execute;
}

sub _line_shorten {
    my($cref, $begin, $end) = @_;
    if (@$cref <= 2) {
	warn "Coordinate list too short for shortening either begin or end\n";
	return;
    }
    if ($begin && $end && @$cref <= 4) {
	warn "Coordinate list too short for shortening begin and end (@$cref)\n";
	return;
    }

    if ($begin) {
	my $len1 = Strassen::Util::strecke([@{$cref}[0,1]], [@{$cref}[2,3]]);
	my $whole_len1 = $len1 > 20 ? 20 : $len1;
	@{$cref}[0,1] =
	    (($cref->[0]-$cref->[2])/$len1*$whole_len1+$cref->[2],
	     ($cref->[1]-$cref->[3])/$len1*$whole_len1+$cref->[3],
	    );
    }
    if ($end) {
	my $len2 = Strassen::Util::strecke([@{$cref}[-4,-3]], [@{$cref}[-2,-1]]);
	my $whole_len2 = $len2 > 20 ? 20 : $len2;
	@{$cref}[-2,-1] =
	    (($cref->[-2]-$cref->[-4])/$len2*$whole_len2+$cref->[-4],
	     ($cref->[-1]-$cref->[-3])/$len2*$whole_len2+$cref->[-3],
	    );
    }
}

sub line_shorten_begin { _line_shorten(shift, 1, 0) }
sub line_shorten       { _line_shorten(shift, 1, 1) }
sub line_shorten_end   { _line_shorten(shift, 0, 1) }

sub split_by_crossings {
    my @p = @_;
    return () if !@p;
    my $crossings = all_crossings();
    my @ret = [$p[0]];
    if (@p > 2) {
	for my $p_i (1 .. $#p-1) {
	    my $p = $p[$p_i];
	    push @{ $ret[-1] }, $p;
	    if (exists $crossings->{$p}) {
		push @ret, [$p];
	    }
	}
    }
    push @{ $ret[-1] }, $p[-1];
    @ret;
}

######################################################################
# temp blockings
sub get_temp_blockings_files {
    my $temp_blockings_dir = "$datadir/temp_blockings";
    my $file = "$temp_blockings_dir/bbbike-temp-blockings.pl";
    my $optimized_file = "$temp_blockings_dir/bbbike-temp-blockings-optimized.pl";
    return { dir            => $temp_blockings_dir,
	     file           => $file,
	     optimized_file => $optimized_file,
	   };
}

sub activate_temp_blockings {
    my $do_show_active_temp_blockings = shift;
    my(%args) = @_;
    my $now = $args{-now} || time;
    my $from = $args{-from};

    my($temp_blockings_dir, $file, $optimized_file) =
	@{ get_temp_blockings_files() }{qw(dir file optimized_file)};
    if (!-r $file && !-r $optimized_file) {
	status_message(M("Kein Support fuer temporaere Sperrungen, das Verzeichnis $temp_blockings_dir fehlt. Dieses Verzeichnis ist per git erh�ltlich, siehe README."), "warn");
	return;
    }

    # Use the optimized file?
    if (!-r $file) {
	$file = $optimized_file;
    } elsif (!defined $from || $from >= $now) {
	if (-r $optimized_file && -s $optimized_file &&
	    -M $optimized_file <= -M $file) {
	    $file = $optimized_file;
	}
    }

    if (!$do_show_active_temp_blockings) {
	$show_active_temp_blockings = 0;
	plot("p", "temp_sperre", -draw => 0);
	plot("str", "temp_sperre_s", -draw => 0);
	#XXX del? ??? not needed??? make_net(); # XXX find more performant solution
	#XXX del? undef $temporary_handicap_s;
	#if ($handicap_s_net) {
	#    undef $handicap_s_net;
	#    make_handicap_net();
	#}
	undef $current_temp_blockings_net;
	undef $current_temp_blockings_ms;
	reset_temp_blockings();
	hide_blockings();
	hide_blockings_infobar();
	return;
    }

    eval {
	use vars qw(@temp_blocking); # XXX do not use a global such as this
	use vars qw(%temp_blocking_inx_mapping); # XXX dito
	@temp_blocking = ();
	do $file; # XXX Safe?
	my($file_mtime) = (stat($file))[9];
	my @s;
	my $global_inx = -1;
	my $used_inx = -1;
	for my $o (@temp_blocking) {
	    $global_inx++;
	    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 $date_spec;
		{
		    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})) : "...";
		    if ($from_date_readable eq '...' && $to_date_readable eq '...') {
			if ($o->{permanent} || $o->{recurring}) {
			    $date_spec = M"periodische Sperrung";
			} else {
			    $date_spec = M"Ende unbekannt";
			}
		    } else {
			$date_spec = $from_date_readable . " - " . $to_date_readable;
		    }
		}
		my $text = $o->{text} . " [" . $date_spec . "]";
		my $s;
		my $f;
		my $mtime;
		if ($o->{file}) {
		    $f = "$temp_blockings_dir/$o->{file}";
		    $s = Strassen->new($f);
		    $mtime = $s->{Modtime};
		} else {
		    $s = Strassen->new_from_data_string($o->{data});
		    $mtime = $file_mtime;
		}
		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);
		    $new_s->set_directives_for_current({ info => [$o] });
		    $used_inx++;
		    $temp_blocking_inx_mapping{$used_inx} = $global_inx;
		}
		$new_s->{Modtime} = $mtime;
		push @s, $new_s;
	    }
	}
	if (!@s) {
	    if ($verbose) {
		if (defined $args{-now}) {
		    print STDERR "Keine aktuellen Sperrungen am " . scalar(localtime($now)) . "\n";
		} else {
		    print STDERR "Keine aktuellen Sperrungen\n";
		}
	    }
	    return;
	}
	my $ms = MultiStrassen->new(@s);
	push @{ $ms->{DependentFiles} }, $file;
	if ($current_temp_blockings_ms && $current_temp_blockings_ms->shallow_compare($ms)) {
	    warn "INFO: no change in temp blockings detected...\n";
	} else {
	    $current_temp_blockings_ms = $ms;
	    $current_temp_blockings_net = StrassenNetz->new($ms);
	    $current_temp_blockings_net->make_net_cat(-onewayhack => 1, -net2name => 1);
	    $current_temp_blockings_net->make_sperre($ms, Type => ['wegfuehrung']);
	    print STDERR "Aktuelle Sperrungen: " . join(", ", $ms->dependent_files) . "\n" if $verbose;
	    add_temp_blockings_to_net();
	    plot("p", "temp_sperre", -object => $ms, -draw => 1);
	    plot("str", "temp_sperre_s", -object => $ms, -draw => 1);
	    if (@realcoords) {
		clear_undecided_temp_blockings();
		check_path_in_blockings_net(\@realcoords);
	    }
	}
    };
    if ($@) {
	$show_active_temp_blockings = 0;
	status_message($@, "warn"); # do not die, may be called before mainloop
    } else {
	$show_active_temp_blockings = 1;
    }
}

sub gui_activate_temp_blockings {
    if (!$show_active_temp_blockings) {
	$show_active_temp_blockings = 1;
    }
    activate_temp_blockings($show_active_temp_blockings);
}

sub refresh_temp_blockings {
    if ($show_active_temp_blockings) {
	activate_temp_blockings($show_active_temp_blockings);
    }
}

sub apply_temp_blockings {
    make_net() if !$net;
    add_temp_blockings_to_net();
    re_search_gui();
}

sub add_temp_blockings_to_net {
    make_net() if !$net;
    make_handicap_net() if !$handicap_s_net;
    my $add_sperre_s   = Strassen->new;
    my $add_handicap_s = Strassen->new;
    while(my($name,$v) = each %temp_blockings_on_route) {
	if ($v->{state} eq 'active') {
	    for my $r (@{ $v->{data} }) {
		my $s;
		if ($r->[Strassen::CAT] =~ m{^q}) {
		    $s = $add_handicap_s;
		} else {
		    $s = $add_sperre_s;
		}
		$s->push($r);
	    }
	}
    }

    eval { # XXX check first if there's something to pop?
	$handicap_s_net->pop_stack;
    };
    my $add_handicap_s_net = StrassenNetz->new($add_handicap_s);
    $add_handicap_s_net->make_net_cat;
    $handicap_s_net->push_stack($add_handicap_s_net);

    $net->remove_all_from_deleted(undef, 'std-temp-blockings');
    $net->make_sperre($add_sperre_s, Type => 'all', DelToken => 'std-temp-blockings');
}


sub reset_temp_blockings {
    %temp_blockings_on_route = ();
    apply_temp_blockings();
}

sub _add_to_temp_blockings_on_route {
    my($r) = @_;
    my $blocking_text = $r->[Strassen::NAME];
    if (!exists $temp_blockings_on_route{$blocking_text}) {
	# Gather all records belonging to this blocking:
	my @data;
	$current_temp_blockings_ms->init;
	while() {
	    my $r = $current_temp_blockings_ms->next;
	    my @c = @{ $r->[Strassen::COORDS] };
	    last if !@c;
	    if ($r->[Strassen::NAME] eq $blocking_text) {
		push @data, $r;
	    }
	}
	$temp_blockings_on_route{$blocking_text} = { state => 'undecided',
						     data => \@data,
						   };
    }
}

sub clear_undecided_temp_blockings {
    for my $name (keys %temp_blockings_on_route) {
	delete $temp_blockings_on_route{$name}
	    if $temp_blockings_on_route{$name}->{state} eq 'undecided';
    }
}

sub check_path_in_blockings_net {
    return if !$current_temp_blockings_net;
    my($pathref) = @_;
    my $net         = $current_temp_blockings_net->{Net};
    my $wegfuehrung = $current_temp_blockings_net->{Wegfuehrung};
 PATH_SEGMENT: for my $p_i (0 .. $#$pathref-1) {
	my($xy0, $xy1) = (join(',', @{$pathref->[$p_i]}),
			  join(',', @{$pathref->[$p_i+1]}));

	# Handling "1"/"2" and "qX" types
	if (exists $net->{$xy0} && exists $net->{$xy0}{$xy1}) {
	    my($pos) = $current_temp_blockings_net->net2name($xy0, $xy1);
	    if (defined $pos) {
		my $r = $current_temp_blockings_ms->get($pos);
		my $cat = $r->[Strassen::CAT];
		if ($cat ne '3') {
		    _add_to_temp_blockings_on_route($r);
		    next PATH_SEGMENT;
		}
		# XXX else: Handled in the Wegf�hrung part
	    }
	}

	# Handling "3" (wegfuehrung) types
	if ($wegfuehrung && exists $wegfuehrung->{$xy1}) {
	    for my $wegfuehrung (@{ $wegfuehrung->{$xy1} }) {
	    CHECK_WEGFUEHRUNG: {
		    for(my $j=0; $j<$#$wegfuehrung; $j++) {
			last CHECK_WEGFUEHRUNG
			    if ($j > $p_i || join(",",@{$pathref->[$p_i-$j]}) ne $wegfuehrung->[$#$wegfuehrung-1-$j]);
		    }
		    # XXX Hackish: find a matching record in $current_temp_blockings_ms
		    my $matching_r;
		    $current_temp_blockings_ms->init;
		    while() {
			my $r = $current_temp_blockings_ms->next;
			my @c = @{ $r->[Strassen::COORDS] };
			last if !@c;
			for my $c_i (0 .. $#c-1) {
			    if ($xy0 eq $c[$c_i] && $xy1 eq $c[$c_i+1]) {
				_add_to_temp_blockings_on_route($r);
				next PATH_SEGMENT; # XXX is this correct? or should we get all the wegf�hrung here?
			    }
			}
		    }
		}
	    }
	}
    }

    if (first { $temp_blockings_on_route{$_}->{state} eq 'undecided' } keys %temp_blockings_on_route) {
	show_blockings_infobar();
    } else {
	hide_blockings_infobar();
    }
    if (Tk::Exists($toplevel{temp_blockings})) {
	show_blockings();
    }
}

sub show_blockings {
    my $blockings_toplevel = redisplay_top($top, 'temp_blockings',
					   -title => M"Aktuelle Sperrungen",
					  );
    my $toplevel_width = int($top->screenwidth*0.7);
    if (!defined $blockings_toplevel) {
	$blockings_toplevel = $toplevel{'temp_blockings'};
	# XXX quick'n'dirty solution... better to keep all the widgets
	# and to just clear the items from the hlists.
	$_->destroy for ($blockings_toplevel->children);
    } else {
	$blockings_toplevel->geometry($toplevel_width."x200");
    }

    # packer priority -> draw first
    my $footer = $blockings_toplevel->Frame->pack(qw(-fill x -side bottom));
    my $cb = $footer->Button(Name => "close",
			     -command => sub { $blockings_toplevel->destroy })->pack(-anchor => 'e', -side => "right");
    $blockings_toplevel->bind('<Escape>' => sub { $cb->invoke });


    if (!keys %temp_blockings_on_route) {
	$blockings_toplevel->Label(-text => M"Keine Sperrungen auf der Route", -font => $font{bold})->pack;
    } else {
	my %gui_temp_blockings_on_route_active = map { ($_ => $temp_blockings_on_route{$_}->{state} eq 'active') } keys %temp_blockings_on_route;

	require Tk::HList;
	my $hl;
	$hl = $blockings_toplevel->Scrolled
	    ('HList',
	     -columns => 3,
	     -header => 1,
	     -selectmode => 'single',
	     -browsecmd => sub {
		 my($hl_index) = @_;
		 return if !defined $hl_index;
		 my $name = $hl->info('data', $hl_index);
		 return if !defined $name;
		 my $coords = [
			       map { [ transpose_all(@{ Strassen::to_koord($_->[Strassen::COORDS]) }) ] }
			       @{ $temp_blockings_on_route{$name}->{data} }
			      ];
		 mark_street(-coords => $coords);
	     },
	     -scrollbars => 'osoe',
	    )->pack(qw(-fill both));
	$hl->anchorClear;
	$hl->headerCreate(0, -text => M"Aktivieren");
	$hl->headerCreate(1, -text => M"Sperrung");
	$hl->headerCreate(2, -text => M"Warn-Zeitraum");
	$hl->columnWidth(0, 80);
	my $descr_width = $toplevel_width - 200;
	$hl->columnWidth(1, $descr_width);

	require Tk::ItemStyle;
	my(%header_style, %nopad_style, %descr_style, %text_style, %bg_color);
	for my $key (qw(odd even)) {
	    my $bg_color = $key eq 'even' ? $hl->cget('-background') : '#dddddd';
	    $bg_color{$key} = $bg_color;
	    $header_style{$key} = $hl->ItemStyle('text', -foreground => 'blue3', -font => $font{'bold'}, -background => $bg_color);
	    $nopad_style{$key} = $hl->ItemStyle('window', -anchor => 'nw', -pady => 0, -padx => 0); # no -background available here
	    $descr_style{$key} = $hl->ItemStyle('text', -wraplength => $descr_width-4, -anchor => 'nw', -background => $bg_color);
	    $text_style{$key} = $hl->ItemStyle('text', -background => $bg_color);
	}

	my %seen_temp_blockings_on_route;
	my $path_i = 0;

	my $add_line = sub {
	    my($name) = @_;
	    my $key = $path_i % 2 == 0 ? 'even' : 'odd';
	    $hl->add($path_i, -itemtype => 'window', -style => $nopad_style{$key},
		     -widget => $hl->Checkbutton(-variable => \$gui_temp_blockings_on_route_active{$name},
						 -onvalue => 1,
						 -offvalue => 0,
						 -background => $bg_color{$key},
						 -highlightthickness => 0,
						),
		     -data => $name,
		    );
	    if (my($desc, $date_spec) = $name =~ m{^(.*)\s\[(.*?)\]$}) {
		$hl->itemCreate($path_i, 1, -text => $desc, -style => $descr_style{$key});
		$hl->itemCreate($path_i, 2, -text => $date_spec, -style => $text_style{$key});
	    } else {
		warn "Could not parse '$name'";
		$hl->itemCreate($path_i, 1, -text => $name, -style => $descr_style{$key});
	    }
	    $path_i++;
	};

	for my $name (sort keys %temp_blockings_on_route) {
	    if ($temp_blockings_on_route{$name}->{state} eq 'undecided') {
		$add_line->($name);
	    }
	}

	my $not_used_header_shown;
	for my $name (sort keys %temp_blockings_on_route) {
	    next if $temp_blockings_on_route{$name}->{state} eq 'undecided';
	    if (!$not_used_header_shown) {
		my $key = $path_i % 2 == 0 ? 'even' : 'odd';
		$hl->add($path_i);
		$hl->itemCreate($path_i, 0, -style => $text_style{$key});
		$hl->itemCreate($path_i, 1, -text => M"Bereits behandelte Sperrungen", -style => $header_style{$key});
		$hl->itemCreate($path_i, 2, -style => $text_style{$key});
		$path_i++;
		$not_used_header_shown++;
	    }
	    $add_line->($name);
	}

	$footer->Button(-text => M"Ausgew�hlte umfahren",
			-command => sub {
			    while(my($name,$v) = each %gui_temp_blockings_on_route_active) {
				$temp_blockings_on_route{$name}->{state} = $v ? 'active' : 'ignore';
			    }
			    apply_temp_blockings();
			})->pack(-anchor => 'w', -side => "left");

	$footer->Button(-text => M"Alle umfahren",
			-command => sub {
			    while(my($name,$v) = each %temp_blockings_on_route) {
				$temp_blockings_on_route{$name}->{state} = 'active';
			    }
			    apply_temp_blockings();
			})->pack(-anchor => 'e', -side => "right");
	$footer->Button(-text => M"Alle ignorieren",
			-command => sub {
			    while(my($name,$v) = each %temp_blockings_on_route) {
				$temp_blockings_on_route{$name}->{state} = 'ignore';
			    }
			    apply_temp_blockings();
			})->pack(-anchor => 'e', -side => 'right');
    }
}

sub hide_blockings {
    if (Tk::Exists($toplevel{temp_blockings})) {
	$toplevel{temp_blockings}->destroy;
    }
}

######################################################################
### AutoLoad Sub
sub read_sperre_tragen {
    if (!eval { StrassenNetz::make_sperre_tragen(get_strassen_file($sperre_file), get_special_vehicle(), \%sperre_tragen, \%sperre_narrowpassage); 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 H�heninformation 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 H�hendaten.
### 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 Gew�sser-Objekt zur�ck.
### 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 zur�ck.
### 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 Landstra�en-Objekt zur�ck.
### 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 F�hren-Objekt zur�ck.
### AutoLoad Sub
sub _get_ferry_obj {
    my @obj;
    push @obj, Strassen->new(get_strassen_file($str_file{'e'}));
    push @obj, eval { Strassen->new(get_strassen_file($str_file{'comm-ferry'})) };
    warn $@ if $@;
    return $obj[0] if (@obj == 1);
    MultiStrassen->new(@obj);
}

# Gibt ein Kommentar-Objekt zur�ck.
### 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);
}

# Gibt ein Fragezeichen-Objekt zur�ck.
### AutoLoad Sub
sub _get_fragezeichen_obj {
    my @files;
    push @files, get_strassen_file("fragezeichen");
##XXX hmmm. When editing, I don't want to see the non-orig fragezeichen.
##XXX But sometimes I like to... need to gather wisdom
#    if ($files[0] ne 'fragezeichen') { # happens in edit mode
#	push @files, "fragezeichen";
#    }
    my $xxx_file = catfile($FindBin::RealBin, "tmp", "XXX.bbd");
    if (0 && -r $xxx_file) { # XXX soll ich oder soll ich nicht XXX.bbd mit einbinden?
	push @files, $xxx_file;
    }
    if (@files > 1) {
	MultiStrassen->new(@files);
    } else {
	Strassen->new($files[0]);
    }
}

# 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);
    }
}

# Konfiguriert Punktsymbole, z.B. U-Bahn-Zeichen
### AutoLoad Sub
sub config_symbol {
    my($c, $abk, %args) = @_;
    my $tag_bg    = $args{'-tag_bg'} || "$abk-bg";
    my $tag_fg    = $args{'-tag_fg'} || "$abk-fg";
    my $tag_label = $args{'-tag_label'} || "$abk-label";
    if ($XXX_use_old_R_symbol && $abk eq 'r') {
	my %arg = get_symbol_scale('r');
	while(my($cat,$v) = each %{ $str_restrict{'r'} }) {
	    $c->itemconfigure
		("$abk-$cat-bg",
		 -fill => ($cat =~ m{^R[ABC]$} ? $category_color{'R'} : $category_color{$cat}),
		 -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}) : ()),
	    );
	$c->itemconfigure($tag_label, -font => "$sans_serif_font_family -12");
	change_label_visibility($c, undef, undef, ["r-label"]);
    } elsif ($abk =~ /^[ubr]$/) {
	$c->itemconfigure($tag_fg, -image => get_symbol_scale($abk));
	if ($abk eq 'u') {
	    $c->itemconfigure('u-U0-fg', -image => get_symbol_scale('u-U0'));
	    $c->itemconfigure('u-UBau-fg', -image => get_symbol_scale('u-UBau'));
	} elsif ($abk eq 'b') {
	    $c->itemconfigure('b-S0-fg', -image => get_symbol_scale('b-S0'));
	    $c->itemconfigure('b-SBau-fg', -image => get_symbol_scale('b-SBau'));
	} elsif ($abk eq 'r') {
	    $c->itemconfigure('r-R0-fg', -image => get_symbol_scale('r-R0'));
	    $c->itemconfigure('r-RBau-fg', -image => get_symbol_scale('r-RBau'));
	    $c->itemconfigure('r-RP-fg', -image => get_symbol_scale('r-RP'));
	}
	$c->itemconfigure($tag_label, -font => "$sans_serif_font_family -12");
	change_label_visibility($c, undef, undef, ["$abk-label"]);
    } 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') {
	for my $cat (qw(Vf Kz)) {
	    $c->itemconfigure("$abk-$cat-fg", -image => get_symbol_scale("$abk-$cat"));
	}
	$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-Bahnh�fe, 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 l�schen
    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, $andreaskr_grey_photo, $zugbruecke_photo);
    if ($abk eq 'lsa') {
	$ampel_photo      = get_symbol_scale('lsa-X');
	$ampelf_photo     = get_symbol_scale('lsa-F');
	$andreaskr_photo  = get_symbol_scale('lsa-B');
	$andreaskr_grey_photo = get_symbol_scale('lsa-B0');
	$zugbruecke_photo = get_symbol_scale('lsa-Zbr');
	$c->delete('lsas'); # Ampelschaltung-Symbole l�schen
	$c->delete('lsas-t'); # Ampelschaltung-Symbole l�schen
    }
    if (!$p_draw{$abk}) {
	if ($main::lazy_p{$abk}) {
	    bbbikelazy_remove_data("p", $abk);
	}
	status_message(Mfmt("Layer <%s> entfernt", exists $p_attrib{$abk} ? $p_attrib{$abk}->[ATTRIB_PLURAL] : $abk), "info");
	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}) {
	status_message(Mfmt("Layer <%s> gezeichnet", exists $p_attrib{$abk} ? $p_attrib{$abk}->[ATTRIB_PLURAL] : $abk), "info");
	return bbbikelazy_add_data("p", $abk, $filename, {exists $args{NameDraw} ? (NameDraw => $args{NameDraw}) : ()});
    }

    # XXX die anderen R�ckgabewerte (..._list, $ignore) werden noch ignoriert
    my($restrict) = _set_restrict($abk);

    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) {
		print STDERR M("Diff-Ausgabe wird nicht verwendet") if $verbose;
		$c->delete($_) for (@del_tags);
	    } else {
		if ($verbose) {
		    print STDERR M("Diff-Ausgabe wird verwendet"), "\n";
		    print STDERR Mfmt("Anzahl der neu zu zeichnenden Punkte: %d", scalar @{$new_str->data}), "\n";
		    print STDERR Mfmt("Anzahl der zu l�schenden 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;
	    }
	}

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

	# XXX Experiment!!!
	if ($orientation eq 'landscape' &&
	    !$edit_mode &&
#XXX?       !$edit_normal_mode &&
	    $abk eq 'lsa' &&
	    !$diffed_str &&
	    !$conv &&
	    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 $rbahn_length = ($abk eq 'r'
			    ? do { my(%a) = get_symbol_scale('r');
				   $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 $draw_sub = eval $plotpoint_draw_sub;
	string_eval_die($@, $plotpoint_draw_sub) 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++;
	}
	config_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 f�r das Caching der Orts/Stra�enlisten
# zur�ck.
### 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 Ausw�hlen einer Stra�e 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 = "auto";
    if (exists $args{-unsorted}) {
	$sorted = "unsorted";
    }
    my $splitter = $args{-splitter};
    my $columnwidths = $args{-columnwidths};
    my $container = $args{-container};
    my $do_popup = exists $args{-popup} ? $args{-popup} : 1;
    my $see = $args{-see};

    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;
	}
    }

    my $lb;

    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 $attrib = ($linetype eq 's'
		      ? $str_attrib{$type}
		      : $p_attrib{$type});

	IncBusy($top);
	my $t;
	eval {
	    my %orte;
	    my @orte;
	    my $object;
	    my $conv;
	    my $title = $attrib ? $attrib->[ATTRIB_PLURAL] : undef;
	    if ($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];
		    $strname =~ s/\|/ /g; # Bla|Foo: Pipe-Zeichen entfernen
		    $orte{$strname} = $i;
		    $i++;
		    push @orte, $strname;
		}
	    } 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;
			}
			push @orte, $strname;
		    }
		    $i++;
		}
	    }

	    if ($sorted eq 'auto') {
		if ($object && $object->can("get_global_directive")) {
		    my $listing_sort = $object->get_global_directive("listing_sort");
		    if ($listing_sort && $listing_sort =~ m{^(unsorted|natural)$}) {
			$sorted = $1;
		    }
		}
	    }
	    if ($sorted eq 'auto') {
		$sorted = "alphabetic";
	    }
	    if ($sorted eq 'natural') {
		if (!eval { require Sort::Naturally; 1 }) {
		    status_message(M"Sort::Naturally kann nicht geladen werden, nat�rliches Sortieren ist nicht m�glich.", "info");
		    $sorted = "alphabetic";
		}
	    }

	    if (!defined $title && $object && $object->can("get_global_directive")) {
		$title = $object->get_global_directive("title.$Msg::lang");
		if (!defined $title) {
		    $title = $object->get_global_directive("title");
		    if (!defined $title) {
			if (defined $object->file) {
			    $title = basename($object->file);
			}
			if (!defined $title) {
			    $title = "Layer $linetype/$type";
			}
		    }
		}
	    }

	    $conv = $object && $object->get_conversion;

	    my $Listbox = "Listbox";
	    if ($splitter) {
		$Listbox = "HList";
	    } else {
		if ($sorted eq 'alphabetic') {
		    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;
		    }
		}
	    }

	    if ($container) {
		$t = $container;
	    } else {
		$t = $top->Toplevel(-title => $title,
				    -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 = $t->Frame->pack(-side => "bottom", -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 $max_cols;
	    if ($Listbox =~ /K.*Listbox/ && $Tk::VERSION >= 800) {
	        my $c = $t->Canvas(-takefocus => 0)->pack;
		my $x = 2; # 2, otherwise A may be cropped with some fonts
		for ('A'..'Z') {
		    $c->createText($x, 1,
				   -text => $_,
				   -font => $font{'small'},
				   -anchor => 'nw',
				   -tags => $_,
				   -fill => 'black',
				  );
		    $x += $t->fontMeasure($font{'small'}, $_);
		}
		$x+=2; # otherwise Z may be cropped
		my $asc = $t->fontMetrics($font{'small'}, '-ascent');
		my $des = $t->fontMetrics($font{'small'}, '-descent');
		# Note that this Canvas is NOT adjusted if the font
		# is changed at runtime.
		$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');
			 });
	    }

	    if ($splitter) {
		keys %orte; # reset
		my($first_ort, $first_index) = each %orte;
		keys %orte; # reset
		my(@cols) = $splitter->($first_ort, $first_index);
		$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;
		if ($columnwidths) {
		    @wraplength = @$columnwidths;
		} else {
		    my $wraplength = $max_cols > 1 ? int($top->screenwidth/($max_cols)) : $top->screenwidth;
		    @wraplength = ($wraplength) x $max_cols;
		}
		my @text_style;
		require Tk::ItemStyle;
		for my $col (0 .. $max_cols-1) {
		    push @text_style, $lb->ItemStyle('text', -wraplength => $wraplength[$col] || 100);
		}
		my $inx = 0;
		# XXX no support for sort styles here XXX
		for my $ort (sort keys %orte) {
		    my(@cols) = $splitter->($ort, $orte{$ort});
		    $lb->add($inx,
			     -text => $cols[0],
			     -data => $ort,
			     -style => $text_style[0],
			    );
		    for my $col (1 .. $#cols) {
			next if $col > $max_cols; # XXX off by one?
			$lb->itemCreate($inx, $col,
					-text => $cols[$col],
					-style => $text_style[$col],
				       );
		    }
		    $inx++;
		}
		# XXX destroy text_styles?
	    } else {
		if ($sorted eq 'unsorted') {
		    $lb->insert('end',
				@orte);
		} elsif ($sorted eq 'natural') {
		    $lb->insert('end',
				Sort::Naturally::nsort(keys %orte));
		} else {
		    # XXX use Sort::Naturally if $sorted eq 'natural'
		    # "use locale" is not used here because:
		    # - there's maybe no locale support at all
		    # - the german locale may be missing
		    # - with various perl versions and OSes I had in the
		    #   past problems with "use locale"
		    my $tf_sub = \&BBBikeUtil::umlauts_for_german_locale;
		    $lb->insert('end',
				map { $_->[1] }
				sort { $a->[0] cmp $b->[0] }
				map { [ do { /^\(?(.*)/; $tf_sub->($1) }, $_] }
				keys %orte);
		}
	    }

	    eval {
		if ($lb->can("Cache")) {
		    $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 $index;
		if ($sorted eq 'unsorted') {
		    $index = $lb_index;
		} else {
		    my $ort = ($splitter
			       ? $lb->info("data", $lb_index)
			       : $lb->get($lb_index)
			      );
		    $index = $orte{$ort};
		}
		my $tcoords = [];
		$args{'-type'} = $type;
		if ($type eq 'o' || $type eq 'p') { # XXX is 'p' OK here?
		    my $p = $object->get($index)->[Strassen::COORDS]->[0];
		    $p = $conv->($p) if $conv;
		    $tcoords->[0][0] = [ transpose(split /,/, $p) ];
		} else {
		    my @i = split(/,/, $index);
		    my $i;
		    foreach $i (@i) {
			my $r = $object->get($i);
			my @c = @{ $r->[Strassen::COORDS] };
			if ($conv) {
			    @c = map { $conv->($_) } @c;
			}
			push @{$tcoords}, [ transpose_all(@{ Strassen::to_koord(\@c) }) ];
		    }
		    if ($linetype =~ /^p/) {
			$args{'-width'} = 20;
			$args{'-type'} = "$type-bg";
		    } else {
			# Is it an area or rectangle?
			if (@{$tcoords->[0]} >= 2 &&
			    "$tcoords->[0][0][0],$tcoords->[0][0][1]" eq
			    "$tcoords->[0][-1][0],$tcoords->[0][-1][1]") {
			    # Use first point (usually upper left?)
			    $args{'-scrollto'} = $tcoords->[0][0];
			} else {
			    # Use middle point of first segment:
			    $args{'-scrollto'} = $tcoords->[0][$#{$tcoords->[0]}/2];
			}
		    }
		}
		$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 $coords = $r->[Strassen::COORDS];
		    my $coord = $coords->[$#$coords/2]; # choose middle one
		    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');
	    }

	    my @bfb;
	    $showb  = $f->Button(Name => 'show',
				 -command => sub { $show_sub->() },
				);
	    push @bfb, $showb;
	    $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;
					 }
				     }
				 },
				);
	    push @bfb, $closeb;
	    pack_buttonframe($f, \@bfb);

	    $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 {
	my $t = $toplevel{"chooseort-$type-$linetype"};
	$t->deiconify;
	# win32 ben�tigt zus�tzliches raise
	$t->raise;
	$lb = $t->Subwidget("Listbox");
    }

    if (defined $see) {
	if ($splitter) {
	TRY: {
		for my $inx ($lb->info('children')) {
		    if ($lb->itemCget($inx, 0, '-text') eq $see) {
			$lb->see($inx);
			$lb->anchorSet($inx);
			last TRY;
		    }
		}
		# XXX inconsistency: in splitter/HList mode, do only
		#     exact match, no substring match
		warn "Cannot find <$see> in listbox content";
	    }
	} else {
	    my $found_index;
	TRY: {
		# first: exact match
		for my $inx (0 .. $lb->index("end")-1) {
		    if ($lb->get($inx) eq $see) {
			$found_index = $inx;
			last TRY;
		    }
		}
		# then: substring match
		for my $inx (0 .. $lb->index("end")-1) {
		    if (index($lb->get($inx), $see) >= 0) {
			$found_index = $inx;
			last TRY;
		    }
		}
		warn "Cannot find <$see> in listbox content";
	    }
	    if (defined $found_index) {
		$lb->see($found_index);
		$lb->selectionSet($found_index);
	    }
	}
    }

}

# Spezialisierung von choose_ort f�r Stadtstra�en
### AutoLoad Sub
sub choose_streets {
    choose_ort(qw(s s),
	       -markstartifactive => 1,
	       (!$city_obj->is_osm_source
		? (-completelistbutton => sub { choose_from_plz(-interactive => 1) },
		   -completelistbuttonlabel => "Alle Stra�en"
		  )
		: ()
	       )
	      );
}

# 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)
# Weitere Optionen:
#   -dont_mark: nur zentrieren, aber nicht markieren
#   -dont_center: nur markieren, aber nicht zentrieren
#   -clever_center: m�glichst so zentrieren, dass die Markierung nicht durch
#                   andere Fenster verdeckt wird
#   -dont_delete_old: alte Markierungen beibehalten
#   -endlessmark: ?
#   -addtag => $tag   : add another tag to the canvas item; this is used as the point name
#   -addtag => \@tags : add more than one tag; by convention the first additional tag is used as the point name
#   -inactive: Markierung reagiert nicht auf Events (insbesondere Tooltips)
### 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;
    my $do_also_overview_canvas = Tk::Exists($overview_canvas);
    if (!$args{'-dont_mark'} && !$args{'-dont_delete_old'}) {
	$c->delete('show');
	if ($do_also_overview_canvas) {
	    $overview_canvas->delete('show');
	}
    }
    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'};
	    }
	}
	my @common_args = (-capstyle => $capstyle_round,
			   ($args{-inactive} ? (-state => "disabled") : ()),
			   -tags => \@tags,
			  );
	$c->createLine($tx, $ty, $tx, $ty,
		       -width => $width,
		       -fill => $mark_color,
		       @common_args,
		      );
	if ($do_also_overview_canvas) {
	    my($otx,$oty) = _convert_transposed_to_overview_coord($tx, $ty);
	    $overview_canvas->createLine($otx,$oty,$otx,$oty,
					 -width => 2,
					 -fill => $mark_color_overview,
					 @common_args,
					);
	}
	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);
	}
    }
    unless ($args{'-dont_mark'}) {
	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);
    { local $^W = 0; 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
# Coordinates must be map coords, not BBBike standard coords
#   (that is, use transpose())
# Important arguments:
#   -coords => [[[x,y],[x2,y2]], # first line
#               [[x3,y3],[x4,y4]], # second line
#              ]
#   -labels => ["first line", "second line" ...]
#   -scrollto => [x,y]
#   -dont_mark => 1: don't mark
#   -dont_center => 1: don't center
### AutoLoad Sub
sub mark_street {
    my(%args) = @_;
    my $do_also_overview_canvas = Tk::Exists($overview_canvas);
    unless ($args{'-dont_delete_old'}) {
	$c->delete('show');
	if ($do_also_overview_canvas) {
	    $overview_canvas->delete('show');
	}
    }
    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;
	    my @common_args = (-tags => ['show', (defined $label ? $label : ())],
			       ($args{-inactive} ? (-state => "disabled") : ()),
			      );
	    if ($args{'-polygon'}) {
		if (@res_coords == 2) {
		    push @res_coords, (@res_coords) x 2;
		}
		$c->createPolygon(@res_coords,
				  -width => 5,
				  -fill => $mark_color,
				  @common_args,
				 );
		if ($do_also_overview_canvas) {
		    my @overview_coords;
		    for(my $i=0; $i<$#res_coords; $i+=2) {
			push @overview_coords, _convert_transposed_to_overview_coord(@res_coords[$i,$i+1]);
		    }
		    $c->createPolygon(@overview_coords,
				      -width => 1,
				      -fill => $mark_color_overview,
				      @common_args,
				     );
		}
	    } elsif (@res_coords) {
		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,
			       @common_args,
			      );
		if ($do_also_overview_canvas) {
		    my @overview_coords;
		    for(my $i=0; $i<$#res_coords; $i+=2) {
			push @overview_coords, _convert_transposed_to_overview_coord(@res_coords[$i,$i+1]);
		    }
		    if (@overview_coords == 2) {
			push @overview_coords, @overview_coords;
			push @add_args, -capstyle => $capstyle_round;
		    }
		    my %add_args = @add_args;
		    $add_args{-width} = 1; # overwrite
		    $overview_canvas->createLine(@overview_coords,
						 %add_args,
						 @common_args,
						);
		}
	    }
 	}
    }
    show_mark() unless $args{'-dont_mark'};
    if ($args{'-zoom_view'} && defined $minx) {
	zoom_view($minx, $miny, $maxx, $maxy);
    } else {
	my($vx,$vy);
	if ($args{'-scrollto'}) {
	    ($vx,$vy) = @{ $args{'-scrollto'} };
	} elsif (!$args{'-dont_scroll'}) {
	    # Prefer an already visible point to scroll to
	    ($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]);
	    }
	}
    }
    unless ($args{'-dont_mark'}) {
	eval { local $SIG{__DIE__}; $c->lower('show', $args{'-type'}) };
    }
}

sub delete_markers {
    $c->delete('show');
    if (Tk::Exists($overview_canvas)) {
	$overview_canvas->delete('show');
    }
    if ($showmark_after) {
	$showmark_after->cancel;
	undef $showmark_after;
    }
}

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 Stra�e aus der Postleitzahl-Datenbank
### AutoLoad Sub
sub choose_from_plz {
    my(%args) = @_;

    return if !defined $city || $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;
	}
    }

    my $plz = make_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 Stra�en im PLZ-Gebiet %s.\n", $plz_nr);
		    }
		}

		# Stra�en 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 Stra�e 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 Stra�enliste",
			       -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('Stra�e').':'
		    )->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 Stra�en 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);
	my @bfb;
	$showb = $bf->Button
	  (Name => 'show',
	   -state => 'disabled',
	   -command => $show_sub_lb);
	push @bfb, $showb;
	$lb->bind('<Return>' => $show_sub_lb);
	push @bfb, $bf->Button(Name => 'close',
		    	       -command => $close_window);
	pack_buttonframe($bf, \@bfb);
	#$t->Popup(@popup_style);
	my($x,$y) = ($c->rootx+10, $c->rooty+10);
	$t->geometry("+$x+$y");

    }
}

# Gibt die aktuelle Fontgr��e f�r die �bergebene Ortskategorie zur�ck.
### AutoLoad Sub
sub get_orte_label_font {
    my($category, $is_overview_canvas) = @_;
    my $base_index = 0;
    if ($is_overview_canvas) {
	$base_index = -2;
    } else {
	if ($scale >= 6) {
	    $base_index = 2;
	} elsif ($scale >= 3) {
	    $base_index = 1;
	} else {
	    $base_index = 0;
	}
    }
    my $fix_index = sub {
	my $index = shift;
	if ($index < 0) { $index = 0 }
	$index;
    };
    my $font;
    # This should handle the range MIN_ORT_CAT .. MAX_ORT_CAT:
    if      ($category == 0) {
	my $index = $fix_index->($base_index + $orte_label_size - 2);
	$font = $font{$font[$index] . "-italic"};
    } elsif ($category == 1) {
	my $index = $fix_index->($base_index + $orte_label_size - 1);
	$font = $font{$font[$index]};
    } elsif ($category <= 2) {
	my $index = $fix_index->($base_index + $orte_label_size);
	$font = $font{$font[$index]};
    } elsif ($category == 3) {
	my $index = $fix_index->($base_index + $orte_label_size + 1);
	$font = $font{$font[$index]};
    } 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 'region'
		      ? \&transpose_small
		      : \&transpose_medium);
	$is_overview_canvas = 1;
    } else {
	$std = 1;
	$transpose = \&transpose;
    }

    # evtl. alte Koordinaten l�schen
    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) {
	status_message(Mfmt("Layer <%s> gezeichnet", exists $p_attrib{$type} ? $p_attrib{$type}->[ATTRIB_PLURAL] : $type), "info");
	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 l�schen
		$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;

	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 gr��eren Orte _sp�ter_ 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);
	}

	if ($type eq 'o') {
	    for my $def ([0 => {-width => 3, -fill => '#0000c0'}],
			 [1 => {-width => 3}],
			 [2 => {-width => 4}],
			 [3 => {-width => 5}],
			 [4 => {-width => 6}],
			 [5 => {-width => 7}],
			 [6 => {-width => 7}],
			) {
		my($cat, $args) = @$def;
		my %args = (-capstyle => $capstyle_round,
			    -fill     => '#000080',
			    %$args,
			   );
		$c->itemconfigure("OP$cat", %args);
	    }
	} else {
	    $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 || $no_overlap_label eq 'drop_non_fitting') {
			    $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 ($municipality) {
		$c->itemconfigure($label_tag, -fill => '#7e7e7e');
	    } elsif (!$do_outline_text) {
		$c->itemconfigure($label_tag, -fill => '#000080');
	    }
	    if ($orientation eq 'landscape' &&
		!$do_outline_text) {
		foreach my $category (MIN_ORT_CAT .. 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 l�schen
    $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} = load_photo($top, $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 verk�rzen
    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;
    my $mounds = delete $args{'-mounds'} || "Tu";
#XXX complicated code, make nicer!
    if ($mounds !~ m{^_}) {
	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,
		      );
    }
    if ($mounds !~ m{_$}) {
	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,
		      );
    }
}

# L�scht alle derzeitig gezeichneten Stra�en und Punkte und liefert
# eine Subroutine zur�ck, mit der die gel�schten Objekte wieder
# gezeichnet werden k�nnen.
### 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 f�r 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;
    }
}

sub gui_start_bbbike_server {
    require BBBikeServer;
    if (!BBBikeServer::running()) {
	BBBikeServer::create_server($top);
	status_message("Der BBBike-Server kann jetzt mit dem Programm <bbbikeclient> angesprochen werden", "info");
    } else {
	status_message("Der BBBike-Server l�uft bereits.", "infodlg");
    }
}

# 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("Einbahnstra�e") .
		(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 Stra�e");
	    }
	} 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"Fu�g�ngerampel"
				       : ($exact_cat =~ /^lsa-B/
					  ? M"Bahn�bergang"
					  : ($exact_cat =~ /^lsa-Zbr/
					     ? M"Zugbr�cke (" . $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 >= 2) {
	    if ($leave_after) {	$leave_after->cancel; undef $leave_after }
	    my $str = join(" / ", @l);
	    if (1) {
		my $add_str = balloon_info_from_all_tags($c);
		if ($add_str) {
		    $str .= "\n$add_str";
		}
	    }
	    $c_balloon->Popup($str);
	} 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 Stra�enzugnamen.
sub enterstr {
    my $c = shift;

    my @balloon_info = balloon_info_from_all_tags($c);
    if (@balloon_info) {
	$act_value{Strasse} = $balloon_info[0];
	$str_label->configure(-fg => 'black');
	if (defined $c_balloon) {
	TRY_BALLOON:
	    {
		if ($use_c_balloon >= 2) {
		    if ($leave_after) {
			$leave_after->cancel;
			undef $leave_after;
		    }
		    my $str = balloon_info_from_all_tags($c);
		    if (defined $str) {
			$c_balloon->Popup($str);
			last TRY_BALLOON;
		    }
		}
		$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 angew�hlt 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 }
	my $b_str = join(" / ", @l);
	if (defined $str && 1) {
	    my $bi_str = balloon_info_from_all_tags($c);
	    $bi_str =~ s{\Q$str\E\n?}{} if $bi_str;
	    $b_str .= "\n" . $bi_str if $bi_str;
	}
	$c_balloon->Popup($b_str);
    } 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.
#
# The position is determined by the optional argument -cxy => [$cx,$cy],
# or the position of the current canvas event.
sub find_below_rx {
    my($c, $allowed_tags_rxs, $tag_pos, $forbidden_tags_rxs, %args) = @_;
    my $cxy = delete $args{-cxy};
    warn "ERROR: Unhandled args: " . join(" ", %args) if %args; # XXX consider to make this a die()
    my($cx,$cy);
    if ($cxy) {
	($cx, $cy) = @$cxy;
    } else {
	my $e = $c->XEvent;
	($cx, $cy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    }

    my(@items) = $c->find(overlapping => $cx-1, $cy-1, $cx+1, $cy+1);
    # Now using "reverse", so top-most items are preferred
 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_tags_rxs) {
                if ($tag =~ /$rx/) {
		    if ($forbidden_tags_rxs) {
			for my $frx (@$forbidden_tags_rxs) {
			    if ($tag =~ /$frx/) {
				next ITEM;
			    }
			}
		    }
		    $ok = 1;
		}
	    }
	}
	if ($ok) {
	    return ($item, @tags);
	}
    }
    undef;
}

# Doc pending XXX
# tag list imcomplete, should be roughly the same like in set_bindings XXX
sub show_below_str {
    my($c) = @_;
    my($item, @tags) = find_below($c,
				  (qw/s sBAB l u b r fz f w/, (map { "comm-$_" } @comments_types)),
				 );
    return if !defined $item;
    $act_value{Strasse} = $tags[1];
    $str_label->configure(-fg => 'black');
    $act_value{Strasse};
}

# Guckt zun�chst 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); # R�ckgabe: String
    } else {
	enterroute($c, $item);
	undef; # R�ckgabe: undef
    }
}

use vars qw($show_info_url);
sub handle_show_info_url {
    my($offset,$maxbytes) = @_;
    return undef if $offset > length($show_info_url);
    substr($show_info_url, $offset, $maxbytes);
}

# 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 $in_2nd_pass = 0;
    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 fz/);
	if (!defined $below_item) {
	    # 2nd pass: check for markers etc.
	    my($below_item, @below_tags) = find_below($c, qw/show/); # XXX still necessary? 'show' is now -state=>'disabled'
	    if (!defined $below_item) {
		# XXX Alert! Hardcoded for special osm layer, see BBBikeOsmUtil XXX
		%BBBikeOsmUtil::osm_layer = %BBBikeOsmUtil::osm_layer if 0; # cease -w
		if (defined $BBBikeOsmUtil::osm_layer{item} && grep { $_ eq 'osm' } @tags) {
		    # just accept
		    last;
		} else {
		    main::status_message("Es wurde kein Kartenelement an dieser Position gefunden.", "err");
		    warn "Current tags=@tags\nBase tag=$base_tag\nBelow item/tags=$below_item @below_tags";
		    return;
		}
	    }
	    $in_2nd_pass = 1;
	}
	@tags = @below_tags;
	last if $in_2nd_pass;
    }

    my $index;
    if ($#tags >= 3) {
	($index = $tags[3]) =~ s/^$base_tag-//;
	#warn $index;
    }
    my $strname = $tags[1];
    my $good_link_for_strname = 1;
    my $outside_berlin = 0; # XXX works only for landstrassen, but not for wasser, flaechen, s/rbahn, sehenswuerdigkeiten ... outside berlin
    if ($tags[0] =~ m{^(?:
			(?:[ub]|kn)-fg
		       )
		    }x) {
	$strname = $tags[2];
    } elsif ($tags[0] eq 'GU-img') {
	$strname = $tags[2];
    } elsif ($tags[0] =~ m{^sperre}) {
	$strname = $tags[2];
	$good_link_for_strname = 0;
    } elsif ($tags[0] =~ m{^(?:qs|hs|ql|hl)}) {
	$good_link_for_strname = 0;
    } elsif ($tags[0] =~ m{^l$}) {
	$outside_berlin = 1;
    } elsif ($tags[0] =~ /^lsa/) {
	undef $strname; # no meaningful name
    } elsif ($tags[0] =~ m{^o$}) {
	$outside_berlin = 1;
	$strname = $tags[2];
    }

    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);
    if ($city_obj->can("standard_to_polar")) {
	($px,$py) = $city_obj->standard_to_polar($sx,$sy);
    } else {
	($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);
		    if ($r->[Strassen::NAME] ne $strname) {
			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
# Au�erdem sind manche Gew�sser gleichzeitig Seen und Fl�sse (Havel), bei
# diesen sollten aus der Fl�che eine vern�nftige L�nge berechnet werden
# und diese zu der normalen L�nge dazuaddiert werden.
	    if ($r) {
		if ($r->[Strassen::CAT()] =~ /^F:/) {
		    $area = Strassen::area($r);
#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($name, $good_link_for_strname, $outside_berlin, $important_txt_and_tag, $unimportant_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 = hypertext_widget($info_top);
	    $info_top->Button(Name => 'close',
			      -command => sub { $info_top->destroy },
			     )->pack(-fill => "x");
	    toplevel_checker($info_top);
	} else {
	    $info_top = $toplevel{$tl_tag};
	    soft_flash($info_text);
	}

	my $link_menu = $info_text->Menu(-title => M"Linkmen�",
					 -tearoff => 0);

	my $copy_link = sub {
	    my($url) = @_;
	    $show_info_url = $url if defined $url;

	    $info_top->SelectionOwn;
	    $info_top->SelectionHandle; # calling this mysteriously solves the closure problem...
	    $info_top->SelectionHandle(\&handle_show_info_url);
	};
	$link_menu->command
	    (-label => M"Link kopieren",
	     -command => sub { $copy_link->() },
	    );
	my $show_url = sub {
	    my($linkcount, $url, $my_link_menu) = @_;
	    $info_text->tagBind
		("link$linkcount", "<ButtonRelease-1>" => sub {
		     my $url = ref $url eq 'CODE' ? $url->() : $url;
		     require WWWBrowser;
		     main::status_message("URL: $url", "info");
		     WWWBrowser::start_browser($url);
		 }
		);
	    if (!$my_link_menu) {
		$my_link_menu = $link_menu;
	    }
	    $info_text->tagBind
		("link$linkcount", "<Button-3>" => sub {
		     my $e = $_[0]->XEvent;
		     $show_info_url = ref $url eq 'CODE' ? $url->() : $url;
		     $my_link_menu->Post($e->X, $e->Y);
		     Tk->break;
		 });
	};

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

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

	if (defined $name && $name !~ m{^\s*$}) {
	    $info_text->insert("end", M("Name")."\n", "bold");

	    my $url;
	    my $common_url;
	    if ($name =~ m{(https?://\S+)}) {
		$url = $1;
	    } elsif ($good_link_for_strname) {
		my $google_url = "http://www.google.com/search?";
		require CGI;
		CGI->import('-oldstyle_urls');
		(my $name = $name) =~ s{(str)\.}{$1a�e}gi;
		# XXX duplicated in LuiseBerlin.pm
		$name =~ s{\[.*\]}{}g; # remove special [...] parts
		$name =~ s{:\s+.*}{}g; # also remove everything after ":"
		($name, my @cityparts) = Strasse::split_street_citypart($name);
		my $common_q = ($outside_berlin ? '' : qq{Berliner }) .
		    qq{"$name"} . (@cityparts ? " ".join(" ",@cityparts) : "");
		$url        = $google_url . CGI->new({ 'q' => qq{site:de.wikipedia.org $common_q} })->query_string;
		$common_url = $google_url . CGI->new({ 'q' => $common_q })->query_string;
	    }

	    if (!$url) {
		$info_text->insert("end", "$name\n");
	    } else {
		$info_text->insert("end", $name, "link$linkcount");

		my $www_link_menu = $info_text->Menu(-title => M"Linkmen�",
						     -tearoff => 0);
		$www_link_menu->command
		    (-label => M"Link kopieren",
		     -command => sub { $copy_link->($url) },
		    );
		if ($common_url) {
		    $www_link_menu->command
			(-label => M"Allgemeine Google-Suche",
			 -command => sub {
			     require WWWBrowser;
			     main::status_message("URL: $common_url", "info");
			     WWWBrowser::start_browser($common_url);
			 }
		     );
		}

		$show_url->($linkcount, $url, $www_link_menu);
		$linkcount++;
		$info_text->insert("end", "\n");
	    }
	    $info_text->insert("end", "\n");
	}

	my $write_txt_and_tag = sub {
	    my(@txt_and_tag) = @_;
	    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");
		}
	    }
	    if (@txt_and_tag) {
		$info_text->insert("end", "\n\n");
	    }
	};

	$write_txt_and_tag->(@$important_txt_and_tag) if @{ $important_txt_and_tag || [] };

	my $comment_label_end_index;
	if (@comments) {
	    $info_text->insert("end", M("Kommentare").": ", "bold");
	    $comment_label_end_index = $info_text->index("end - 1c");
	    $info_text->insert("end", "\t" . join("\n\t", @comments), "comments_text");
	    $info_text->insert("end", "\n\n");
	}
	if (defined $area) {
	    my($area_value, $area_unit);
	    if ($area > 10_000) {
		$area_value = $area / 1_000_000;
		$area_unit = 'km�';
	    } else {
		$area_value = $area;
		$area_unit = 'm�';
	    }
	    $info_text->insert("end", M("Fl�che") . ":", "bold",
			       sprintf("\t%.2f %s", $area_value, $area_unit) . M(" (dieses Teilst�ck)"), undef); # XXX Msg
	    $info_text->insert("end", "\n\n");
	}
	if (defined $total_len) {
	    $info_text->insert("end", M("L�nge") . ":", "bold",
			       sprintf("\t%.2f km", $total_len) . M(" (dieses Teilst�ck)"), undef); # XXX Msg
	    $info_text->insert("end", "\n\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://localhost/bbbike/cgi/mapserver_address.cgi", "Lokaler Mapserver", "is_local"];
	}

	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 gBO)] => "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;
		}
	    }
	}
	push @layers, "route"; # the "mark" is also in the "route" layer

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

	if ($city_obj->cityname eq 'Berlin') { # only mapserver links for Berlin data
	    my $mapserver_logo_photo = load_photo($top, 'mapserver_logo', -persistent => 1);
	    my $need_indentation = !$mapserver_logo_photo;
	    for my $def (@mapserver_def) {
		my($mapserver_url, $mapserver_label, $is_local) = @$def;
		my $url = "$mapserver_url/coords=" . $real_coords;
		$url .= "/mapext=" . join(",",@mapext);
		if (@layers) {
		    $url .= "/" . join("/", map { "layer=$_" } @layers);
		}
		if ($mapserver_logo_photo) {
		    $info_text->imageCreate("end", -image => $mapserver_logo_photo,
					    -align => "bottom", -padx => 2, -pady => 2);
		}
		$info_text->insert("end", $mapserver_label, ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
		$show_url->($linkcount, $url);
		$info_text->insert("end", "\n");
		$linkcount++;

		if ($advanced && !$is_local) {
		    if ($mapserver_logo_photo) {
			$info_text->imageCreate("end", -image => $mapserver_logo_photo,
						-align => "bottom", -padx => 2, -pady => 2);
		    }
		    $info_text->insert("end", $mapserver_label . " (kurzer Link)",
				       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
		    $show_url->($linkcount, sub {
				    if (exists $long_url_to_short_url{$url}) {
					return $long_url_to_short_url{$url};
				    }
				    if (!eval { require WWW::Shorten; WWW::Shorten->import(); 1 }) {
					status_message("Das Modul WWW::Shorten ist nicht vorhanden.", "die");
				    }
				    my $short_url = makeashorterlink($url);
				    $long_url_to_short_url{$url} = $short_url;
				    $short_url;
				});
		    $info_text->insert("end", "\n");
		    $linkcount++;
		}
	    }
	}

	if ($city_obj->cityname eq 'Berlin') { # only bbbike.de links for Berlin data (XXX but maybe bbbike.org links could be done instead?)
	    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://localhost/bbbike/cgi/bbbike.cgi", "lokal: BBBike im WWW"];
	    }

	    my $zielname = "";
	    {
		my $is_first = 1;
		for my $def (@bbbike_cgi_def) {
		    my $bbbike_cgi_url = $def->[0];

		    my $need_indentation;
		    if ($srtbike16_icon) {
			$info_text->imageCreate("end", -image => $srtbike16_icon,
						-align => "bottom", -padx => 2, -pady => 1);
		    } else {
			$need_indentation = 1;
		    }

		    $info_text->insert("end", $def->[1],
				       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
		    $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;
		    }

		    my $www_link_menu = $info_text->Menu(-title => M"Linkmen�",
							 -tearoff => 0);
		    $www_link_menu->command
			(-label => M"Link kopieren als Ziel",
			 -command => sub { $copy_link->() },
			);
		    $www_link_menu->command
			(-label => M"Link kopieren als Start",
			 -command => sub {
			     my $current_start_link_url = $show_info_url;
			     $current_start_link_url =~ s{ziel}{start}g;
			     $copy_link->($current_start_link_url);
			 });
		    $www_link_menu->command
			(-label => M"Link kopieren als Start und Ziel",
			 -command => sub {
			     my $current_start_link_url = $show_info_url;
			     $current_start_link_url =~ s{ziel}{start}g;
			     my $complete_link_url = "$current_start_link_url\n$show_info_url";
			     $copy_link->($complete_link_url);
			 });

		    $show_url->($linkcount, sub {
				    require CGI;
				    # sigh, ";" still makes problems...
				    my $zielname = $zielname;
				    if ($Tk::VERSION >= 804) {
					$zielname = Encode::encode("iso-8859-1", $zielname);
				    }
				    CGI->import('-oldstyle_urls');
				    my $q = CGI->new({zielc_wgs84 => $wgs84_coords,
						      zielname    => $zielname,
						     });
				    my $url = "$bbbike_cgi_url?" . $q->query_string;
				    $url;
				},
				$www_link_menu,
			       );
		    $info_text->insert("end", "\n");
		    $linkcount++;
		}
	    }
	}

	if ($advanced
	    && !$city_obj->is_osm_source # no fragezeichen form link for osm data
	    && grep { $_ eq 'fz' } @tags
	   ) {
	    my $need_indentation = 1; # XXX unless I have an icon
	    $info_text->insert("end", "fragezeichenform",
			       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
	    $show_url->($linkcount, sub {
			    require CGI;
			    my $fragezeichen_comment = $strname;
			    if ($Tk::VERSION >= 804) {
				$fragezeichen_comment = Encode::encode("iso-8859-1", $fragezeichen_comment);
			    }
			    CGI->import('-oldstyle_urls');
			    my $qs = CGI->new({strname => $fragezeichen_comment,
					       strname_html => CGI::escapeHTML($fragezeichen_comment),
					       supplied_coord => $real_coords,
					      })->query_string;
			    # XXX $BBBIKE_UPDATE_WWW shows also to root bbbike directory at server
			    my $url = "$BBBike::BBBIKE_UPDATE_WWW/html/fragezeichenform.html?$qs";
			    $url;
			});
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

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

	if (!$google_photo) {
	    $google_photo = load_photo($top, 'google');
	}
	if (!$bbbike_google_photo) {
	    $bbbike_google_photo = load_photo($top, 'bbbike_google');
	}
	if (!$google_streetview_photo) {
	    $google_streetview_photo = load_photo($top, 'google_streetview');
	}

	{
	    my @bbbike_google_map_defs = (($devel_host
					   ? ["lokal: Google Maps (BBBike)", "http://localhost/bbbike/cgi/bbbikegooglemap.cgi"]
					   : ()
					  ),
					  ["Google Maps (BBBike)", $BBBike::BBBIKE_GOOGLEMAP_URL],
					 );
	    for my $def (@bbbike_google_map_defs) {
		my($label, $baseurl) = @$def;
		my $need_indentation;
		if ($bbbike_google_photo) {
		    $info_text->imageCreate("end", -image => $bbbike_google_photo,
					    -align => "bottom", -padx => 2, -pady => 1);
		} else {
		    $need_indentation = 1;
		}
		$info_text->insert("end", $label,
				   ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
		$show_url->($linkcount, sub {
				require CGI;
				my $center = "$px,$py";
				my $zoom;
				if ($mapscale_scale < 2000) {
				    $zoom = 18;
				} elsif ($mapscale_scale < 4000) {
				    $zoom = 17;
				} elsif ($mapscale_scale < 8000) {
				    $zoom = 16;
				} elsif ($mapscale_scale < 16000) {
				    $zoom = 15;
				} else {
				    $zoom = 14;
				}
				my $q2 = CGI->new({ center => $center,
						    zoom => $zoom,
						    autosel => 1,
						    maptype => "hybrid",
						    coordsystem => "polar",
						    mapmode => "addroute",
						  });
				my $url = $baseurl . "?" . $q2->query_string;
				$url;
			    });
		$info_text->insert("end", "\n");
		$linkcount++;
	    }
	}

	{
	    my $need_indentation;
	    if ($google_photo) {
		$info_text->imageCreate("end", -image => $google_photo,
					-align => "bottom", -padx => 2, -pady => 1);
	    } else {
		$need_indentation = 1;
	    }

	    $info_text->insert("end", "Google Maps (Original)",
			       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
	    $show_url->($linkcount, sub {
			    require CGI;
			    my $q2 = CGI->new({ ll => "$py,$px" });
			    my $url = "http://www.google.com/maps?" . $q2->query_string;
			    $url;
			});
	    $info_text->insert("end", "\n");
	    $linkcount++;

	    if ($google_streetview_photo) {
		$info_text->imageCreate("end", -image => $google_streetview_photo,
					-align => "bottom", -padx => 2, -pady => 1);
	    }

	    $info_text->insert("end", "Google Maps (StreetView)",
			       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
	    $show_url->($linkcount, sub {
			    require CGI;
			    my $q2 = CGI->new({ cbll => "$py,$px",
						layer => 'c',
						cbp => '0,0,,0,0', # whatever is the meaning of these params
					      });
			    my $url = "http://www.google.com/maps?" . $q2->query_string;
			    $url;
			});
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

	{
	    my $need_indentation = 1;
	    my $show_leaflet_url = sub {
		my($baseurl, $linkcount) = @_;
		$show_url->($linkcount, sub {
				require CGI;
				my $scale = 17 - log(($mapscale_scale)/3000)/log(2);
				$scale = 18 if $scale > 18;
				my $q2 = CGI->new({ mlat => $py,
						    mlon => $px,
						    ($Msg::lang eq 'en' ? (lang => "en") : ()),
						    zoom => int($scale),
						  });
				my $url = $baseurl . "?" . $q2->query_string;
				$url;
			    }
			   );
	    };

	    if ($devel_host) {
		$info_text->insert("end", "BBBike Leaflet (local)",
				   ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
		$show_leaflet_url->("http://localhost/bbbike/html/bbbikeleaflet.html", $linkcount);
		$info_text->insert("end", "\n");
		$linkcount++;
	    }

	    $info_text->insert("end", "BBBike Leaflet",
			       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
	    $show_leaflet_url->($BBBike::BBBIKE_LEAFLET_URL, $linkcount);
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

	{

	    if (!$wikipedia_photo) {
		$wikipedia_photo = load_photo($top, 'wikipedia');
	    }

	    my(@x) = Karte::Polar::ddd2dms($px);
	    my(@y) = Karte::Polar::ddd2dms($py);
	    push @x, $x[0] < 0 ? do { $x[0] *= -1; "W" } : "E";
	    push @y, $y[0] < 0 ? do { $y[0] *= -1; "S" } : "N";
	    #my $url = "http://stable.toolserver.org/geohack/geohack.php?params=" . join("_", @y, @x) . "_type:landmark_region:DE-BE";
	    my $url = "http://toolserver.org/~geohack/geohack.php?params=" . join("_", @y, @x) .
		($city_obj->cityname eq 'Berlin' ? "_type:landmark_region:DE-BE" : '');

	    my $need_indentation;
	    if ($wikipedia_photo) {
		$info_text->imageCreate("end", -image => $wikipedia_photo,
					-align => "bottom", -padx => 2, -pady => 1);
	    } else {
		$need_indentation = 1;
	    }

	    $info_text->insert("end", "Wikipedia Mapsources",
			       ["link$linkcount", ($need_indentation ? "iconindent" : ())]);
	    $show_url->($linkcount, $url);
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

	my($px0,$py0,$px1,$py1);
	{
	    my($x0,$y0,$x1,$y1) = $c->get_corners;
	    my($sx0,$sy0,$sx1,$sy1) = (anti_transpose($x0,$y0),
				       anti_transpose($x1,$y1));
	    if ($city_obj->can("standard_to_polar")) {
		($px0,$px0) = $city_obj->standard_to_polar($sx0,$sy0);
		($px1,$px1) = $city_obj->standard_to_polar($sx1,$sy1);
	    } else {
		($px0,$py0) = $Karte::Polar::obj->trim_accuracy($coord_system_obj->map2map($Karte::Polar::obj, $sx0, $sy0));
		($px1,$py1) = $Karte::Polar::obj->trim_accuracy($coord_system_obj->map2map($Karte::Polar::obj, $sx1, $sy1));
	    }
	}

	for my $key (keys %info_plugins) {
	    my $plugin = $info_plugins{$key};

	    my @args = (coords => $real_coords,
			street => $strname,
			px => $px,
			py => $py,
			px0 => $px0, # left
			px1 => $px1, # right
			py0 => $py0, # top
			py1 => $py1, # bottom
			mapscale_scale => $mapscale_scale,
			tags => \@tags,
		       );
	    if ($plugin->{visibility} && !$plugin->{visibility}->(@args)) {
		next;
	    }

	    my $need_indentation;
	    if ($plugin->{icon}) {
		eval {
		    $info_text->imageCreate("end", -image => $plugin->{icon},
					    -align => "bottom", -padx => 2, -pady => 1);
		};
		warn $@ if $@;
	    } else {
		$need_indentation = 1;
	    }

	    $info_text->insert("end", $plugin->{name},
			       ["link$linkcount", $need_indentation ? 'iconindent' : ()]);
	    if ($plugin->{using_current_region}) {
		$info_text->insert('end', " \x{2610}" # BALLOT BOX
				  );
	    }
	    $info_text->insert('end', "\n");
	    $info_text->tagBind
		("link$linkcount", "<ButtonRelease-1>" => sub {
		     $plugin->{callback}->(@args);
		 });
	    if ($plugin->{callback_3_std}) {
		$info_text->tagBind
		    ("link$linkcount", "<Button-3>" => sub {
			 my $e = $_[0]->XEvent;
			 $show_info_url = $plugin->{callback_3_std}->(@args);
			 $link_menu->Post($e->X, $e->Y);
			 Tk->break;
		     });
	    } elsif ($plugin->{callback_3}) {
		$info_text->tagBind
		    ("link$linkcount", "<Button-3>" => sub {
			 $plugin->{callback_3}->(@args, widget => $_[0]);
		     });
	    }
	    $linkcount++;
	}

	{
	    $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");
		$info_text->insert("end", M("Polar (DDD,DDD)") . "\t$px,$py\n"); # alternative
	    }
	    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");
	    }
	    if (defined $px && defined $py) {
		$info_text->insert("end", "URI:\t");
		my $uri = "geo:$py,$px";
		$info_text->insert("end", $uri, ["link$linkcount"]);
		$info_text->insert("end", "\n");
		$info_text->tagBind
		    ("link$linkcount", "<ButtonRelease-1>" => sub {
			 $info_text->SelectionOwn;
			 $info_text->SelectionHandle; # calling this mysteriously solves the closure problem...
			 $info_text->SelectionHandle(sub { return $uri });
			 main::status_message("Geo URI $uri in selection", "info");
		     });
		$linkcount++;
	    }
	    $info_text->insert("end", "BBBike:\t$sx,$sy\n");
	    if (defined $px && defined $py) {
		$info_text->insert("end", "Wikipedia-Markup:\tNS=$py|EW=$px");
	    }
	    $info_text->insert("end", "\n");
	}

	# 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);
Sonnenaufgang:\t$sunrise_real
D�mmerung ab:
  b�rgerliche:\t$sunrise_civil
  nautische:\t$sunrise_nautical
  astronomische:\t$sunrise_astro

Sonnenuntergang:\t$sunset_real
D�mmerung bis:
  b�rgerliche:\t$sunset_civil
  nautische:\t$sunset_nautical
  astronomische:\t$sunset_astro

EOF
	};
	warn $@ if $@;

	$write_txt_and_tag->(@$unimportant_txt_and_tag) if @{ $unimportant_txt_and_tag || [] };

	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),
		);
	}

	if (defined $yview) {
	    $info_text->yviewMoveto($yview);
	}

    };

    my @important_txt_and_tag;
    my @info_txt_and_tag;
    my @internal_canvas_tags;

 FIND_INFO: {
	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, "";
		    }
		    push @important_txt_and_tag, "$dbf_info\n", undef;
		    push @internal_canvas_tags, join("\n", @tags), undef;
		    last FIND_INFO;
		}
	    }
	}

	my(%info, $info_file);
	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]}) {
			    push @info_txt_and_tag, $info{$tags[$i]}, undef;
			    last TRY;
			}
			if ($tags[$i] =~ /^L\d+-(\d+)/) {
			    my $id = $1;
			    foreach my $type (qw(s p)) {
				if (defined $info{"$type-$id"}) {
				    push @info_txt_and_tag, $info{"$type-$id"}, undef;
				    last TRY;
				}
			    }
			    if (defined $info{$id}) {
				push @info_txt_and_tag, $info{$id}, undef;
				last TRY;
			    }
			}
		    }
		}
	    }
	    push @internal_canvas_tags, join("\n", @tags), undef;
	    untie %info;
	    last FIND_INFO;
	}

	if ($advanced) {
	    if (@tags > 3) {
		my $text = splice @tags, 2, 1;
		unshift @tags, $text, "";
	    }

	    # XXX slightly hackish: link to the OSM node/way/... browser
	    for (@tags) {
		if (my($type,$id) = $_ =~ m{^osm-(node|way|relation)-(\d+)$}) {
		    push @tags, "http://www.openstreetmap.org/browse/$type/$id";
		    last;
		}
	    }

	    push @internal_canvas_tags, join("\n", @tags), undef;
	}
    }

    if (@internal_canvas_tags) {
	unshift @internal_canvas_tags, M("Interne Canvas-Tags").":\n", "bold";
    }
    if (@info_txt_and_tag) {
	unshift @info_txt_and_tag, M("Info").":\n", "bold";
    }
    $show_info_sub->($strname,
		     $good_link_for_strname,
		     $outside_berlin,
		     [
		      @important_txt_and_tag,
		      @info_txt_and_tag,
		     ],
		     [
		      @internal_canvas_tags,
		     ],
		    );
}

sub hypertext_widget {
    my($t, %args) = @_;

    require Tk::ROText;
    my $info_text = $t->Scrolled('ROText',
				 -wrap => 'word',
				 -scrollbars => 'osoe',
				 -highlightthickness => 0,
				 -borderwidth => 0,
				 -insertwidth => 0,
				 -width => 40,
				 -height => 30,
				)->pack(-expand => 1, -fill => "both");
    # Hack as described in http://wiki.tcl.tk/6101
    my $info_real_text = $info_text->Subwidget("scrolled");
    $info_real_text->bindtags(["myTextTag", $info_real_text->bindtags]);
    $info_real_text->bind
	("myTextTag",
	 "<Button-3>",
	 [sub {
	      my($w,$x,$y) = @_;
	      if (grep { /^link/ } $w->tagNames("\@$x,$y")) {
		  Tk->break;
	      }
	  }, Ev("x"), Ev("y")]);

    $info_text->tagConfigure("bold", -font => $font{'bold'});
    $info_text->tagConfigure("fixed", -font => $font{'fixed'});
    $info_text->tagConfigure("iconindent", -lmargin1 => 16 + 2);

    $info_text;
}

### 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), "err");
    }
}

### 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};
    delete $layer_active_color{$abk};
    delete $layer_pre_enter_command{$abk};
    delete $layer_post_enter_command{$abk};
    delete $layer_pre_leave_command{$abk};
    delete $layer_post_leave_command{$abk};
    delete $layer_line_width{$abk};
    delete $layer_line_length{$abk};
    delete $layer_category_line_arrow{$abk};
    delete $layer_line_arrow{$abk};
    delete $layer_stipple{$abk};
    delete $layer_line_dash{$abk};
    delete $layer_line_capstyle{$abk};
    delete $layer_category_size{$abk};
    delete $layer_category_color{$abk};
    delete $layer_category_line_width{$abk};
    delete $layer_category_image{$abk};
    delete $layer_category_stipple{$abk};
    delete $layer_category_line_dash{$abk};
    delete $layer_category_capstyle{$abk};
    delete $layer_category_line_shorten{$abk};
    delete $layer_line_shorten{$abk};
    delete $layer_category_line_shorten_end{$abk};
    delete $layer_line_shorten_end{$abk};
    delete $layer_name{$abk};
    delete $layer_icon{$abk};
    delete $p_name_draw{$abk};
    delete $str_name_draw{$abk};
    delete $no_overlap_label{$abk};
    delete $do_outline_text{$abk};
    remove_from_stack($abk);
}

### AutoLoad Sub
sub set_coord_output_sub {
    my $_coord_output = shift;
    if (defined $_coord_output) {
	$coord_output = $_coord_output;
    }
    (my $undecorated_coord_output = $coord_output) =~ s{:.*}{};
    # 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 ($undecorated_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 ($coord_output eq 'polar:dms') {
		    $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 ($coord_output eq 'polar:dms') {
		    $coord_output_sub = sub {
			my(@c) = map { sprintf "%d�%02d'%05.2f\"", Karte::Polar::ddd2dms($_) } $o->can('standard2map')->($o, @_);
			@c;
		    };
		} elsif ($coord_output eq 'standard') {
		    $coord_output_sub = sub {
			# force int
			my(@c) = map { int } $o->can('standard2map')->($o, @_);
			@c;
		    };
		} else {
		    $coord_output_sub = sub {
			my(@c) = $o->trim_accuracy($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";
    }
}

# F�gt 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
}

sub addpoints_xy {
    my($realcoords_ref, %args) = @_;
    my $canvascoords_ref = delete $args{-canvascoords};
    my $power_cache = {};
    for(my $i = 0; $i <= $#$realcoords_ref; $i++) {
	my($cx,$cy);
	if ($canvascoords_ref) {
	    ($cx,$cy) = @{ $canvascoords_ref->[$i] };
	}
	addpoint_xy(@{$realcoords_ref->[$i]}, $cx, $cy, -powercache => $power_cache);
    }
}

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

    my $power_cache = delete $args{-powercache};

    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

	# F�hrstrecken von der Gesamtstrecke ausschlie�en:
    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 =~ /^F�hre /) {
		    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 => ($route_below ? int(get_line_width('HH')*2.5) : 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 m�ssten F�hrstrecken 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;
	    }
	}

	# Verh�ltnis zwischen der m�glichen Geschwindigkeit, die ohne
	# Gegenwind und Steigung erreicht werden kann, und der tats�chlich
	# 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 H�hen von beiden Etappenpunkten definiert ist, kann
	    # die Steigung trivial errechnet werden. Wenn nur die H�he des
	    # Etappenzielpunktes bekannt ist, wird nachgeguckt, ob in den
	    # bisherigen Etappenstartpunkten die H�he 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 m�glicherweise 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 (keys %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 f�r die jeweilige Etappe
	    # 1: Gegenwindgeschwindigkeit (crosswind mit eingerechnet)
	    # 2: L�nge der Etappe
	    # 3: H�he 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 f�r die verschiedenen "Power"s unterschiedlich ist,
	    # die anderen Daten aber alle gleich.
	}
    }

    if (keys %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,
			-anchor => 'c',
			-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: Fu�punkt 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 {
    my $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;
	}
    }
}

### 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();
	addpoints_xy(\@oldrealcoords, -canvascoords => \@oldcoords);
	@search_route_points = @oldsearchroutepoints;
	set_flag('via');
	set_flag('ziel');
	updatekm();
	if (!defined $last_route_below || $last_route_below ne $route_below) {
	    if ($route_below) {
		# Hmmm, need to make sure it's over wasser+flaechen XXX
		#XXXspecial_lower("route", "delay-restack");
		set_in_stack('route', 'above', '*landuse*');
	    } else {
		set_in_stack('route', 'above', '*route*');
	    }
	    $last_route_below = $route_below;
	}
	restack_delayed();
    };
    DecBusy($top);
}

# Einfaches Umdrehen der Route (kein echter R�ckweg!)
### 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();
	addpoints_xy(\@newrealcoords, -canvascoords => \@newcoords);
	set_flag('via');
	set_flag('ziel');
	updatekm();
	if ($show_strlist) {
	    show_route_strname();
	}
	clear_undecided_temp_blockings();
	check_path_in_blockings_net(\@realcoords);
	restack_delayed();
    };
    warn __LINE__ . ": $@" if $@;
    DecBusy($top);
}

# Echte Berechnung des R�ckwegs
### 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);
    }

    hide_blockings_infobar();

    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 l�schen",
#  	 -command => sub { delete_route_gui_toggle($menu_index) }
#  	);
#  }

# Hierf�r nicht Autoload verwenden, weil es sonst *langsam* wird!
sub bikepwr_get_v { # Resultat in m/s
    my($wind, $i, $grade, $power_cache) = @_;
    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);
}

# l�scht 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) {
	    # F�hrstrecken ausschlie�en
	CHECK_NO_FERRY: {
		if ($net) {
		    my $xy0 = join(",", @{$realcoords[-1]});
		    my $name = $net->{Net2Name}{$xy0}{$xy} ||
			       $net->{Net2Name}{$xy}{$xy0};
		    if (defined $name && $name =~ /^F�hre /) {
			last CHECK_NO_FERRY;
		    }
		}

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

	# Via l�schen, 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();
	}
	if ($map_mode eq MM_BUTTONPOINT) { # update also selection
	    if (@inslauf_selection) {
		pop @inslauf_selection;
		update_clipboard();
	    }
	}
	check_path_in_blockings_net(\@realcoords);
    }
}

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

### AutoLoad Sub
sub update_clipboard {
    if ($use_clipboard) {
	$c->clipboardClear;
	# Use a leading space, to be consistent with rest of (lazy) clipboard
	# code.
	$c->clipboardAppend(" " . join(" ", @inslauf_selection));
    }
}

# bis zum letzten Via l�schen
### AutoLoad Sub
sub deltovia {
    return if !@realcoords || !@search_route_points;
    # Zuerst wird �berpr�ft, ob der letzte Punkt ein Via-Punkt ist. In
    # diesem Fall wird diese Tatsache ignoriert und der Punkt wird
    # gel�scht.
    my $via = $search_route_points[-1]->[SRP_COORD];
    my($x, $y) = @{ $realcoords[-1] };
    my $xy = "$x,$y";
    if ($xy eq $via) {
	dellast();
    }
    goto CLEANUP if !@realcoords;
    goto CLEANUP 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();
	    goto CLEANUP;
	} else {
	    dellast(1);
	}
    }
  CLEANUP:
    update_clipboard();
}

# Ausgabe der aktuellen Routenl�nge
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") .
			" (-" . s2hm_or_s($lost_time_s) . ")";
	}
    } 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) .
			" (-" . s2hm_or_s($lost_time_tragen_s) . ")";
	}
    }

    my @time_h;
    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_h[$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_h[$i] += ($s/1000)/min(@etappe_speeds);
		}
	    }
	} else {
	    $time_h[$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_s eq 'm') {
	$act_value{Km} = sprintf "%d", $scale_coeff * $strecke;
    } elsif ($unit_s eq 'mi') {
	$act_value{Km} = float_prec($scale_coeff * $strecke/1609.344, 1);
    } 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_h = $time_h[$i] +
	  (defined $lost_time_s && $ampel_count->{"speed"}[$i]
	   ? $lost_time_s/3600 : 0);
	$time_h += ($lost_time_tragen_s+$lost_time_narrowpassage_s)/3600;
	my $time_s = $time_h*3600;
	$act_value{TimeSeconds}->[$i] = $time_s;
	$act_value{Time}->[$i] = s2hm_or_s($time_s);
    }

    if ($bikepwr) {
	for(my $i = 0; $i <= $#power; $i++) {
	    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{PowerTimeSeconds}->[$i] = $time;
	    $act_value{PowerTime}->[$i] = s2hm_or_s($time);
	    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;
}

# l�scht die Route (Liste, Linie, m�gliche tempor�re Blockings)
sub resetroute {
    $strecke = 0;
    $act_value{Km} = "";
    $act_value{Percent} = "";
    for(my $i = 0; $i <= $#speed; $i++) {
	$act_value{TimeSeconds}->[$i] = undef;
	$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{PowerTimeSeconds}->[$i] = undef;
	    $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_coords($c, $scale, $old_scale);
	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);
}

sub scalecanvas_from_canvas_event {
    my($c, $scalefactor) = @_;
    my $e = $c->XEvent;
    return unless $e;
    my($x, $y) = ($c->canvasx($e->x),
		  $c->canvasy($e->y));
    scalecanvas($c, $scalefactor, $x, $y);
}

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

# XXX scale obst (mehrere Icon-Gr��en)
    foreach my $type
	(qw(s-BAB sBAB-BAB s-HH s-B s-H s-NH s-N s-NN
	    SBAB-BAB-out s-HH-out s-B-out s-H-out s-NH-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 gBO 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.
	# XXX adjust and move to scale_coords?
 	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-B0 lsa-F lsa-Zbr rest kn vf-Vf vf-Kz u b), ($XXX_use_old_R_symbol ? () : ('r'))) {
	$c->itemconfigure($_ . '-fg && !attrib-inwork', -image => get_symbol_scale($_, $scale));
    }
    foreach (qw(u-U0 u-UBau b-S0 b-SBau r-R0 r-RBau r-RP)) { # overwrite the previous settings of u,b,r
	$c->itemconfigure($_ . '-fg', -image => get_symbol_scale($_, $scale));
    }
    foreach (qw(attrib-inwork)) {
	$c->itemconfigure('attrib-inwork', -image => get_symbol_scale($_, $scale));
    }
    foreach (qw(e comm-tram nl)) {
	$c->itemconfigure($_ . '-img', -image => get_symbol_scale($_, $scale));
    }

    if ($XXX_use_old_R_symbol) {
	# XXX ... nur �ndern, falls sich die Skalierung �ndert... (wie oben)
	# XXX arrowshape von sperre1 �ndern
	my %arg = get_symbol_scale('r');
	$c->itemconfigure('r-bg', -width => $arg{-width});
	$c->itemconfigure("r-fg",
			  -text => (defined $arg{-font} ? 'R' : ''),
			  (defined $arg{-font} ? (-font => $arg{-font}) : ()),
			 );
    }
    # rearrange outline_text
    # XXX performance is quite bad (about 0.6s for all U+S-Bahnh�fe)
## DEBUG_BEGIN
#benchbegin("Repositioning labels");
## DEBUG_END
    # XXX adjust and move to scale_coords?
    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

    # XXX adjust and move to scale_coords?
    foreach my $item ($c->find(withtag => 'strnr')) {
	my $master = ($c->gettags($item))[2];
	$master =~ s/^strnr-//;
	my(@bbox) = $c->bbox($master);
	if ($c->type($item) eq 'image') {
	    $c->coords($item, ($bbox[0]+$bbox[2])/2, ($bbox[1]+$bbox[3])/2); # XXX this is duplicated from draw_street_numbers!
	} else {
	    $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);
	#warn "$o_cat -> " . Dumper($top->fontActual($font)) . "\n";
	$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 scale_coords {
    my($c, $scale, $old_scale) = @_;

    {
	my $new_width = get_line_width('comm-scenic-View', $scale);
	my $old_width = get_line_width('comm-scenic-View', $old_scale);
	if ($new_width != $old_width) {
	    foreach my $item ($c->find(withtag => 'comm-scenic-View')) {
		my($cx,$cy) = Strassen::Util::middle($c->coords($item));
		$c->coords($item,$cx-$new_width,$cy-$new_width,$cx+$new_width,$cy+$new_width);
	    }
	}
    }
}

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

    # XXX genaue Version f�r 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, $restrict) = @_;

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

    $new_scale = $scale unless defined $new_scale;

    my %tags = ('r-label' => 0.35,
		'b-label' => 1.5,
		'u-label' => 1.5,
		'v-fg'    => 1.5,
	       );

    if ($restrict) {
	my %new_tags;
	for (@$restrict) {
	    $new_tags{$_} = $tags{$_};
	}
	%tags = %new_tags;
    }

    while(my($tag, $scale_limit) = each %tags) {
	if ((!defined $old_scale || $old_scale >= $scale_limit) && $new_scale <= $scale_limit) {
	    $c->itemconfigure($tag, -state => "hidden");
	} elsif ((!defined $old_scale || $old_scale < $scale_limit) && $new_scale >= $scale_limit) {
	    $c->itemconfigure($tag, -state => "normal");
	}
    }
}

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

    {
	my $new_width = get_line_width('sBAB-BAB', $scale);
	my $old_width = get_line_width('sBAB-BAB', $old_scale);
	if ($new_width != $old_width) {
	    if ($new_width < $sBAB_two_track_width && $old_width >= $sBAB_two_track_width) {
		$c->itemconfigure('sBAB-fg', -state => 'hidden');
	    } elsif ($new_width >= $sBAB_two_track_width && $old_width < $sBAB_two_track_width) {
		$c->itemconfigure('sBAB-fg', -state => 'normal');
	    }
	}
    }

    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$//;
    }
    if ($tag =~ /^L\d+/ &&
	defined $default_line_width && $default_line_width == 1) {
	1;
    } else {
	$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 =~ m{^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 =~ m{^lsa-B0$}) {
	if ($myscale > 4*$mod) {
	    return $andreaskr_grey_photo;
	} elsif ($scale >= 2*$mod) {
	    return $andreaskr_grey_klein_photo;
	} elsif ($scale >= 0.5*$mod) {
	    return $andreaskr_grey_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 > 2*$mod) {
	    return $ferry_photo;
	} elsif ($scale >= 0.5*$mod) {
	    return $ferry_klein_photo;
	} elsif ($scale >= 0.2*$mod) {
	    return $ferry_mini_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 ($XXX_use_old_R_symbol && $tag eq 'r') {
	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 'r-RP') {
	my $filename;
	if ($myscale >= 2*$mod) {
	    $filename = 'eisenbahn_klein';
	} elsif ($myscale >= 1*$mod) {
	    $filename = 'eisenbahn_mini';
	}
	if ($filename) {
	    return load_photo($top, $filename, -persistent => 1);
	} else {
	    return undef;
	}
    } elsif ($tag eq 'r' || $tag eq 'r-R0') {
	my $filename;
	if ($myscale > 2*$mod) {
	    $filename = 'eisenbahn'
	} elsif ($myscale >= 0.5*$mod) {
	    $filename = 'eisenbahn_klein';
	} elsif ($myscale >= 0.2*$mod) {
	    $filename = 'eisenbahn_mini';
	}
	my $photo;
	if ($filename) {
	    if ($tag eq 'r-R0') {
		$filename =~ s{(eisenbahn)}{$1_stillg};
	    }
	    $photo = load_photo($top, $filename, -persistent => 1);
	}
	return $photo;
    } elsif ($tag eq 'u' || $tag eq 'b' || $tag eq 'u-U0' || $tag eq 'b-S0' || $tag eq 'u-UBau' || $tag eq 'b-SBau') {
	my $photo;
	my $base = $tag =~ m{^b} ? "sbahn" : "ubahn";
	my $filename;
	if ($myscale > 2*$mod) {
	    $filename = $base;
	} elsif ($myscale >= 0.5*$mod) {
	    $filename = $base . "_klein";
	} elsif ($myscale >= 0.2*$mod) {
	    $filename = $base . "_mini";
	}
	if ($filename) {
	    if ($tag =~ m{^[ub]-[US](0|Bau)$}) {
		$photo = load_photo($top, $filename, -persistent => 1, -palette => 256, -gamma => 3);
	    } else {
		$photo = load_photo($top, $filename, -persistent => 1);
	    }
	}
	return $photo;
    } elsif ($tag eq 'vf-Vf') {
	if ($myscale > 2*$mod) {
	    $vorfahrt_photo = load_photo($top, 'vorfahrt') if !$vorfahrt_photo;
	    return $vorfahrt_photo;
	} elsif ($scale >= 0.5*$mod) {
	    $vorfahrt_klein_photo = load_photo($top, 'vorfahrt_klein') if !$vorfahrt_klein_photo;
	    return $vorfahrt_klein_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'vf-Kz') {
	if ($myscale > 2*$mod) {
	    $kreuzung_photo = load_photo($top, 'kreuzung') if !$kreuzung_photo;
	    return $kreuzung_photo;
	} elsif ($scale >= 0.5*$mod) {
	    $kreuzung_klein_photo = load_photo($top, 'kreuzung_klein') if !$kreuzung_klein_photo;
	    return $kreuzung_klein_photo;
	} else {
	    return undef;
	}
    } elsif ($tag eq 'comm-tram') {
	my $filename;
	if ($myscale > 4*$mod) {
	    $filename = 'strassenbahn'
	} elsif ($myscale >= 1*$mod) {
	    $filename = 'strassenbahn_klein';
	}
	my $photo;
	if ($filename) {
	    $photo = load_photo($top, $filename, -persistent => 1);
	}
	return $photo;
    } elsif ($tag eq 'nl') {
	my $photo;
	if ($myscale > 8*$mod) {
	    $photo = $night_photo;
	} elsif ($myscale >= 2*$mod) {
	    my $filename = 'night_klein';
	    $photo = load_photo($top, $filename, -persistent => 1);
	}
	return $photo;
    } elsif ($tag eq 'attrib-inwork') {
	my $photo;
	if ($myscale > 4*$mod) {
	    $photo = $inwork_photo;
	} elsif ($myscale >= 2*$mod) {
	    $photo = $inwork_klein_photo;
	}
	return $photo;
    }
}

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 $@;
	    }
	}
    }
}

sub scrollregion_best {
    if ($city_obj->bbox) {
	require BBBikeAdvanced;
	set_scrollregion(@{ $city_obj->_bbox_standard_coordsys });
    }
}

# Zentriert entweder auf eine Stra�e oder Koordinaten oder auf die Mitte
# Berlins.
### AutoLoad Sub
sub center_best {
    if (defined $city && $city eq 'Berlin') {
	if (defined $center_on_str && $center_on_str !~ /^\s*$/) {
	    choose_from_plz(-str   => $center_on_str);
	    return;
	} elsif (defined $center_on_coord && $center_on_coord !~ /^\s*$/) {
	    choose_from_plz(-coord => $center_on_coord);
	    return;
	}
    }
    if ($city_obj->_center_standard_coordsys) {
	$c->center_view(transpose(split /,/, $city_obj->_center_standard_coordsys));
    } elsif ($city_obj->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 f�r den
# Bildschirm und quadratischen Dots aus.
# R�ckgabewert: 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) });
    }
}

# Mark blinking is only implemented in the main canvas,
# not the overview canvas
### 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));
	# restrict aspect to 4:3 --- a 16:9 overview window does not look good
	$w = min($w, int($h*4/3));
	my($x,$y) = ($sy->rootx - $w - 4*2, $sx->rooty - $h - 20 - 4);
	geometry($overview_top,$x,$y,$w,$h);
    }
    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 overview_draw_route {
    if (Tk::Exists($overview_canvas)) {
	my $transpose = $show_overview_mode eq 'region' ? \&transpose_small : \&transpose_medium;
	$overview_canvas->delete("route");
	return if !@realcoords;
	my @coords = map { $transpose->(@$_) } @realcoords;
	if (@coords == 2) {
	    push @coords, @coords;
	}
	$overview_canvas->createLine(@coords,
				     -fill => "red", -tags => "route");
    }
}

sub overview_del_route {
    if (Tk::Exists($overview_canvas)) {
	$overview_canvas->delete("route");
    }
}

sub _convert_transposed_to_overview_coord {
    my($tx,$ty) = @_;
    my $transpose = $show_overview_mode eq 'region' ? \&transpose_small : \&transpose_medium;
    $transpose->(anti_transpose($tx, $ty));
}

sub _convert_overview_to_transposed_coord {
    my($x,$y) = @_;
    my $anti_transpose = $show_overview_mode eq 'region' ? \&anti_transpose_small : \&anti_transpose_medium;
    $anti_transpose->(transpose($x, $y));
}

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,
	);

    Hooks::get_hooks("new_route")->add
	    (sub {
		 overview_draw_route();
	     }, "bbbike-overviewcanvas");
    Hooks::get_hooks("del_route")->add
	    (sub {
		 overview_del_route();
	     }, "bbbike-overviewcanvas");
    $overview_canvas->OnDestroy
	(sub {
	     for my $hook ("new_route", "del_route") {
		 Hooks::get_hooks($hook)->del("bbbike-overviewcanvas");
	     }
	 });

    my $ov_transpose      = $show_overview_mode eq 'region' ? \&transpose_small : \&transpose_medium;
    my $ov_anti_transpose = $show_overview_mode eq 'region' ? \&anti_transpose_small : \&anti_transpose_medium;
    {
	my($x0,$y0,$x1,$y1) = @scrollregion;
	($x0,$y0) = $ov_transpose->(anti_transpose($x0,$y0));
	($x1,$y1) = $ov_transpose->(anti_transpose($x1,$y1));
	my @s = ($x0,$y0,$x1,$y1);
	$overview_canvas->configure(-scrollregion => [@s]);
    }

    $overview_canvas->createLine(0,0,0,0,-fill => 'red', -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->center) {
	$center_coords = [ split /,/, $city_obj->center ];
    } else {
	$center_coords = [8581,12243]; # Fallback: Brandenburger Tor
    }

    my($ov_center_x,$ov_center_y) = $ov_transpose->(@$center_coords);

    my $center_name;
    if ($city_obj->center_name) {
	$center_name = $city_obj->center_name;
    }

    my $arrow_update;
    if ($center_name) {
	$arrow_update = sub {
	    $overview_canvas->delete('berlinarrow');
	    my($cx1,$cy1,$cx2,$cy2) = $overview_canvas->get_corners;
	    # Ersten Schnittpunkt (inneres Rechteck) ermitteln
	    my($ix1,$iy1) = VectorUtil::intersect_line_rectangle
		($cx1+($cx2-$cx1)/2, $cy1+($cy2-$cy1)/2, $ov_center_x,$ov_center_y,
		 $cx1+15,$cy1+15,$cx2-15,$cy2-15);
	    if (defined $ix1 and defined $iy1) {
		# zweiten Schnittpunkt ermitteln (aktuelle Canvasgrenze)
		my($ix2,$iy2) = VectorUtil::intersect_line_rectangle($ix1,$iy1,$ov_center_x,$ov_center_y,
								     $cx1,$cy1,$cx2,$cy2);
		if (defined $ix2 and defined $iy2) {
		    # Distance to center (in Berlin: Brandenburger Tor)
		    my $entf = Strassen::Util::strecke
			([$ov_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::canvas_translation(BBBikeCalc::line_to_canvas_direction
								   ($ix1,$iy1,$ix2,$iy2)),
			 -text => "$center_name\n".sprintf("%d km", $entf/1000),
			 -fill => "red",
			 -font => $font{'small'},
			 -tags => ['berlinarrow','berlinarrowlabel']);
		}
	    }
	};
    } else {
	$arrow_update = sub {};
    }

    $overview_canvas->configure(-yscrollcommand =>
				sub {
				    $sy->set(@_);
				    $arrow_update->();
				},
                                -xscrollcommand =>
				sub {
				    $sx->set(@_);
				    $arrow_update->();
				},
    );

    # Zoom buttons
    my $button_x = 2;
    {
	my @zoom_button;
	my $set_disabled_buttons = sub {
	    if ($show_overview_mode eq 'city') {
		$zoom_button[0]->configure(-state => 'disabled');
		$zoom_button[1]->configure(-state => 'normal');
	    } else {
		$zoom_button[0]->configure(-state => 'normal');
		$zoom_button[1]->configure(-state => 'disabled');
	    }
	};
	for my $def (['+', 'city'],
		     ['-', 'region'],
		    ) {
	    my($label, $overview_mode_value) = @$def;
	    push @zoom_button, $overview_top->Button
		(-text => $label,
		 -font => $font{'reduced'},
		 -padx => 0, -pady => 0,
		 -highlightthickness => 0,
		 -takefocus => 0,
		 -command => sub {
		     my $this_button = shift;
		     $show_overview_mode = $overview_mode_value;
		     $overview_top->after(10, sub { show_overview_clean_and_populate($overview_top) });
		     $set_disabled_buttons->();
		 },
		);
	    $zoom_button[-1]->place("-x" => $button_x, "-y" => 2);
	    $button_x += $zoom_button[-1]->reqwidth+2;
	}
	$set_disabled_buttons->();
    }

    my($km100_pixel) = ($ov_transpose->(100000,0))[0] - ($ov_transpose->(0,0))[0];

    # Radar button
    if ($advanced && $devel_host) {
	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 'region'
		#				    ? '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 'region'
					   ? (3,20)
					   : $ov_transpose->(0,0));
			$overview_canvas->createImage
			    ($xoff, $yoff,
			     -image => $radar_image,
			     -tags => 'radarimage');
			foreach my $raise (qw(g gP gD gBO 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" => $button_x+2, "-y" => 2);
    }

    my @layer_errors;

    # Zeichnen von Gew�ssern, S-Bahnen, Regionalbahnen, Stra�en
    # in der �bersichtskarte
    foreach my $abk (qw(w b s l r)) {
	eval {
	    local %str_outline   = %{ clone \%str_outline };
	    local %str_name_draw = %{ clone \%str_name_draw };
	    local $wasserumland  = $wasserumland;
	    local $wasserstadt   = $wasserstadt;
	    local %str_far_away  = %{ clone \%str_far_away };
	    local %str_restrict  = %{ clone \%str_restrict };
	    local %p_draw        = %{ clone \%p_draw };
	    if ($overview_draw{$abk} || ($abk eq 'l' && $overview_draw{'s'})) {
		$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 F:I)) {
			    $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' || $abk eq 'l') {
		    $str_restrict{$abk} = {qw(HH 1 B 1 H 0)}; # XXX bad bad hack. The H=>0 is necessary too trigger $all_set=0 elsewhere XXX
		}

		plot('str',$abk,
		     Canvas => $overview_canvas,
		     Width  => 1,
		     %args,
		    );

		if ($abk eq 'w') {
		    # Hack: need to display islands over water
		    $overview_canvas->raise('i-I');
		}
	    }
	};
	if ($@) {
	    push @layer_errors, "Der Layer <$abk> kann nicht gezeichnet werden: $@";
	}
    }

    overview_draw_route();

    $progress->InitGroup;
    for my $abk (qw(g gD)) {
	eval {
	    plot('str',$abk,
		 Canvas => $overview_canvas,
		 ($abk eq 'g' && $coord_system ne 'standard' ? (Filename => "plz-orig") : ()),
		 Width => 3,
		);
	};
	if ($@) {
	    push @layer_errors, "Der Layer mit den Grenzen <$abk> kann nicht gezeichnet werden: $@";
	}
    }

    eval {
	# local does not work here, segfault on Win98+perl5.6.1/perl5.8.0+Tk800.0xx
	my $orte_far_away_orig = $p_far_away{'o'};
	$p_far_away{'o'} = 1;
	my $no_overlap_label_orig = $no_overlap_label{'o'};
	$no_overlap_label{'o'} = 1; # XXX Kein Effekt - warum?
	my $orte_label_size_orig = $orte_label_size;
	$orte_label_size = 1;
	if ($city_obj->is_osm_source) {
	    # The PlaceCategory=2/3 limit works good for Dalmatia,
	    # but is a little bit slow and to dense for Hessen and Sachsen
	    plotorte(Canvas => $overview_canvas,
		     PlaceCategory => $show_overview_mode eq 'city' ? 2 : 3,
		     Shortname => 1,
		     NoOverlapLabel => 'drop_non_fitting',
		    );
	} else {
	    # the old procedure for Berlin data
	    plotorte(Canvas        => $overview_canvas,
		     PlaceCategory => 4,
		     Shortname     => 1,
		     NoOverlapLabel => 0,
		    );
	    if ($show_overview_mode eq 'city') {
		plotorte(Canvas        => $overview_canvas,
			 PlaceCategory => 0,
			 Shortname     => 1,
			 NameDraw      => 1,
			 -municipality => 1,
			 -type         => 'oo'
		    );
	    }
	}

	$p_far_away{'o'} = $orte_far_away_orig;
	$orte_label_size = $orte_label_size_orig;
	$no_overlap_label{'o'} = $no_overlap_label_orig;
    };
    if ($@) {
	push @layer_errors, "Der Orte-Layer kann nicht gezeichnet werden: $@";
    }

    $progress->FinishGroup;

    if (@layer_errors) {
	status_message(join("\n", @layer_errors), "warn");
    }

    $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];

	  ($xx, $yy) = ($show_overview_mode eq 'region'
			? anti_transpose_small($xx, $yy)
			: anti_transpose_medium($xx, $yy)
		       );
	  ($xx, $yy) = transpose($xx, $yy);
	  $c->center_view($xx,$yy);
      };

    $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 'region'
	      ? \&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 = @$via_arr if defined $via_arr;

    destroy_delayed_restack();

    IncBusy($top, %busy_watch_args);
    eval {
	status_message("");
	my @res = do_search($start, $ziel, \@via, %args);

	if (!@res) {
	    die M"Keine Strecke gefunden.\n";
	}

	my @path = @{ $res[StrassenNetz::RES_PATH] };
	if (!$continue) {
	    clear_undecided_temp_blockings();
	}
	check_path_in_blockings_net(\@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;
 	}

	addpoints_xy(\@path);
	updatekm();
	# 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();
	}
	if ($edit_mode_flag) {
	    require BBBikeAdvanced;
	    path_to_selection();
	}
	set_flag('via');
	set_flag('ziel');
	restack_delayed();
    };
    my $err = $@;
    $in_search = 0;
    DecBusy($top);
    status_message($err, 'err') if ($err);
}

# Low-level search
sub do_search {
    my($start, $ziel, $via_ref) = @_;

    # XXX $str_draw{'r'} ueberprfen, wenn im RB-Mode
    if (!$net and ($str_draw{'s'} || $str_draw{'l'})) { make_net() }
    print STDERR "Suche von <$start> bis <$ziel>" . (@$via_ref ? " via <@$via_ref>" : "") . "\n"
	if $verbose;
    my %extra_args;
    $extra_args{Via} = $via_ref;
    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,
						 'NH' => 1,
						 'H' => 2,
						 'HH' => 3,
						 'BAB' => 3, # XXX
						 'B' => 4}};
	}
	# XXX optprefs
    }

    # Qualit�t, Handicap und tempor�re Handicaps
    foreach my $def ({OptSwitch	 => \$qualitaet_s_optimierung,
		      OptName	 => 'Qualit�t',
		      Speed          => \%qualitaet_s_speed,
		      MakeNet	 => \&make_qualitaet_net,
		      CatPrefix	 => 'Q',
		      ExtraArgsName	 => 'Qualitaet',
		     },
		     {OptSwitch	 => \$handicap_s_optimierung,
		      OptName	 => 'Sonstige Beeintr�chtigungen',
		      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 || $N_RW1_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_Bus" => ($N_RW1_optimization ? 4 : 1),
			    "H_RW"  => 1,
			    "N"     => 1,
			    "N_Bus" => 1,
			    "N_RW"  => 1 };
	    $extra_args{RadwegeStrcat} =
		{Net => $N_RW_net,
		 Penalty => $penalty,
		};
	}
    }

    if ($tram_optimization) {
	if (!$tram_net) {
	    $tram_net = StrassenNetz->new(Strassen->new('comments_tram')); # XXX -orig?
	    $tram_net->make_net_cat;
	}
	if ($tram_net) {
	    my $penalty = { "CS"   => 4 }; # XXX about 20km/h -> 5km/h
	    $extra_args{Tram} =
		{Net => $tram_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 M�glichkeit au�er /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, h�chstens einmal! durchfahren
    # werden.
    if ($aufschlag != 0 && $aufschlag != 1) {
	$extra_args{Aufschlag} = $aufschlag;
	$extra_args{All}       = 1;
    }
    # XXX weitere m�gliche Optimierungen:
    # (benutzungspflichtige) Radwege
    # verkehrsberuhigte Zonen => 6 .. 20 km/h
    # Fu�g�ngerampeln: Abbremsen auf 10 km/h und gleich wieder hoch
    # Kreuzungen (Neben/Haupt, Haupt/Haupt ohne Ampel)
    # Berufsverkehr (Stau auf gro�en Stra�en => 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);

    @res;
}

# 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();
}

sub add_via_to_current_search {
    my($before, $via, $after) = @_;

    destroy_delayed_restack();
    IncBusy($top, %busy_watch_args);
    eval {
	status_message("");

	my $insert_index;
	for my $i (0 .. $#search_route_points-1) {
	    # We assume that the same before/after combination
	    # exists exactly once in the route. This is a
	    # rather pragmatic assumption.
	    if ($search_route_points[$i]->[SRP_COORD] eq $before &&
		$search_route_points[$i+1]->[SRP_COORD] eq $after) {
		$insert_index = $i;
		last;
	    }
	}
	if (!defined $insert_index) {
	    # Should never happen, no translation necessary:
	    die "Cannot insert via point (no insertion index found using $before - $after)";
	}

	# Neither $before nor $after should be used multiple times. This
	# is still pragmatic, but less likely as the above assumption.
	my($before_index_in_route, $after_index_in_route);
	my $stage = 0; # 0: search for before, 1: search for after
	for my $i (0 .. $#realcoords) {
	    if ($stage == 0) {
		if (join(",",@{$realcoords[$i]}) eq $before) {
		    $before_index_in_route = $i;
		    $stage = 1;
		}
	    } else {
		if (join(",",@{$realcoords[$i]}) eq $after) {
		    $after_index_in_route = $i;
		    last;
		}
	    }
	}
	if (!defined $before_index_in_route ||
	    !defined $after_index_in_route) {
	    # Should never happen, no translation necessary:
	    die "Cannot find either $before or $after in realcoords";
	}

	$via = add_new_point($net, $via); # may die if via is not insertable

	my @res = do_search($before, $after, [$via]);
	if (!@res) {
	    die M"Keine Strecke gefunden.\n";
	}
	my @path = @{ $res[StrassenNetz::RES_PATH] };
	check_path_in_blockings_net(\@path);

	# XXX what about register/undo/... stuff?

	splice @search_route_points, $insert_index+1, 0, [$via, POINT_SEARCH];
	splice @realcoords, $before_index_in_route, ($after_index_in_route-$before_index_in_route)+1, @path;

	# XXX Too much duplication with other route handling functions:
	# search_route, redraw_path, reverse_route ...
	my @oldrealcoords = @realcoords;
	my @oldsearchroutepoints = @search_route_points; # hack
	resetroute();
	addpoints_xy(\@oldrealcoords);
	# XXX as a side effect, @realcoords and @coords are set to the new route
	@search_route_points = @oldsearchroutepoints;
	set_flag('via');
	set_flag('ziel');
	updatekm();
	restack_delayed();
    };
    my $err = $@;
    DecBusy($top);
    status_message($err, 'err') if ($err);
}

# 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');
    TRY: {
	    for my $check_against (['route', 'routename'],
				   ['routename'],
				  ) {
		my $returnanchor;
		if (draw_text_intelligent
		    ($c, $x, $y,
		     -text => $str,
		     -tags => [@tags],
		     -abk => $check_against,
		     -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]);
		    last TRY;
		}
	    }
	    $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";
	    #XXX maybe combine with code below
	    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..." if $devel_host;
		    Tk::Placement::placer($toplevel{strlist}, -screen => $c,
					  -addx => 20, -addy => 25, # XXX for fvwm
					  );
		}
		$toplevel{strlist}->deiconify;
		# raise nur ausf�hren, wenn es wirklich was zu sehen gibt
		#$toplevel{strlist}->raise;
	    }

	}
    } 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 {
				my($offset, $maxbytes) = @_;
				my $res = route_info_to_text();
				return undef if $offset > length($res);
				$res;
			    });
    }

    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"L�nge");
	$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"Stra�e");
	$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, $next_extra)
	  = ("", "", undef, "");
	my $last_str;
	my %seen_comments;
	for(my $i = 0; $i <= $#search_route; $i++) {
	    my($str, $index_arr);
	    my($entf, $winkel, $richtung, $extra)
	      = ($next_entf, $next_winkel, $next_richtung, $next_extra);
	    my $entf_s;
	    ($str, $next_entf, $next_winkel, $next_richtung, $index_arr, $next_extra)
	      = @{$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 && (!$extra || !$extra->{ImportantAngle})) {
		    $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 f�r 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 !~ /^de/) {
		    $compass =~ s/([NESW])/{N => M("nord"),
					    E => M("ost"),
					    S => M("s�d"),
					    W => M("west")}->{$1}/gei;
		    $richtung = $compass . M("w�rts");
		} else {
		    $richtung = M("nach")." ".$compass;
		}
	    }

	    $route_strname_lbox->add($i, -text => $entf_s);
	    $route_strname_lbox->itemCreate($i, 1, -text => $ges_entf_s);
	    $route_strname_lbox->itemCreate($i, 2, -text => $richtung);
	    $route_strname_lbox->itemCreate($i, 3, -text => $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_obj) = $comments_net->get_point_comment([@realcoords], $i, \%seen_comments, AsObj => 1);
		    if (defined $etappe_comment_obj &&
			# Ignore data from comments_kfzverkehr:
			$etappe_comment_obj->[Strassen::CAT()] !~ m{^[+-][12]$}
		       ) {
			my $name = $etappe_comment_obj->[Strassen::NAME()];
			$name =~ s{.*:\s+}{}; # strip street part
## The following is not needed if the comments are specific enough, i.e.
## "An der Ampel Voltairestr. die Gehwegseite wechseln" instead of
## "An der Ampel die Gehwegseite wechseln". As most comments are in this
## form already I will try to be consistent and have everything like
## this (of course, with osm data this would be another story, but
## currently CP/CP2/PI comments are not created by osm2bbd)
#			# If the special comment is not at beginning
#			# of an etappe, then it is useful to have the
#			# exact crossing displayed.
#			if ($i != $index_arr->[0] && $etappe_comment_obj->[Strassen::CAT()] =~ m{^(CP|CP2|PI)(;|$)?}) {
#			    my $crossings = all_crossings();
#			    my $c = join ',', @{ $realcoords[$i] };
#			    if ($crossings && exists $crossings->{$c}) {
#				# XXX strip also "current" street
#				my $cr_name = join '/', map { Strassen::strip_bezirk($_) } @{ $crossings->{$c} };
#				$name .= " (Kreuzung $cr_name)";
#			    }
#			}
			push @comments, $name;
		    }
		}
		$etappe_comment = join("; ", @comments) if @comments;
	    }
	    $route_strname_lbox->itemCreate($i, 4, -text => $etappe_comment);
	    push @route_info, [($entf_s||""), ($ges_entf_s||""),
			       ($richtung||""), ($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"Stra�ennamen 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 => sub { 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 => sub { show_route_strname() },
			 -font => $font{'small'},
			)->pack(-side => 'left');
    }
    $f1->Checkbutton(-text => M"Kommentare",
		     -variable => \$do_route_strnames_comments,
		     -command => sub { show_route_strname() },
		     -font => $font{'small'},
		    )->pack(-side => 'left');

    my @bfb;
    my $endb = $bf->Button(Name => 'end',
			   -command => $withdraw_sub,
			  );
    $t->bind('<Escape>' => sub { $endb->invoke });
    push @bfb, $endb;
    push @bfb, $bf->Button
      (-text => M"Sichern (Text)",
       -command => sub {
	   my($file) = $bf->getSaveFile
	       (($os eq 'win' ? (-defaultextension => '.TXT') : ()),
		-title => M"Route sichern",
		-initialdir => $home,
	       );
	   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 m�glich: %s", $file, $!),
		    'err');
	   }
       },
      );
    push @bfb, $bf->Button
      (-text => M"Sichern (GPX)",
       -command => sub { save_route_as_optimized_gpx() },
      );
    push @bfb, $bf->Button
      (-text => M("GPS (Garmin)"),
       -command => sub { send_route_to_gps() },
      );
    $t->bind('<Control-g>' => sub { send_route_to_gps() }); # XXX re-use toplevel binding?
    # 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()) {
	push @bfb, create_palm_button($bf);
    }
    my $print_text_sub = sub {
	my $font = shift;
	if (!$show_route_start) { $show_route_start = "???" }
	if (!$show_route_ziel)  { $show_route_ziel = "???" }
	my $header = Mfmt("Route von %s bis %s",
			  $show_route_start, $show_route_ziel);
	if ($^O eq 'MSWin32' && defined &Win32Util::start_txt_print) {
	    # Make a nice filename as it's visible on the hardcopy:
	    my $start = $show_route_start;
	    my $ziel  = $show_route_ziel;
	    for ($start, $ziel) {
		s{[^A-Za-z0-9_-]}{_}g;
	    }
	    my $base = "Route_" . $start . "_" . $ziel;
	    $base = substr($base, 0, 28) if length($base) > 28;
	    $base .= ".txt";

	    print_text_windows
		(-header   => $header,
		 -text     => route_info_to_text(),
		 -basename => $base,
		);
	} 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 => $header,
			     -font => $font,
			    );
		    } elsif ($try eq 'routepdf') {
			print_route_pdf();
		    }
		}
	    }
	}
    };
    push @bfb, $bf->Button
      (-text => M"Drucken",
       -command => sub { $print_text_sub->($ps_fixed_font||"Courier7") },
      );
    if (_can_send_mail()) {
	push @bfb, $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());
		 }
	     });
    }
    $t->bind('<Up>'   => sub { $route_strname_lbox->yview(scroll => -1,
							  'units') });
    $t->bind("<Down>" => sub { $route_strname_lbox->yview(scroll => 1,
							  'units') });
    pack_buttonframe($bf, \@bfb);
    $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"L�nge", M"Gesamt", M"Richtung", M"Stra�e");
    $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 abk�rzen --- 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 {
    require BBBikeLaTeX;
    BBBikeLaTeX::route_info_to_latex(-routetitle => _get_route_title(),
				     -routeinfo => \@route_info,
				    );
}

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}) {
		    my $s = Strassen->new($str_file{$abk});
		    if ($abk eq 'fz') {
			$s = $s->grepstreets(sub { $_->[Strassen::CAT] !~ m{(?:projected|inwork)} });
		    }
		    $str_obj{$abk} = $s;
		}
		push @$net_source, $str_obj{$abk};
		push @$net_source_abk, $abk;
	    };
	    warn "Cannot get Strassen for $abk: $@" if $@;
	}
    }
}

sub make_plz {
    require PLZ;
    my $plz;
    if (defined $city && $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 = PLZ->new;
    }
    $plz;
}

sub make_net {
    my(%args) = @_;
    IncBusy($top);
    $progress->Init(-label => M("Berechnen des Stra�ennetzes")."...",
		    -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;
    undef $crossings;

    eval {
	my $add_temp_blockings;
	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 %s_restrict = %{$str_restrict{'s'}};
		if ($net_type eq 's-car') {
		    $str_obj{'sBAB'} = Strassen->new($str_file{'sBAB'})
			if !$str_obj{'sBAB'};
		    push @net_source,     $str_obj{'sBAB'};
		    push @net_source_abk, 'sBAB';
		    $s_restrict{'NN'} = 0;
		}
		my $is_restricted = 0;
#XXX use new_copy_restricted
		foreach (keys %s_restrict) {
		    if ($s_restrict{$_} == 0 &&
			$s_restrict{$_} ne 'P') { # Pl�tze
			$is_restricted = 1;
			last;
		    }
		}
		if ($is_restricted) {
		    my $restr_str = Strassen->new;
		    # XXX Copy at least the map global directive
		    if ($str_obj{'s'}->{GlobalDirectives}{map}) {
			@{ $restr_str->{GlobalDirectives}{map} } = @{ $str_obj{'s'}->{GlobalDirectives}{map} };
		    }
		    $str_obj{'s'}->init;
		    while(1) {
			my $ret = $str_obj{'s'}->next;
			last if !@{$ret->[Strassen::COORDS]};
			my($cat) = $ret->[Strassen::CAT] =~ m{^([^:]+)}; # strip attributes
			next if !$s_restrict{$cat};
			$restr_str->push($ret);
		    }
		    $restr_str->{File} = $str_obj{'s'}->file;
		    $restr_str->{Id}   = $str_obj{'s'}->id . "_restr_" . join("_", grep { $s_restrict{$_} } keys %s_restrict);
		    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 ($show_active_temp_blockings && $current_temp_blockings_ms) {
		$add_temp_blockings = 1;
	    }
	}

	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->set_source(@net_source);
	$net->set_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' || $net_type eq 's-car') {
		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,
					  SpecialVehicle => get_special_vehicle(),
					 );
		    }; warn $@ if $@;
		    if ($net_type eq 's-car') {
			eval {
			    $net->make_sperre("$datadir/gesperrt_car",
					      Type => \@sperre_type,
					      # no SpecialVehicle defined for vars
					     );
			}; 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 ($add_temp_blockings) {
	    add_temp_blockings_to_net();
	}

	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) {
	# XXX hmmm, fails fataly if any of the layers is missing
	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) {
	# XXX hmmm, fails fataly if any of the layers is missing
	eval {
	    my @s = (Strassen->new("handicap_s"),
		     Strassen->new("handicap_l"),
		    );
	    $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();
    }
    if ($str_obj{"comm"}) {
	$comments_net = new StrassenNetz $str_obj{"comm"};
	$comments_net->make_net_cat(-net2name => 1,
				    -multiple => 1,
				    -obeydir => 1);
    }
}

# Erzeugt einen Hash aller Kreuzungen
### AutoLoad Sub
sub all_crossings {
    if (!$crossings || !%$crossings) {
	my $s = $multistrassen ? $multistrassen : $str_obj{'s'};
	return if !$s;
	$crossings = $s->all_crossings(RetType => 'hash',
				       UseCache => 1);
    }
    $crossings;
}

# 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) if $net;
    };
}

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");
	    }
	}
    }
}

# -force => 1: be quiet and do not ask or warn
sub delete_user_dels {
    my(%args) = @_;

    my($any_delnet_tag) = $c->find("withtag", "delnet");
    if (!defined $any_delnet_tag) {
	if (!$args{-force}) {
	    $top->messageBox(-message => M"Keine benutzerdefinierten Sperrungen vorhanden.");
	}
	return;
    }

    if ($args{-force} ||
	$top->messageBox(-message => M"Alle benutzerdefinierten Sperrungen l�schen?",
			 -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' ||
	     ($net_type eq 's-car' && $tags[0] eq 'sBAB')
	     # XXX weitere Ausnahmen f�r $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 @accept_tags = qw(s l p pp lsa);
	if ($net_type eq 's-car') { push @accept_tags, 'sBAB' }
	my($item, @tags) = find_below($c, @accept_tags);
	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 b-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_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 b-fg 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' || $net_type eq 's-car'
			? qw(s l fz)
			: ($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' || $net_type eq 's-car') && $use_faehre) {
	push @click_items, "e";
    }
    if ($net_type eq 's-car') {
	push @click_items, 'sBAB'; # XXX check!
    }
    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');
    }
    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 save_cursor {
    $c->{SavedCursor} = $c->get_cursor;
    if (!defined $c->{SavedCursor}) {
	$c->{SavedCursor} = "__DEFAULT__";
    }
}

### AutoLoad Sub
sub restore_cursor {
    if ($c->{SavedCursor}) {
	if ($c->{SavedCursor} eq '__DEFAULT__') {
	    $c->set_cursor(undef);
	} else {
	    $c->set_cursor($c->{SavedCursor});
	}
	undef $c->{SavedCursor};
    }
}

sub set_cursor {
    my($type, $fallback) = @_;
    if (!defined $fallback && defined $type) {
	if ($type eq 'ziel') {
	    $fallback = 'right_ptr';
	}
    }
    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']);
	}
    } elsif (defined $fallback) {
	$c->set_cursor($fallback);
    } else {
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
    }
    if (defined $type && $type eq 'start') {
	status_message(M"Start ausw�hlen");
    } elsif (defined $type && $type eq 'ziel') {
	status_message(M"Ziel ausw�hlen");
    }
}

### AutoLoad Sub
sub set_cursor_data {
    my($data, $persistent, $cur_data) = @_;
    my $tmpfile = "$tmpdir/cursor.$<-$$";
    if ($persistent) {
	$tmpfile .= "_" . $persistent;
    }
    if ($os eq 'win') {
	if ($cur_data) {
	    $tmpfile .= ".cur";
	} else {
	    $c->set_cursor(undef);
	    return;
	}
    } else {
	$tmpfile .= ".xbm";
    }
    if (open(C, ">$tmpfile")) {
        print C ($os eq 'win' ? $cur_data : $data);
	close C;
	#$c->configure(-cursor => ['@' . $tmpfile, 'black']);
	if ($os eq 'win') {
	    $c->set_cursor(['@' . $tmpfile]);
	} else {
	    $c->set_cursor(['@' . $tmpfile, 'black']);
	}
	if (!$persistent) {
	    unlink $tmpfile;
	} else {
	    $tmpfiles{$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 unabh�ngige Setzen von Start/Ziel
    # erm�glichen (z.B. zuerst Ziel, dann Start ausw�hlen). 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 Stra�ennetz, wohingegen die Telefonbuch-Stra�en-Auswahl
# ganz gut ohne gemaltes Stra�ennetz 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 n�tig? 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' || $net_type eq 's-car') {
		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 {
	    print STDERR M"`Stra�ennetz 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;

	make_net() if !$net;
	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
		    # kr�ftige �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" => '*']],
			    -initialdir => "$FindBin::RealBin/plugins",
			   );
		       if (defined $file) {
			   load_plugin($file);
		       }
		   });
    if (0) { # XXX The old Plugin lister could be removed completely some day
	$opbm->command(-label => M"Alle Plugins zeigen (alt)",
		       -command => sub {
			   require BBBikePlugin;
			   BBBikePlugin::find_all_plugins($FindBin::RealBin, $top);
		       });
    } else {
	$opbm->command(-label => M"Alle Plugins zeigen",
		       -command => sub {
			   require BBBikePluginLister;
			   BBBikePluginLister::plugin_lister($top, $FindBin::RealBin);
		       });
    }
}

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 ausw�hlen", $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 ausw�hlen", $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...");
	# No balloon for actual menu:
	$balloon->attach($menu, -msg => []);
    }
    $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
#  infodlg: info with a dialog
#  infoauto: info with auto-popped down toplevel
#  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/ && $err ne "infodlg" && $err ne "infoauto") || !$use_dialog) {
	if (!defined $progress) {
	    if (defined $err && $err eq 'info-stack-trace') {
		require Carp;
		Carp::cluck($msg);
	    } else {
		print STDERR "$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();
	    }
	}
    } elsif ($err eq 'infoauto') {
	my $l;
	if ($status_message_toplevel && Tk::Exists($status_message_toplevel)) {
	    $status_message_toplevel->deiconify;
	    $status_message_toplevel->raise;
	    $l = $status_message_toplevel->Subwidget("Text");
	} else {
	    $status_message_toplevel = $top->Toplevel;
	    set_as_toolwindow($status_message_toplevel);
	    $status_message_toplevel->geometry('+30+30'); # XXX better geometry
	}
	if (!$l || !Tk::Exists($l)) {
	    $l = $status_message_toplevel->Component("Label" => "Text",
						     -background => Tk::NORMAL_BG,
						    )->pack(qw(-fill both -expand 1));
	}
	$l->configure(-text => $msg);
    } else {
	# warn or error
	if (!$top) {
	    print STDERR "$msg\n";
	} else {
	    my %args = (-title  => ($err eq 'warn' ? 'Warnung' : $err eq 'infodlg' ? 'Info' : 'Fehler'),
			-text   => $msg,
			-bitmap => ($err eq 'warn' ? 'warning' : $err eq 'infodlg' ? 'info' : '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;
	    }

	    my $Dialog = LongOrNormalDialog();
	    $status_message_dialog = $top->$Dialog(%args);
	    # KDE's window manager seems to have a bug (?)
	    # that the dialog might be behind other
	    # transients. Fix the situation by forcing the dialog
	    # on top.
	    $kde->keep_on_top($status_message_dialog) if $kde;
	    $status_message_dialog->Show;
	}
    }
    if (defined $err && $err eq 'die') { # also die
	require Carp;
	Carp::confess($msg);
    }
}

sub info_auto_popdown {
    if ($status_message_toplevel && Tk::Exists($status_message_toplevel)) {
	$status_message_toplevel->withdraw;
    }
}

sub LongOrNormalDialog {
    my $Dialog = "Dialog";
    if (eval { require Tk::LongDialog; 1 }) {
	$Dialog = "LongDialog";
    } else {
	require Tk::Dialog;
    }
    $Dialog;
}

sub _blockings_infobar_exists {
    return if $blockings_infobar && Tk::Exists($blockings_infobar);
    my %stdcolor = (-bg => 'yellow');
    $blockings_infobar = $c->Frame(Name => "blockingsinfobar", %stdcolor, -relief => 'raised', -borderwidth => 1);
    $blockings_infobar->Label(-text => M"M�gliche tempor�re Sperrungen auf der Route", %stdcolor)->pack(-side => "left");
    $blockings_infobar->Button(-padx => 1, -pady => 1, -borderwidth => 1,
			       -text => M"Anzeigen",
			       -command => sub { show_blockings() },
			      )->pack(-side => "left", -padx => 10);
    $blockings_infobar->idletasks; # to force -reqheight to be set
}

sub show_blockings_infobar {
    require Tk::SmoothShow;
    _blockings_infobar_exists();
    Tk::SmoothShow::show($blockings_infobar);
}

sub hide_blockings_infobar {
    if ($blockings_infobar && Tk::Exists($blockings_infobar)) {
	require Tk::SmoothShow;
	Tk::SmoothShow::hide($blockings_infobar);
    }
}

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 (-> index=0 !!!)
    $points[0] = [$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[0] });
}

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);
	my $item_type_by_tag = $tags[0];
	if (grep { $item_type_by_tag eq $_ } $net->get_source_abk) {
	    return nearest_line_points($x, $y, @tags);
	}

#XXX del:
#        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
#	    }
#	} elsif ($net_type eq 's-car') {
#	    if (($tags[0] =~ /^[sSlL]$/ || $tags[0] eq 'sBAB') && !grep { /^[sSlL]-label/ || /^sBAB-label/ } @tags) {
#		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;
    @tags = grep { $_ ne 'current' } @tags;

    my @forbidden_tags_rxs = ('^show$', '^route$', '-label'); # ignore labels and show marker etc.
    my $forbidden_tags_qr = join("|", @forbidden_tags_rxs);
    $forbidden_tags_qr = qr{$forbidden_tags_qr};
    if (grep { $_ =~ $forbidden_tags_qr } @tags) {
	(undef, @tags) = find_below_rx($c, [q{.}], undef, \@forbidden_tags_rxs);
    }

    my($pos, @points);
    eval {
	($pos, @points) = nearest_line_points($x, $y, @tags);
    };
    if ($@) {
	# 2nd try: restrict to just s and l types
	(undef, @tags) = find_below($c, 's', 'l');
	($pos, @points) = nearest_line_points($x, $y, @tags);
    }
    ($pos, @points);
}

# 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
	    # (h�ngt von der Breite der Stra�en 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. L�sung?
# 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 n�chsten zwei Punkte in @coords werden einfach als
    # Nachbarn deklariert. Funktioniert ganz gut, es sei denn, die Stra�e
    # 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 Gew�sser und Fl�chen, dann Stra�en etc. und ganz oben
# Punkte wie Haltestellen, Orte und Kreuzungen.
# Allgemeine Fl�chen kommen unter Gew�sser, damit man z.B. bei in
# W�ldern 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 anw�hlbar bleiben), dagegen sind Labels von Bahnh�fen
# �ber den Bahnhofspunkten und Bahnstrecken (m�ssen nicht anw�hlbar 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;

    push @real_order, @special_lower;
    foreach (@normal_stack_order) {
	next if m{^\*.*\*$}; # ignore special tags
	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 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);
    if (defined $how) {
	if ($how eq 'lowermost') {
	    unshift @normal_stack_order, $abk, "$abk-fg";
	    return;
	} elsif ($how eq 'topmost') {
	    push @normal_stack_order, $abk, "$abk-fg";
	    return;
	}
    }

    # Smart match do-it-yorself:
    my $other_abk_match =
	(ref $other_abk eq 'ARRAY'
	 ? sub {
	     my($tag) = @_;
	     first { $_ eq $tag } @$other_abk;
	 }
	 : ref $other_abk eq 'Regexp'
	 ? sub {
	     my($tag) = @_;
	     $tag =~ $other_abk;
	 }
	 : sub {
	     my($tag) = @_;
	     $tag eq $other_abk;
	 }
	);

    my $i = 0;
    for my $tag (@normal_stack_order) {
	# XXX I think I don't have to check against '*...*' tags
	if ($other_abk_match->($tag)) {
	    if ($how =~ m{^(after|above)$}) {
		splice @normal_stack_order, $i+1, 0, $abk, "$abk-fg";
		return;
	    } elsif ($how =~ m{^(before|below)$}) {
		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 set_in_stack {
    my($abk, $how, $other_abk) = @_;
    remove_from_stack($abk);
    add_to_stack($abk, $how, $other_abk);
}

### AutoLoad Sub
sub remove_from_stack {
    my($abk) = @_;
    my $abk_fg = "$abk-fg";
    @normal_stack_order = grep { $_ ne $abk && $_ ne $abk_fg } @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;

    my %git_info;
    if ($as_about && -r "$FindBin::RealBin/miscsrc/BBBikeGit.pm") {
	require "$FindBin::RealBin/miscsrc/BBBikeGit.pm";
	%git_info = BBBikeGit::git_info();
    }

    $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 %common_args =
	(
	 -padx => 5,
	 -highlightthickness => 1,
	 -highlightbackground => 'white',
	 -relief => 'flat',
	 -borderwidth => 0,
	);
    my $Button_or_Label = ($as_about ? "Button" : "Label");
    my $www_b =
	$f->$Button_or_Label
	    (-text =>
	     "$progname $VERSION\n" .
	     ($git_info{patchnum} ? "(patchnum $git_info{patchnum})\n" : '') .
	     M("Ein Informationssystem f�r Radfahrer in Berlin") .
	     "\n\n� 1995-2012 Slaven Rezic",
	     %common_args,
	     -wraplength => 320,
	     -font => $font{'bold'},
	     -pady => 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",
	     %common_args,
	     ($as_about ?
	      (-command => sub { copying_viewer($logotop) }) : ()),
	    )->pack(-fill => "x");
    if (%git_info) {
	$f->$Button_or_Label
	    (-text => M"Detaillierte GIT-Information",
	     %common_args,
	     ($as_about ?
	      (-command => sub {
		   require Data::Dumper;
		   my $t = $logotop->Toplevel(-title => M"Detaillierte GIT-Information");
		   my $txt = $t->Scrolled("ROText", -scrollbars => "osoe")->pack(-fill => "both", -expand => 1);
		   local $Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys = 1; # doubled to cease -w
		   local $Data::Dumper::Indent = 2;
		   my $dump = Data::Dumper::Dumper(\%git_info);
		   $dump =~ s{^(.*?=)}{" " x length $1}e;
		   $txt->insert('end', $dump);
		   $t->Button(Name => 'close',
			      -command => sub { $t->destroy },
			     )->pack(-fill => "x", -expand => 1);
	       }) : ()),
	     )->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?
	# This could be wrong, e.g. if cygwin's uname is
	# in the PATH, but Win32 perl is running,
	# hence the "maybe"
	if (is_in_path("uname")) {
	    chomp(my $real_os = `uname`);
	    if ($^O !~ /^$real_os$/i) {
		$os_info .= " (Real OS, maybe: $real_os)";
	    }
	}
	$f->Label(-text => "perl $]\nTk $Tk::VERSION\n$os_info",
		  -font => $font{'small'},
		  -justify => 'left',
		 )->pack(-anchor => 'w', -expand => 1,
			 -fill => 'x');
    }

    # Send mail to software maintainer
    my $mail_b =
	$f->$Button_or_Label
	    (-text => $BBBike::EMAIL,
	     -pady => 0,
	     %common_args,
	     ($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);
	$okb->focus;
	$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 ge�ffnet 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'}) {
	# Explicitely check for Windows - Tk::InputO might be install e.g.
	# in a cygwin install for Tk/X11 and fail then if Tk/MSWin32 is
	# used.
	if ($Tk::platform ne 'MSWin32' && 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->{'BBBikeBusyIO'})
			  ? $t->{'BBBikeBusyIO'}
			  : $t->InputO);
		$io->configure(-cursor => (defined $args{-cursor} ? $args{-cursor} : 'watch'));
		$io->place('-x' => 0, '-y' => 0, -relwidth => 1, -relheight => 1);
		$io->idletasks;
		$t->{'BBBikeBusy'} = 1;
		$t->{'BBBikeBusyIO'} = $io;
	    }
	} else {
	    # see "Busy" changes in TkChange.pm
	    my $except = delete $args{-except};
	    if ($except) {
		# In this case we must not use the -recurse option, as
		# usually using -except means that there's a "cancel" window
		# which has to be accessible all the time
		$top->Busy(%args);
	    } else {
		$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->{'BBBikeBusyIO'}) {
	    for my $t ($top, values(%toplevel)) {
		next if !Tk::Exists($t) ||
		        !Tk::Exists($t->{'BBBikeBusyIO'});
		$t->{'BBBikeBusyIO'}->placeForget;
	    }
	    delete $top->{'BBBikeBusy'};
	} else {
	    $top->Unbusy;
	}
    }
}

### 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);
    my $transient = (exists $args{-transient} ? delete $args{-transient} : 1);
    my $geometry  = delete $args{-geometry};
    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 ben�tigt zus�tzliches raise
	$t->raise     if $raise;
	undef;
    } else {
	$toplevel{$name} = $top->Toplevel(%args);
	$toplevel{$name}->geometry($geometry) if $geometry;
	set_as_toolwindow($toplevel{$name}) if $transient;
	$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();
	    read_sperre_tragen() unless $lowmem; # XXX should be called automatically, maybe?
	} 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 f�r %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 hinzuf�gen\nMit Alt oder Shift: Mauscursor muss sich nicht �ber einer Stra�e befinden\nZiehen der Maus: Bewegen der Karte";
	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 l�schen";
	}
    }
}

sub change_font {
    my($font_type) = @_;
    $font_type = "normal" if !$font_type;
    eval {
	require Tk::FontDialog;
	Tk::FontDialog->VERSION(0.06); # -fixedfont...
    };
    if ($@) {
	return if !perlmod_install_advice('Tk::FontDialog');
    }

    my %fd_args;
    if ($font_type eq 'fixed') {
	$fd_args{'-fixedfont'} = 1;
	$fd_args{'-fixedfontsbutton'} = 0;
	$fd_args{'-initfont'} = $font{'fixed'};
    }
    my $fedit = $top->FontDialog(%fd_args);
    my $f = $fedit->Show;
    if (defined $f) {
	if ($font_type eq 'fixed') {
	    $font{'fixed'} = $f; # XXX probably this does not re-set existing labels
	    $fixed_font_family = $top->fontActual($font{'fixed'}, '-family');
	    # XXX note that there's no way to set the point size
	} else {
	    my $normal_font = $f;
	    set_fonts($normal_font);
	    $top->optionAdd("*font" => $font{normal}, 'userDefault');
	}
    }
}

sub size2px {
    my $size = shift;
    $size <  0 ? -$size : int(0.5 + $size*($top_dpi/72));
}

sub size2pt {
    my $size = shift;
    $size >= 0 ?  $size : int(0.5 - $size/($top_dpi/72));
}

# A part of set_fonts which has to be called very early
sub set_sans_serif_font_family {
    $has_xft = 0;
    $sans_serif_font_family = "Helvetica";
    eval {
	require Tk::Config;
	$has_xft = $Tk::Config::xlib =~ /-lXft\b/;
	if ($has_xft) {
	    $sans_serif_font_family = "sans-serif";
	}
    };
}

# Create the fontset for bbbike. Use $std_font (which must be a
# current Tk font name, not a font specification) 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') {
		    # Using MS Sans Serif is probably not correct
		    # See also: http://www.tcl.tk/cgi-bin/tct/tip/64.html
		    my(%std_font) = $l->fontActual($std_font);
		    if ($std_font{-family} =~ m{ms sans serif}i) {
			my %font_families = map{(lc($_),1)} $top->fontFamilies;
			my $new_family = (  exists $font_families{tahoma} ? "tahoma"
					  : exists $font_families{arial} ? "arial" : undef
					 );
			if (defined $new_family) {
			    $std_font = $top->fontCreate(-family => $new_family,
							 -size => size2pt($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 (!$std_font) {
	    # $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;
		} elsif (defined $font_size) {
		    warn "Font size defined as <$font_size>, but does not match pattern, so fallback to default size...";
		    $a{-size} = $font_size = 10;
		}
		if (defined $font_weight && $font_weight ne '') {
		    $a{-weight} = $font_weight;
		}
		eval {
		    $std_font = $top->fontCreate(%a);
		};
		if ($@) {
		    my $err = $@;
		    $std_font = "helvetica 10";
		    print STDERR Mfmt("Fehler beim Definieren des Zeichensatzes:\n" .
			      "%s\n" .
			      "Fallback auf den Zeichensatz <%s>.\n",
			      $err, $std_font) .
			 wrap("", "",
			      Mfmt("Dieser Fehler kann m�glicherweise durch Korrigieren der Eintr�ge <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 (exists $font{'normal'} && $std_font) {
	    $top->fontConfigure($font{normal}, $top->fontActual($std_font));
	} elsif ($std_font) {
	    $font{'normal'} = $top->fontCreate($top->fontActual($std_font));
	} else {
	    $font{'normal'} = $top->fontCreate;
	}

        my %normal_attr = $top->fontActual($font{'normal'});

        my $size = $normal_attr{'-size'}; # points or pixels depending on Tk ver
	my $px = size2px($size);
	my $pt = size2pt($size);
	my $win_width = @want_extends ? $want_extends[GEOMETRY_WIDTH] : $top->width;
	if ($win_width <= 800 && $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));
	}

	# This looks like a no-op, as $font{normal} was usually
	# determined from the default font in the option database. But
	# with this setting the _Tk font name_ is forced to be used.
	# This is a requirement to see immediate effects when changing
	# the font using FontDialog.
	$top->optionAdd('*font' => $font{'normal'}, 'userDefault');

	foreach (qw(veryhuge huge verylarge large bold
		    reduced small tiny fixed standard fix15)) {
	    if (exists $font{$_}) {
		$top->fontConfigure($font{$_}, $top->fontActual($font{'normal'}));
	    } else {
		$font{$_} = $top->fontCreate($top->fontActual($font{'normal'}));
	    }
	}

	my $minfs = sub {
	    my $fs = shift;
	    $fs = 6 if ($fs < 6);
	    $fs;
	};

	$top->fontConfigure($font{'bold'},
			    -size => sprintf("%.f", $minfs->($pt)),
			    -weight => 'bold');
	$top->fontConfigure($font{'fix15'}, # exactly 15 pixels height (if not $small_icons in effect)
			    -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 ($pt >= 8) {
	    $top->fontConfigure($font{fixed}, -family => $fixed_font_family);
	} else {
	    $font{'fixed'} = "5x7"; # XXX really necessary?
	}

## Here from a Win98 session what fonts are readable
##
#  Arial:          unterhalb von 5pt: nicht zu gebrauchen
#		   5pt - 6pt: noch lesbar, aber einige Buchstaben
#			      sehen kaputt aus
#		   7pt: OK
#  Courier New:	   5pt: kaum lesbar
#		   6pt: sieht ziemlich schlecht aus
#		   7pt: OK
#  Lucida Console:  unterhalb von 5pt: nicht zu gebrauchen
#		   5pt: erstaunlich gut
#		   6pt und mehr: OK
#  MS Sans Serif:  9pt scheint die Minimalgr��e zu sein
#  MS Serif:       6pt ist die Minimalgr��e und recht gut lesbar
#  System:         16pt scheint die Minimalgr��e zu sein
#  Tahoma:         unterhalb von 5pt: nicht zu gebrauchen
#		   5pt - 6pt: noch lesbar, aber einige Buchstaben
#			      sehen kaputt aus
#		   7pt: OK
#  Times New Roman:unterhalb von 10px (6pt): nicht zu gebrauchen
#		   10px (6pt): ein paar Buchstaben sehen komisch aus
#		   12px (7pt): OK, wenn auch etwas gequetscht
#  Verdana:        unterhalb von 5pt: nicht zu gebrauchen
#		   5pt - 6pt: noch lesbar, aber einige Buchstaben
#			      sehen kaputt aus
#		   7pt: OK
#  Pixel <-> Point (bei Times New Roman)
#    3         2
#    4         2
#    5         4
#    6         5
#    7         5
#    8         5
#    9         5
#   10         6
#   11         6
#   12         7
#   13         8
#   14         8
#   15         9
#
	my %min_px =
	    ('helvetica'	      => 8,
	     'times'		      => 10,
	     'times new roman'        => 10, # 12 w�re eigentlich besser
	     'lucida'		      => 8,
	     'new century schoolbook' => 8,
	     'fixed'		      => 7,
	     'arial'		      => 8, # at this size some characters already look somewhat broken (seen on Win98, 800x600 screen)
	     'courier new'	      => 8,
	     '__DEFAULT__'	      => 8,
	    );

	# 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) {
	    my $family = lc $top->fontActual($v, '-family');
	    my $min_px = $min_px{$family} || $min_px{__DEFAULT__};
	    my $current_size = $top->fontActual($v, "-size");
	    my $current_px = size2px($current_size);
	    if ($current_px < $min_px) {
		$top->fontConfigure($v, -size => -$min_px);
	    }
	}
    }

    # Array of sorted fonts (by size) used e.g. in
    # get_orte_label_font()
    @font = qw(tiny small reduced normal large verylarge huge veryhuge);

    for my $font (@font) {
	my $font_key = $font."-italic";
	eval {
	    if (exists $font{$font_key}) {
		$top->fontConfigure($font{$font_key},
				    $top->fontActual($font{$font}, -slant => "italic"),
				   );
	    } else {
		$font{$font_key} = $top->fontCreate($top->fontActual($font{$font}), -slant => "italic");
	    }
	};
	if ($@ || !$font{$font_key}) {
	    # fallback to non-italic variant
	    $font{$font_key} = $font{$font};
	}
    }
}

# Set image, if available, otherwise the fallback 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);
    }
}

# Load the image from file $file. Do nothing if $lowmem mode
# is set. If the -persistent is set, then store the image into the
# persistent %photo hash for caching. -name can be set
# for a Tcl-styled image name. In $small_icons mode every
# image is shrinked to half width/height.
#
# .xpm files are loaded into a Tk::Pixmap object, not Tk::Photo
# (unless $small_icons is active)
#
# .svg files are converted using the svg2photo function. In
# this case, the options -w and -h are mandatory.
sub load_photo {
    my($top, $file, %args) = @_;
    if (!defined $file) {
	require Data::Dumper;
	die "File missing in load_photo, called in " . Dumper(caller);
    }

    my $cache_key = $file;
    my %photo_args;
    for my $key (qw(-palette -gamma)) {
	if (exists $args{$key}) {
	    my $val = $photo_args{$key} = delete $args{$key};
	    $cache_key .= "-$key:$val";
	}
    }
    for my $key (qw(-w -h)) {
	if (exists $args{$key}) {
	    my $val = $args{$key};
	    $cache_key .= "-$key:$val";
	}
    }
    return $photo{$cache_key} if exists $photo{$cache_key};

    my $photo;
    unless ($lowmem) {
	eval {
	    my @name = exists $args{-name} ? ($args{-name}) : ();
	    my $do_subsample = $small_icons;
	    if ($file =~ m{\.xpm$}i && !$small_icons) {
		# Pixmap seem to be more memory-efficient, but it's
		# not possible to do subsample operations (in case of
		# $small_icons)
		$photo = $top->Pixmap(@name, -file => Tk::findINC($file));
	    } else {
		my $path;
		if (file_name_is_absolute($file)) {
		    $path = $file;
		} else {
		    for my $try_file ((-d "$datadir/images" ? "$datadir/images/$file" : ()),
				      "$FindBin::RealBin/images/$file",
				     ) {
			my $try_path = try_image_suffix($try_file);
			if (defined $try_path && -r $try_path) {
			    $path = $try_path;
			    last;
			}
		    }
		    if (!defined $path) {
			warn "Could not find photo, try <$file> in some \@INC dirs...\n"; # XXX should never happen?
			$path = Tk::findINC($file);
		    }
		}
		if ($path) {
		    if ($path =~ m{\.svg$}i) {
			my $w = delete $args{-w};
			die "-w is mandatory for svg files" if !$w;
			my $h = delete $args{-h};
			die "-h is mandatory for svg files" if !$h;
			if ($small_icons) {
			    $w /= 2;
			    $h /= 2;
			    $do_subsample = 0;
			}
			$photo = svg2photo($path, $w, $h);
		    } else {
			$photo = $top->Photo(@name, -file => $path, %photo_args);
		    }
		}
	    }
	    if ($do_subsample && $photo) {
		# XXX setting of @name missing
		my $small_photo = $top->Photo(-width => $photo->width/2,
					      -height => $photo->height/2,
					      %photo_args);
		$small_photo->copy($photo, -subsample => 2, 2);
		$photo->delete;
		$photo = $small_photo;
	    }
	};warn $@ if $@;
    }
    if ($args{-persistent}) {
	$photo{$cache_key} = $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) {
	print STDERR Mfmt("Die Datei <%s> existiert nicht.", $base) . "\n";
    } elsif (-r $xbm) {
	my $mask = Tk::findINC($lang_def . '_ptr_mask.xbm');
	if (-r $mask) {
	    $cursor{$key}      = $xbm;
	    $cursor_mask{$key} = $mask;
	}
    }
}

sub load_stipple {
    my($def) = @_;
    return $stipple{$def} if exists $stipple{$def};
    if ($def =~ m{^gray(?:25|50|75)$}) { # some builtins
	$stipple{$def} = $def;
    } else {
	$stipple{$def} = Tk::findINC($def);
	if ($stipple{$def}) {
	    $stipple{$def} = '@' . $stipple{$def};
	}
    }
    $stipple{$def};
}

# 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(%args) = @_;
    my $with_via = exists $args{-withvia} ? delete $args{-withvia} : 1;
    if (%args) {
	warn "WARNING: get_route_description called with extra arguments: " . join(" ", %args);
    }

    my $text = "";
    my @search_route = @{ get_act_search_route() };
    if (@search_route) {
	$text = $search_route[0][StrassenNetz::ROUTE_NAME];
	if ($with_via && @search_route_points > 2) { # do we have a via?
	    # XXX This is a simple solution. A better one use the
	    # farthest point instead the point in the middle of the
	    # list.
	    $text .= " - " . $search_route[@search_route/2][StrassenNetz::ROUTE_NAME];
	}
	$text .= " - " . $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).
# If @koord is just a point then return it.
### AutoLoad Sub
sub get_polyline_center {
    my(@koord) = @_;
    return @koord if @koord == 2;
    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 g�ltige Datei, kein Backup.",
				$file),
			   'err');
	}
    }
}

use your qw($StrassenNetz::VERBOSE $Strassen::VERBOSE $wettermeldung2::VERBOSE
	    $Tk::SRTProgress::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;
    $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] =~ m{^[+-]} ? '' : '+') . $extends[GEOMETRY_X] .
	    ($extends[GEOMETRY_Y] =~ m{^[+-]} ? '' : '+') . $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;
    }

    # Hack for small screens. Should be a better solution in
    # Tk::Getopt. Unfortunately there's even no -font option
    # in Tk::Getopt, so try to use a option db hack.
    if ($top->screenwidth <= 11024) {
	my $font = $top->screenwidth <= 800 ? $font{small} : $font{reduced};
	$top->optionAdd("*bbbikeOptionEditor*font" => $font);
    }

    $opt_edit =	$opt->option_editor
	($top,
	 Name => "bbbikeOptionEditor", # lowercase beginning!
	 ($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 f�r",
		      }
	  ) : ()),
	 -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;

    # Temporarily close all toplevels to make sure that the
    # canvas window is topmost (but it's still not perfect!)
    my $redisplay_toplevels;
    {
	my %withdrawn_toplevels;
	# $top->stackorder did not work under MSWin32 before Tk 804.028 (but ->can returned true!)
	my @stackorder = $Tk::platform ne "MSWin32" || $Tk::VERSION >= 804.028 ? $top->stackorder : ();
	$top->Walk(sub {
		       my($w) = @_;
		       if (Tk::Exists($w) && $w->isa("Tk::Wm") && eval { $w->state } eq 'normal') {
			   $w->withdraw;
			   $withdrawn_toplevels{$w->PathName()} = $w;
		       }
		   });
	$redisplay_toplevels = sub {
	    my %handled_toplevels;
	    for my $tpn (reverse @stackorder) {
		if ($withdrawn_toplevels{$tpn}) {
		    eval { $withdrawn_toplevels{$tpn}->deiconify };
		    $handled_toplevels{$tpn}++;
		} else {
		}
	    }
	    while(my($tpn, $w) = each %withdrawn_toplevels) {
		if (!$handled_toplevels{$tpn}) {
		    eval { $w->deiconify };
		}
	    }
	};
    }
    $top->raise;
    $top->update;
    $top->tk_sleep(1); # make sure the update was really done

    my $imager_fmt = $fmt eq 'ppm' ? 'pnm' : $fmt;
    if ($devel_host && eval {
	require Imager;
	Imager->VERSION(0.62);
	die "Imager does not support image format <$imager_fmt>, use fallback...\n"
	    if !grep { $imager_fmt eq $_ } Imager->write_types;
	require Imager::Screenshot;
	Imager::Screenshot->VERSION(0.005);
	1;
    }) {
	my $img;
	eval {
	    ## This should work, but does not, because $widget->can("frame") seems
	    ## to be always true
	    ## XXX for Version 0.006 this will work:
	    #$img = Imager::Screenshot::screenshot(widget => $c);
	    #my $img = Imager::Screenshot::screenshot(widget => $c, decor => 0);
	    $img = Imager::Screenshot::screenshot(($Tk::platform eq 'MSWin32' ? 'hwnd' : 'id'),
						  hex $c->id);
	    if ($img) {
		$img->write(file => $outfile, type => $imager_fmt) or $img = undef;
	    }
	};
	warn $@ if $@;
	$redisplay_toplevels->();
	if (!$img) {
	    status_message("Imager and Imager::Screenshot installed, but screenshot failed", "warn");
	} else {
	    return;
	}
    }

    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;

	} elsif ($fmt eq 'pdf' &&
		 !eval {
		     require GfxConvert;
		     GfxConvert::check($in_fmt, $fmt, $tmpfile, $outfile, %args);
		     1;
		 }) {
	    pdf_export(-visiblemap => 1, -file => $outfile);
	    $post_processing_needed = 0;
	} 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"Tempor�re Postscript-Datei kann nicht erstellt werden.";
	    }
	}

	if (!$post_processing_needed) {
	    if (defined $tmpfile) {
		mv($tmpfile, $outfile);
	    }
	} else {
	    require GfxConvert;
	    # -mapcolor wandelt die Farbe der Nebenstra�en
	    # (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);
    $redisplay_toplevels->();
    if ($err) {
	status_message($err, 'err');
    }
}

sub slow_postscript_generation {
    # XXX Hmmm, seems to be OK on Win98 with Tk800 and Tk804, with quite a number of layers turned on
    # XXX But it is really slow on a Windows2000 system with Tk800 (SiePerl 5.6.1)
    return $os eq 'win' &&
	$top->messageBox(-icon => "question",
			 -message => M"Die PostScript-Erzeugung k�nnte unter Windows langsam sein. Soll trotzdem fortgesetzt werden?",
			 -type => "YesNo") !~ /yes/i;
}

sub get_strassen_file {
    my $file = shift;
    if ($file =~ /-orig$/) {
	# XXX The need to check for this condition seems to be a bug.
	# In BBBikeLazy.pm, there are lines like
	#     $p_file{$abk} = $file;
	# which set the $p_file{...} filename to the -orig version
	# in edit mode, and this every time!
	$file;
    } else {
	$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();
	} elsif ($type eq 'fz') {
	    $object = _get_fragezeichen_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;
    # XXX One day this should contain all of @plotting_hint_line_vars
    my %accept_modern_style = map{($_,1)}
	qw(line_arrow line_dash);
    # XXX Everything else should be slowly discouraged...
    my %accept_global_hash_directives = map{($_,1)}
	qw(category_size category_color
	   category_line_width category_image
	   category_stipple category_dash
	   category_capstyle
	   category_line_shorten category_line_shorten_end
	  );
    my %accept_global_hashref_directives = map{($_,1)}
	qw(str_attrib p_attrib);
    my %accept_global_catless_directives = map{($_,1)}
	qw(str_color outline_color line_width);
    my %accept_global_catless_directives_with_layer_prefix = map{($_,1)}
	qw(line_length
	   line_dash line_arrow
	   line_capstyle
	   line_shorten line_shorten_end
	   name
	  );
    # Aliases for directives without category
    my %aliases = (
		   category_width => "category_line_width",
		   line_color => "str_color",
		  );
    # Aliases for directives with category
    my %aliases_withcat = (
			   line_color => "category_color",
			  );
    my @aliases_code = (
			sub { $_[0] =~ s{^category_dash\.}{line_dash.}; }, # was used in radwege-orig, and is still used in streets-accurate-categorized..., remove some day XXX
		       );

    my $get_val = sub {
	my($key, $vals) = @_;
	my $val = $vals->[0];
	if ($key =~ m{(?:_dash|_capstyle|^line_length$)}) { # list of directives using arrays
	    $val = [split /\s*,\s*/, $val];
	} elsif ($key =~ m{_width}) {
	    my @vals = split /\s*,\s*/, $val;
	    if (@vals == 1) {
		my $factor = $vals[0] / $line_width{default}->[3];
		for my $inx (0 .. $#{ $line_width{default} }) {
		    $vals[$inx] = int($line_width{default}->[$inx] * $factor + 0.5);
		    if ($vals[$inx] < 1) {
			$vals[$inx] = 1;
		    }
		}
	    } elsif (@vals != scalar @{ $line_width{default} }) {
		warn "$key should have either one or exactly six comma-separated values";
	    }
	    $val = \@vals;
	}
	$val;
    };

    # XXX scrollregion
    while(my($directive, $vals) = each %$glob_dir) {
	if ($aliases{$directive}) {
	    $directive = $aliases{$directive};
	}
	for my $code (@aliases_code) {
	    $code->($directive);
	}
	if ($accept_modern_style{$directive}) {
	    no strict 'refs';
	    ${"layer_".$directive}{$abk} = $get_val->($directive, $vals);
	} elsif ($accept_global_catless_directives{$directive}) {
	    no strict 'refs';
	    ${$directive}{$abk} = $get_val->($directive, $vals);
	} elsif ($accept_global_catless_directives_with_layer_prefix{$directive}) {
	    no strict 'refs';
	    ${"layer_".$directive}{$abk} = $get_val->($directive, $vals);
	} elsif ($directive eq 'layer_stack') {
	    my($how, $other_abk) = split /:/, $vals->[0];
	    if (!defined $other_abk) {
		status_message("The layer_stack directive needs how:tag as an argument", "die");
	    }
	    set_in_stack($abk, $how, $other_abk);
	} else {
	    my($key, $cat) = $directive =~ /^([^\.]+)\.([^\.]+)/;
	    if (defined $key) {
		if ($aliases_withcat{$key}) {
		    $key = $aliases_withcat{$key};
		}
		if ($accept_modern_style{$key}) {
		    no strict 'refs';
		    ${"layer_category_".$key}{$abk}{$cat} = $get_val->($key, $vals);
		    next;
		} elsif ($accept_global_hash_directives{$key}) {
		    no strict 'refs';
		    ${"layer_".$key}{$abk}{$cat} = $get_val->($key, $vals);
		    next;
		} elsif ($accept_global_hashref_directives{$key}) {
		    no strict 'refs';
		    ${$key}->{$abk."-".$cat} = $get_val->($key, $vals); # XXX $abk-???
		    next;
		}
	    }
	    #warn "Don't know how to handle global directive <$key>";
	}
    }
}

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);
        }
    }
}

sub get_image {
    my($base, $file) = @_;

    my $images = ($top->{'MapImages'} ||= {});
    my $p = $images->{$base};
    if (!$p) {
	my $try_file = try_image_suffix($file);
	if (defined $try_file) {
	    $file = $try_file;
	}
	eval {
	    if ($file =~ /\.png$/ && !exists $INC{"Tk/PNG.pm"}) {
		require Tk::PNG;
	    }
	    if ($file =~ /\.jpe?g$/ && !exists $INC{"Tk/JPEG.pm"} && !exists $INC{"Tk/JPEG/Lite.pm"}) {
		require Tk::JPEG; # fallback to Tk::JPEG::Lite? XXX
	    }

	    #warn "Try $file...\n";
	    $p = $c->Photo(-file => $file);
	};
	if (!$p) {
	    eval {
		my $try_file = try_image_suffix("$FindBin::RealBin/images/$file");
		if (defined $try_file) {
		    $file = $try_file;
		} else {
		    warn "Could not find $file in images, try in \@INC..."; # XXX should never happen?
		    $file = Tk::findINC($file);
		}
		#warn "Try $file...\n";
		$p = $c->Photo(-file => $file)
		    if defined $file;
	    };
	}
	if ($p) {
	    $images->{$base} = $p;
	}
    }
    $p;
}

sub get_image_for_p {
    my($base, $file, $abk) = @_;
    get_image_for_any($base, $file, $abk, 'p');
}

sub get_image_for_str {
    my($base, $file, $abk) = @_;
    get_image_for_any($base, $file, $abk, 'str');
}

sub get_image_for_any {
    my($base, $file, $abk, $type) = @_;

    my($realfile,$w,$h,$refscale,$doxxx);
    my $is_svg;
    if ($file =~ m{(.*\.svg)(?::(\d+)x(\d+)(?:=1:(\d+)(,xxx)?)?)?$}) {
	($realfile,$w,$h,$refscale,$doxxx) = ($1,$2,$3,$4,$5);
	$is_svg = 1;
    } else {
	$realfile = $file;
    }
    my $images = ($top->{'MapImages'} ||= {});
    my $key = $base.' '.$realfile.' '.(defined $w ? $w.'x'.$h.' ' : '').(defined $refscale ? "$mapscale " : '').$type.' '.$abk;
    my $p = $images->{$key};
    if (!$p) {
	eval {
	    my $abs_realfile;
	    if ($realfile =~ m{^/}) {
		$abs_realfile = $realfile;
	    } else {
		# XXX Es ist nicht zugesichert, dass eine Datei f�r ein
		# p/str-Objekt existiert. Somit kann $p/str_file{$abk}
		# leer sein und der dirname-Aufruf meckern (fileparse()
		# need a valid pathname)
		my $bbd_abspath = $type eq 'p' ? $p_file{$abk} : $str_file{$abk};
		if ($bbd_abspath !~ m{^/}) { # XXX windows compat? Should check for all occurences of this pattern and replace by function!
		    $bbd_abspath = "$datadir/$bbd_abspath";
		}
		my $dir = dirname($bbd_abspath);
		$abs_realfile = "$dir/$realfile";
	    }
	    if ($is_svg) {
		# XXX move svg stuff to some general-purpose function or module
		if (!defined $w) {
		    ($w,$h) = (100,100); # some hardcoded default
		}
		if (defined $refscale) {
		    my($curr_mapscale) = $mapscale =~ m{^1:(\d+)}; # ignore decimals, if any
		    my $factor = $refscale/$curr_mapscale;
		    $factor = 0.5+$factor/2 if $doxxx; # XXX good name for xxx? make the factor "flatter"
		    $w *= $factor;
		    $h *= $factor;
		}
		$p = svg2photo($abs_realfile, $w, $h);
	    } else {
		$p = get_image($base, $realfile);
		if (!$p) {
		    warn "Try $abs_realfile...\n";
		    $p = $c->Photo(-file => $abs_realfile);
		}
	    }
	};
	if ($@) {
	    warn "Warning: $@ (supplid args: ($base, $file, $abk, $type)" if $@;
	    $p = $c->Photo(-file => "$FindBin::RealBin/images/px_1t.gif"); # XXX cache this one!
	}
	if ($p) {
	    $images->{$key} = $p;
	}
    }
    $p;
}

sub svg2photo {
    my($file, $w, $h) = @_;
    warn "Try to convert from svg to png, geometry ${w}x${h}...\n" if $verbose;
    require File::Temp;
    require Tk::PNG;
    my(undef,$tmpfile) = File::Temp::tempfile(SUFFIX => ".png", UNLINK => 1)
	or die "Can't create temporary file: $!";
    my @cmd = ("convert", "-geometry", "${w}x${h}", $file, $tmpfile);
    system(@cmd) == 0
	or die "Error while converting: @cmd, status=$?";
    my $p = $c->Photo(-file => $tmpfile);
    unlink $tmpfile;
    $p;
}

sub pp_color {
    if (ref $pp_color eq 'ARRAY') {
	$c->itemconfigure('ppkvp',
			  -fill => $pp_color->[0]);
## 2nd not yet used:
# 	$c->itemconfigure('ppcrs',
# 			  -fill => $pp_color->[1]);
	$c->itemconfigure('ppcrs',
			  -fill => $pp_color->[0]);
    } else {
	$c->itemconfigure('pp',
			  -fill => $pp_color);
    }
}

# Very nice. Note that the Tk::CanvasBalloon::Track method cannot cope with
# dealing with stacked items, so the <Motion> binding in std_str_binding
# needs additional code to deal with this.
sub balloon_info_from_all_tags {
    my($c) = @_;
    my $e = $c->XEvent;
    my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    my $closeenough = $balloon_info_from_all_tags_closeenough;
    my(@items) = $c->find(overlapping =>
			  $xx-$closeenough, $yy-$closeenough,
			  $xx+$closeenough, $yy+$closeenough);
    # Now using "reverse", so top-most items are preferred
    @items = reverse @items;
    if (!@items) {
	push @items, "current";
    }
    my @major_balloon_info;
    my @balloon_info;
    my %balloon_info_seen;
    my $major_item_seen = 0;
    my $comments_rx = join("|", map { "comm-" . quotemeta }
			   grep { $_ ne "kfzverkehr" } # list types without meaningful "name" field XXX but maybe comm-kfzverkehr should have meaningful names some day...
			   @Strassen::Dataset::comments_types);

    for my $item (@items) {
	my(@tags) = $c->gettags($item);
	if ($verbose && $verbose >= 2) {
	    require Data::Dumper;
	    print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([\@tags],[qw()])->Indent(1)->Useqq(1)->Dump;
	}

	if ($tags[0] =~ m{^(s|sBAB|l|$comments_rx|qs|ql|hs|hl|fz|u|b|r|f|w|rw|e|v|v-fg|temp_sperre|temp_sperre_s|L\d+|L\d+-fg|L\d+-bg)$}) {
	    my $label = $tags[1];
	    if ($tags[0] eq 'rw' ||
		$tags[0] eq 'comm-cyclepath') { # Special handling for cyclepaths
		(my $rw_code) = $tags[2] =~ /^(?:rw|comm-cyclepath)-(RW(?:\d*|\?))/; # XXX should probably use $Radwege::rw_qr without the anchors?
		my $name = Radwege::code2name($rw_code);
		if (defined $name) {
		    if (defined $label && $label ne "") {
			$label = "$name ($label)";
		    } else {
			$label = $name;
		    }
		}
	    } elsif ($tags[0] eq 'temp_sperre') {
		$label = $tags[2];
	    }
	    next if $label =~ m{^\s*$};
	    $label =~ s/\|.*$//; # Teil hinter "|" abschneiden
	    if ($tags[0] =~ m{^(s|l)$}) { # most significant, should be top-most:
		if (!exists $balloon_info_seen{$label}) {
		    push @major_balloon_info, $label;
		    $balloon_info_seen{$label} = 1;
		}
		$major_item_seen++;
	    } else {
		if (($tags[2]||'') =~ m{^e-(CS|img)$}) { # comm-ferry
		    if ($label =~ m{^(?:.*)?:\s*(.*)}) {
			$label = $1;
		    }
		} elsif ($tags[0] =~ m{^(qs|ql|hs|hl)$}) {
		    if ($label =~ m{^(?:.*)?:\s*(.*)}) {
			$label = $1;
		    }
		    if (my($cat) = $tags[2] =~ m{-(.*)}) {
			if ($cat eq 'img') {
			    # not the category, but really an quality/handicap
			    # image, most probably an in-construction image
			    next;
			}
			$label .= " ($cat)";
		    }
		} elsif ($tags[0] =~ m{^L\d+-fg$}) {
		    $label = $tags[2];
		}
		if ($major_item_seen && $tags[0] =~ m{^(f|w)$}) {
		    next;
		}
		if (!exists $balloon_info_seen{$label}) {
		    push @balloon_info, $label;
		    $balloon_info_seen{$label} = 1;
		}
	    }
	}
    }

    @balloon_info = (@major_balloon_info, @balloon_info);

    if ($verbose && $verbose >= 2) {
	require Data::Dumper;
	print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([\@balloon_info],[qw(balloon_info)])->Indent(1)->Useqq(1)->Dump;
    }

    if (wantarray) {
	if (!@balloon_info) {
	    ();
	} else {
	    @balloon_info;
	}
    } else {
	if (!@balloon_info) {
	    undef;
	} else {
	    join("\n", @balloon_info);
	}
    }
}

sub get_special_vehicle { !defined $special_vehicle_rb || $special_vehicle_rb eq 'normal' ? '' : $special_vehicle_rb }

# Currently works only if the original background is white
sub soft_flash {
    my $w = shift;
    # XXX Could be a little bit smoother...
    my @color_states = ('#ffe126', '#ffdb00', '#ffe126', '#ffe960', '#ffec74', '#fff19a', '#fff6be', '#ffffff');
    my $color_i = 0;
    my $next_color_state;
    $next_color_state = sub {
	return if !Tk::Exists($w);
	$w->configure(-background => $color_states[$color_i]);
	$color_i++;
	if ($color_i <= $#color_states) {
	    $w->after(100, $next_color_state);
	}
    };
    $next_color_state->();
}

sub _can_send_mail {
    return $BBBikeMail::can_send_mail if defined $BBBikeMail::can_send_mail;

    require BBBikeMail;
    BBBikeMail::capabilities();
    $BBBikeMail::can_send_mail;
}

# REPO BEGIN
# REPO NAME tk_sleep /home/e/eserte/work/srezic-repository
# REPO MD5 6e344458a3a154eefaf7b82d5f9bb576

=head2 tk_sleep

=for category Tk

    $top->tk_sleep($s);

Sleep $s seconds (fractions are allowed). Use this method in Tk
programs rather than the blocking sleep function. The difference to
$top->after($s/1000) is that refrsh events are still handled in the
sleeping time.

=cut

sub Tk::Widget::tk_sleep {
    my($top, $s) = @_;
    my $sleep_dummy = 0;
    $top->after($s*1000,
                sub { $sleep_dummy++ });
    $top->waitVariable(\$sleep_dummy)
	unless $sleep_dummy;
}
# REPO END

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

package bbbike; # HACK for autosplit