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

#
# $Id: bbbike,v 3.122 2004/01/17 17:48:22 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (c) 1995-2003 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;

#perl2exe_include Tk/Checkbutton.pm

use FindBin;
use lib ("$FindBin::RealBin",
	 "$FindBin::RealBin/images",
	 "$FindBin::RealBin/lib",
	);
BEGIN { eval 'use BBBikeDebug' if $ENV{BBBIKE_DEBUG} }

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

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

use Config;

## DEBUG_BEGIN
#  BEGIN {
#      $BBBikeDebug::start = time;
#      if ($Config{'optimize'} =~ /PERL_DEBUGGING_MSTATS/ &&
#  	eval 'require Devel::Peek; 1') {
#  	eval q{
#  	    sub mymstat {
#  		my $time = defined &Tk::timeofday ? Tk::timeofday() : time;
#  		printf STDERR "%-30s: %.2f\n", "@_", $time-$BBBikeDebug::start;
#  		Devel::Peek::mstat();
#  	    }
#  	}
#      } else {
#  	eval q{
#  	    sub mymstat {
#  		my $time = defined &Tk::timeofday ? Tk::timeofday() : time;
#  		printf STDERR "%-30s: %.2f\n", "@_", $time-$BBBikeDebug::start;
#  	    }
#  	}
#      }
#      warn $@ if $@;
#      mymstat("Begin");
#  }
## DEBUG_END

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

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

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

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

use Tk;
#XXX for now disabled ... still too many bugs floating around
#use Tk::ErrorDialog; # XXX is this OK?
use Tk::CanvasUtil;
use File::Basename;
## DEBUG_BEGIN
#BEGIN{mymstat("before BBBikeUtil");}
## DEBUG_END
use BBBikeUtil;
use BBBikeVar;
use BBBikeCalc;
use BBBikeTrans;
## DEBUG_BEGIN
#BEGIN{mymstat("before Strassen");}
## DEBUG_END
use Strassen;
## 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);
## DEBUG_BEGIN
#BEGIN{mymstat("before locale");}
## DEBUG_END

BEGIN {
}

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

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

use BBBikeGlobalVars;

# XXX move to BBBikeGlobalVars?
# Map modes
# Please don't change order to stay compatible with tkbabybike
use enum qw(:MM_
	    SEARCH INFO BUTTONPOINT USEREDIT DRAG EDITPOINT
	    SPECIALEDIT INSERTPOINT CREATERELATION CUSTOMCHOOSE
	    BABYBIKE_SELECT BABYBIKE_BROWSE SCRIBBLE
	   );

# Button2 modes
use enum qw(:B2M_
	    NONE DELLAST AUTOSCROLL SCAN FASTSCAN CUSTOM);

# Attribute description field indexes
use enum qw(:ATTRIB_ SINGULAR PLURAL LINES LONG);

# XXX maybe this should go to Strassen::Dataset?
@comments_types = qw(cyclepath ferry misc mount path route tram);

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

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

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

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

eval 'use BBBikeXS 0.09';

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

$^W = 1;

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

# OS related
$progname = basename($0);
$devel_host = ($ENV{HOST} && $ENV{HOST} =~ /^(vran|cabulja|cvrsnica|spiff|devpc01.iconmobile.de)/i);
$os = (($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos')
       ? 'win'
       : ($^O eq 'MacOS'
	  ? 'mac'
	  : 'unix'));
if (!defined $is_handheld) {
    $is_handheld = $Config{"archname"} =~ /^arm-linux$/i;
}
$sfn    = 0; # short filenames (8.3)
$win32s = 0; # Win32S
$use_clipboard = 1 if $os eq 'win';

# include after setting $os!
require TkChange;

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

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

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

## I don't think this is necessary anymore...
#check_available_memory();

# enable DnD
use Tk::DropSite;

$tmpdir = $ENV{TMPDIR} || $ENV{TEMP} || "/tmp";
if (! -d $tmpdir) {
    $tmpdir = "/temp";
    if (! -d $tmpdir) {
	$tmpdir = catfile($FindBin::RealBin, "tmp");
	warn Mfmt("Verwende Unterverzeichnis 'tmp' des Programmverzeichnisses (%s) als temporres Verzeichnis", $tmpdir);
    }
}
# Var section: map scales and orientation
set_landscape();
$scale_coeff = 1;
$small_scale  = 0.0625;    # map scale for overview window (region mode)
$medium_scale = 0.13;      # map scale for overview window (city/Berlin mode)
$small_scale_edit  = 0.01;         # dasselbe fr den Edit-Mode XXX not yet
$medium_scale_edit = 0.02;
set_canvas_scale(DEFAULT_SCALE);
Karte::preload('Standard');
$init_scrollregion = $Karte::Standard::init_scrollregion;
$normal_scrollregion = $init_scrollregion*$scale;
@scrollregion = ((-$normal_scrollregion) x 2,
		 ($normal_scrollregion)  x 2);
$bbbike_route_ext = 'bbr';

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

%tag_group = # group related tags (for stacking)
  ('str_s' => ['s-out', 'gr', 'rw',
	       's-NN', 's-N', 's-H', 's-HH', 's-B', 's-BAB', 'comm',
	       (map { "comm-$_" } @comments_types),
	       'nl', 'qs', 'hs', 'mount',
	       's-label-bg', 's-label', 'hoehe', 'vf-bg', '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', 'u-bg', 'u-fg', 'u-label'],
   'str_b' => ['b', 'b-bg', 'b-fg', 'b-label'],
   'str_r' => ['r', 'r-bg', 'r-fg', 'r-label'],
   'str_w' => ['w-out', 'w', 'i-out', 'i', 'w-label-bg', 'w-label'],
   'str_f' => ['f', 'f-label-bg', 'f-label', 'f-Pabove'],
   'str_g' => ['z', 'g', 'gP', 'gD'],
   'p_kn'  => ['kn', 'ki', 'rest'],
   'map'   => ['map'],
   'route' => ['route'],
   'v'     => ['v', 'v-fg'],
   'e'     => ['e', 'e-img'],
  );
$do_iconframe = 1;
$do_route_strnames          = 0 if !defined $do_route_strnames;
$do_route_strnames_km       = 0 if !defined $do_route_strnames_km;
$do_route_strnames_compact  = 0 if !defined $do_route_strnames_compact;
$do_route_strnames_comments = 1 if !defined $do_route_strnames_comments;
$net_type = "s";
$no_make_net = 0;
$str_far_away{'w'} = 0;
$orte_label_size = 1;
$str_far_away{'l'} = 0;
$show_overview_mode = "b";
$show_overview = $show_strlist = 0;
$show_calories = 0;
$use_hoehe = 1; # XXX kann im Programm nicht gesetzt werden
$steigung_optimierung = 0;
$green_optimization = 0;
$grade_minimum_short_length = 100; # 100m gilt als kurz fr grademinimumshort
$use_legend = $use_legend_right = 0;
$use_faehre = 0;
$sperre{'einbahn'} = 1;
$sperre{'einbahn-strict'} = 0;
$sperre{'sperre'} = 1;
$sperre{'wegfuehrung'} = 1;
$sperre{'Q3'} = 0;
$p_draw{'sperre'} = 0;
$sperre_file = "gesperrt";
# immediate_replot: 0 = none, 1 = immediate, 2 = deferred
my($immediate_replot, $immediate_recalc) = (1, 1);
$auto_visible = 1;
%tag_visibility =
  ('p-hoehe'  => 1,
   'str-s-NN' => 0.5,
   'str-s-N'  => 0.5,
   'p-lsa'    => 0.5,
   'p-o-0'    => 0.375,
   'p-o-1'    => 0.25,
   'str-s-H'  => 0.125,
   'p-o-2'    => 0.125,
  );
$map_draw = 0;
$map_default_type = 'berlinmap';
$map_surround = 0;
$dont_delete_map = 1;
$str_file = "strassen";
$landstr_file = "landstrassen";
$wasser_file = "wasserstrassen";
$flaechen_file = "flaechen";
$plz_file = "plz";
$border_file = "berlin";
$coord_prefix = 0;
$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 = B2M_FASTSCAN;
%b2_mode_desc = (B2M_NONE, M"Nichts",
		 B2M_SCAN, M"Scanning",
		 B2M_FASTSCAN, M"Fast Scanning",
		 B2M_AUTOSCROLL, M"Autoscrolling",
		 B2M_DELLAST, M"Letzten Punkt lschen",
		);
# Default ist rot, weil das Orange von power oder wind schlecht zu erkennen ist
$mark_color    = 'red'; # Farbe der Markierung in mark_street et al.
$gps_waypoints = 50;

define_item_attribs();

generate_plot_functions();

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

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

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

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

use enum qw(:SRP_ COORD TYPE);

$aufschlag = 1;

# Wetter-Variablen
$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; # Grad Celsius
init_wind();

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

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

### Fonts
$standard_height = 12;

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

$nr = -1;
{
    my $cachedir = catfile($FindBin::RealBin, "cache");
    $cache_root = (-d $cachedir && -w $cachedir
		   ? catfile($FindBin::RealBin, "cache")
		   : $tmpdir);
    $Karte::cache_root = $cache_root;
}

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

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

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

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

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

Tk::CmdLine::SetArguments();

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

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

   M"Anzeige",
   ['fontrot','!',1,
    label => M"Rotierte Zeichenstze", var => \$use_font_rot],
   ['fontfamily','=s','helvetica',
    label => M"Zeichensatz (Proportional)", var =>        \$font_family],
   ['fixedfontfamily','=s','courier',
    label => M"Zeichensatz (Fixed)", var =>   \$fixed_font_family],
   ['fontheight','=i',12,
    label => M"Zeichensatzgre", var => \$font_size],
   ['fontweight','=s',undef,
    label => M"Zeichensatzform", var => \$font_weight],
   ['geometry','=s',undef,
    subtype => "geometry", # XXX use fix_geometry for tk::getopt editor
    label => M"Geometry", var => \$geometry],
   ['scaling','=f',undef,
    label => M"Skalierung", var => \$scaling],
   ['visual','=s',undef,
    label => M"Visual", var => \$visual],
   ['scale','=f',undef,
    label => M"Skalierung", nogui => 1,
    var => sub { my $oldscale = $scale;
		 set_canvas_scale($_[1]);
		 foreach (@scrollregion) {
		     $_ *= ($scale/$oldscale);
		 }
	     }],
   ['overviewwasser','!',0,
    label => M"bersichtskarte mit Gewssern", var => \$overview_draw{'w'}],
   ['overviewsbahn','!',0,
    label => M"bersichtskarte mit S-Bahnen", var => \$overview_draw{'b'}],
   ['overviewsbahn','!',0,
    label => M"bersichtskarte mit Hauptstraen", var => \$overview_draw{'s'}],
   ['coloring','=s','red',
    label => M"Einfrben der Route", var => \$coloring,
    choices => [qw(red blue black power wind)]],
   ['handheld','!',undef,
    label => M"Handheld", var => \$is_handheld],

   M"GUI",
   ['menu','!',1, # XXX hier stand mal "menu|stdmenu|standardmenu" => aber Aliase werden anscheinend von Tk::GetOpt nicht untersttzt?!
    label => M"Standard-Men", var => \$standard_menubar],
   ['balloon','!',1,
    label => M"Balloons", var => \$use_balloon],
   ['cballoon','!',2,  # 0 = nie, 1 = auf der Route, 2 = immer
    label => M"Canvas balloons", var => \$use_c_balloon],
   ['cballoonwait','=i',350,
    label => M"Wartezeit fr Canvas balloons", var => \$c_balloon_wait],
   ['flat','!',1,
    label => M"Flaches Relief", var => \$flat_relief],
   ['contexthelp','!',1,
    label => M"Kontextsensitive Hilfe", var => \$use_contexthelp],
   ['rightispopup','!',1,
    label => M"Popup-Men rechts", var => \$right_is_popup],
   ['smoothscroll','!',0,
    label => M"Weiches Scrollen", var => \$use_smooth_scroll],
   ['followmouse','!',0,
    label => M"Kartenausschnitt folgt Cursor", var => \$followmouse],
   ['dialog','!',1,
    label => M"Verwendung von Dialog-Fenstern", var => \$use_dialog],
   ['transient','!',1,
    label => M"Transiente Dialoge", var => \$transient],
   ($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],
   ['autoscroll','!',undef, # XXX make nogui => 0, choices!
    label => M"Autoscrolling", nogui => 1, var => sub { $b2_mode = B2M_AUTOSCROLL }],
   ['autoscrollspeed','=s','normal',
    choices => [qw(slow normal fast)],
    label => M"Autoscrolling-Geschwindigkeit", var =>   \$autoscroll_speed],
   ['autoscrollmiddle','!',undef,
    label => M"Autoscrollpunkt in der Mitte", var =>   \$autoscroll_middle],
   ['focuspolicy','=s',undef,
    label => M"Focus-Policy",
    longhelp => 'click:'.M("Click-to-focus")."\n".
                'follow:'.M("Focus-follows-mouse")."\n",
    var => \$focus_policy,
    choices => [qw(click follow)],
   ],

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

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

   M"GPS",
   ['exporttxtmode','=i',EXPORT_TXT_SIMPLIFY_AUTO,
    label => M"Export-Format bei Routen",
    longhelp => EXPORT_TXT_FULL.":".M("Komplette Route")."\n".
                EXPORT_TXT_SIMPLIFY_NAME.":".M("Unterschiedliche Straennamen")."\n".
                EXPORT_TXT_SIMPLIFY_ANGLE.":".M("Abbiegevorgnge")."\n".
                EXPORT_TXT_SIMPLIFY_NAME_OR_ANGLE.":".M("Abbiegevorgnge/unterschiedliche Straennamen")."\n".
                EXPORT_TXT_SIMPLIFY_AUTO.":".M("automatisch")."\n".
                '',
    choices => [EXPORT_TXT_FULL,EXPORT_TXT_SIMPLIFY_NAME,
		EXPORT_TXT_SIMPLIFY_ANGLE,EXPORT_TXT_SIMPLIFY_NAME_OR_ANGLE,
		EXPORT_TXT_SIMPLIFY_AUTO], # XXX better choices
    var =>  \$export_txt_mode],
   ['exporttxtminangle','=s',30,
    label => M"Minimalwinkel bei Route-Export",
    longhelp => "Minimalwinkel in Grad bei (GPS-)Export von Routen\n",
    var => \$export_txt_min_angle],
   ['gpswaypoints','=i',50,
    label => M"Maximale Anzahl der GPS-Waypoints",
    longhelp => "Moderne Garmin-Gerte knnen 50 Waypoints pro Route verwenden,\nwhrend ltere nur 20 Waypoints laden knnen\n",
    var => \$gps_waypoints,
   ],
   ['gpsdevice','=s',($os eq 'win' ? "COM1" : ($^O =~ /bsd/i ? '/dev/cuaa0' : '/dev/ttyS0')),
    #XXX check: subtype => 'file',
    label => M"GPS-Device", var => \$gps_device],

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

   M"Advanced",
   ['edit','=s',undef,	alias => [qw(mode)],
    label => M"Editmodus", var => \$set_mode],
   ['stderr','!',0,
    label => M"Fehlerausgabe auf stderr", var => \$stderr],
   ['autoinstall','!',0,
    label => M"Auto-Installation vom CPAN", var => \$auto_install_cpan],
   ['advanced','!',undef, var => \$advanced],
   ['public','!',undef, nogui => 1,
    var => sub { $advanced = 0;
		 $devel_host = 0;
		 $do_www = 0;
		 $no_map = 1;
		 $public = 1;
		 $autosave_opts = 0;
		 undef $proxy;
	     }],
   ['v','!',0,	alias => [qw(verbose)],
    label => M"Verbose", var => \$verbose],
   ['version','!',undef,
    nogui => 1, var => sub {
	print
	    "$progname $VERSION\n(file revision $PROG_REVISION)\n",
		"perl $]\nTk $Tk::VERSION\n";
	exit 0;
    }],
   ['plugins','=s',undef,
    label => M"Plugins", var => \$initial_plugins],
   ['layers','=s',undef,
    label => M"Layers", 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') : ())],
    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.49);
};
if ($@) { # XXX
die "Please report to author: use opttable_to_getopt!!!! XXX";
    warn __LINE__ . ": $@" if $verbose;
    my @getopt_list;
    foreach (@getopt) {
	push @getopt_list, $_ unless /^=/;
    }
    # XXX '@' geht nur mit Getopt::Long
    push @getopt_list, 'power=i@' => \@power, 'speed=i@' => \@speed;
    require Getopt::Long;
#XXX X11-Optionen durchschleifen...
#    if (!Getopt::Long::GetOptions(@getopt_list)) { usage('', \@getopt_list) }
    Getopt::Long::config('pass_through');
    Getopt::Long::GetOptions(@getopt_list);
#XXX    if (!GetOptions(@getopt_list)) { usage('', \@getopt_list) }
} else {
    $Tk::Getopt::x11_pass_through = 1;
    $opt = new Tk::Getopt(-opttable => \@opttable,
			  -filename => catfile($bbbike_configdir, "config"),
			 );
    $opt->set_defaults;
    pre_check_arguments();
    $opt->load_options unless $public; # force defaults
    if (!$opt->get_options) {
	print $opt->usage;
	exit 1;
    }
    $opt->process_options;
}

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

if (defined $city) {
    if (opendir GEO, "$FindBin::RealBin/Geography") {
	my $search_term = $city;
	if (defined $country) {
	    $search_term .= ".*_$country";
	}
	my $found = 0;
	while(defined(my $f = readdir GEO)) {
	    next if -d $f || $f !~ /\.pm$/;
	    if ($f =~ /^$search_term/i) {
		$f =~ s/\.pm$//;
		$citypkg = 'Geography::' . $f;
		eval 'require ' . $citypkg;
		die $@ if $@;
		my $cityobj = $citypkg->new;
		set_datadir($cityobj->datadir, -clearold => 1);
		%global_search_args = $cityobj->search_args
		    if $cityobj->can("search_args");
		$found++;
		$no_original_datadir = 1;
		last;
	    }
	}
	closedir GEO;
	if (!$found) {
	    die Mfmt("Kann keine passende Datei fr Stadt=%s und Land=%s finden",
		     $city, (defined $country ? $country : M("(unbestimmt)")));
	}
    } else {
	die Mfmt("Kann das Verzeichnis %s nicht ffnen: %s",
		 "$FindBin::RealBin/Geography", $!);
    }
} elsif ($datadir) {
    set_datadir($datadir, -clearold => 1);
    $no_original_datadir = 1;
} else {
    # default (Berlin)
    set_datadir("$FindBin::RealBin/data");
}

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

if ($advanced) {
    Karte::preload(':all');
    require BBBikeAdvanced;
}

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

if ($verbose) {
    set_verbose();
}

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

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

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

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

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

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

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

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

change_net_type();

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

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

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

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

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

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

#XXXXXX
#  *rot_text = \&rot_text_old;
#  if (0) { # XXX rot_text_newer ist wesentlich *langsamer* als rot_text_old
#      # X11::Protocol scheint Speicherfresser zu sein
#      use vars qw($use_rotx11font); # XXX
#      if (!defined $x11) {
#  	eval '
#  	    require X11::Protocol;
#  	    $x11 = X11::Protocol->new;
#  	    use lib "$ENV{HOME}/devel";
#  	    require Tk::RotX11Font;
#  	    if ($use_font_rot) {
#  		$use_rotx11font = 1;
#  		*rot_text = \&rot_text_newer;
#  	    }
#  	';
#      }
#  }

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

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

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

    # Es gibt gute Grnde, fr CloseMainWin kein Escape zu nehmen
    # (damit knnen Vorgnge abgebrochen werden) und fr CloseWin kein q
    # zu nehmen (weil in Dialogen evtl. Text eingegeben werden muss).
    $top->eventAdd(qw[<<CloseMainWin>> <Control-c> <q>]);
    $top->eventAdd(qw[<<CloseWin>>     <Control-c> <Escape>]);

    if ($os eq 'win') { # vorerst, Windows kann keine tearoffs
	$top->optionAdd("*tearOff", "false", "startupFile");
    }
    for (qw(background highlightBackground)) {
	$top->optionAdd("*$_", 'grey80', 'startupFile');
    }
    for (qw(Balloon CanvasBalloon)) {
	$top->optionAdd("*$_.background", '#C0C080', 'startupFile');
    }
    # Browse is for Tk::HistEntry::Browse
    for (qw(Browse Entry NumEntry Date*NumEntryPlain PathEntry
	    Listbox KListbox K2Listbox
	    TixHList HList Text ROText BrowseEntry.Entry SimpleHistEntry
	   )) {
	$top->optionAdd("*$_.background", "grey95", "startupFile");
    }
    for (qw(Scale Scrollbar)) {
	$top->optionAdd("*$_.troughcolor", "grey95", "startupFile");
    }
    for (qw(Button Checkbutton Radiobutton Menubutton
	    FlatCheckbox FlatRadiobutton FireButton)) {
	$top->optionAdd("*$_.cursor", "hand2", "startupFile");
    }

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


}

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


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

$focus_policy = 'click' if $exceed;

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

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

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

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

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

# Geometry
set_default_geometry();
geometry_dependent_settings();

# Zeichenstze
set_fonts();

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

## DEBUG_BEGIN
#BEGIN{mymstat("after mk_power_txt BEGIN");} mymstat("after mk_power_txt");
## 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;
    }
    $want_extends[GEOMETRY_HEIGHT] -= $menu_height;
}

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

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

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

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

# In ->Icon wird auch ein ->update durchgefhrt:
$top->Icon(-image => $srtbike_icon) if defined $srtbike_icon;
if ($splash_screen) {
    $splash_screen->Raise; # raise after the first ->update on $top, otherwise on Windows the splash screen will stay obscured by the main window
    $splash_screen->Update(0.0);
}

# XXX Folgendes ist obsolet:
# XXX berprfen, ob idletasks width bei win32 setzt... wine macht es
# jedenfalls nicht
#$top->idletasks; # um width und height festzulegen
#$top->update; # besser als idletasks, damit splash_screen neu gezeichnet wird

# Mit strictMotif kann man zwar Extra-Space um Buttons herum verhindern,
# allerdings hat man dann auch keine Key bindings wie C-a.
#$Tk::strictMotif = 1;

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

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

# Zeichenstze fr Straennamen
if ($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"};
    if (!check_font($rot_font_sub->(120))) {
	undef $rot_font_sub;
    }
}
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"};
}
if ($font_family =~ /nimbus/) {
    $rot_bold_font_sub  = sub { "-*-nimbus sans l-bold-r-condensed--0-" . $_[0]
				  . "-0-0-p-0-iso8859-1"};
    if (!check_font($rot_bold_font_sub->(120))) {
	undef $rot_bold_font_sub;
    }
}
if (!$rot_bold_font_sub) {
    my $font_family = "helvetica";
    $rot_bold_font_sub  = sub { "-*-$font_family-bold-r-normal--0-" . $_[0]
				  . "-0-0-p-0-iso8859-1"};
}
%category_rot_font =
  ('N'   => $rot_font_sub,
   'NN'  => $rot_font_sub,
   'H'   => $rot_bold_font_sub,
   'HH'  => $rot_bold_font_sub,
   'B'   => $rot_bold_font_sub,
   'BAB' => $rot_bold_font_sub,
   'W'   => $rot_bold_font_sub);

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

$km_frame = $top_frame->Frame(-relief => 'raised',
				 -bd => 1);
my $kmcb = $km_frame->Button
    (-textvariable => \$unit_km,
     -class => 'FlatBut',
     -command => sub {
	 $unit_km = ($unit_km eq 'km' ? 'm' : 'km');
	 updatekm();
     },
    )->pack;
#  my $kmcbm = $km_frame->Menu(-title => "Meter");
#  $kmcbm->radiobutton(-label => 'km',
#  		    -variable => \$unit_km,
#  		    -value => 'km',
#  		    -command => sub { &updatekm;
#  				      $kmcb->configure(-text => 'km');
#  				  }
#  		   );
#  $kmcbm->radiobutton(-label => 'm',
#  		    -variable => \$unit_km,
#  		    -value => 'm',
#  		    -command => sub { &updatekm;
#  				      $kmcb->configure(-text => 'm');
#  				  }
#  		   );
#  menuright($kmcb, $kmcbm);
#  $balloon->attach($kmcbm, -msg => ['',
#  				  'Streckenangabe in Kilometer',
#  				  'Streckenangabe in Meter']);
if ($km_frame->can('UnderlineAll')) { $km_frame->UnderlineAll }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

arrange_topframe();

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

$check_sub{'s'} = sub {
    plot("str",'s');
};
$check_sub{'l'} = sub {
    plot("str",'l');
};
$check_sub{'u'} = sub {
    $p_draw{'u'} = $str_draw{'u'};
    $progress->InitGroup;
    plot("str",'u');
    plot("p",'u');
    $progress->FinishGroup;
};
$check_sub{'b'} = sub {
    $p_draw{'b'} = $str_draw{'b'};
    $progress->InitGroup;
    plot('str','b');
    plot('p','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';
	$top->optionAdd('*FlatCheckbox*background' => 'grey80',
			"startupFile");
	#$top->optionAdd('*FlatCheckbox*raiseOnEnter' => 1,#XXX???
	#		"startupFile"); # ist noch nicht so schn...
    }
    eval { require Tk::FlatRadiobutton };
    if (!$@) {
	$Radiobutton = 'FlatRadiobutton';
	$top->optionAdd('*FlatRadiobutton*background' => 'grey80',
			"startupFile");
    }
}

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

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

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

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

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

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

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

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

    my $strcmb = $misc_frame->Menubutton;
    $strcmb->focus;
    my $strcm = $strcmb->Menu(-title => M("Straen"));
    menu_entry_choose_ort
	($strcm, 's',
	 -accelerator => 's',
	 -strchooseortargs =>
	 {'-markstartifactive' => 1,
	  -completelistbutton => sub { choose_from_plz(-interactive => 1) },
	  -completelistbuttonlabel => M"Alle Straen",
	 },
	);
    $strcm->cascade(-label => M('Auswahl aus').' ...');
    {
	my $ausm = $strcm->Menu(-title => M("Auswahl aus").' ...');
	$strcm->entryconfigure('last', -menu => $ausm);
	$plzmcmd = $ausm->command
	    (-label => M"Komplette Straenliste",
	     -command => sub { choose_from_plz(-interactive => 1) });
	# XXX zusammenfassen
	$ausm->command
	  (-label => M"Telefonbuch-Datenbank (Strae)",
	   -command => sub {
	       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);
	       };
	       Telefonbuch::tk_str_dialog($top, $mark, $get_coord);
	   });
	$ausm->command
	  (-label => M"Telefonbuch-Datenbank (Name)",
	   -command => sub {
	       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);
	       };
	       Telefonbuch::tk_tel_dialog($top, $mark, $get_coord);
	   });
	if ($advanced) {
	    $ausm->command(-label => M"MySQL-DB",
			   -command => sub {
			       push @INC, "$FindBin::RealBin/miscsrc";
			       eval {
				   require TelbuchDBApprox;
				   TelbuchDBApprox::tk_choose($top);
			       };
			       if ($@) {
				   status_message($@, "die");
			       }
			   });
	}
    }
    $strcm->separator;
    $strcm->cascade(-label => M"Straenkategorien");
    {
	my $skm = $strcm->Menu(-title => M"Straenkategorien");
	$strcm->entryconfigure('last', -menu => $skm);
	my @l = ([M"wichtige Hauptstraen", 'HH'],
		 [M"Hauptstraen", 'H'],
		 [M"Nebenstraen", 'N'],
		 [M"fr Kfz gesperrte Straen", 'NN']);
	if ($advanced) {
	    unshift @l, [M"Autobahnen", 'BAB'];
	}
	foreach (@l) {
	    $skm->checkbutton
	      (-label => $_->[0],
	       -variable => \$str_restrict{'s'}->{$_->[1]},
	       -command => sub {
		   pending(1, 'replot-str-s');
	       },
	      );
	}
    }
    $strcm->checkbutton(-label => M"Hhenangaben",
			-variable => \$p_draw{'hoehe'},
			-command => sub { plot('p','hoehe') });
    $strcm->checkbutton(-label => M"Radwege",
			-variable => \$str_draw{'rw'},
			-command => sub { plot('str','rw')},
			-accelerator => 'R',
		       );
    my $radwege_check_index = $strcm->index('last');
    $strcm->cascade(-label => M"Radwegekategorien");
    {
	my $rkm = $strcm->Menu(-title => M"Radwegekategorien");
	$strcm->entryconfigure('last', -menu => $rkm);
	foreach my $t (@Radwege::category_order) {
	    my $cat_code = $Radwege::category_code{$t} || '';
	    next if $cat_code eq 'RW0';
	    $rkm->checkbutton
	      (-label => $Radwege::category_name{$t},
	       -variable => \$str_restrict{'rw'}->{$cat_code},
	       -command => sub {
		   pending(1, 'replot-str-rw');
	       },
	      );
	}
    }

    $strcm->checkbutton(-label => M"Einbahn-/gesperrte Straen",
			-variable => \$p_draw{'sperre'},
			-command => sub { plot_sperre() },
			-accelerator => 'g',
		       );
    my $sperre_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Fhren",
			-variable => \$str_draw{'e'},
			-command => sub { plot('str','e') });
    $strcm->checkbutton(-label => M"Ampeln",
			-variable => \$p_draw{'lsa'},
			-command => sub { plot('p','lsa') },
			-accelerator => 'a',
		       );
    my $ampeln_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Outline zeichnen",
			-variable => \$str_outline{'s'},
			-command => sub {
			    pending(1, 'replot-str-s');
			},
		       );
    if ($os ne 'win' || $advanced) {
	# No rotation on win possible.
	$strcm->checkbutton(-label => M"Straennamen",
			    -variable => \$str_name_draw{'s'},
			    -command => sub {
				pending(1, 'replot-str-s');
			    },
			   );
    }
    $strcm->checkbutton(-label => M"Straenqualitt",
			-variable => \$str_draw{'qs'},
			-command => sub { plot('str','qs') },
			-accelerator => 'Q',
		       );
    my $qualitaet_check_index = $strcm->index('last');
    $strcm->cascade(-label => M"Qualittskategorien");
    {
	my $qm = $strcm->Menu(-title => M"Qualittskategorien");
	$strcm->entryconfigure('last', -menu => $qm);
	foreach (0 .. 3) {
	    my $cat = "Q$_";
	    my $label = $category_attrib{$cat}->[ATTRIB_SINGULAR];
	    $qm->checkbutton
	      (-label => $label,
	       -variable => \$str_restrict{'qs'}->{$cat},
	       -command => sub {
		   $str_restrict{'ql'}->{$cat} =
		       $str_restrict{'qs'}->{$cat};
		   pending(1, 'replot-str-qs');
		   pending(1, 'replot-str-ql');
	       },
	      );
	}
    }
    $strcm->checkbutton(-label => M"Sonstige Behinderungen",
			-variable => \$str_draw{'hs'},
			-command => sub { plot('str','hs') },
		       );
    my $handicap_check_index = $strcm->index('last');
    $strcm->checkbutton(-label => M"Unbeleuchtete Straen",
			-variable => \$str_draw{'nl'},
			-command => sub { plot('str','nl') },
		       );
    $strcm->checkbutton(-label => M"Grne Wege",
			-variable => \$str_draw{'gr'},
			-command => sub { plot('str','gr') },
		       );
    $strcm->checkbutton(-label => M"Vorfahrt",
			-variable => \$p_draw{'vf'},
			-command => sub { plot('p','vf') },
		       );
    my $fragezeichen_check_index;
    if ($advanced and $devel_host) {
	$strcm->checkbutton(-label => M"Fragezeichen",
			    -variable => \$str_draw{'fz'},
			    -command => sub { plot('str','fz') },
			    -accelerator => '?',
			   );
	$fragezeichen_check_index = $strcm->index('last');
    }
    if ($advanced) {
	$strcm->checkbutton(-label => M"Kommentare",
			    -variable => \$str_draw{'comm'},
			    -command => sub { plot('str','comm') },
			   );
	$strcm->checkbutton
	    (-label => M"Steigungen",
	     -variable => \$str_draw{'mount'},
	     -command => sub {
		 my $comm = Strassen->new("comments");
		 my $comm_mount = Strassen->new_copy_restricted($comm, -grep => ["St;"]);
		 my $mount = MultiStrassen->new($str_file{"mount"},
						$comm_mount);
		 plot('str','mount', -object => $mount);
	     },
	    );
    }
    menu_entry_up_down($strcm, $tag_group{'str_s'});
    menuright($strasse_check, $strcm);
    menuarrow($strcmb, $strcm, $col++, -special => 'LAYER');

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

    my $lstrcmb = $misc_frame->Menubutton;
    my $lstrcm = $lstrcmb->Menu(-title => M"Landstraen");
    menu_entry_choose_ort($lstrcm, 'l',
			  -accelerator => 'l',
			  -strchooseortargs => {'-markstartifactive' => 1});
    $lstrcm->separator;
    $lstrcm->checkbutton(-label => M"Outline zeichnen",
			 -variable => \$str_outline{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
			);
    $lstrcm->checkbutton(-label => M"Landstraen jwd zeichnen",
			 -variable => \$str_far_away{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
			 -accelerator => 'L',
			);
    my $land_jwd_check_index = $lstrcm->index('last');
    $lstrcm->checkbutton(-label => M"Straennamen",
			 -variable => \$str_name_draw{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
		       );
    $lstrcm->checkbutton(-label => M"Straennummern",
			 -variable => \$str_nr_draw{'l'},
			 -command => sub {
			     pending(1, 'replot-str-l');
			 },
		       );
    $lstrcm->checkbutton(-label => M"Straenqualitt",
			 -variable => \$str_draw{'ql'},
			 -command => sub { plot('str','ql') },
			 -accelerator => 'Q',
			);
    my $qualitaet_l_check_index = $lstrcm->index('last');
    $lstrcm->checkbutton(-label => M"Sonstige Behinderungen",
			 -variable => \$str_draw{'hl'},
			 -command => sub { plot('str','hl') },
			);
    my $handicap_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 #####
    $ort_photo = load_photo($misc_frame, 'ort.' . $default_img_fmt);
    my $ort_check = $misc_frame->$Checkbutton
      (image_or_text($ort_photo, 'Ort'),
       -variable => \$p_draw{'o'},
       -command => $check_sub{'o'},
      )->grid(-row => $curr_row, -column => $col, -sticky => 's');
    $balloon->attach($ort_check, -msg => M"Orte im Umland");
    $ch->attach($ort_check, -pod => "^\\s*Ort-Symbol");

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

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

    my $ubcmb = $misc_frame->Menubutton;
    my $ubcm = $ubcmb->Menu(-title => M"U-Bahn");
    menu_entry_choose_ort($ubcm, 'u', -accelerator => 'u',
			  -pchooseortargs => {'-markstartifactive' => 1});
    $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->separator;
    foreach ([M"VBB-Zone Berlin A", 'UA'],
	     [M"VBB-Zone Berlin B", 'UB'],
	     [M"in Bau", 'U0'],
	    ) {
	$ubcm->checkbutton(-label => $_->[0],
			   -variable => \$str_restrict{'u'}->{$_->[ATTRIB_PLURAL]},
			   -command => sub {
			       $progress->InitGroup;
			       pending(1, 'replot-str-u');
			       pending(1, 'replot-p-u');
			       $progress->FinishGroup;
			   },
			  );
    }
    menu_entry_up_down($ubcm, $tag_group{'str_u'});
    menuright($ubahn_check, $ubcm);
    menuarrow($ubcmb, $ubcm, $col++,
	      -menulabel => M"U-Bahn", -special => 'LAYER');

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

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

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

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

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

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

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

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

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

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

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

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

## DEBUG_BEGIN
#mymstat("iconframe: map button");
## DEBUG_END
    if (!$no_map) {
###### Zuschalten einer realen Karte #####
	my $map_photo = load_photo($misc_frame, 'map.' . $default_img_fmt);
	my $karte_check = $misc_frame->$Checkbutton
	  (image_or_text($map_photo, 'Map'),
	   -variable => \$map_draw,
	   -command => sub { getmap($c->get_center, undef, -from_check => 1) },
	  )->grid(-row => $curr_row, -column => $col, -sticky => 's');
	$balloon->attach($karte_check, -msg => M"reale Karte");
	$ch->attach($karte_check, -pod => "^\\s*Karten-Symbol");

	my $kcmb = $misc_frame->Menubutton;
	my $kcm = $kcmb->Menu(-title => M"reale Karte");
	my $set_default_type;
	foreach (@Karte::map) {
	    my $o = $Karte::map{$_};
	    if ($o->can('coord')) { # check auf Karten-Funktion
		$kcm->radiobutton(-label => $o->name,
				  -variable => \$map_default_type,
				  -value => $o->token,
				 );
	    }
	    if ($_ eq 'brbmap') {
		my $index = $kcm->index('last');
		push @edit_mode_brb_cmd, sub { $kcm->invoke($index) };
	    } elsif ($_ eq 'berlinmap') {
		my $index = $kcm->index('last');
		push @edit_mode_b_cmd, sub { $kcm->invoke($index) };
	    }
	}

	$kcm->separator;
	$kcm->checkbutton(-label => M"WWW",
			  -variable => \$do_wwwmap,
			 );
	$kcm->checkbutton(-label => M"WWW-Cache",
			  -variable => \$use_wwwcache,
			 );
	$kcm->separator;
	$kcm->checkbutton(-label => M"mit Umgebung",
			  -variable => \$map_surround,
			 );
	$kcm->checkbutton(-label => M"mehrere Karten",
			  -variable => \$dont_delete_map,
			 );
	$kcm->command(-label => M"Karten lschen",
		      -command => \&delete_map,
		     );
	$kcm->separator;
	foreach my $color ([M"Farbe (Photo)", 'color'],
			   [M"Farbe (Pixmap)", 'pixmap'],
			   [M"Graustufen", 'gray'],
			   [M"Schwarz/Wei", 'mono'],
			  ) {
	    $kcm->radiobutton(-label => $color->[0],
			      -variable => \$map_color,
			      -value => $color->[1],
			     );
	}
	menu_entry_up_down($kcm, $tag_group{'map'});
	menuright($karte_check, $kcm);
	menuarrow($kcmb, $kcm, $col++,
		  -menulabel => M"Karte", -special => 'LAYER');
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    #####

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

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

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

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

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

    #####

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

    my $reset_photo = load_photo($misc_frame2, 'cross.' . $default_img_fmt);
    my $reset_button = $misc_frame2->Button
	(image_or_text($reset_photo, 'X'),
	 -command => \&reset_button_command,
	 )->grid(-row => $curr_row, -column => $col++, -sticky => 's');
    $balloon->attach($reset_button, -msg => M"Route zurcksetzen");
    $ch->attach($reset_button, -pod => "^\\s*Route zurcksetzen");

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

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

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

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

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

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

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

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

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

    foreach my $fmt (['Postscript', 'ps'],
		     ['PNG',        'png'],
		     ['GIF',        'gif'],
		     ['JPEG',       'jpeg'],
		     ['PPM',        'ppm'],
		    ) {
	$svm->command(-label => "$fmt->[0]",
		      -command => sub {
			  $svm->after(50, sub { export_visible_map($fmt->[1]) });
		      });
    }
    $svm->separator;
    $svm->command(-label => M"Postscript-Auflsung:",
		  -state => "disabled",
		  -font => $font{"bold"});
    {
    my(%sizes) = (36 => 0, 72 => 0, 100 => 0, 150 => 0);
	$sizes{int($top_dpi)}++;
	foreach my $size (sort { $a <=> $b } keys %sizes) {
	    $svm->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 (
		     'PDF',
		     'XFig',
		     'bbd (BBBike data)',
		     ($advanced ? 'ESRI' : ()),
		     #'-',
		     ['G7toWin (ASCII)', 'G7toWin_ASCII'],
		     ['GPSMAN (Tracklog)', 'GpsmanData'],
		     ['Waypoint+ (Track)', 'WaypointPlus'],
		     '-',
		     ['Send Route to Garmin', 'DirectGarmin'],
		     ['Simulate send to Garmin', 'DirectGarmin_Test'],
		    ) {
	if ($fmt eq '-') {
	    $svm->separator;
	} elsif ($fmt eq 'PDF') {
	    $svm->command
		(-label => $fmt,
		 -command => \&pdf_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 =~ /^bbd/) {
	    if (-x "$FindBin::RealBin/miscsrc/bbr2bbd") {
		$svm->command
		    (-label => $fmt,
		     -command => \&save_route_as_bbd
		    );
	    }
	} elsif ($fmt =~ /^esri/i) {
	    if (-x "$FindBin::RealBin/miscsrc/bbd2esri" &&
		-x "$FindBin::RealBin/miscsrc/bbr2bbd"
	       ) {
		$svm->command
		    (-label => $fmt,
		     -command => \&save_route_as_esri
		    );
	    }
	} elsif (ref $fmt eq 'ARRAY') {
	    $svm->command
		(-label => "$fmt->[0]",
		 -command => sub { gps_interface(@$fmt) },
		);
	}
    }

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

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

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

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

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

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

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

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

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

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

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

### not yet..., see start_followmouse()
#      $opbm->checkbutton(-label => M"Followmouse",
#  		       -variable => \$followmouse,
#  		       -command => sub {
#  			   if ($followmouse) {
#  			       start_followmouse();
#  			   } else {
#  			       stop_followmouse();
#  			   }
#  		       },
#  		      );
    if ($advanced) {
	stderr_menu($opbm);
    }
    $opbm->checkbutton(-label => M"Wortreich (verbose)",
		       -variable => \$verbose,
		       -command => \&set_verbose);
    if ($advanced) {
	$opbm->command
	    (-label => M"Update ber das Internet",
	     -command => sub {
		 if ($devel_host) {
		     die "Kein Update auf cabulja/vran/cvrsnica/spiff mglich!!!\n";
		 }
		 require Tk::Dialog;
		 if ($top->Dialog
		     (-title => M"Update",
		      -text => M("Soll das Update gestartet werden?\nJe nach Internet-Verbindung und Stand der Daten\nkann das Update 5 bis 10 Minuten dauern.\nAlternativ knnen die Dateien manuell von\n$BBBike::BBBIKE_UPDATE_WWW/data\ngeholt und in das Verzeichnis\n$FindBin::RealBin/data\nkopiert werden.\n"),
		      -bitmap => 'question',
		      -buttons => [M"Ja", M"Nein"])->Show eq M"Ja") {
		     require Update;
		     Update::bbbike_data_update();
		 }
	     },
	    );
    }
    $opbm->command(-label => M"Alarmliste",
		   -command => sub {
		       require BBBikeAlarm;
		       BBBikeAlarm::tk_show_all();
		   },
		  );

    {
	package Tk::LazyMenu;
	@Tk::LazyMenu::ISA = qw(Tk::Menu);
	Construct Tk::Widget 'LazyMenu';
	sub postcascade {
	    my $w = shift;
	    if (!$w->{'job_done'}
		&& $w->index("active") eq $w->index(main::M("Letzte geffnete Layer")."...")) {
		my $m = $w->entrycget("active", -menu);
		{ package main; require BBBikeAdvanced; }
		$main::last_loaded_layers_obj =
		    {
		     List => [],
		     File => "$main::bbbike_configdir/last_layers",
		     Menu => $m,
		     Title => main::M("Letzte Layer").":",
		     Cb => sub { main::plot_additional_layer_s($_[0]) },
		     Max => 8,
		    };
		main::load_last_loaded($main::last_loaded_layers_obj);
		$w->{'job_done'} = 1;
	    }
	    $w->SUPER::postcascade(@_);
	}
    }

    # XXX it would be nice to use autouse in the following callbacks,
    # but it does not work because of artificial restrictions in
    # autouse.pm
    # XXX This menu is duplicated in setting and map layers. It should not.
    $opbm->cascade(-label => M"Zustzlich zeichnen ...");
    {
	my $cusm = $opbm->LazyMenu(-title => M"Zustzlich zeichnen ...");
	$BBBike::Menubar::additional_layer_menu = $cusm;
	$BBBike::Menubar::additional_layer_menu = $BBBike::Menubar::additional_layer_menu; # peacify -w
	$cusm->{BBBike_Menulabel} = M"Zustzliche Kartenebenen";
	$opbm->entryconfigure('last', -menu => $cusm);
	$cusm->command(-label => M"Zustzliche Layer",
		       -state => 'disabled',
		       -font => $font{'bold'});
	$cusm->command(-label => M"Straen-Layer zeichnen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_plot_additional_layer('str') });
	if ($advanced) {
	    $cusm->command(-label => M"Sperrungen-Layer zeichnen", # XXX label? in advanced mode because there is no way to delete the blockings from net!
			   -command => sub {
			       require BBBikeAdvanced;
			       plot_additional_sperre_layer() });
	}
	$cusm->command(-label => M"Punkte-Layer zeichnen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_plot_additional_layer('p') });
	$cusm->command(-label => M"Straen/Punkte auswhlen",
		       -command => sub {
			   require BBBikeAdvanced;
			   choose_from_additional_layer() });
	$cusm->cascade(-label => M("Letzte geffnete Layer")."...",
		       -menu => $cusm->Menu);
	if ($Tk::platform ne 'MSWin32') {
	    $cusm->command(-label => M"Umordnen",
			   -accelerator => 'Shift-X',
			   -command => sub {
			       require BBBikeAdvanced;
			       layer_editor() });
	}
	$cusm->command(-label => M"Layer lschen",
		       -command => sub {
			   require BBBikeAdvanced;
			   delete_additional_layer() });
	$cusm->command(-label => M"Ausschnitt an Layer anpassen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_zoom_view_for_layer() });
	$cusm->command(-label => M"Scrollregion an Layer anpassen",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_set_scrollregion_for_layer() });
	$cusm->command(-label => M"Scrollregion fr Layer vergrern",
		       -command => sub {
			   require BBBikeAdvanced;
			   tk_enlarge_scrollregion_for_layer() });
	if ($advanced) {
	    $cusm->checkbutton(-label => M"Linienbreite 1 Punkt",
			       -variable => \$default_line_width,
			       -offvalue => undef, # XXX don't work,
                                                   # set to 0... ???
			       -onvalue => 1,
			      );
	}
	$cusm->separator;
	$cusm->command(-label => M"Gpsman-Daten zeichnen",
		       -command => sub {
			   draw_gpsman_data($top);
		       });
	$cusm->command(-label => M"GPS-Track-Animation",
		       -command => sub {
			   require BBBikeAdvanced;
			   gps_animation($top);
		       });
    }

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

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

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

    $hpbm->checkbutton(-label => M"Maushilfe",
		       -command => \&toggle_mouse_help,
		       -variable => \$show_mouse_help,
		      );
    if ($use_contexthelp) {
	$hpbm->command(-label => M"Kontexthilfe",
		       -command => sub { $ch->activate });
    }
    my $bbbike_html = Tk::findINC("bbbike.html");
    my $url;
    if (defined $bbbike_html && -r $bbbike_html) {
	$url = "file:$bbbike_html";
	$hpbm->command
	  (-label => M"Dokumentation (lokal)",
	   -command => sub {
	       require WWWBrowser;
	       WWWBrowser::start_browser($url);
	   });
    }
    $hpbm->command
      (-label => M"Dokumentation (WWW)",
       -command => sub {
	   my $url = "$BBBike::BBBIKE_SF_WWW/bbbike/bbbike.html";
	   require WWWBrowser;
	   WWWBrowser::start_browser($url);
       });
    $hpbm->command(-label => M('ber').' ...',
		   -command => sub { show_logo('as_about') });
    $hpbm->command(-label => M"Busy-Zeiger zurcksetzen",
		   -command => sub { ResetBusy($top) });
    menuright($help_button, $hpbm);
    menuarrow($hpbmb, $hpbm, $col++, -menulabel => M"~Hilfe");

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

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

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

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

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

    arrange_symframe();

    $ampelstatus_label = $sym_frame->Label(-justify => "left")->grid
      (-row => 0, -column => 2, -sticky => 'n');

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

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

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

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

} # do_iconframe

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

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

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

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

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

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

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

my $sy = $canvas_frame->Scrollbar(-command => ["yview", $c],
				  -takefocus => 0,
				  -highlightthickness => 0,
				 );
my $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 $BBBikeExp::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 $BBBikeExp::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;
		},
	     );

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

if ($c->can('DropSite')) {
    eval {
	$c->DropSite
	  (-dropcommand => [\&accept_drop, $c],
	   -droptypes => ($os eq 'win' ? 'Win32' : ['KDE', 'XDND', 'Sun'])
	  );
	warn M("Datei-DND wird akzeptiert") if $verbose;
    };
    warn __LINE__ . ": $@" if $@ && $verbose;
}

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

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

$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;
    if (!$stderr) {
	require Tk::SRTProgress;
	Tk::SRTProgress->VERSION(0.06);
	$progress = $status_frame->SRTProgress
	  (-relief => 'sunken',
	   -borderwidth => 2,
	   -visible => 0,
	   -width => $top->width/10,
	  )->grid(-row => 0,
		  -column => $gridx++,
		  -sticky => 'ew');
    } else {
	require Tk::TextProgress;
	$progress = new Tk::TextProgress;
    }
    $status_label = $status_frame->Label(-justify => 'left', -anchor => 'w')
      ->grid(-row => 0, -column => $gridx++, -sticky => 'ew');

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

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

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

##### initiales Zeichnen ######################################
## DEBUG_BEGIN
#BEGIN{mymstat("before init draw BEGIN");} mymstat("before init draw");
## DEBUG_END
$progress->InitGroup;
if ($set_mode) {
    require BBBikeAdvanced;
    switch_mode($set_mode);
}
foreach (keys %init_str_draw) {
    $str_draw{$_} = $init_str_draw{$_};
    eval {
	plot('str',$_)   if $str_draw{$_};   # Strecken plotten
    };
    if ($@ && !$no_original_datadir) {
	die $@;
    }
}
foreach (keys %init_p_draw) {
    $p_draw{$_}   = $init_p_draw{$_};
    eval {
	plot('p',$_)     if $p_draw{$_};     # Punkte (z.B. Ampeln) zeichnen
    };
    if ($@ && !$no_original_datadir) {
	die $@;
    }
}
# Hhen einlesen
read_hoehe()  if $show_grade || $steigung_optimierung || $use_hoehe;
read_ampeln() unless $lowmem;
read_sperre_tragen() unless $lowmem;
plot_sperre() if $p_draw{'sperre'};

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

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

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

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

set_bindings();

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

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

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

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

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

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

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

set_mouse_desc();

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

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

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

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

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

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

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

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

if ($turbo) {
    bbbikeexp_init();
}

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

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

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

choose_streets()                            if $init_choose_street;

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

MainLoop unless $ENV{BBBIKE_TEST_PERFORMANCE};

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

sub load_photos {
    $flag_photo{'start'} = load_photo($top, 'flag2_bl.' . $default_img_fmt);
    $flag_photo{'via'}   = load_photo($top, 'flag_via.' . $default_img_fmt);
    $flag_photo{'ziel'}  = load_photo($top, 'flag_ziel.' . $default_img_fmt);
    $ampel_photo         = load_photo($top, 'ampel.' . $default_img_fmt);
    $ampel_klein2_photo  = load_photo($top, 'ampel_klein2.' . $default_img_fmt);
    $andreaskr_klein_photo = load_photo($top,
					'andreaskr_klein.' . $default_img_fmt);
    $andreaskr_klein2_photo= load_photo($top,
					'andreaskr_klein2.' . $default_img_fmt);
    $andreaskr_photo     = load_photo($top, 'andreaskr.' . $default_img_fmt);
    $vorfahrt_photo      = load_photo($top, 'vorfahrt.' . $default_img_fmt);
    $windrose2_photo     = load_photo($top, 'windrose2.' . $default_img_fmt);
    $kneipen_photo       = load_photo($top, 'glas.' . $default_img_fmt);
    $kneipen_klein_photo = load_photo($top, 'glas_klein.' . $default_img_fmt);
    $essen_photo         = load_photo($top, 'essen.' . $default_img_fmt);
    $essen_klein_photo   = load_photo($top, 'essen_klein.' . $default_img_fmt);
    $kino_klein_photo    = load_photo($top, 'kino_klein.' . $default_img_fmt);
    $steigung_photo      = load_photo($top, 'steigung.' . $default_img_fmt);
    $gefaelle_photo      = load_photo($top, 'gefaelle.' . $default_img_fmt);
    $inwork_photo        = load_photo($top, 'inwork.' . $default_img_fmt);
    $ferry_photo         = load_photo($top, 'ferry.' . $default_img_fmt);
    $ferry_klein_photo   = load_photo($top, 'ferry_klein.' . $default_img_fmt);
}

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

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


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

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

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

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

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

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

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

	 'green1' => '#7fbb7f',
	 'green2' => '#008b00',
	);
    %category_font_color =
	(
	 'W'  => '#2a45b7',
	 'U'  => '#000060',
	 'S'  => '#006000',
	 'R'  => '#006000', 	# altes Farbschema
	 #   'R'  => '#a00000',# neues Farbschema
	);
    for (qw(UA UB U0)) { $category_font_color{$_} = $category_font_color{"U"} }
    for (qw(SA SB SC S0)) { $category_font_color{$_} = $category_font_color{"S"} }
    for (qw(RA RB RC R0)) { $category_font_color{$_} = $category_font_color{"R"} }
    %category_font =
	(
	 'W'  => 'helvetica %d italic',
	 'P'  => 'helvetica %d',
	 'Pabove' => 'helvetica %d',
	 'Ae' => 'helvetica %d',
	);

    $pp_color = '#008000';

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

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

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

    %line_arrow =
	('PI' => 'last',
	 'P0' => 'last',
	);
    %line_shorten =
	('CP' => 1,
	 'P0' => 1,
	 'PI' => 1,
	);
    # Label size per category
    %category_size =
	('N'  => 8,
	 'NN' => 7,
	 'H'  => 10,
	 'HH' => 10,
	 'B'  => 10,
	 'BAB'=> 10,
	 'W'  => 12);
    %outline_color =
	('s' => 'grey70',
	 'l' => 'grey70',
	 'w' => 'blue4',
	 'i' => 'blue4',
	);
    %str_file =
	('s'  => $str_file,
	 'l'  => $landstr_file, # XXX scoped
	 'u'  => 'ubahn',
	 'b'  => 'sbahn',
	 'r'  => 'rbahn',
	 'w'  => $wasser_file,	# XXX scoped
	 'f'  => $flaechen_file,
	 'v'  => 'sehenswuerdigkeit',
	 'z'  => $plz_file,
	 'g'  => $border_file,
	 'gP' => "potsdam",
	 'gD' => "deutschland",
	 'e'  => 'faehren',
	 'rw' => 'radwege',
	 'qs' => 'qualitaet_s',
	 'ql' => 'qualitaet_l',
	 'hs' => 'handicap_s',
	 'hl' => 'handicap_l',
	 'nl' => 'nolighting',
	 'gr' => 'green',
	 'comm' => 'comments',
	 'mount' => 'mount',
	 'fz' => "$FindBin::RealBin/misc/fragezeichen", # only for development
	);
    foreach my $type (@comments_types) {
	$str_file{"comm-$type"} = "comments-$type";
    }
    %p_file =
	('lsa'    => 'ampeln',
	 'u'      => 'ubahnhof',
	 'b'      => 'sbahnhof',
	 'r'      => 'rbahnhof',
	 'o'      => 'orte',	# XXX scoped
	 'sperre' => $sperre_file,
	 'obst'   => 'obst',
	 'pl'     => 'plaetze',
	 'vf'     => 'vorfahrt',

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

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

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

    # fr Orte und Sonstiges
    $xadd_anchor_type->{'o'} = {'w' => 4, 'n' => 0, 'e' => -4, 's' => 0,
				'nw' => 2, 'sw' => 2};
    $yadd_anchor_type->{'o'} = {'w' => 0, 'n' => 1, 'e' => 0,  's' => -1,
				'nw' => 1, 'sw' => -1};
    # fr Routen
    $xadd_anchor_type->{'route'} = {'w' => 10, 'n' => 0, 'e' => -10, 's' => 0,
				    'nw' => 5, 'sw' => 5};
    $yadd_anchor_type->{'route'} = {'w' => 0, 'n' => 10, 'e' => 0,  's' => -10,
				    'nw' => 5, 'sw' => -5};
    # U-Bahnsymbole
    $xadd_anchor_type->{'u'} = {'w' => 8, 'n' => 0, 'e' => -8, 's' => 0,
				'nw' => 5, 'sw' => 5};
    $yadd_anchor_type->{'u'} = {'w' => 0, 'n' => 8, 'e' => 0,  's' => -8,
				'nw' => 5, 'sw' => -5};

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

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

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

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

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

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

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

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

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

		} elsif ($cat_hin =~ /^IMG:([^|]+)(?:\|ANCHOR:([^|]+))?$/) { # Bild, no $cat_rueck handling here
		    my $img = $1;
		    my $anchor = ($2 ? $2 : "c");
		    $img = Tk::findINC("data/$img");
		    my $p = $c->Photo(-file => $img);
		    # XXX this is leaking (photo never deleted...)
		    # XXX $abk-XXX => $abk-fg or $abk-img ?
		    # XXX use $abk-fg for now (scaling works!)
		    if ($p) {
			$c->createImage(@coordlist[0..1], -image => $p,
					-anchor => $anchor,
					-tags => [$abk, $strname,
						  "$abk-fg", "$abk-" . ($i-1)],
				       );
		    } 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-1)],
		      );

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

			# dicken Punkt zeichnen
			$c->createLine(@coordlist, @coordlist,
				       -fill => $this_color_hin,
				       -width => 5, # XXX skalieren
				       -capstyle => 'round',
				       -tags => [$abk, $strname,
						 "$abk-$cat_hin", "$abk-" . ($i-1),
						 @extra_tags],
				      );
		    } else {
			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"],
                               ($use_stippleline ? (-dash => $line_dash{$abk}) : ()),
			       (exists $line_arrow{$cat_hin} ? (-arrow => $line_arrow{$cat_hin}) : ()),
			      );
			}
			if (defined $cat_rueck) {
			    my %side_coordlist;
			    for my $dir (1, -1) {
				my($cl, $this_color, $this_width, $cat);
				if ($dir == 1 && $cat_hin ne '') {
				    $this_color = $this_color_hin;
				    $this_width = $this_width_hin/2;
				    $cat        = $cat_hin;
				    $cl         = [@coordlist],
				} elsif ($dir == -1 && $cat_rueck ne '') {
				    $this_color = $this_color_rueck;
				    $this_width = $this_width_rueck/2;
				    $cat        = $cat_rueck;
				    $cl         = [reverse @coordlist];
				} 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  => [$abk, $strname,
						"$abk-$cat", "$abk-" . ($i-1),
						@extra_tags],
				     ($use_stippleline ? (-dash => $line_dash{$abk}) : ()),
				     #(exists $line_arrow{$cat} ? (-arrow => $line_arrow{$cat}) : ()),
				     -arrow => "last",
				    );
			    }
			} else {
			    $c->createLine
				(@coordlist,
				 -fill      => $this_color_hin,
				 -width     => $this_width_hin,
				 -joinstyle => 'bevel',
				 -tags      => [$abk, $strname,
						"$abk-$cat_hin", "$abk-" . ($i-1),
						@extra_tags],
				 ($use_stippleline ? (-dash => $line_dash{$abk}) : ()),
				 (exists $line_arrow{$cat_hin} ? (-arrow => $line_arrow{$cat_hin}) : ()),
				);
			}

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

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

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

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

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

	    if ($abk =~ /^[ubr]$/) {
		$c->createLine($x-$ubahn_length, $y, $x+$ubahn_length, $y,
			       -tags => ["$abk-bg", $pointname, $xx, $yy]);
		$c->createText($x, $y,
			       -tags => ["$abk-fg", $pointname, $xx, $yy]);
	    } elsif ($abk eq 'lsa') {
		# keine Verwendung von _coord_as_string
		# XXX 'F' sollte mal ein leicht anderes Bild bekommen
		$c->createImage
		  ($x, $y,
		   -image => ($category eq 'B'
			      ? $andreaskr_photo
			      : $ampel_photo),
		   -tags => ["$abk-fg", "$xx,$yy",
			     "$abk-" . ($category eq 'B' ? 'B' : 'X') . "-fg"],
		  );
		$ampeln{"$xx,$yy"} = $category;
	    } elsif ($abk eq 'pl') {
		$c->createLine($x, $y, $x, $y,
			       -tags => ["$abk-fg", $pointname],
			      );
	    } elsif ($abk eq 'vf') {
		$c->createImage(transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][1])}),
				-tags => "$abk-fg");
		my($x1,$y1,$x2,$y2,$x3,$y3) =
		  (transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][0])}),
		   transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][1])}),
		   transpose(@{Strassen::to_koord1($ret->[Strassen::COORDS][2])}));
		my $len1 = Strassen::Util::strecke([$x1,$y1], [$x2,$y2]);
		my $whole_len1 = $len1 > 20 ? 20 : $len1;
		my $len2 = Strassen::Util::strecke([$x2,$y2], [$x3,$y3]);
		my $whole_len2 = $len2 > 20 ? 20 : $len2;
		my($cx1,$cy1,$cx2,$cy2,$cx3,$cy3)
		  = (($x1-$x2)/$len1*$whole_len1+$x2,
		     ($y1-$y2)/$len1*$whole_len1+$y2,
		     $x2,$y2,
		     ($x3-$x2)/$len2*$whole_len2+$x2,
		     ($y3-$y2)/$len2*$whole_len2+$y2,
		    );
		$c->createLine($cx1,$cy1,$cx2,$cy2,$cx3,$cy3,
			       -tags => "$abk-bg");
	    } elsif ($abk =~ /^L(\d+)/) {
		my $color = $category =~ /^\#/ ? $category : exists $category_color{$category} ? $category_color{$category} : undef;
		my $width = $category_width{$category} || 6;
		$c->createLine($x, $y, $x, $y,
			       (defined $color ? (-fill => $color) : ()),
			       -width => $width,
			       -tags => ["$abk-fg", "$xx,$yy", $pointname, "p-" . ($i-1), "L-fg"]);
	    } elsif ($abk =~ /^(kn|ki|rest)$/) {
		$c->createImage($x, $y,
				-tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . ($i-1)]);
	    } 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-1)]);
	    } else {
		# Else draw a generic point (broad, color from cat)
		my $color = $category_color{$category} || ($category =~ /^\#/ ? $category : 'red');
		my $width = $category_width{$category} || 6;
		$c->createLine($x, $y, $x, $y,
			       -fill => $color, -capstyle => 'round',
			       -width => $width,
			       -tags => ["$abk-fg", "$xx,$yy", $pointname, "$abk-" . ($i-1)]);
	    }
	    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{$abk} ||
			 !draw_text_intelligent
			 ($c, $x, $y,
			  -abk  => $name_draw_other,
			  -xadd => $xadd_anchor,
			  -yadd => $yadd_anchor,
			  -outline => 1,
			  %args,
			 )) {
		    outline_text($c,
				 $x+$xadd_anchor->{'w'},
				 $y+$yadd_anchor->{'w'},
				 -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];
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, $fullname, $label_tag."P$cat"],
			);
                }
		if ($name_o) {
		    my $text = ($args{Shortname}
				? $name
				: $fullname);
		    my(@tags) = ($label_tag, "$label_tag$cat");
		    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{$type} && !$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 => " $text",
					   -tags => \@tags,
					  );
			}
		    }
		}
	    }
	};
EOF
}

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

    foreach (qw(s 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)) {
	std_str_binding($_);
    }

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

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

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

    # Stack in tkstadtware fr dragging angucken! XXX
    $c->CanvasBind("<1>" => sub {
		       if ($map_mode =~ /^BBBike/) {
			   my $button_callback = $map_mode . '::button';
			   if (defined &$button_callback) {
			       my $e = $c->XEvent;
			       eval $button_callback.'($_[0], $e)';
			       die $@ if $@;
			       return;
			   }
		       } elsif ($map_mode eq MM_CUSTOMCHOOSE) {
			   set_route_point($c);
		       } elsif ($map_mode eq MM_SCRIBBLE) {
			   # XXX not Tk::Babybike!
			   Tk::Babybike::handle_button1_scribble($c,$c->XEvent);
		       }
		       return unless $map_mode eq MM_DRAG;
		       my $e = $c->XEvent;
		       $c->scan('mark', $e->x, $e->y);
		   });
    $c->CanvasBind('<B1-Motion>' => sub {
		       if ($map_mode eq MM_SCRIBBLE) {
			   # XXX not Tk::Babybike!
			   return Tk::Babybike::handle_button1_motion_scribble($c,$c->XEvent);
		       }
		       return unless $map_mode eq MM_DRAG;
		       my $e = $c->XEvent;
		       $c->scan('dragto', $e->x, $e->y, 1);
		   });

    set_b2();

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

    my $alt_mouse1 = sub {
	if ($alt_set_route_point{$map_mode}) {
	    return $alt_set_route_point{$map_mode}->(@_);
	}
	if ($map_mode eq MM_BUTTONPOINT) {
	    freerec_sub(@_);
	}
	freedraw_sub(@_);
    };

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

    if ($followmouse) {
	start_followmouse();
    }

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

    $top->protocol('WM_DELETE_WINDOW', \&exit_app_noninteractive);
    my($old_width, $old_height);
    $top->bind('<Configure>' => sub {
		   my $e = $top->XEvent;
		   return if !$e;
		   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;
		   }
	       });

    $top->bind("<<CloseMainWin>>" => \&exit_app);
    $top->bind("<Alt-r>" => \&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('<Control-Key-f>' => sub {
		   require BBBikeAdvanced;
		   search_anything();
	       });

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

    $top->bind("<P>" => sub {
		   require BBBikeAdvanced;
		   start_ptksh();
	       });
    $top->bind("<Control-R>" => sub {
		   require BBBikeAdvanced;
		   reload_new_modules();
	       });
    $top->bind("<S>" => sub {
		   if ($BBBikeExp::mode) {
		       bbbikeexp_clear();
		   } else {
		       bbbikeexp_init();
		   }
	       });
    $top->bind("<U>" => sub {
		   $map_mode = MM_USEREDIT;
		   set_cursor('delnet');
	       });
    if ($Tk::platform ne 'MSWin32') {
	$top->bind("<X>" => \&layer_editor);
    }
    $top->bind("<i>" => sub { show_info() });

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

    $top->bind("<BackSpace>" => \&mouse_dellast);
    $top->bind("<Shift-BackSpace>" => \&reset_button_command);
    $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}Next>"  => sub { $c->yview(scroll =>  5, 'units') });
	$top->bind("<${kp}Prior>" => sub { $c->yview(scroll => -5, 'units') });
	$top->bind("<${kp}Home>"  => sub { $c->xview(scroll => -5, 'units') });
	$top->bind("<${kp}End>"   => sub { $c->xview(scroll =>  5, 'units') });

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

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

}

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

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

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

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

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

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

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 'custom') {
	*set_coords = \&set_coords_custom;
    } else {
	*set_coords = \&set_coords_str;
    }
    if (defined $net) {
	make_net();
    }
}

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

sub draw_street_numbers {
    # the coloring is german specific
    my($c,$strname,$abk,$coordlist_ref) = @_;
    my($type,$nr) = Strasse::parse_street_type_nr($strname);
    if (defined $type) {
	my $dist = 0;
	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
		my($midx,$midy) = Strassen::Util::middle(@{$coordlist_ref}[$ci-2..$ci+1]);
		my $item = $c->createText
		    ($midx,$midy,-text => ($type =~ /^(B|BAB)$/ ? "" : $type) . $nr,
		     -fill => ($type eq 'BAB' ? 'white' :
			       ($type =~ /^(F|R)$/ ? 'green4' :
				'black')),
		     -tags => "$abk-label");
		my(@bbox) = $c->bbox($item);
		my $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",
		    );
		$c->raise($item,$r_item);
		$dist = 0;
	    }
	}
    }
}

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

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

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

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

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

    exit_app_noninteractive();
}

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

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

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

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

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

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

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

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

    calc_ampel_optimierung() if $ampel_optimierung;

    redraw_path() if $has_old;
}

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

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

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

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

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

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

    my_popup($t);
}

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

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

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

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

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

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

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

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

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

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

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

    my_popup($t);
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    $t->Popup(@popup_style);
}

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

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

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

# Kat     Scale	Res

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

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

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

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

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

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

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

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

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

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

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

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

    my_popup($t);

}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	    undef $search_route_flag;
	    search_route_mouse_cont();
	};

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

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

### AutoLoad Sub
sub save_route_as_esri {
    my $file = $top->getSaveFile(-defaultextension => '.shp');
    return unless defined $file;
    $file =~ s/\.shp$//;
    my $tmpfile1 = "$tmpdir/bbbike-$$.bbr";
    my $tmpfile2 = "$tmpdir/bbbike-$$.bbd";
    load_save_route(1, $tmpfile1);
    system("$FindBin::RealBin/miscsrc/bbr2bbd", $tmpfile1, $tmpfile2);
    system("$FindBin::RealBin/miscsrc/bbd2esri", $tmpfile2, "-o", $file);
    unlink $tmpfile2;
    unlink $tmpfile1;
}

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

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

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

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

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

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

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

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

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

    # Get source from filename or street object
    my($filename, $str);
    if (!defined $args{-object}) {
	$filename = $args{-filename} || $args{Filename};
	if (defined $filename) {
	    $str_file{$abk} = $filename;
	} else {
	    $filename = ($coord_system eq 'standard'
			 ? $str_file{$abk}
			 : "$str_file{$abk}-orig"
			);
	}
	delete $pending{"replot-str-$abk"};
	if (!defined $filename) {
	    status_message(Mfmt("Dateiname fr <%s> ist nicht definiert.", $abk),
			   'err');
	    return;
	}
    } else {
	$str = delete $args{-object};
	delete $str_file{$abk}; # XXX -orig?
    }

    if (defined $filename && -e "$filename.desc") {
	require BBBikeAdvanced;
	read_desc_file("$filename.desc");
    }

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

    my $dont_use_cache;
    my $dont_set_cache = 1;

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

    if (!defined $str) {
	cache_decider_init();
	if ($abk eq 'w') {
	    $str = _get_wasser_obj($filename);
	} elsif ($abk eq 'l') {
	    $str = _get_landstr_obj();
	} else {
	    eval { $str = new Strassen $filename };
	    if ($@) {
		if ($edit_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]$/) {
		# fr nearest_line_points Caching erzwingen
		$str_obj{$abk} = $str;
		if ($abk eq 'l') {
		    $str_cache_attr{'l'} = "$str_far_away{'l'}";
		    # XXX str_regions?
		}
	    }
	}
    }

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

    my $diffed_str = 0;
    #XXX Abfrage auf $edit_mode notwendig?
    if (($edit_mode || $abk eq 'relgps') && $args{FastUpdate}) {
	my($new_str, $todelref) = $str->diff_orig(-clonefile => 1);
	if (!defined $new_str) {
	    warn M("Diff-Ausgabe wird nicht verwendet") if $verbose;
	    $c->delete($abk);		# evtl. alte Koordinaten lschen
	    $c->delete("pp-$abk");
	} else {
	    warn M("Diff-Ausgabe wird verwendet") if $verbose;
	    foreach (@$todelref) {
		$c->delete("$abk-$_");
	    }
	    $str = $new_str;
	    $diffed_str = 1;
	}
    }

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

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

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

    my $coordsys = $coord_system_obj->coordsys;

#XXX del:
#      foreach ($str->file) {
#  	$old_mtime{$_} = (stat($_))[STAT_MODTIME];
#  	$mtime_file_type{$_} = ['str', $abk];
#      }

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

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

    destroy_delayed_restack();

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

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

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

	my $i = ($diffed_str ? "" : 0);
	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 $@; #die $@ if $@;

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

	    $draw_sub->($ret); # XXX evtl. den Code mit eval erzeugen
	}
# XXXXXX can this ever happen? XXXXXXXXXXXXXXXXXXXXXXXXXXX
if ($str->pos != scalar @{$str->{Data}}) { status_message("warning: " . $str->pos . " != " . scalar(@{$str->{Data}}) . "!", "dialog", "err") }
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
	warn sprintf "Plotting streets took %.3fs\n", Tk::Time_So_Far()-$bench
	    if $verbose;

      PLOTSTR_CONT:
	$c->itemconfigure('pp',
			  -capstyle => $capstyle_round,
			  -width => 5,
			  -fill => $pp_color,
			 );
	if ($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) {
	    if (defined $net && !$net->is_source($str)
		&& $abk =~ /^[sl]$/ && !$edit_mode) {
		make_net();
	    } elsif (!defined $net
		     && $abk =~ /^[sl]$/ && !$edit_mode) {
		make_net();
	    }
	}

	if (($edit_mode || $abk eq 'relgps') and !$diffed_str) {
	    warn "Try to copy original data" if $verbose;
	    my $r = $str->copy_orig;
	    warn "Returned $r" if $verbose;
	}

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

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

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

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

# Zeichnet gesperrte Straen und Einbahnstraen.
# XXX gesperrte Wegfhrungen werden noch nicht gezeichnet
### AutoLoad Sub
sub plot_sperre {
    my $file = shift;
    my %args = @_;
    my $abk = $args{-abk} || 'sperre';
    Hooks::get_hooks("before_plot")->execute;
    $c->delete($abk);
    if (!$p_draw{$abk}) {
	Hooks::get_hooks("after_plot")->execute; # XXX should not be here
	return;
    }
    IncBusy($top);
    eval {
	my $gesperrt = new Strassen (defined $file
				     ? $file
				     : ($coord_system eq 'standard'
					? $sperre_file
					: "$sperre_file-orig"
				       )
				    );

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

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

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

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

	# XXX don't duplicate code from plotstr!
	my $diffed_str = 0;
	my $str = $gesperrt;
	#XXX Abfrage auf $edit_mode notwendig?
	if ($edit_mode && $args{FastUpdate}) {
	    my($new_str, $todelref) = $str->diff_orig(-clonefile => 1);
	    if (!defined $new_str) {
		warn M("Diff-Ausgabe wird nicht verwendet") if $verbose;
		$c->delete($abk);		# evtl. alte Koordinaten lschen
		$c->delete("pp-$abk");
	    } else {
		warn M("Diff-Ausgabe wird verwendet") if $verbose;
		foreach (@$todelref) {
		    $c->delete("$abk-$_");
		}
		$str = $new_str;
		$diffed_str = 1;
		$gesperrt = $str;
	    }
	}

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

	    my($cat,@addinfo) = split ':', $ret->[Strassen::CAT];
	    if ($cat eq StrassenNetz::BLOCKED_CARRY) {
		if ($width0) { # grer 0
		    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, 'sperre0',
				       $ret->[Strassen::NAME], $abk.'-'.$pos],
			    );
		    }
		}
		next;
	    } elsif ($cat eq StrassenNetz::BLOCKED_NARROWPASSAGE) {
#XXX works, but write nicer...
		# if ($widthBNP) XXX
		my($x,$y) =
		    transpose(@{Strassen::to_koord1($kreuzungen[0])});

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

		line_shorten(\@c);

		# 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,
		     -fill => 'red', -width => $width3,
		     -smooth => 1,
		     -arrow => 'last',
		     -arrowshape => [4,6,3],
		     ($Tk::VERSION >= 800.016 ? (-dash => $line_dash{sperre3}) : ()),
		     -tags => [$abk, 'sperre3',
			       $ret->[Strassen::NAME], $abk.'-'.$pos],
		    );
		next;
	    }

	    my $i;
	    if ($cat eq StrassenNetz::BLOCKED_COMPLETE && $#kreuzungen == 0) {
		# ein bisschen schummeln ...
		push @kreuzungen, $kreuzungen[0];
	    }
	    for($i = 0; $i < $#kreuzungen; $i++) {
		my($x1,$y1) =
		  transpose(@{Strassen::to_koord1($kreuzungen[$i])});
		my($x2,$y2) =
		  transpose(@{Strassen::to_koord1($kreuzungen[$i+1])});
		my($xm,$ym) = (int(($x2-$x1)/2+$x1), int(($y2-$y1)/2+$y1));

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

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

	    }
	}

	if ($edit_mode and !$diffed_str) {
	    warn "Try to copy original data" if $verbose;
	    my $str = $gesperrt;
	    my $r = $str->copy_orig;
	    warn "Returned $r" if $verbose;
	}

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

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

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

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

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

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

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

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

# Gibt ein Landstraen-Objekt zurck.
### AutoLoad Sub
sub _get_landstr_obj {
    my @obj;
    push @obj, new Strassen ($coord_system eq 'standard'
			     ? $str_file{'l'}
			     : $str_file{'l'} . "-orig");
    if ($str_far_away{'l'}) {
	my $file = ($sfn ? "landstr2" : "landstrassen2");
	push @obj, new Strassen ($coord_system eq 'standard'
				 ? $file
				 : "$file-orig"); # XXX allgemeiner
    }
    if ($str_regions{'l'}) {
	foreach my $file (@{ $str_regions{'l'} }) {
	    push @obj, new Strassen ($coord_system eq 'standard'
				     ? $file
				     : "$file-orig"); # XXX allgemeiner
	}
    }
    return $obj[0] if (@obj == 1);
    new MultiStrassen @obj;
}

# 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);
    } elsif ($abk eq 'obst') {
	plotobst();
    } elsif ($abk eq 'hoehe') {
	plot_hoehe();
    } else {
	plot_point($abk, %args);
    }
}

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

# Zeichnen von Punkten. Hiermit werden U-/S-/R-Bahnhfe, Ampeln und alle
# sonstigen Punkte gezeichnet.
### AutoLoad Sub
sub plot_point {
    my($abk, %args) = @_;

    my $filename = $args{-filename} || $args{Filename};
    if (!defined $filename) {
	$filename = ($coord_system eq 'standard'
		     ? $p_file{$abk}
		     : "$p_file{$abk}-orig"
		    );
    }
    if (!defined $filename) {
	status_message("Filename is not defined", 'err');
	return;
    }

    status_message("");

    # Tags lschen
    $c->delete("$abk-bg");
    $c->delete("$abk-img");
    $c->delete("$abk-fg");
    $c->delete(uc($abk));#XXX obsolete
    $c->delete("$abk-label");

    my($ampel_photo, $andreaskr_photo);
    if ($abk eq 'lsa') {
	undef %ampeln;
	$ampel_photo     = get_symbol_scale('lsa-X');
	$andreaskr_photo = get_symbol_scale('lsa-B');
	$c->delete('lsas'); # Ampelschaltung-Symbole lschen
	$c->delete('lsas-t'); # Ampelschaltung-Symbole lschen
    }
    if (!$p_draw{$abk}) {
	return;
    }

    if (-e "$filename.desc") {
	require BBBikeAdvanced;
	read_desc_file("$filename.desc");
    }

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

    my $coordsys = $coord_system_obj->coordsys;

    destroy_delayed_restack();

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

    eval {
	my $bhf;
	if (defined $p_obj{$abk} && $coord_system eq 'standard' &&
	    $abk !~ /^L\d+/) {
	    $bhf = $p_obj{$abk};
	} else {
	    cache_decider_init();
	    eval {
		$bhf = new Strassen $filename;
	    };
	    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
	       ) {
		$p_obj{$abk} = $bhf;
	    }
	}

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

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

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

	while(1) {
	    my $ret = $bhf->next;
	    last if !@{$ret->[Strassen::COORDS]};
	    $progress->Update($i/$anzahl_eindeutig) if $i % 80 == 0;
	    $i++;
	    $draw_sub->($ret);
	}
	plot_symbol($c, $abk);
      PLOTPOINT_CONT:
	restack_delayed(); # XXX check!
    };
    if ($@) {
	if ($@ =~ /^no-original-datadir/) {
	    # silently ignore
	} elsif ($@ !~ /^OK/) {
	    status_message($@, ($edit_mode ? 'info-stack-trace' : 'err'));
	}
    }
    $progress->Finish;
    DecBusy($top);
}

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

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

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

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

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

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

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

	my $Listbox = "Listbox";
	if (!defined $K2Listbox && $sorted) {
	  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: $@";
		  }
	      }
	  }
	}
	my $attrib = ($linetype eq 's'
		      ? $str_attrib{$type}
		      : $p_attrib{$type});
	IncBusy($top);
	my $t;
	eval {
	    $t = $top->Toplevel(-title => $attrib->[ATTRIB_PLURAL],
				-class => "Bbbike Chooser");
	    $t->transient($top) if $transient;
	    my $origext = '';
	    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;
	    } else {
		$origext = '-orig';
	    }
	    my($showb, $closeb);

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

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

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

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

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

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

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

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

	    if (!$sorted) {
		$lb->insert('end',
			    map { $_->[1] }
			    sort { $a->[0] <=> $b->[0] }
			    map { [$orte{$_}, $_] }
			    keys %orte);
	    } else {
		# XXX maybe use Sort::Naturally? speed issues?
		my $tf_sub = (defined &Win32Util::sort_cmp_hack_transform &&
			      $os eq 'win'
			      ? sub { Win32Util::sort_cmp_hack_transform($_[0]) }
			      : sub { $_[0] });
		$lb->insert('end',
			    map { $_->[1] }
			    sort { $a->[0] cmp $b->[0] }
			    map { [ do { /^\(?(.*)/; $tf_sub->($1) }, $_] }
			    keys %orte);
	    }

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

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

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

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

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

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

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

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

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

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

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

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

    require PLZ;
    my $plz = new PLZ;
    if (!$plz) {
	$plzmcmd->configure(-state => 'disabled');
	status_message(M"Keine PLZ-Datenbank vorhanden!", 'err');
	return;
    }

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

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

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

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

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

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


    my $str;
    if (defined $args{'-str'}) { # auf Strae zentrieren
	$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
	mark_point(-coords => [[[ transpose(split(/,/, $args{'-coord'})) ]]],
		   -dont_mark => 1);
    } else { # interaktiv
	my $t = $top->Toplevel(-title => M"Auswahl aus kompletter Straenliste",
			       -class => "Bbbike Extended Chooser");
	$t->transient($top) if $transient;
	$toplevel{"chooseplz"} = $t;

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

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

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

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

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

    }
}

# Gibt die aktuelle Fontgre fr die bergebene Ortskategorie zurck.
### AutoLoad Sub
sub get_orte_label_font {
    my($category) = @_;
    my $font;
    if      ($category <= 2) {
	$font = $font{$font[$orte_label_size]};
    } elsif ($category == 3) {
	$font = $font{$font[$orte_label_size+1]};
    } elsif ($category == 4) {
	$font = $font{$font[$orte_label_size+2]};
    } elsif ($category == 5) {
	$font = $font{$font[$orte_label_size+3]};
    } elsif ($category > 5) {
	$font = $font{$font[$orte_label_size+4]};
    } else {
	die "Unknown category $category";
    }

    $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);
    if (exists $args{Canvas}) {
	$c = $args{Canvas};
	$std = 0;
	$transpose = ($show_overview_mode eq 'brb'
		      ? \&transpose_small
		      : \&transpose_medium);
    } else {
	$std = 1;
	$transpose = \&transpose;
    }

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

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

    if ($std && !$p_draw{$type}) {
	undef $p_obj{$type};
	return;
    }

    my $coordsys = $coord_system_obj->coordsys;

    destroy_delayed_restack();
    IncBusy($top);
    $progress->Init(-dependents => $c,
		    -label => 'orte');
    eval {
	my $i = 0;
	my $orte = _get_orte_obj($type);

	my $place_category = (exists $args{PlaceCategory}
			      ? $args{PlaceCategory} : $place_category);
	my $name_o        = (exists $args{NameDraw}
			     ? $args{NameDraw}     : $p_name_draw{$type});
	my $progress_hack = ($name_o && $no_overlap_label{$type});

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

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

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

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

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

	$c->itemconfigure($type,
			  -capstyle => $capstyle_round,
			  -width => 5,
			  -fill => '#000080',
			 );
	if ($name_o) {
	    if ($no_overlap_label{$type}) {
		# 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);
		    my(@tags) = ($label_tag, "$label_tag$cat");
		    if (!draw_text_intelligent($c, $tx, $ty,
					       -text => $text,
					       -font => $font,
					       -tags => \@tags,
					       -abk  => $label_tag,
					      )) {
			if ($cat <= $place_category+1) {
			    $c->delete($point_item);
			} else {
			    my $anchor = 'w';
			    $c->createText
			      ($tx+$xadd_anchor_type->{'o'}{$anchor},
			       $ty+$yadd_anchor_type->{'o'}{$anchor},
			       -text => $text,
			       -font => $font,
			       -tags => \@tags,
			       -anchor => $anchor,
			       -justify => 'left',
			      );
			}
		    }
		}
	    }
	    if (!$no_overlap_label{$type} && !$municipality &&
		!$do_outline_text) {
		$c->itemconfigure($label_tag,
				  -anchor => 'w', -justify => 'left');
	    }
	    if ($orientation eq 'landscape' &&
		!$do_outline_text) {
		$c->itemconfigure($label_tag,
				  -font => get_orte_label_font(2));
	    }
	    if ($municipality) {
		$c->itemconfigure($label_tag, -fill => '#7e7e7e');
	    } elsif (!$do_outline_text) {
		$c->itemconfigure($label_tag, -fill => '#000080');
	    }
	    if ($orientation eq 'landscape' &&
		!$do_outline_text) {
		unless ($args{'AllSmall'}) {
		    # wichtigere Orte bekommen eine grere Schrift
		    foreach my $category (3, 4, 5, 6) {
			$c->itemconfigure
			  ("$label_tag$category",
			   -font => get_orte_label_font($category));
		    }
		}
	    }
	}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

# Zeigt Namen der aktuellen Haltestelle oder des aktuellen Ortes
# (unterhalb des Cursors).
sub enterpoint {
    my $c = shift;
    my(@tags) = $c->gettags('current');
    if ($tags[0] eq 'p') {
	$act_value{Haltestelle} = $names[$tags[1]];
	$hs_label->configure(-fg => 'black');
    } elsif ($tags[0] eq 'o' || $tags[0] =~ /^[ubr]-/) {
	my $prefix = '';
	if ($tags[0] =~  /^u-/) {
	    $prefix = 'U ';
	} elsif ($tags[0] =~  /^b-/) {
	    $prefix = 'S ';
	} elsif ($tags[0] =~  /^r-/) {
	    $prefix = 'Bhf. '; # XXX language?
	}
	$act_value{Haltestelle} = $prefix . $tags[1];
	$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] eq 'sperre') {
	if ($tags[1] eq 'sperre0') {
	    $act_value{Haltestelle} = $tags[2] || M"tragen notwendig";
	} elsif ($tags[1] =~ /^sperre1/) {
	    $act_value{Haltestelle} = M("Einbahnstrae") .
		(defined $tags[2] and $tags[2] ne "" ? " - " . $tags[2] : "");
	} elsif ($tags[1] eq 'sperre2') {
	    if (defined $tags[2] and $tags[2] ne "") {
		$act_value{Haltestelle} = $tags[2];
	    } else {
		$act_value{Haltestelle} = M("gesperrte Strae");
	    }
	} else {
	    $act_value{Haltestelle} = $tags[2] || '';
	}
	$hs_label->configure(-fg => 'black');
    } elsif ($tags[0] =~ /^lsa-/) {
	if ($tags[2] !~ /^lsa-X/) {
	    $act_value{Haltestelle} = ($tags[2] =~ /^lsa-F/
				       ? M"Fugngerampel"
				       : ($tags[2] =~ /^lsa-B/
					  ? M"Bahnbergang"
					  : substr($tags[2], 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[1];
	$hs_label->configure(-fg => 'black');
    }

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

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

# Zeigt aktuellen Straenzugnamen.
sub enterstr {
    my $c = shift;
    my(@tags) = $c->gettags('current');
    $act_value{Strasse} = $tags[1];
    $act_value{Strasse} =~ s/\|.*$//; # Teil hinter "|" abschneiden
    if ($edit_mode and defined $tags[3] and $tags[3] =~ /-(\d+)$/) {
	$act_value{Strasse} .= " [" . ($1+1) . "]"; # Zeilennummer
    }
    $str_label->configure(-fg => 'black');

    my @l;
    if ($hs_label->cget(-fg) eq 'black') {
	push @l, $act_value{Haltestelle};
    }
    if (defined $act_value{Strasse} && $act_value{Strasse} ne '') {
	push @l, $act_value{Strasse};
    }
    if (defined $c_balloon) {
	if (@l && $use_c_balloon > 1) {
	    if ($leave_after) {	$leave_after->cancel; undef $leave_after }
	    $c_balloon->Popup(join(" / ", @l));
	} else {
	    $c_balloon->Deactivate;
	}
    }
}

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

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

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

# Gibt den ersten Tag aus @allowed_tags aus, der sich unter dem jetzigen
# Tag befindet.
sub find_below {
    my($c, @allowed_tags) = @_;
    my $e = $c->XEvent;
    my($xx, $yy) = ($c->canvasx($e->x), $c->canvasy($e->y));
    my(@items) = $c->find(overlapping => $xx-1, $yy-1, $xx+1, $yy+1);
    my %allowed_tags;
    foreach (@allowed_tags) { $allowed_tags{$_} = 1 }
    my %res;
    my $item;
    foreach $item (@items) {
	my(@tags) = $c->gettags($item);
	if ($allowed_tags{$tags[0]} && !exists $res{$tags[0]}) {
	    $res{$tags[0]} = $item;
	}
    }
    foreach (@allowed_tags) {
	if (exists $res{$_}) {
	    return ($res{$_}, $c->gettags($res{$_}));
	}
    }
    undef;
}

# Similar to find_below, but use a list of regexes and restrict to
# a list of tag positions.
sub find_below_rx {
    my($c, $allowed_rx_tags, $tag_pos) = @_;
    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);
    foreach my $item (@items) {
	my(@tags) = $c->gettags($item);
	for my $tag (@tags[@$tag_pos]) {
	    for my $rx (@$allowed_rx_tags) {
                if ($tag =~ /$rx/) {
		    return ($item, @tags);
		}
	    }
	}
    }
    undef;
}

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

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

# Zeigt Informationen zum aktuellen Tag.
### AutoLoad Sub
sub show_info {
    my($x, $y) = @_;
    my(@tags) = $c->gettags('current');
    return if !@tags || !defined $tags[0];
    my $base_tag = $tags[0];
    my $is_p = ($base_tag =~ /-(?:[fb]g|img)$/);
    $base_tag =~ s/-(?:[fb]g|img)$//;
    return if !exists $p_file{$base_tag} and !$str_file{$base_tag};
    my $index;
    if ($#tags >= 3) {
	($index = $tags[3]) =~ s/^$base_tag-//;
	#warn $index;
    }

    my @polarcoord;
    # XXX replace with "http://www.berlin.de/stadtplan/explorer"?
    # XXX is there a LL interface?
    my $stadtplan_url = "http://www.stadtplandienst.de/query"; # XXX not here
    my $url;
    my(@coords) = $c->coords('current');
    if (!@coords || @coords > 2) {
	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) = anti_transpose($coords[0], $coords[1]);
    my($px,$py) = $coord_system_obj->map2map($Karte::Polar::obj, $sx, $sy);
    @polarcoord = (Karte::Polar::dms_human_readable("lat", Karte::Polar::ddd2dms($py)),
		   Karte::Polar::dms_human_readable("long", Karte::Polar::ddd2dms($px)));
    $url = "$stadtplan_url?ORT=b&LL=+${py}+${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"} = Strassen->new("comments");
    }
    if (!$comments_pos_net) {
	eval {
	    $comments_pos_net = $str_obj{"comm"}->make_coord_to_pos
		(sub {
		     my $cat = $_[0]->[Strassen::CAT];
		     #$cat =~ /^(S1|S2)$/ ? 2 : 0;
		     $cat =~ /^CS/ ? 2 : 0;
		 });
	}; warn $@ if $@;
    }
    if ($comments_pos_net && $str_obj{"comm"}) {
	eval {
	    my($first, $second);
	    (undef,undef,$first,$second) = nearest_line_points_mouse($c);
	    $first = join(",",@$first);
	    $second = join(",",@$second);
	    if (defined $first && defined $second &&
		$comments_pos_net->{"${first}_${second}"}) {
		foreach my $pos (@{$comments_pos_net->{"${first}_${second}"}}) {
		    my $r = $str_obj{"comm"}->get($pos);
		    push @comments, $r->[Strassen::NAME];
		}
	    }
	}; warn $@ if $@;
    }

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

    my $show_info_sub = sub {
	my $txt = shift;
	#my $tl_tag = "info-$base_tag"; # one window per canvas type
	my $tl_tag = "info"; # one window for all
	my $info_top = redisplay_top($top, $tl_tag,
				     -title => M"Information",
				     -class => "BbbikePassive",
				    );
	if (defined $info_top) {
	    require Tk::ROText;
	    $info_text = $info_top->Scrolled('ROText',
					     -wrap => 'word',
					     -scrollbars => 'osoe',
					     -highlightthickness => 0,
					     -borderwidth => 0,
					     -width => 40,
					     -height => 10,
					     )->pack(-expand => 1, -fill => "both");
	    for (1 .. 3) {
		$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);
				    });
	    }
	    $info_top->Button(Name => 'close',
			      -command => sub { $info_top->destroy },
			     )->pack(-fill => "x");
	    toplevel_checker($info_top);
	}

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

	$info_text->delete("1.0", "end");
	$info_text->insert("1.0", $txt);
	if (@comments) {
	    $comments[0] = "Kommentare:\t$comments[0]";
	    @comments[1..$#comments] = map { "\t$_" } @comments[1..$#comments];
	    $info_text->insert("end", "\n\n" . join("\n", @comments));
	}
	if (defined $area) {
	    $info_text->insert("end", sprintf "\n\nFlche:\t%.2f km", $area); # XXX Msg
	}
	if (defined $total_len) {
	    $info_text->insert("end", sprintf "\n\nLnge:\t%.2f km", $total_len); # XXX Msg
	}
	if (@polarcoord) {
	    $info_text->insert("end", "\n\nKoordinaten\nPolar:\t$polarcoord[0]\n\t$polarcoord[1]");
	}

	if (defined $gkk_zone_potsdam) {
	    $info_text->insert("end", "\nGKK (Potsdam):\t[$gkk_zone_potsdam] $gkk_easting_potsdam/$gkk_northing_potsdam");
	}
	if (defined $gkk_zone_wgs84) {
	    $info_text->insert("end", "\nGKK (WGS 84):\t[$gkk_zone_wgs84] $gkk_easting_wgs84/$gkk_northing_wgs84");
	}
	if (defined $utm_ze) {
	    $info_text->insert("end", "\nUTM (WGS 84):\t[$utm_ze/$utm_zn] $utm_x/$utm_y");
	}
	if (defined $etrs_east) {
	    $info_text->insert("end", "\nETRS 89:\t$etrs_east/$etrs_north");
	}
	$info_text->insert("end", "\nBBBike:\t$sx,$sy");
	$info_text->insert("end", "\n\n");

	my @mapserver_def = ([$BBBike::BBBIKE_MAPSERVER_ADDRESS_URL,
			      "Mapserver"]);
	if ($devel_host) {
	    push @mapserver_def, ["http://www/~eserte/bbbike/cgi/mapserver_address.cgi", "Lokaler Mapserver"];
	}
	my $linkcount = 1;
	for my $def (@mapserver_def) {
	    my $mapserver_url = $def->[0];
	    my $url = "$mapserver_url?coords=" . join(",", anti_transpose($coords[0], $coords[1]));
	    $info_text->insert("end", $def->[1], "link$linkcount");
	    $info_text->tagBind("link$linkcount", "<ButtonRelease-1>" => sub {
				    require WWWBrowser;
				    WWWBrowser::start_browser($url);
				}
			       );
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}
	if ($devel_host) {
	    # t0p s3cr37!
	    my $url = sprintf "http://www.stadt".
		"plan".
		    "dienst.de/tpl/vm005/map.asp?ll=%.5fx%.5f", $px, $py;
	    $info_text->insert("end", "Stadt".
			       "plandienst\n", "link$linkcount");
	    $info_text->tagBind("link$linkcount", "<ButtonRelease-1>" => sub {
				    require WWWBrowser;
				    WWWBrowser::start_browser($url);
				}
			       );
	    $info_text->insert("end", "\n");
	    $linkcount++;
	}

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

	    # XXX use fixed font or tabs
	    $info_text->insert("end", <<EOF);
Sonnenaufgang:	$sunrise_real
Dmmerung ab:
  brgerliche:	$sunrise_civil
  nautische:	$sunrise_nautical
  astronomische:	$sunrise_astro

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

EOF
	}

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

    my(%info, $info_file);
    if ($str_file{$base_tag} =~ /\.shp$/) {
	(my $dbf_file = $str_file{$base_tag}) =~ s/\.shp$/.dbf/;
	require BBBikeAdvanced;
	my $index;
	for (@tags) {
	    if (/^$base_tag-(\d+)/) {
		$index = $1;
		last;
	    }
	}
	if (defined $index) {
	    my $dbf_info = get_dbf_info($dbf_file, $index);
	    if (defined $dbf_info) {
		if (@tags > 3) {
		    my $text = splice @tags, 2, 1;
		    unshift @tags, $text, "";
		}
		$show_info_sub->(join("\n", $dbf_info, grep { !/^current$/ } @tags));
		return;
	    }
	}
    }

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

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

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

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

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

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

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

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

# Fgt interaktiv die angeklickte Stelle in die Route (ber die
# Funktion addpoint_xy) ein, erneuert die Kilometerangaben.
sub addpoint_inter {
    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');
    restack_delayed();
    update_route_strname();
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    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+7, $y-7, -image => $flag_photo{$type},
			-tags => ['route', "route-$nr", $type . 'flag']);
    }
}

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

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

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

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

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

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

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

sub delete_route {
    reset_button_command();
    if (@inslauf_selection || @ext_selection) {
	require BBBikeAdvanced;
	reset_selection();
    }
    update_route_strname(); # XXX => hook
    Hooks::get_hooks("del_route")->execute;
}

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

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

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

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

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

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

	$c->delete("route-$nr");
	$nr--;
	unless ($no_update) {
	    set_flag('via');
	    set_flag('ziel');
	    updatekm();
	    if (!@coords) {
		undef $search_route_flag;
		search_route_mouse(1);
	    }
	    update_route_strname();
	}
    }
}

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

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

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

    my $lost_time_s;
    if (%ampeln) {
	my $ampel_count = 0;
	foreach (@realcoords) {
	    if ($ampeln{$_->[0].",".$_->[1]}) {
		$ampel_count++;
	    }
	}
	if ($ampel_count == 0) {
	    if ($ampelstatus_label) {
		$ampelstatus_label->configure(-text => M"Keine Ampeln");
	    }
	} else {
	    $lost_time_s = $ampel_count*$lost_time_per_ampel;
	    if ($ampelstatus_label) {
		$ampelstatus_label->configure
		    (-text => "$ampel_count " .
		     ($ampel_count > 1 ? M"Ampeln" : M"Ampel") .
		     " (-" . s2ms($lost_time_s) . ")"
		    );
	    }
	}
    } else {
	if ($ampelstatus_label) {
	    $ampelstatus_label->configure(-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 ($ampelstatus_label && $lost_time_tragen_s) {
	    my $oldlabel = $ampelstatus_label->cget(-text);
	    $ampelstatus_label->configure(-text => $oldlabel . "\n${tragen_count}x tragen (-" . s2ms($lost_time_tragen_s) . ")");
	}
    }

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

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

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

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

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

    $ampelstatus_label->configure(-text => "") if $ampelstatus_label;
    $c->delete('route');
    $nr = -1;
    $next_is_undo = 0;
    undef @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} };

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

    1;
}

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

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

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

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

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

	scale_maps($scalefactor);

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

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

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

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

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

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

##XXX Does not work. Probably best is too put the code snippets of plot_sperre
## into strings to be evaled, used in plot_sperre and re-used here.
#  	if ($sperre_type =~ /^sperre1/) {
#  	    my $new_length = get_line_length($sperre_type);
#  	    my $old_length = get_line_length($sperre_type, $old_scale);
#  	    if ($new_width != $old_width && $new_width > 0) {
#  		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) = (int(($x2-$x1)/2+$x1), int(($y2-$y1)/2+$y1));
#  			my $item_length = Strassen::Util::strecke([$x1,$y1],
#  								  [$x2,$y2]);
#  			my $f = $item_length*$new_length/$old_length;
#  			$c->coords(map { $f*$_} ($x1,$y1,$x2,$y2));
#  		    }
#  		}
#  	    }
#  	}
    }

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

    # XXX ... nur ndern, falls sich die Skalierung ndert... (wie oben)
    # XXX arrowshape von sperre1 ndern
    my %arg = get_symbol_scale('b');
    $c->itemconfigure('b-bg', -width => $arg{-width});
    $c->itemconfigure('r-bg', -width => $arg{-width});
    $c->itemconfigure("b-fg",
		      -text => (defined $arg{-font} ? 'S' : ''),
		      (defined $arg{-font} ? (-font => $arg{-font}) : ()),
		     );
    $c->itemconfigure("r-fg",
		      -text => (defined $arg{-font} ? 'R' : ''),
		      (defined $arg{-font} ? (-font => $arg{-font}) : ()),
		     );
    %arg = get_symbol_scale('u');
    $c->itemconfigure('u-bg', -width => $arg{-width});
    $c->itemconfigure("u-fg",
		      -text => (defined $arg{-font} ? 'U' : ''),
		      (defined $arg{-font} ? (-font => $arg{-font}) : ()),
		     );
    foreach my $tag ($c->find('withtag', 'u-bg')) {
	my($x1,$y1,$x2,$y2) = $c->coords($tag);
	# work around 800.0_16-to-be bug
	if (ref $x1 eq 'ARRAY') { ($x1,$y1,$x2,$y2) = @{ $c->coords($tag) } }
	my $xm = ($x2-$x1)/2+$x1;
	$c->coords($tag, $xm-$arg{-width}/2, $y1, $xm+$arg{-width}/2, $y2);
    }
    # rearrange outline_text
    # XXX performance is quite bad (about 0.6s for all U+S-Bahnhfe)
    my $t = Tk::timeofday();
    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]);
	    }
	}
    }
    warn sprintf "Repositioning labels took %.3fs\n", (Tk::timeofday()-$t)
	if $devel_host;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

# Zentriert entweder auf eine Strae oder Koordinaten oder auf die Mitte
# Berlins.
### AutoLoad Sub
sub center_best {
    if (defined $center_on_str) {
	choose_from_plz(-str   => $center_on_str);
    } elsif (defined $center_on_coord) {
	choose_from_plz(-coord => $center_on_coord);
    } else {
#XXX auf das Brandenburger Tor zentrieren, falls Berlin
	$c->center_view;
    }
}

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

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

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

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

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

# Diese Funktion geht von einer korrekten dpi-Einstellung fr den
# Bildschirm und quadratischen Dots aus.
# Rckgabewert: Der Teil hinter dem Doppelpunkt.
sub calc_mapscale {
    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));
    $mapscale = "1:$nenner";
    $nenner;
}

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

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

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

### AutoLoad Sub
sub show_overview {
    my $new    = shift;

    if ($overview_top && $overview_top->{CoordSystem} ne $coord_system) {
	$new = 1;
    }
    if (defined $overview_top and Tk::Exists($overview_top)) {
	$overview_top->destroy if ($new);
    }

    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->transient($top) if $transient;
    $overview_top->{CoordSystem} = $coord_system;
    # Try to set the overview to the right bottom corner of the main
    # window:
    my($w,$h) = (int($top->width/3), int($top->height/3));
    if (!@max_extends) {
	warn "Should not happen: no defined max_extends";
	$overview_top->geometry("${w}x$h-0-0");
    } else {
	my(@want_extends) = ($top->x+$top->width, $top->y+$top->height,
			     $w, $h);

	crop_geometry(\@want_extends, \@max_extends);
	if ($want_extends[GEOMETRY_HEIGHT] < $h) {
	    $want_extends[GEOMETRY_HEIGHT] = $h;
	    $want_extends[GEOMETRY_Y]      = "-0";
	} else {
	    $want_extends[GEOMETRY_Y] =~ s/^/+/;
	}
	if ($want_extends[GEOMETRY_WIDTH] < $w) {
	    $want_extends[GEOMETRY_WIDTH] = $w;
	    $want_extends[GEOMETRY_X]     = "-0";
	} else {
	    $want_extends[GEOMETRY_X] =~ s/^/+/;
	}
	my $geom = "$want_extends[GEOMETRY_WIDTH]x$want_extends[GEOMETRY_HEIGHT]" . "$want_extends[GEOMETRY_X]$want_extends[GEOMETRY_Y]";
	$overview_top->geometry($geom);
    }

    show_overview_populate($overview_top);
}

sub show_overview_clean_and_populate {
    my $overview_top = shift;
    for ($overview_top->children) {
	$_->destroy;
    }
    show_overview_populate($overview_top);
}

sub show_overview_populate {
    my $overview_top = shift;
    my $withdraw_sub = sub { $overview_top->withdraw;
			     $show_overview = 0 };
    $overview_top->protocol('WM_DELETE_WINDOW', $withdraw_sub);

    # Canvas. Create scrollbars manually, so arrow_update can be called
    $overview_canvas = $overview_top->Canvas
	(-xscrollincrement => 15, # XXX check values
	 -yscrollincrement => 15);

    my($overview_width, $overview_height);
    if ($coord_system eq 'standard') {
	$overview_width = $normal_scrollregion/DEFAULT_SCALE*
	    ($show_overview_mode eq 'brb' ? $small_scale : $medium_scale);
	$overview_height = $overview_width;
	$overview_canvas->configure
	    (-scrollregion => [-$overview_width, -$overview_width,
			       $overview_width,  $overview_width]
	    );
    } else {
	my @s = $coord_system_obj->scrollregion;
	# XXX show_overview_mode beachten
	@s = (transpose_medium(@s[0, 1]),
	      transpose_medium(@s[2, 3]));
	$overview_width  = ($s[2]-$s[0])/2;
	$overview_height = ($s[3]-$s[1])/2;
	$overview_canvas->configure(-scrollregion => [@s]);
    }

    $overview_canvas->createLine(0,0,0,0,-tags => 'zoomrect');
    $overview_top->gridColumnconfigure(0, -weight => 1);
    $overview_top->gridRowconfigure(0, -weight => 1);
    $overview_canvas->grid(-row => 0, -column => 0, -sticky => 'eswn');
    my $sy = $overview_top->Scrollbar(-command => ["yview", $overview_canvas]);
    $sy->grid(-row => 0, -column => 1, -sticky => 'ns');
    my $sx = $overview_top->Scrollbar(-orient => 'horiz',
				      -command => ["xview", $overview_canvas]);
    $sx->grid(-row => 1, -column => 0, -sticky => 'ew');

    my $brandenburger_tor_coords = [8581,12243];

    my $arrow_update = sub {
	$overview_canvas->delete('berlinarrow');
	require Geometry;
	my($cx1,$cy1,$cx2,$cy2) = $overview_canvas->get_corners;
	# Ersten Schnittpunkt (inneres Rechteck) ermitteln
	# Die Mitte ist (0,0) (ca. Berlin-Moabit).
	my($ix1,$iy1) = Geometry::get_intersection
	    ($cx1+($cx2-$cx1)/2, $cy1+($cy2-$cy1)/2, 0,0,
	     $cx1+15,$cy1+15,$cx2-15,$cy2-15);
	if (defined $ix1 and defined $iy1) {
	    # zweiten Schnittpunkt ermitteln (aktuelle Canvasgrenze)
	    my($ix2,$iy2) = Geometry::get_intersection($ix1,$iy1,0,0,
						       $cx1,$cy1,$cx2,$cy2);
	    if (defined $ix2 and defined $iy2) {
		my $anti_transpose = ($show_overview_mode eq 'brb'
				      ? \&anti_transpose_small
				      : \&anti_transpose_medium);
		# zum Brandenburger Tor
		my $entf = Strassen::Util::strecke
		    ([$anti_transpose->($ix1,$iy1)],
		     $brandenburger_tor_coords);
		$overview_canvas->createLine
		    ($ix1,$iy1,$ix2,$iy2,
		     -arrow => "last",
		     -width => 2,
		     -fill => "red",
		     -tags => 'berlinarrow');
		$overview_canvas->createText
		    ($ix1, $iy1,
		     -anchor => opposite_direction(line_to_canvas_direction
						   ($ix1,$iy1,$ix2,$iy2)),
		     -text => "Berlin\n".sprintf("%d km", $entf/1000),
		     -fill => "red",
		     -font => $font{'small'},
		     -tags => ['berlinarrow','berlinarrowlabel']);
	    }
	}
    };

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

    # Mode button
    my $mode_button = $overview_top->Button
	(-font => $font{'small'},
	 -padx => 0, -pady => 0,
	 -highlightthickness => 0,
	 -takefocus => 0,
	 -command => sub {
	     $show_overview_mode =
		 ($show_overview_mode eq 'b' ? 'brb' : 'b');
#	     $overview_top->after(10, sub { show_overview(1) });
	     $overview_top->after(10, sub { show_overview_clean_and_populate($overview_top) });
	 });
    $mode_button->place("-x" => 2, "-y" => 2);
    if ($show_overview_mode eq 'brb') {
	$mode_button->configure(-text => "=> Berlin");
    } else {
	$mode_button->configure(-text => "=> Brandenburg");
    }

    my $ts = ($show_overview_mode eq 'brb'
	      ? \&transpose_small
	      : \&transpose_medium);
    my($km100_pixel) = ($ts->(100000,0))[0] - ($ts->(0,0))[0];

    # Radar button
    if ($advanced) {
    my $radar_onoff = 0;
    my $radar_button;
    my $show_radar_image;
    $radar_button = $overview_top->Checkbutton
      (-font => $font{'small'},
       -indicatoron => 0,
       -padx => 0,
       -pady => 1, # for Checkbuttons 1, for Buttons 0 (why?)
       -highlightthickness => 0,
       -takefocus => 0,
       -text => 'Radar',
       -variable => \$radar_onoff,
       -command => sub {
	   $radar_button->after(50, $show_radar_image);
       }
      );
    $show_radar_image = sub {
	if ($radar_image) {
	    eval q{ $radar_image->delete };
	}
	$overview_canvas->delete('radarimage');
	return if !$radar_onoff;

	IncBusy($top);
	$progress->Init(-label => M"Radarschirm");
	eval {
	    require FURadar;
	    $FURadar::progress = $progress;
	    $FURadar::VERBOSE = $verbose;
#	       $FURadar::use_map = ($show_overview_mode eq 'brb'
#				    ? 'FURadar2' : 'FURadar');
	    $FURadar::use_map = 'FURadar2'; # the only left...
	    # XXXX use fetch and cache routine
	    my $origimgfile = FURadar::fetch();
	    if ($origimgfile) {
		my $time = (stat($origimgfile))[STAT_MODTIME];
		my $imgfile = FURadar::interesting_parts
		    ($origimgfile,
		     -km100pixel => $km100_pixel);
		if (-r $imgfile) {
		    $radar_image = $overview_canvas->Photo(-file => $imgfile);
		    my($xoff,$yoff) = ($show_overview_mode eq 'brb'
				       ? (3,20)
				       : $ts->(0,0));
		    $overview_canvas->createImage
			($xoff, $yoff,
			 -image => $radar_image,
			 -tags => 'radarimage');
		    foreach my $raise (qw(g gP gD O o)) { # XXX evtl. andere Tags auch raisen
			$overview_canvas->raise($raise);
		    }
		}
		if ($time) {
		    $balloon->attach($radar_button,
				     -msg => scalar localtime $time);
		}
	    }
	};
	warn __LINE__ . ": $@" if $@;
	$progress->Finish;
	DecBusy($top);
    };
    $radar_button->configure(-selectcolor => $radar_button->cget(-background));
    $radar_button->place("-x" => 2+2+$mode_button->reqwidth, "-y" => 2);
    }

    # Zeichnen von Gewssern, S-Bahnen, Straen in der
    # bersichtskarte
    foreach my $abk (qw(w b s)) {
	local(%str_outline, %str_name_draw, $wasserumland, $wasserstadt,
	      %str_far_away, %str_restrict, %p_draw);
	if ($overview_draw{$abk}) {
	    $str_outline{$abk} = 0;
	    $p_draw{'pp'} = 0;
	    if ($abk eq 'w') {
		$str_name_draw{$abk} = 0;
		$wasserumland = $wasserstadt = 1;
		$str_far_away{$abk} = 1;

		for my $cat (qw(W1 W2 F:W)) {
		    $str_restrict{$abk}->{$cat} = 1;
		}
		$str_restrict{$abk}->{W} = 0;
	    } elsif ($abk eq 's') {
		$str_restrict{$abk}->{'HH'} = 1;
	    }

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

    $progress->InitGroup;
    for my $abk (qw(g gD)) {
	plot('str',$abk,
	     Canvas => $overview_canvas,
	     ($abk eq 'g' && $coord_system ne 'standard' ? (Filename => "plz-orig") : ()),
	    );
    }
    {
	# schner wr's mit local(), aber geht nicht so ohne weiteres
	my $orte_far_away_orig = $p_far_away{'o'};
	my $overlap_label_orig = $no_overlap_label{'o'};
	$p_far_away{'o'} = 1;
	$no_overlap_label{'o'} = 0; # XXX leider langsam
	plotorte(Canvas        => $overview_canvas,
		 PlaceCategory => 4,
		 AllSmall      => 1,
		 Shortname     => 1,
		);
	$p_far_away{'o'} = $orte_far_away_orig;
	$no_overlap_label{'o'} = $overlap_label_orig;

	if ($show_overview_mode eq 'b') {
	    plotorte(Canvas        => $overview_canvas,
		     PlaceCategory => 0,
		     AllSmall      => 1,
		     Shortname     => 1,
		     NameDraw      => 1,
		     -municipality => 1,
		     -type         => 'oo'
		    );
	}
    }
    $progress->FinishGroup;
    $overview_canvas->raise("zoomrect");
    $overview_top->bind('<q>' => $withdraw_sub);
    $overview_top->bind('<Q>' => sub { &$withdraw_sub;
				       $overview_top->destroy
				   });
    my $real_canvas = $overview_canvas;
    my $scroll_lock;
    my $set_scroll_lock = sub {
	$scroll_lock = $overview_canvas->after(100,
					       sub { undef $scroll_lock });
    };
    my $button_pressed;
    my $refresh_sub;
    my($delta_x_fraction, $delta_y_fraction) = (0.5, 0.5);
    $refresh_sub =
      sub {
	  my($w, $initial) = @_;
	  my $e = $w->XEvent;
	  if (!defined $button_pressed) {
	      $button_pressed = $overview_canvas->repeat
		(100, sub { $refresh_sub->($w, 0); });
	  }
	  return if $scroll_lock;
	  my($x, $y) = ($e->x, $e->y);
	  my($xx, $yy) = ($overview_canvas->canvasx($x),
			  $overview_canvas->canvasy($y));
	  if ($initial) {
	      my(@c) = $overview_canvas->bbox('zoomrect');
	      if ($xx >= $c[0] && $xx <= $c[2] &&
		  $yy >= $c[1] && $yy <= $c[3]) {
		  # Click in rect, record initial position.
		  # This code is necessary to avoid jumps on initial click.
		  $delta_x_fraction = ($xx-$c[0])/($c[2]-$c[0]);
		  $delta_y_fraction = ($yy-$c[1])/($c[3]-$c[1]);
	      }
	  }
	  my $real_canvas_width  = $real_canvas->width;
	  my $real_canvas_height = $real_canvas->height;
	  # XXX ist noch etwas ruckartig ... kleinere units,
	  # intelligenteres Handling!
	  my $pad = 10;
	  if ($x < $pad) {
	      $overview_canvas->xview(scroll => -1, 'units');
	      $set_scroll_lock->();
	  }
	  if ($y < $pad) {
	      $overview_canvas->yview(scroll => -1, 'units');
	      $set_scroll_lock->();
	  }
	  if ($x > $real_canvas_width-$pad) {
	      $overview_canvas->xview(scroll => +1, 'units');
	      $set_scroll_lock->();
	  }
	  if ($y > $real_canvas_height-$pad) {
	      $overview_canvas->yview(scroll => +1, 'units');
	      $set_scroll_lock->();
	  }
	  my(@oldx) = $c->xview;
	  my(@oldy) = $c->yview;
	  my($xwidth) = $oldx[1]-$oldx[0];
	  my($ywidth) = $oldy[1]-$oldy[0];
	  if ($coord_system ne 'standard') {
	      ($xx, $yy) = anti_transpose_medium($xx, $yy); # XXX brb mode!!!
	      $c->center_view($xx, $yy);
	  } else {
	      $c->xview(moveto => (($xx+$overview_width)/($overview_width*2)
				   - $xwidth*$delta_x_fraction)
		       );
	      $c->yview(moveto => (($yy+$overview_height)/($overview_height*2)
				   - $ywidth*$delta_y_fraction)
		       );
	  }
      };

    $real_canvas->Tk::bind('<ButtonPress-1>'  => sub {
			       my $w = shift;
			       $refresh_sub->($w, 1, @_)
			   });
    $real_canvas->Tk::bind('<B1-Motion>' => sub {
			       my $w = shift;
			       $refresh_sub->($w, 0, @_)
			   });
    $real_canvas->Tk::bind
      ('<ButtonRelease-1>'
       => sub {
	   if (defined $button_pressed) {
	       $button_pressed->cancel();
	       undef $button_pressed;
	   }
	   ($delta_x_fraction, $delta_y_fraction) = (0.5, 0.5);
       });

    # 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 {
    if (defined $overview_top && Tk::Exists($overview_top)) {
	$overview_top->destroy;
    }
    eval q{ $radar_image->delete };

    undef $overview_top;
    $show_overview = 0;
}

### AutoLoad Sub
sub overview_update {
    return if !$overview_canvas || !Tk::Exists($overview_canvas);
    my @a = $c->get_corners;
    my @c;
    my $i;
    my $ts = ($show_overview_mode eq 'brb'
	      ? \&transpose_small
	      : \&transpose_medium);
    for($i = 0; $i < $#a; $i+=2) {
	push @c, $ts->(anti_transpose($a[$i], $a[$i+1]));
    }
    $overview_canvas->coords('zoomrect', @c[0,1, 0,3, 2,3, 2,1, 0,1]);
    my($midx, $midy) = (($c[2]-$c[0])/2+$c[0],
			($c[3]-$c[1])/2+$c[1]);

    if (!$overview_canvas->is_visible($midx, $midy)) {
	$overview_canvas->center_view($midx, $midy);
    }
}

##### Suche #####################################################
sub search_route {
    my($start, $ziel, $via_arr, $continue, %args) = @_;
    return if $in_search;
    $in_search++;
    my(@via) = @$via_arr if defined $via_arr;

    destroy_delayed_restack();

    IncBusy($top, %busy_watch_args);
    eval {
	status_message("");
	# XXX $str_draw{'r'} ueberprfen, wenn im RB-Mode
	if (!$net and ($str_draw{'s'} || $str_draw{'l'})) { make_net() }
	warn "Suche von <$start> bis <$ziel>" . (@via ? " via <@via>" : "")
	  if $verbose;
	my %extra_args;
	if (keys %ampeln) {
	    if ($ampel_optimierung) {
		$extra_args{Ampeln} =
		  {Net     => \%ampeln,
		   Penalty => $lost_strecke_per_ampel};
	    } elsif ($optprefs{'Ampeln'}) {
		$extra_args{Ampeln} =
		  {Net     => \%ampeln,
		   Penalty => optprefs2penalty($optprefs{'Ampeln'})*100};
	    } # XXX
	    if ($abbiege_optimierung) {
		$extra_args{Abbiegen} = {Penalty => $abbiege_penalty,
					 Order   => {'NN' => 0,
						     'N' => 1,
						     'H' => 2,
						     'HH' => 3,
						     'BAB' => 3, # XXX
						     'B' => 4}};
	    }
	    # XXX optprefs
	}

	# Qualitt und Handicap
	foreach my $def ({OptSwitch	 => \$qualitaet_s_optimierung,
			  OptName	 => 'Qualitt',
			  Speed          => \%qualitaet_s_speed,
			  MakeNet	 => \&make_qualitaet_net,
			  CatPrefix	 => 'Q',
			  ExtraArgsName	 => 'Qualitaet',
			 },
			 {OptSwitch	 => \$handicap_s_optimierung,
			  OptName	 => 'Sonstige Behinderungen',
			  Speed          => \%handicap_s_speed,
			  MakeNet	 => \&make_handicap_net,
			  CatPrefix	 => 'q',
			  ExtraArgsName	 => 'Handicap',
			 },
			) {
	    my $opt = $ {$def->{OptSwitch}};
	    if ($opt || $optprefs{$def->{OptName}}) {
		my $speed = $def->{Speed};
		my $makenet = $def->{MakeNet};
		my $catprefix = $def->{CatPrefix};
		my $net = $makenet->();
		my $penalty;
		if ($opt) {
		    foreach (0 .. 4) {
			next if !defined $speed->{$catprefix . "$_"};
			$penalty->{$catprefix . "$_"} =
			    max_speed($speed->{$catprefix . "$_"});
		    }
		} else {
		    foreach (0 .. 4) {
			next if !defined $penalty->{$catprefix . "$_"};
			# XXX
			$penalty->{$catprefix . "$_"} =
			    optprefs2penalty($optprefs{$def->{OptName}}) * $_;
		    }
		}
		$extra_args{$def->{ExtraArgsName}} =
		    {Net => $net,
		     Penalty => $penalty,
		    };
	    }
	}

	if ($strcat_optimierung || $optprefs{'Kategorie'}) {
	    # XXX wenn L zugeschaltet wird, mu strcat_net aktualisiert werden
	    if (!$strcat_net) {
		if ($multistrassen) {
		    $strcat_net = new StrassenNetz $multistrassen;
		} elsif ($str_obj{'s'}) {
		    $strcat_net = new StrassenNetz $str_obj{'s'};
		}
		if ($strcat_net) {
		    $strcat_net->make_net_cat;
		}
	    }
	    if ($strcat_net) {
		my $penalty;
		if ($strcat_optimierung) {
		    foreach (keys %strcat_speed) {
			$penalty->{$_} = max_speed($strcat_speed{$_});
		    }
		} else {
# 		my %strcat_def = (B  => HH => 100,
#    H  => 100,
#    N  => 100,
#    NN => 100);
# 		foreach (keys %strcat_speed) {
# 		    # XXX
# 		    $penalty->{"Q$_"} = optprefs2penalty($optprefs{'Kategorie'})* $_;
# 		}
		}
		$extra_args{Strcat} =
		  {Net => $strcat_net,
		   Penalty => $penalty,
		  };
	    }
	}
	if ($radwege_optimierung) {
	    if (!$radwege_net) {
		my $radwege_exact = new Strassen "radwege_exact";
		$radwege_net = new StrassenNetz $radwege_exact;
		$radwege_net->make_net_cat(-obeydir => 1);
		# add all other streets do not have cycle paths ...
		while(my($p1,$hash) = each %{ $net->{Net} }) {
		    while(my($p2,$entf) = each %$hash) {
			if (!exists $radwege_net->{Net}{$p1}{$p2}) {
			    $radwege_net->{Net}{$p1}{$p2} = "RW0";
			    $radwege_net->{Net}{$p2}{$p1} = "RW0";
			}
		    }
		}
	    }
	    my $penalty;
	    foreach (keys %radwege_speed) {
		$penalty->{$_} = max_speed($radwege_speed{$_});
	    }

	    $extra_args{Radwege} =
	      {Net => $radwege_net,
	       Penalty => $penalty,
	      };
	}

	if ($N_RW_optimization) {
	    # XXX check if $N_RW_net is up-to-date with respect to its
	    # sources, or whether a new $N_RW_net should be build
	    if (!$N_RW_net) {
		my $s = $multistrassen ? $multistrassen : $str_obj{'s'};
		if (!$s) {
		    warn "Can't get streets object, ignore N_RW optimization";
		} else {
		    $N_RW_net = new StrassenNetz $s;
		    $N_RW_net->make_net_cyclepath(Strassen->new("radwege_exact"), 'N_RW');
		}
	    }
	    if ($N_RW_net) {
		my $penalty = { "H"    => 4,
				"H_RW" => 1,
				"N"    => 1,
				"N_RW" => 1 };
		$extra_args{RadwegeStrcat} =
		    {Net => $N_RW_net,
		     Penalty => $penalty,
		    };
	    }
	}

	if ($green_optimization) {
	    # XXX check if $green_net is up-to-date with respect to its
	    # sources, or whether a new $green_net should be build
	    if (!$green_net) {
		$green_net = new StrassenNetz(Strassen->new("green"));
		$green_net->make_net_cat;
	    }
	    my $penalty = ($green_optimization == 2
			   ? { "green0" => 3,
			       "green1" => 2,
			       "green2" => 1,
			     }
			   : { "green0" => 2,
			       "green1" => 1.5,
			       "green2" => 1,
			     }
			  );
	    $extra_args{Green} =
		{Net => $green_net,
		 Penalty => $penalty,
		};
	}

	if ($unlit_streets_optimization) {
	    if (!$unlit_streets_net) {
		$unlit_streets_net = new StrassenNetz(Strassen->new("nolighting"));
		$unlit_streets_net->make_net_cat;
	    }
	    my $penalty = { "NL" => 4,
			  };
	    $extra_args{UnlitStreets} =
		{Net => $unlit_streets_net,
		 Penalty => $penalty,
		};
	}

	if ($steigung_optimierung) {
	    if (!$steigung_net) {
		$steigung_net = new StrassenNetz Strassen->new;
		$steigung_net->make_net_steigung($net, \%hoehe);
	    }
	    my $penalty;
	    my $act_power;
	    if ($active_speed_power{Type} eq 'power') {
		$act_power = $power[$active_speed_power{Index}];
	    } else {
		$act_power = speed2power($speed[$active_speed_power{Index}]);
	    }
	    if (!defined $steigung_penalty_env{ActPower} ||
		$steigung_penalty_env{ActPower} != $act_power) {
		$steigung_penalty = {};
	    }
	    $steigung_penalty_env{ActPower} = $act_power;
	    $extra_args{Steigung} =
	      {Net => $steigung_net,
	       Penalty => $steigung_penalty,
	       PenaltySub => sub { steigung_penalty($_[0], $act_power) },
	      };
	}
	if (!$sperre{'tragen'}) {
	    $extra_args{Tragen} = 1;
	}
	$extra_args{Velocity} = get_active_speed()/3.6; # should be m/s
	# XXX Bislang noch keine Mglichkeit auer /tmp/add.pl, um
	# $aufschlag zu setzen.
	# Der Alternativ-Strecken-Code braucht noch viel Arbeit. Als
	# erstes sollte ein Start/Ziel-Punkt, der zwischen zwei
	# Kreuzungen/Kurvenpunkten liegt, hchstens einmal! durchfahren
	# werden.
	if ($aufschlag != 0 && $aufschlag != 1) {
	    $extra_args{Aufschlag} = $aufschlag;
	    $extra_args{All}       = 1;
	}
	# XXX weitere mgliche Optimierungen:
	# (benutzungspflichtige) Radwege
	# verkehrsberuhigte Zonen => 6 .. 20 km/h
	# Fugngerampeln: Abbremsen auf 10 km/h und gleich wieder hoch
	# Kreuzungen (Neben/Haupt, Haupt/Haupt ohne Ampel)
	# Berufsverkehr (Stau auf groen Straen => 15 .. 20 km/h)
	if ($search_stat) {
	    $extra_args{Stat} = 1;
	}
	if ($search_visual) {
	    $extra_args{'VisualSearch'} = {'Canvas' => $c,
					   'Transpose' => \&transpose,
					   'Delay' => 0.1,
				       };
	}
	if (%global_search_args) {
	    while(my($k,$v) = each %global_search_args) {
		$extra_args{$k} = $v;
	    }
	}
	if (keys %penalty_subs) {
	    # Note: the %penalty_subs should only multiply $p, not add to
	    # if there are more than one penalty sub!
	    $extra_args{UserDefPenaltySub} = sub {
		my($p, $next_node, $last_node) = @_;
		while(my($k,$v) = each %penalty_subs) {
		    $p = $v->($p, $next_node, $last_node);
		}
		$p;
	    };
	}

	make_net() if (!$net);
	foreach my $ref (\$start, \$ziel) {
	    if (!$net->reachable($$ref)) {
		add_new_point($net, $$ref); # XXX ja?
	    }
	}
	my(@res) = $net->search($start, $ziel, %extra_args);

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

	my @path = @{ $res[StrassenNetz::RES_PATH] };
 	my $old_nr;
 	if ($continue) {
 	    save_route_to_register('cont'); # if $max_list > 0;
 	    $old_nr = $#coords;
 	} else {
	    # XXX shouldn't be necessary!!!
	    my($save_start) = $search_route_points[0]; # XXX used to be [SRP_COORD]?!
 	    if (!exists $args{-undo} || $args{-undo}) {
		reset_undo_route();
	    } else {
		resetroute();
	    }
	    push @search_route_points, $save_start;
 	}
# 	my(@res);
# 	$power_cache = {};
# 	for(my $i=$max_list; $i>=0; $i--) {
# 	    my $res_ref = $res_list[$i];
# 	    next if (!ref $res_ref or !@$res_ref);
# 	    @res = @$res_ref;
 	    foreach my $p (@path) {
 		my($x, $y) = @$p;
 		addpoint_xy($x, $y, transpose($x, $y));
 	    }
 	    undef $power_cache;
 	    updatekm();
# 	    if ($max_list > 0) {
# 		save_route_to_register($i+1);
# 		resetroute();
# 		get_route_from_register('cont');
# 	    }
# 	}
# 	get_route_from_register(1) if $max_list > 0;
	# continue with best route
	if ($continue) {
	    push @act_search_route,
		$net->route_to_name([@path], -startindex => $old_nr); # XXX is wrong (?): +1);
	} else {
	    @act_search_route = $net->route_to_name([@path], -startindex=>0);
	}
	if (@path) {
	    push @search_route_points, [join(",", @{ $path[-1] }),
					POINT_SEARCH];
	}
	print "Route: ", join(", ", map { $_->[0] } @act_search_route), "\n"
	  if $verbose;
	if (exists $args{-caller} && $args{-caller} eq 'chooseort') {
	    zoom_view() if ($zoom_new_route_chooseort);
	} else {
	    zoom_view() if ($zoom_new_route);
	}
	if ($auto_show_list) {
	    $show_strlist = 1;
	    show_route_strname();
	}
	set_flag('via');
	set_flag('ziel');
	restack_delayed();
    };
    my $err = $@;
    $in_search = 0;
    DecBusy($top);
    status_message($err, 'err') if ($err);
}

# Wiederholung der Suche (evtl. mit neuen Parametern)
### AutoLoad Sub
sub re_search {
    my(%args) = @_;
    return if @search_route_points < 2;
    IncBusy($top, %busy_watch_args);
    eval {
	my(@old_search_route_points) = @search_route_points;
	@search_route_points = $old_search_route_points[SRP_COORD];
	for(my $i=0; $i<$#old_search_route_points; $i++) {
	    my $p1 = $old_search_route_points[$i];
	    my $p2 = $old_search_route_points[$i+1];
	    if ($p2->[SRP_TYPE] eq POINT_MANUELL) {
		addpoint_xy(split(/,/, $p2->[SRP_COORD]));
		push @search_route_points, [@$p2];
	    } else {
		search_route
		    ($p1->[SRP_COORD], $p2->[SRP_COORD],
		     undef, ($i == 0 ? '' : 'cont'),
		     (exists $args{-undo} ? (-undo => $args{-undo}) : ()),
		    );
	    }
	}
    };
    my $err = $@;
    DecBusy($top);
    die $err if $err;
}

sub re_search_gui {
    re_search(@_);
    update_route_strname();
}

# Steigung mu als Tausendfaches angegeben werden.
### AutoLoad Sub
sub steigung_penalty {
    my($steigung, $act_power) = @_;
    my $frac = ($steigung/1000+0.08)/(0.08*2);
    max_speed(power2speed($act_power, -grade => $steigung/1000));
}

### AutoLoad Sub
sub route_strname_on_map {
    my $xadd_anchor = $xadd_anchor_type->{'route'};
    my $yadd_anchor = $yadd_anchor_type->{'route'};

    require Tk::StippleLine;

    foreach my $def (@route_strnames) {
	my($str, $x, $y, $inx, $entf) = @$def;
	$str = $str .= " ($entf)" if defined $entf and $do_route_strnames_km;
	my(@tags) = ('route',
		     "route-" . $inx,
		     'routename');
	my $returnanchor;
	if (draw_text_intelligent
	    ($c, $x, $y,
	     -text => $str,
	     -tags => [@tags],
	     -abk => ['route','routename'],
	     -checktagindex => 'all',
	     -xadd => $xadd_anchor,
	     -yadd => $yadd_anchor,
	     -returnanchor => \$returnanchor,
	    )) {
	    Tk::StippleLine::create
	      ($c, $x, $y,
	       $x+$xadd_anchor->{$returnanchor},
	       $y+$yadd_anchor->{$returnanchor},
	       -fill => 'black',
	       -width => 2,
	       -tags => [@tags]);
	} else {
	    $c->createText($x, $y, -text => $str,
			   -anchor => 'w',
			   -tags => [@tags]);
	}
    }
}

### AutoLoad Sub
sub get_act_search_route {
    my @search_route;
    if (!@act_search_route) {
	if (@realcoords) {
	    make_net() if !$net;
	    @search_route = $net->route_to_name([@realcoords],-startindex=>0);
	}
    } else {
	@search_route = @act_search_route;
    }
    \@search_route;
}

### AutoLoad Sub
sub show_route_strname {
    require Tk::HList;

    my $t;
    my $withdraw_sub;
    if (defined $toplevel{strlist} && Tk::Exists($toplevel{strlist})) {
	if (!$show_strlist) {
	    $toplevel{strlist}->withdraw;
	} else {
	    my $was_withdrawn = $toplevel{strlist}->state ne "normal";
	    $toplevel{strlist}->deiconify;
	    # raise nur ausfhren, wenn es wirklich was zu sehen gibt
	    #$toplevel{strlist}->raise;

	    #XXX maybe combine with code below
	    if ($was_withdrawn && eval {require Tk::Placement; 1; }) {
		# XXX use placer also for other toplevels --- replace
		# all Popup(@popup_style) calls?
		warn "Use Tk::Placement, yet experimental..." if $devel_host;
		Tk::Placement::placer($toplevel{strlist}, -screen => $c,
				      -addx => 20, -addy => 25, # XXX for fvwm
				     );
	    }

	}
    } else {
	$toplevel{strlist} = $top->Toplevel(-title => M"Aktuelle Route",
				      -class => "Bbbike Routeinfo");
	$toplevel{strlist}->transient($top) if $transient;
	$withdraw_sub = sub { $toplevel{strlist}->withdraw;
			      $show_strlist = 0 };
	$toplevel{strlist}->protocol('WM_DELETE_WINDOW', $withdraw_sub);
	$t = $toplevel{strlist};
    }

    undef @route_info;
    if (defined $t) {
	$t->SelectionOwn;
	# XXX maxbytes beachten
	$t->SelectionHandle(sub { route_info_to_text() });
    }

    my($bf, $f1);
    if (defined $t) {
	$bf = $t->Frame->pack(-fill => 'x', -side => "bottom");
	$f1 = $t->Frame->pack(-fill => 'x', -side => "bottom");
    }

    if (!Tk::Exists($route_strname_lbox)) {
	if (!defined $t) {
	    die "No route_strname_lbox?!";
	}
	$route_strname_lbox = $t->Scrolled
	  ('HList',
	   -header => 1,
	   -columns => 5,
	   -selectmode => 'extended',
	   -scrollbars => 'osoe',
	   -width => 68, # XXX
	  )->pack(-expand => 1, -fill => 'both');
	$route_strname_lbox->header('create', 0, -text => M"Lnge");
	$route_strname_lbox->header('create', 1, -text => M"Gesamt");
	$route_strname_lbox->header('create', 2, -text => M"Richtung");
	$route_strname_lbox->header('create', 3, -text => M"Strae");
	$route_strname_lbox->header('create', 4, -text => "");
#	$route_strname_lbox->header('create', 5, -text => M"Zeit");
    } else {
	$route_strname_lbox->delete('all');
    }

    if ($do_route_strnames_comments && !$do_route_strnames_compact) {
	$route_strname_lbox->header('configure', 4, -text => M"Kommentar");
    } else {
	$route_strname_lbox->header('configure', 4, -text => M"");
    }

    undef $show_route_start;
    undef $show_route_ziel;
    undef @route_strnames;
    my(@search_route) = @{ get_act_search_route() };

    if (@search_route) {

	if ($do_route_strnames_orte) {
	    if (!$nearest_orte) {
		$nearest_orte = new_from_strassen Kreuzungen
		                                  Strassen => _get_orte_obj();
		$nearest_orte->make_grid;
	    }
	}

	if ($do_route_strnames_comments) {
	    if (!$comments_net) {
		make_comments_net();
	    }
	}

	$route_strname_lbox->configure
	  (-command => sub {
	       my $i = shift;
	       if (defined $search_route[$i][4] and
		   ref $search_route[$i][4] eq 'ARRAY') {
		   my @line_coords;
		   foreach my $nr ($search_route[$i][4][0]+1 ..
				   $search_route[$i][4][1]+1) {
		       my @coords = $c->coords("route-$nr");
		       push @line_coords, [ @coords ] if @coords;
		   }
		   mark_street(-coords => \@line_coords,
			       -clever_center => 1,
			      ) if @line_coords;
	       }
	   });

	# max angle meaning straight forward
	use constant ROUTE_STRAIGHT_ANGLE => 30;

	my $ges_entf = 0;
	my($next_entf, $ges_entf_s, $next_winkel, $next_richtung)
	  = ("", "", undef, "");
	my($aggr_begin_dist, $aggr_streets) = (0, "");
	my $aggr_dir = undef;
	my $last_str;
	my ($out_dist, $out_total_dist, $out_dir, $out_str);
	my $out_dist_add;
	my %seen_comments;
	for(my $i = 0; $i <= $#search_route; $i++) {
	    my($str, $index_arr);
	    my($entf, $winkel, $richtung)
	      = ($next_entf, $next_winkel, $next_richtung);
	    my $entf_s;
	    ($str, $next_entf, $next_winkel, $next_richtung, $index_arr)
	      = @{$search_route[$i]};
	    my $route_strnames_index;
	    if ($str ne '...' &&
		(!defined $last_str || $last_str ne $str)) {
		$last_str = $str;
		$str = Strassen::strip_bezirk($str);
		if (!defined $show_route_start) {
		    $show_route_start = $str;
		}
		$show_route_ziel = $str;
		if (ref $index_arr eq 'ARRAY' &&
		    defined $index_arr->[0] &&
		    defined $coords[$index_arr->[0]] &&
		    defined $coords[$index_arr->[0]+1]) {
		    my($x, $y) = ($coords[$index_arr->[0]]->[0],
				  $coords[$index_arr->[0]]->[1]);
		    push @route_strnames, [$str, $x, $y, $index_arr->[0]];
		    $route_strnames_index = $#route_strnames;
		}
	    }

	    if ($i > 0) {
		if (!$winkel) { $winkel = 0 }
		$winkel = int($winkel/10)*10;
		if ($winkel < ROUTE_STRAIGHT_ANGLE) {
		    $richtung = "";
		} else {
		    my $artikel = (!defined $Msg::lang || $Msg::lang =~ /^(|de)$/
				   ? Strasse::de_artikel($str)
				   : "=>");
		    $richtung =
		      ($winkel <= 45 ? M"halb" : '') .
			($richtung eq 'l' ? M"links" : M"rechts") . " " .
			  "($winkel) " . $artikel;
		}

		if ($do_route_strnames_orte) {
		    my($nearest_ort_xy) =
			$nearest_orte->nearest_loop
			    ($realcoords[$index_arr->[0]]->[0],
			     $realcoords[$index_arr->[0]]->[1],
			     IncludeDistance => 1);
		    if ($nearest_ort_xy) {
			my $ort = $nearest_orte->get_first($nearest_ort_xy->[0]);
			# XXX evtl. Ort-Kat fr 1000 beachten
			my $in_bei = ($nearest_ort_xy->[1] <= 1000
				      ? M"in" : M"bei");
			$richtung = "$in_bei " .
			            (Strassen::split_ort($ort))[0] .
				    ": $richtung";
		    }
		}

		$ges_entf += $entf;
		$ges_entf_s = "(" . m2km($ges_entf) . ")";
		$entf_s = M("nach")." ".m2km($entf, 3, 2);
		if (defined $route_strnames_index) {
		    $route_strnames[$route_strnames_index]->[4]
		      = m2km($ges_entf);
		}
	    } elsif (@coords > 1) {
		my $compass = uc(opposite_direction(line_to_canvas_direction
						    (@{ $coords[0] }, @{ $coords[1] })));
		if (defined $Msg::lang && $Msg::lang =~ /^en/) {
		    $compass =~ s/([NESW])/{N => 'north',
					    E => 'east',
					    S => 'south',
					    W => 'west'}->{$1}/gei;
		    $richtung = $compass . "ward";
		} else {
		    $richtung = M("nach")." ".$compass;
		}
	    }

	    if ($do_route_strnames_compact) {
#		$aggr_dist += $entf if defined $entf;
		if (!defined $aggr_dir) {
		    $aggr_dir = $richtung;
		}
		if (!defined $aggr_begin_dist) {
		    $aggr_begin_dist = $entf;
		    $out_dist_add = 0;
		} else {
		    $out_dist_add += $entf;
		}
		if ($aggr_streets ne '') {
		    $aggr_streets .= ", ";
		}
		$aggr_streets .= $str;
		if (!defined $next_winkel ||
		    $next_winkel < ROUTE_STRAIGHT_ANGLE) {
		    next;
		}
		($out_dist, $out_dir, $out_str)
		    = ($aggr_begin_dist > 0 ? M("nach")." ".m2km($aggr_begin_dist, 3, 2) : "",
		       $aggr_dir,
		       $aggr_streets);
		($aggr_begin_dist, $aggr_streets) = (undef,"");
		undef $aggr_dir;
	    } else {
		($out_dist, $out_dir, $out_str)
		    = ($entf_s, $richtung, $str);
		if (defined $out_dist_add) {
		    $out_dist += $out_dist_add;
		    undef $out_dist_add;
		}
	    }
	    $out_total_dist = $ges_entf_s;

	    $route_strname_lbox->add($i, -text => $out_dist);
	    $route_strname_lbox->itemCreate($i, 1, -text => $out_total_dist);
	    $route_strname_lbox->itemCreate($i, 2, -text => $out_dir);
	    $route_strname_lbox->itemCreate($i, 3, -text => $out_str);

	    my $etappe_comment = "";
	    if ($do_route_strnames_comments && $comments_net &&
		!$do_route_strnames_compact) {
		my @comments;
		for my $i ($index_arr->[0] .. $index_arr->[1]) {
		    my($etappe_comment) = $comments_net->get_point_comment([@realcoords], $i, \%seen_comments);
		    push @comments, $etappe_comment if defined $etappe_comment;
		}
		$etappe_comment = join("; ", @comments) if @comments;
	    }
	    $route_strname_lbox->itemCreate($i, 4, -text => $etappe_comment);
	    push @route_info, [($out_dist||""), ($out_total_dist||""),
			       $out_dir, $out_str];
	}
	$ges_entf_s = "(" . m2km($ges_entf+$next_entf) . ")";
	my $i = $#search_route + 1;
	$route_strname_lbox->add($i, -text => M("nach")." ".m2km($next_entf, 3, 2));
	$route_strname_lbox->itemCreate($i, 1, -text => "$ges_entf_s");
	$route_strname_lbox->itemCreate($i, 2, -text => M"angekommen!");
	push @route_info, [M("nach")." ".m2km($next_entf, 3, 2),
			   $ges_entf_s, M"angekommen!"];

	my(@children) = $route_strname_lbox->info('children');
	my $last_i = $children[-1];
	for(my $j = $i+1; $j<=$last_i; $j++) {
	    $route_strname_lbox->delete($j);
	}
	if ($do_route_strnames) {
	    $c->delete("routename");
	    route_strname_on_map(\@route_strnames);
	}
	$toplevel{strlist}->raise;
    } else {
	$route_strname_lbox->add(0, -text => M"Keine Route");
    }

    return if !defined $t;

    my $do_route_strnames_sub = sub {
	$c->delete("routename");
	if ($do_route_strnames) {
	    route_strname_on_map(\@route_strnames);
	}
    };
    my $cb1 = $f1->Checkbutton(-text => M"Straennamen an der Route",
			       -variable => \$do_route_strnames,
			       -font => $font{'small'},
			      )->pack(-side => 'left');
    my $cb2 = $f1->Checkbutton(-text => M"km-Angaben",
			       -variable => \$do_route_strnames_km,
			       -command => $do_route_strnames_sub,
			       -font => $font{'small'},
			      )->pack(-side => 'left');
    my $cb2_enabler = sub {
	$cb2->configure(-state => $do_route_strnames ? "normal" : "disabled");
    };
    $cb2_enabler->();
    $cb1->configure(-command => sub {
			$cb2_enabler->();
			$do_route_strnames_sub->();
		    });

    if ($advanced) { # XXX funktioniert noch nicht richtig...
	$f1->Checkbutton(-text => M"Kompakt",
			 -variable => \$do_route_strnames_compact,
			 -command => \&show_route_strname,
			 -font => $font{'small'},
			)->pack(-side => 'left');
    }
    $f1->Checkbutton(-text => M"Orte einbinden",
		     -variable => \$do_route_strnames_orte,
		     -command => \&show_route_strname,
		     -font => $font{'small'},
		    )->pack(-side => 'left');
    $f1->Checkbutton(-text => M"Kommentare",
		     -variable => \$do_route_strnames_comments,
		     -command => \&show_route_strname,
		     -font => $font{'small'},
		    )->pack(-side => 'left');

    my $endb = $bf->Button(Name => 'end',
			   -command => $withdraw_sub,
			  )->pack(-side => 'left');
    $bf->Button
      (-text => M"Sichern",
       -command => sub {
	   my($file) = $bf->getSaveFile
	       (($os eq 'win' ? (-defaultextension => '.TXT') : ()),
		-title => M"Route sichern",
		-initialdir => $tmpdir,
	       );
	   return if !defined $file;
	   if ($os eq 'win' and $file !~ /\.txt$/i) {
	       $file .= '.TXT';
	   }
	   make_backup($file);
	   if (open(ROUTE, ">$file")) {
	       print ROUTE route_info_to_text();
	       close ROUTE;
	   } else {
	       status_message
		   (Mfmt("Schreiben auf <%s> nicht mglich: %s", $file, $!),
		    'err');
	   }
       },
      )->pack(-side => 'left');
    # If there is a txt => palm converter and a palm transfer program,
    # then show this button:
    require BBBikePalm;
    if (can_create_and_transfer_palm_docs()) {
	create_palm_button($bf)->pack(-side => 'left');
    }
    my $print_text_sub = sub {
	my $font = shift;
	if (!$show_route_start) { $show_route_start = "???" }
	if (!$show_route_ziel)  { $show_route_ziel = "???" }
	if ($^O eq 'MSWin32' && defined &Win32Util::start_txt_print) {
	    require POSIX;
	    my $temp = POSIX::tmpnam(); # XXX it never gets deleted
	    $temp =~ tr{/}{\\};
	    $temp =~ s/\.$//;
	    $verbose and warn "Using $temp as the temp file for hardcopying\n";
	    open(TMP, ">$temp") or status_message("Can't write to $temp: $!", "die");
	    print TMP Mfmt("Route von %s bis %s",
			   $show_route_start, $show_route_ziel), "\n";
	    print TMP route_info_to_text();
	    close TMP;
	    Win32Util::start_txt_print($temp);
	    $tmpfiles{$temp}++;
	} elsif (1) { # XXX make an option
	    print_text_pdflatex
		(route_info_to_latex());
	} else {
	    print_text_postscript
		(route_info_to_text(),
		 -columns => 1,
		 -header => Mfmt("Route von %s bis %s",
				 $show_route_start, $show_route_ziel),
		 -font => $font,
		);
	}
    };
    my $db;
    $db = $bf->Button
      (-text => M"Drucken",
       -command => sub { $print_text_sub->($ps_fixed_font||"Courier7") },
      )->pack(-side => 'left');
    $bf->Button
      (-text => M"Mail",
       -command => sub {
	   if (@route_info) {
	       $show_route_start = "???" unless $show_route_start;
	       $show_route_ziel  = "???" unless $show_route_ziel;
	       enter_send_mail
		 (Mfmt("BBBike-Route von %s bis %s",
		       $show_route_start, $show_route_ziel),
		  -data => route_info_to_text());
	   }
       })->pack(-side => 'left');
    $bf->Button
      (-text => M"Fax",
       -command => sub {
	   if (@route_info) {
	       $show_route_start = "???" unless $show_route_start;
	       $show_route_ziel  = "???" unless $show_route_ziel;
	       enter_send_fax
		 (Mfmt("BBBike-Route von %s bis %s",
		       $show_route_start, $show_route_ziel),
		  -data => route_info_to_text());
	   }
       })->pack(-side => 'left');
    $t->bind('<Up>'   => sub { $route_strname_lbox->yview(scroll => -1,
							  'units') });
    $t->bind("<Down>" => sub { $route_strname_lbox->yview(scroll => 1,
							  'units') });
    $endb->focus;
    #$t->Popup(@popup_style);

    my $was_withdrawn = $t->state ne "normal";
    if ($was_withdrawn) {
	if (eval {require Tk::Placement; 1; }) {
	    # XXX use placer also for other toplevels --- replace
	    # all Popup(@popup_style) calls?
	    warn "Use Tk::Placement, yet experimental...";
	    Tk::Placement::placer($t, -screen => $c,
				  -addx => 20, -addy => 25, # XXX for fvwm
				 );
	} else {
	    $t->withdraw;
	    my($x,$y) = ($top->rootx+$top->width-10, $top->rooty+$top->height-30);
	    $t->idletasks;
	    $x -= $t->reqwidth;
	    $y -= $t->reqheight;
	    $x = 0 if ($x < 0);
	    $y = 0 if ($y < 0);
	    $t->geometry("+$x+$y");
	    $t->deiconify;
	}
    }
}

sub route_info_to_text {
    my $text = sprintf("%-14s %-10s %-26s %s\n",
		       M"Lnge", M"Gesamt", M"Richtung", M"Strae");
    $text .= "-" x 70 . "\n";
    $text .= join "", map { sprintf("%-14s %-10s %-26s %s\n", @$_) } @route_info;
    $text;
}

sub _get_route_title {
    my $route_name = "BBBike-Route";
    if (defined $show_route_start and
	defined $show_route_ziel) {
	my $start = Strasse::short(Strassen::strip_bezirk($show_route_start), 3); # Start besser abkrzen --- ist meist immer der Gleiche
	my $ziel  = Strasse::short(Strassen::strip_bezirk($show_route_ziel), 2);
	$route_name = "BBBike: $start-$ziel";
    }
    $route_name;
}

sub route_info_to_html {
    my $html_route_name = _get_route_title();
    eval {
	require HTML::Entities;
	HTML::Entities::encode_entities($html_route_name);
    };
    warn $@ if $@;
    my $html = "<html><head><title>$html_route_name</title></head><body>";
    $html .= join "", map { sprintf(" %s %s<br>\n%s <b>%s</b><br><br>\n", @$_) } @route_info;
    $html .= "</body></html>";
    $html;
}

# More tweaking could be done (other font face/size, real wide margins...)
sub route_info_to_latex {
    my $route_title = _get_route_title();
    # escape for latex missing XXX
    my $latex = <<'EOF';
\documentclass[10pt]{article}
\usepackage[latin1]{inputenc}
\usepackage[widemargins]{a4}
\usepackage{german}
\usepackage{supertabular}
\pagestyle{empty}
\sloppy
\begin{document}
EOF
    $latex .= "\\section*{$route_title}\n";
    $latex .= <<'EOF';
\begin{supertabular}{lllp{8cm}}
EOF
    $latex .= join(" & ", M"Lnge", M"Gesamt", M"Richtung", M"Strae") . "\\\\\n";
    $latex .= "\\hline \\\\\n";

    $latex .= join "", map {
	join(" & ", map { s/=>/\$\\rightarrow{}\$/g; $_ } @$_) . "\\\\\n"
    } @route_info;
    $latex .= <<'EOF';
\end{tabular}
\end{document}
EOF
    $latex;
}

sub update_route_strname {
    if (defined $toplevel{strlist} && Tk::Exists($toplevel{strlist})) {
	show_route_strname();
    }
}

sub make_net {
    my(%args) = @_;
    IncBusy($top);
    $progress->Init(-label => M("Berechnen des Straennetzes")."...",
		    -dependents => $c,
		    -visible => 1,
		   );

    my $user_dels;
    if ($net && $net->{_Deleted}) { # remember user dels
	require Data::Dumper;
	# clone:
	$user_dels = eval substr(Data::Dumper::Dumper($net->{_Deleted}), 7);
    }

    eval {
	my(@net_source, @net_source_abk);
	if ($net_type eq "r") {
	    if (!$str_obj{'r'}) {
		$str_obj{'r'} = new Strassen $str_file{'r'};
	    }
	    push @net_source,     $str_obj{'r'};
	    push @net_source_abk, 'r';
	} elsif ($net_type eq "us" || $net_type eq 'rus') {
	    my @abk = ($net_type eq 'us' ? qw(u b) : qw(u b r));
	    foreach (@abk) {
		if (!$str_obj{$_}) {
		    $str_obj{$_} = new Strassen $str_file{$_};
		}
		push @net_source,     $str_obj{$_};
		push @net_source_abk, $_;
	    }
	} elsif ($net_type eq 'custom') {
	    while(my($abk,$val) = each %str_draw) {
		if ($val && $abk =~ /^L\d/) {
		    eval {
			if (!$str_obj{$abk}) {
			    $str_obj{$abk} = new Strassen $str_file{$abk};
			}
			push @net_source, $str_obj{$abk};
			push @net_source_abk, $abk;
		    };
		    warn "Cannot get Strassen for $abk: $@" if $@;
		}
	    }
	} else {
	    if ($str_obj{'l'}) {
		push @net_source,     $str_obj{'l'};
		push @net_source_abk, 'l';
	    }
	    if ($str_obj{'s'}) {
		my $is_restricted = 0;
#XXX use new_copy_restricted
		foreach (keys %{$str_restrict{'s'}}) {
		    if ($str_restrict{'s'}->{$_} == 0 &&
			$str_restrict{'s'} ne 'P') { # Pltze
			$is_restricted = 1;
			last;
		    }
		}
		if ($is_restricted) {
		    my $restr_str = new Strassen;
		    $str_obj{'s'}->init;
		    while(1) {
			my $ret = $str_obj{'s'}->next;
			last if !@{$ret->[Strassen::COORDS]};
			next if !$str_restrict{'s'}->{$ret->[Strassen::CAT]};
			$restr_str->push($ret);
		    }
		    $restr_str->{File} = $str_obj{'s'}->file;
		    $restr_str->{Id}   = $str_obj{'s'}->id . "_restr_" . join("_", keys %{$str_restrict{'s'}});
		    push @net_source,     $restr_str;
		    push @net_source_abk, 's';
		} else {
		    if ($str_obj{'s'}) {
			push @net_source,     $str_obj{'s'};
			push @net_source_abk, 's';
		    }
		}
	    }
	    if (!@net_source) { # XXX n
		my(@str_types) = ('s');
		if ($args{'-l_add'}) {
		    push @str_types, 'l';
		}
		foreach my $str_type (@str_types) {
		    cache_decider_init();
		    my $str = new Strassen $str_file{$str_type};
		    if (cache_decider() && $coord_system eq 'standard') {
			$str_obj{$str_type} = $str;
		    }
		    push @net_source,     $str;
		    push @net_source_abk, $str_type;
		}
	    }
	}

	if (@net_source == 0) {
	    die "Netz kann nicht berechnet werden, keine Sourcen";
	} elsif (@net_source == 1) {
	    $net = new StrassenNetz $net_source[0];
	} else {
	    $multistrassen = new MultiStrassen @net_source;
	    $net = new StrassenNetz $multistrassen;
	}

	$net->source(@net_source);
	$net->source_abk(@net_source_abk);

	my $make_net_all = sub {
	    if (defined $global_search_args{Algorithm} &&
		$global_search_args{Algorithm} =~ /^C-A\*-2/) {
		$net->use_data_format($StrassenNetz::FMT_MMAP);
	    } else {
		$net->use_data_format($StrassenNetz::FMT_HASH);
	    }
	    $net->make_net(Progress => $progress,
			   UseCache => 0,
			  );

	    if ($net_type eq "s") {
		my @sperre_type;
		foreach ('einbahn', 'einbahn-strict', 'sperre', 'tragen', 'wegfuehrung') {
		    push @sperre_type, $_ if $sperre{$_};
		}
		if (@sperre_type) {
		    eval {
			$net->make_sperre($sperre_file,
					   Type => \@sperre_type);
		    }; warn $@ if $@;
		}
		if ($sperre{'Q3'}) {
		    eval {
			$net->make_sperre("qualitaet_s", Type => ['Q3']);
			if ($str_obj{'l'}) {
			    $net->make_sperre("qualitaet_l", Type => ['Q3']);
			}
		    }; warn $@ if $@;
		}
		if ($use_faehre) {
		    $net->add_faehre($str_file{'e'});
		}
	    } elsif ($net_type eq 'us' || $net_type eq 'rus') {
		my @abk = ($net_type eq 'us' ? qw(u b) : qw(u b r));
		my @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
		     });
	    }
	};

	if ($use_mldbm) {
	    eval {
		warn "Trying MLDBM cache...\n";
		$net->load_net_mldbm;
		warn "OK!\n";
	    };
	    if ($@) {
		$make_net_all->();
		eval {
		    warn "Saving MLDBM cache...\n";
		    $net->save_net_mldbm;
		    warn "OK!\n";
		};
		warn __LINE__ . ": $@" if $@;
	    }
	} else {
	    $make_net_all->();
	}

	if ($verbose) {
	    warn $net->statistics;
	}
	status_message("");
	delete $pending{'recalc-net'};
    };
    status_message($@, 'err') if ($@);

    if ($user_dels) {
	restore_user_dels($net, $user_dels);
    }

    $progress->Finish;
    DecBusy($top);
}

sub make_qualitaet_net {
    if (!$qualitaet_s_net) {
	eval {
	    $qualitaet_s_net = StrassenNetz->new
		(MultiStrassen->new(Strassen->new("qualitaet_s"),
				    Strassen->new("qualitaet_l")));
	    $qualitaet_s_net->make_net_cat;
	};
	if ($@ && !$no_original_datadir) {
	    status_message($@, "info");
	}
    }
    $qualitaet_s_net;
}

sub make_handicap_net {
    if (!$handicap_s_net) {
	eval {
	    $handicap_s_net = StrassenNetz->new
		(MultiStrassen->new(Strassen->new("handicap_s"),
				    Strassen->new("handicap_l")));
	    $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"} = Strassen->new("comments");
    }
    if ($str_obj{"comm"}) {
	$comments_net = new StrassenNetz $str_obj{"comm"};
	$comments_net->make_net_cat(-net2name => 1,
				    -multiple => 1,
				    -obeydir => 1);
    }
}

# User definable blockings
sub load_user_dels {
    my $file = shift || "$bbbike_configdir/userdels.bbd";
    $net->load_user_deletions
	($file,
	 -oncallback  => sub { set_usercross_image(@_) }, #XXX do not duplicate
	 -offcallback => sub { # XXX do not duplicate
	     my($xy1,$xy2) = @_;
	     $c->delete("delnet-$xy1-$xy2");
	     $c->delete("delnet-$xy2-$xy1");
	 },
	);
    _restore_cursor();
}

sub _save_umask (&) {
    my $code = shift;
    my $old_umask;
    eval {
	$old_umask = umask;
    };
    eval {
	$code->();
    };
    my $err = $@;
    if (defined $old_umask) {
	umask $old_umask;
    }
    die $err if $err;
}

sub save_user_dels {
    my $file = shift || "$bbbike_configdir/userdels.bbd";
    my(%args) = @_;
    _save_umask {
	umask 022;
	$net->save_user_deletions($file, %args);
    };
}

sub restore_user_dels {
    my($net, $user_dels) = @_;
    # restore user deletions
    while(my($k1,$v1) = each %$user_dels) {
	while(my($k2,$v2) = each %$v1) {
	    my $ok;
	    if (exists $net->{Net}{$k1}{$k2}) {
		$net->{_Deleted}{$k1}{$k2} = $net->{Net}{$k1}{$k2};
		$ok++;
	    }
	    if (exists $net->{_Deleted}{$k1}{$k2}) {
		$ok++;
	    }
	    if (exists $net->{Net}{$k2}{$k1}) {
		$net->{_Deleted}{$k2}{$k1} = $net->{Net}{$k2}{$k1};
		$ok++;
	    }
	    if (exists $net->{_Deleted}{$k2}{$k1}) {
		$ok++;
	    }
	    if ($ok) {
		$net->del_net($k1, $k2, 2);
		# image still exists (well it should)
	    } else {
		$c->delete("delnet-$k1-$k2");
		$c->delete("delnet-$k2-$k1");
	    }
	}
    }
}

sub delete_user_dels {
    if ($top->messageBox(-message => M"Alle benutzerdefinierten Sperrungen lschen?",
			 -type => "YesNo",
			 -icon => "question") =~ /^yes/i) {
	$net->remove_all_from_deleted(sub {
					  my($xy1,$xy2) = @_;
					  $c->delete("delnet-$xy1-$xy2");
					  $c->delete("delnet-$xy2-$xy1");
				      });
	_restore_cursor();
    }
}

# Return "x,y"
sub set_coords_str {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] eq 'p' or $tags[0] eq 'pp' or $tags[0] =~ /^lsa/) {
	$tags[1];
    } elsif ($tags[0] =~ /^[sSlL]$/) {
	my($pos, @points) = nearest_line_points_mouse($c, @tags);
	make_net() if !$net;
	if ($net->can("adjust_to_nearest")) {
	    $points[0] = [ split /,/,
			   $net->adjust_to_nearest(join ",", @{$points[0]})
			 ];
	} else {
	    $net->add_net($pos, @points);
	}
	my($x, $y) = @{$points[0]};
	Route::_coord_as_string([$x,$y]);
    } else {
	my($item, @tags) = find_below($c, qw/s l p pp lsa/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, s noch l sollte nicht vorkommen!";
    }
}

### AutoLoad Sub
sub set_coords_rbahn {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] =~ /^r-[bf]g/) {
	Route::_coord_as_string([$tags[2], $tags[3]]);
    } 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/) {
	Route::_coord_as_string([$tags[2], $tags[3]]);
    } else {
	my($item, @tags) = find_below($c, qw/u-bg b-bg u-fg u-bg/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, o, s noch l sollte nicht vorkommen!";
    }
}

### AutoLoad Sub
sub set_coords_bahn {
    my($c, @tags) = @_;
    @tags = $c->gettags('current') if !@tags;
    return if !@tags;
    if ($tags[0] =~ /^[ubr]-[bf]g/) {
	Route::_coord_as_string([$tags[2], $tags[3]]);
    } else {
	my($item, @tags) = find_below($c, qw/u-bg b-bg u-fg u-bg r-bg r-fg/);
	return if !defined $item;
	set_coords($c, @tags); # hoffentlich keine Endlosrekursion...
	#die "Tag [@tags] ist weder p, pp, o, s noch l sollte nicht vorkommen!";
    }
}

# 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 {
    # XXX zur Zeit nur Lschen mglich
    return unless $net;
#    my(@tags) = $c->gettags('current');
#    return if !@tags;
#    if ($tags[0] =~ /^[sSlL]$/) {
    my(@click_items) = ($net_type eq 's'
			? qw(s l)
			: ($net_type =~ /^(r|us|rus)$/
			   ? map { $_ eq 's' ? 'b' : $_ } split //, $net_type
			   : warn "Unhandled net type $net_type"
			  )
		       );
    my($item, @tags) = find_below($c, @click_items);
    if (defined $item) {
	my($pos, @points) = nearest_line_points_mouse($c, @tags);
	my($xy1,$xy2) = (join(",",@{$points[1]}), join(",",@{$points[2]}));
	$net->toggle_deleted_line
	    ($xy1,$xy2,
	     sub {
		 my($xy1,$xy2) = @_;
		 set_usercross_image($xy1,$xy2)
	     },
	     sub {
		 my($xy1,$xy2) = @_;
		 $c->delete("delnet-$xy1-$xy2");
		 $c->delete("delnet-$xy2-$xy1");
		 _restore_cursor();
	     });
    }
}

### AutoLoad Sub
sub set_usercross_image {
    my($xy1,$xy2) = @_;
    if (!$usercross_photo) {
	$usercross_photo =
	    load_photo($top, 'usercross.' . $default_img_fmt);
    }
    my($x1,$y1,$x2,$y2) = (split(/,/,$xy1), split(/,/,$xy2));
    my($midx,$midy) = (int(($x2-$x1)/2+$x1), int(($y2-$y1)/2+$y1));
    ($midx,$midy) = transpose($midx, $midy);
    $c->createImage($midx+2,$midy-1,
		    -image => $usercross_photo,
		    -tags => ["delnet", "delnet-$xy1-$xy2"]);
}

### AutoLoad Sub
sub _restore_cursor {
    if ($c->{SavedCursor}) {
	$c->set_cursor($c->{SavedCursor});
	undef $c->{SavedCursor};
    }
}

sub set_cursor {
    my $type = shift;
    if (!defined $type) {
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
	status_message('');
    } elsif (exists $cursor{$type}) {
	if (exists $cursor_mask{$type}) {
	    #$c->configure(-cursor =>
	    $c->set_cursor(['@' . $cursor{$type},
			    $cursor_mask{$type},
			    'black', 'white']);
	} else {
	    #$c->configure(-cursor =>
	    $c->set_cursor(['@' . $cursor{$type}, 'black']);
	}
    } else {
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
    }
    if (defined $type && $type eq 'start') {
	status_message(M"Start auswhlen");
    } elsif (defined $type && $type eq 'ziel') {
	status_message(M"Ziel auswhlen");
    }
}

### AutoLoad Sub
sub set_cursor_data {
    my $data = shift;
    my $tmpfile = "$tmpdir/cursor.$$.xbm";
    if (open(C, ">$tmpfile")) {
        print C $data;
	close C;
	#$c->configure(-cursor => ['@' . $tmpfile, 'black']);
	$c->set_cursor(['@' . $tmpfile, 'black']);
	unlink $tmpfile;
    } else {
	warn "Can't set cursor data with file $tmpfile: $!";
	#$c->configure(-cursor => undef);
	$c->set_cursor(undef);
    }
}

### AutoLoad Sub
sub set_route_start_street {
    my $street = shift;
    my $coord = choose_from_plz(-str => $street,
				-noshow => 0);
    set_route_start($coord) if $coord;
}

### AutoLoad Sub
sub set_route_ziel_street {
    my $street = shift;
    my $coord = choose_from_plz(-str => $street,
				-noshow => 1);
    set_route_ziel($coord) if $coord;
}

# Setzt den Start-Punkt der Route
# Eingabe ist "$x,$y" (realcoords)
# XXX viel Redundanz mit search_route_mouse!
### AutoLoad Sub
sub set_route_start {
    my $xy = shift;
    return if !defined $xy;
    my $search_route_start = $xy;

    if (!$net) { make_net() }

    if (!$net->reachable($search_route_start)) {
	my $new_search_route_start = $net->fix_coords($search_route_start);
	if (!$new_search_route_start) {
	    $top->bell;
	    status_message(M"Der Startort ist nicht erreichbar", 'warn');
	    undef $search_route_start;
	    return; #goto CLEANUP;
	} else {
	    $search_route_start = $new_search_route_start;
	}
    }

    resetroute();

    # XXX vielleicht sollte man das unabhngige Setzen von Start/Ziel
    # ermglichen (z.B. zuerst Ziel, dann Start auswhlen). Z.Zt.
    # mu $search_route_ziel undefiniert werden.
    #XXXundef $search_route_ziel;
    $search_route_flag = 'ziel';
    my($x, $y) = transpose(split(/,/, $search_route_start));
    set_flag('start', $x, $y);
    set_cursor('ziel');

    @search_route_points = [$search_route_start, POINT_MANUELL];

    return;
}

# Setzt den Ziel-Punkt der Route
# Eingabe ist "$x,$y"
# XXX viel Redundanz mit search_route_mouse_cont!
### AutoLoad Sub
sub set_route_ziel {
    my $xy = shift;
    my(%args) = @_;
    return if !defined $xy;

#XXX dieser Teil ist halbnotwendig, falls der Startpunkt manuell
# gesetzt wurde und nearest_line_points aufgerufen werden muss.
# Allerdings funktioniert nearest_line_points anscheinend nicht ohne
# gemaltes Straennetz, wohingegen die Telefonbuch-Straen-Auswahl
# ganz gut ohne gemaltes Straennetz funktioniert.
# Deshalb vorerst disabled.
#
#     if (@realcoords) {
# 	if ($net->reachable
# 	    (Route::_coord_as_string($realcoords[$#realcoords]))) {
# 	    $search_route_start
# 	      = Route::_coord_as_string($realcoords[$#realcoords]);
# 	}
# 	my($tx, $ty) = transpose(@{$realcoords[$#realcoords]});
# 	my($pos, @points) = nearest_line_points_xy($tx, $ty);
# 	if (@points) { # XXX wirklich?
# 	    $net->add_net($pos, @points);
# 	    $search_route_start = Route::_coord_as_string($points[0]);
# 	} else {
# 	    addpoint_inter();
# 	    return;
# 	    #		$search_route_start = $search_route_ziel;
# 	}
#     }

#     my $this_search_route_start = $search_route_ziel;
#     if (!defined $this_search_route_start) {
# 	$this_search_route_start = $search_route_start;
# 	if (!defined $this_search_route_start) {
# 	    return;
# 	}
#     }

    my $this_search_route_start = $search_route_points[-1]->[SRP_COORD];
    return if (!defined $this_search_route_start);
    my $search_route_ziel = $xy;

    if (!$net) { make_net() }

    if (!$net->reachable($search_route_ziel)) {
	my $new_search_route_ziel = $net->fix_coords($search_route_ziel);
	if (!$new_search_route_ziel) {
	    $top->bell;
	    status_message(M"Der Zielort ist nicht erreichbar", 'warn');
	    undef $search_route_ziel;
	    return; #goto CLEANUP;
	} else {
	    $search_route_ziel = $new_search_route_ziel;
	}
    }
    # XXX nicht ntig? my($x, $y) = transpose(split(/,/, $search_route_ziel));
    search_route($this_search_route_start, $search_route_ziel,
		 undef, 'cont', %args);
    update_route_strname();
}

sub search_route_mouse {
    my $by_button = shift;
    $map_mode = MM_SEARCH;
    if (!$search_route_flag) {
	$search_route_flag = 'start';

	if (!$lowmem) {
	    if ($net_type eq "s") {
		if (!$net and ($str_draw{'s'} || $str_draw{'l'})) {
		    make_net();
		}
	    }
	    # XXX $str_draw{'r'} ueberprfen, wenn im RB-Mode
	    $net->reset if ($net);
	} else {
	    warn M"`Straennetz neu berechnen' vor Suche anklicken!\n";
	}

	set_cursor('start');
	return;
    } elsif ($search_route_flag eq 'start') {
	if ($by_button) {
	    undef $search_route_flag;
	    goto CLEANUP;
	}
	my $search_route_start = set_coords($c);
	return if !defined $search_route_start;

	if (!$net->reachable($search_route_start)) {
	    $top->bell;
	    status_message(M"Der Startort ist nicht erreichbar", 'warn');
	    undef $search_route_start;
	    return; #goto CLEANUP;
	}
	$search_route_flag = 'ziel';
	my($x, $y) = transpose(split(/,/, $search_route_start));
	set_flag('start', $x, $y);
	set_cursor('ziel');
	@search_route_points = [$search_route_start, POINT_MANUELL];
	return;
    } else { # ziel
	if ($by_button) {
	    undef $search_route_flag;
	    goto CLEANUP;
	}
	my $search_route_ziel = set_coords($c);
	return if !defined $search_route_ziel;
	if (!$net->reachable($search_route_ziel)) {
	    $top->bell;
	    status_message(M"Der Zielort ist nicht erreichbar", 'warn');
	    undef $search_route_ziel;
	    return; #goto CLEANUP;
	}
	status_message('');
	my $this_search_route_start = $search_route_points[-1]->[SRP_COORD];
	return if !defined $this_search_route_start;
	search_route($this_search_route_start, $search_route_ziel);

	# XXX duplicate code (see above)
	undef $search_route_flag;
	update_route_strname();
	search_route_mouse_cont();
	return;
    }

  CLEANUP:
    undef $search_route_flag;
    set_cursor(undef);
}

# Setzt das Suchen einer Route vom bisherigen Endpunkt fort.
# Der neue Zielpunkt wurde gerade per Maus angeklickt.
sub search_route_mouse_cont {
    if (!$search_route_flag) {
	# ??? Es existiert noch kein Startpunkt.
	$search_route_flag = 'ziel_cont';
	set_cursor('ziel');
	return;
    } else {
	my $this_search_route_start;
	if (!$net) { make_net() } # Netz wird neu berechnet
	if (@realcoords) { # Es existieren bereits Punkte in der Route.
	    if ($net->reachable
		(Route::_coord_as_string($realcoords[-1]))) {
		# Der vorherige Zielpunkt ist direkt erreichbar (Punkt
		# existiert in der Datenbank)
		$this_search_route_start
		    = Route::_coord_as_string($realcoords[-1]);
	    } else {
		# Wann tritt dieser Fall auf?
		warn "In search_route_mouse_cont, 2nd case";
		my($tx, $ty) = transpose(@{$realcoords[-1]});
		my($pos, @points) = nearest_line_points_xy($tx, $ty);
		if (@points) { # XXX wirklich?
		    $net->add_net($pos, @points);
		    $this_search_route_start = Route::_coord_as_string($points[0]);
		    @{$realcoords[-1]} = @{$points[0]}; # XXXX workaround
		    # der aber nicht stimmt, wenn der letzte Punkt ber
		    # freehand eingegeben wurde ...
		    # sigh, der ganze search_route_mouse_cont-Kram braucht eine
		    # krftige berarbeitung ... :-(
		} else {
		    addpoint_inter();
		    return;
		}
	    }
	}
	my $search_route_ziel = set_coords($c);
	return if !defined $search_route_ziel;
	if (!$net->reachable($search_route_ziel)) {
	    $top->bell;
	    status_message(M"Der Zielort ist nicht erreichbar", 'warn');
	    #$search_route_ziel = $this_search_route_start;
	    #undef $search_route_start;
	    return; #goto CLEANUP;
	}
	status_message('');
	search_route($this_search_route_start, $search_route_ziel,
		     undef, 'cont');

	update_route_strname();
    }
  CLEANUP:
}

sub plugin_menu {
    my $opbm = shift;
    $opbm->command(-label => M"Plugin laden",
		   -command => sub {
		       my($file) = $top->getOpenFile
			   (-title => M("Plugin laden"),
			    -filetypes => [[M"Perl-Module" => '.pm'],
					   [M"Alle Dateien" => '*']],
			   );
		       if (defined $file) {
			   load_plugin($file);
		       }
		   });
    $opbm->command(-label => M"Alle Plugins zeigen",
		   -command => sub {
		       require BBBikePlugin;
		       BBBikePlugin::find_all_plugins($FindBin::RealBin, $top);
		   });
}

sub menu_entry_up_down {
    my($menu, $tag_group) = @_;
    my(@tags) = @$tag_group;
    $menu->separator;
    my $x; # dummy
    $menu->radiobutton(-label => M"oben zeichnen",
		       -variable => \$x,
		       -command => sub {
			   foreach (@tags) { special_raise($_, 0) }
			   restack();
		       });
    $menu->radiobutton(-label => M"normal",
		       -variable => \$x,
		       -command => sub {
			   foreach (@tags) { special_normal($_, 0) }
			   restack();
		       });
    $menu->radiobutton(-label => M"unten zeichnen",
		       -variable => \$x,
		       -command => sub {
			   foreach (reverse @tags) { special_lower($_, 0) }
			   restack();
		       });
}

sub menu_entry_choose_ort {
    my($menu, $abk, %args) = @_;
    if (exists $str_attrib{$abk}) {
	$menu->checkbutton(-label => $str_attrib{$abk}->[ATTRIB_PLURAL],
			   -variable => \$str_draw{$abk},
			   -command => sub { plot('str',$abk); },
			   (defined $args{'-accelerator'} ?
			    (-accelerator => $args{'-accelerator'}) :
			    (),
			   ),
			  );
	my %str_args;
	if (exists $args{'-strchooseortargs'}) {
	    %str_args = %{$args{'-strchooseortargs'}};
	}
	$menu->command(-label => Mfmt("%s auswhlen", $str_attrib{$abk}->[ATTRIB_SINGULAR]),
		       -command => sub { choose_ort('s', $abk, %str_args) });
	if ($advanced) {
	    $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 (exists $p_attrib{$abk} && exists $str_attrib{$abk}) {
	$menu->separator;
    }

    if (exists $p_attrib{$abk}) {
	$menu->checkbutton(-label => $p_attrib{$abk}->[ATTRIB_PLURAL],
			   -variable => \$p_draw{$abk},
			   -command => sub { plot('p',$abk) },
			   (defined $args{'-accelerator_p'} ?
			    (-accelerator => $args{'-accelerator_p'}) :
			    (),
			   ),
			  );
	my %p_args;
	if (exists $args{'-pchooseortargs'}) {
	    %p_args = %{$args{'-pchooseortargs'}};
	}
	$menu->command(-label => Mfmt("%s auswhlen", $p_attrib{$abk}->[ATTRIB_SINGULAR]),
		       -command => sub { choose_ort('p', $abk, %p_args) });
	if ($advanced) {
	    $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);
			     });
	}
    }
}

# bindet ein Men an die rechte Taste
sub menuright {
    my($b, $menu) = @_;
    $b->bind('<ButtonPress-3>' => sub {
		 if (0) { # old code XXX
		     $menu->Popup(-popover => $b,
				  -popanchor => 'n',
				  -overanchor => 's',
				 );
		 } else {
		     my $e = $b->XEvent;
		     my $X = $e->X;
		     my $Y = $e->Y;
		     $menu->Post($X,$Y);
		 }
	     }
	    );
}

sub menuarrow {
    my($b, $menu, $col, %args) = @_;
    return if !menuarrow_unmanaged($b, $menu, %args);
    if (defined $col) {
	$b->grid(-row => $curr_row+1, -column => $col, -sticky => 'nesw');
    } else {
	my(@packargs) = (exists $args{'-pack'} ? @{$args{'-pack'}} : ());
	$b->pack(@packargs);
    }
}

sub menuarrow_unmanaged {
    my($b, $menu, %args) = @_;
    return 0 if !$menuarrow_photo;
    $b->configure(-menu => $menu);
    $b->configure
      (-image => $menuarrow_photo,
       -takefocus => 1,
       -highlightthickness => 1,
       -indicatoron => 0,
       -bd => ($small_icons ? 0 : 2),
       -padx => 0,
       -pady => 0,
      );

    my $menulabel;
    if (defined $args{'-menulabel'}) {
	$menulabel = $args{'-menulabel'};
    } else {
	for my $inx (0 .. $menu->index('last')) {
	    if ($menu->type($inx) !~ /^(separator|tearoff)$/) {
		$menulabel = eval q{$menu->entrycget($inx, -label)};
		last if defined $menulabel;
	    }
	}
    }
    if (defined $menulabel and $menulabel ne '') {
	(my $balloonlabel = $menulabel) =~ s/~//;
	$balloon->attach($b, -msg => M("Men")." $balloonlabel...");
    }
    $menu->{BBBike_Menulabel} = $menulabel;
    $menu->{BBBike_Special}   = $args{-special};
    $b->bind('<ButtonPress-3>' => sub { $b->ButtonDown });
    1;
}

# error categories:
#  info: never pops up a dialog: either writes to stderr or to the
#        status bar if available
#  warn: warn with a dialog
#  err:  error with a dialog
#  die:  error with a dialog and die afterwards
sub status_message {
    my($msg, $err) = @_;
    if (!defined $err || $err =~ /^info/ || !$use_dialog) {
	if (!defined $progress) {
	    if (defined $err && $err eq 'info-stack-trace') {
		require Carp;
		Carp::cluck($msg);
	    } else {
		warn "$msg\n";
	    }
	} else {
	    $msg =~ s/\n+\z//;
	    $status_label->configure(-text => $msg);
	    if ($msg =~ /\n/) {
		set_status_button
		    (-text => "OK",
		     -command => sub {
			 status_message("", "info");
		     });
	    } else {
		remove_status_button();
	    }
	}
    } else {
	# warn or error
	if (!$top) {
	    warn "$msg\n";
	} else {
	    $splash_screen->Destroy if $splash_screen; undef $splash_screen;
	    require Tk::Dialog;
	    my $d = $top->Dialog
	      (-title  => ($err eq 'warn' ? 'Warnung' : 'Fehler'),
	       -text   => $msg,
	       -bitmap => ($err eq 'warn' ? 'warning' : 'error'),
	      );
	    $d->Show;
	}
    }
    if (defined $err && $err eq 'die') { # also die
	require Carp;
	Carp::confess($msg);
    }
}

sub set_status_button {
    my(%args) = @_;
    $status_button->grid(-column => $status_button_column,
			 -row => 0);
    if (!$args{-command}) {
	die "-command missing";
    }
    my $cmd = $args{-command};
    $args{-command} = sub {
	$cmd->();
	remove_status_button();
    };
    $status_button->configure(%args);
}

sub remove_status_button {
    if ($status_button->manager) {
	$status_button->configure(-text => "", -command => \&Tk::NoOp);
	$status_button->gridForget;
    }
}

sub add_new_point {
    my $net   = shift;
    my $point = shift;
    my(%args) = @_;
    my($rx, $ry) = split(/,/, $point);
    my($tx, $ty) = transpose($rx, $ry);
    my($pos, @points) = nearest_line_points_xy($tx, $ty);
    # Korrektur des mittleren Punktes
    $points[1] = [$rx, $ry];
    if (@points) {
	$net->add_net($pos, @points);
    }
    unless ($args{'-quiet'}) {
	if (!$net->reachable($point)) {
	    status_message(Mfmt("Der Punkt <%s> existiert im Netz nicht und kann auch nicht erzeugt werden", $pos), "die");
	}
    }
    join(",", @{ $points[1] });
}

sub nearest_line_points_xy {
    my($x, $y) = @_;
    my $start;
    my %seen;
    my $stage = 'closest';
    my @find;
    my $find_i;
my $safe_loop = 0; #XXX
    while (1) {
die "too many loops, please report, line " . __LINE__ if ($safe_loop++ > 100);
	my $find;
	if ($stage eq 'closest') {
	    $find = $c->find('closest', $x, $y, 0, $start);
	    if (defined $find and $find ne '') {
		if (exists $seen{$find}) {
		    $stage = 'overlapping';
		    next;
		}
	    }
	} elsif ($stage eq 'overlapping') {
	    if (!@find) {
		@find = $c->find('overlapping', $x-2, $y-2, $x+2, $y+2);
		$find_i = 0;
	    }
	    return undef if $find_i > $#find;
	    $find = $find[$find_i];
	    $find_i++;
	}
	my @tags = $c->gettags($find);
        if ($net_type eq "r") {
	    if ($tags[0] eq 'r') {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} elsif ($net_type eq "us") {
	    if ($tags[0] =~ /^[ub]$/) {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} elsif ($net_type eq "rus") {
	    if ($tags[0] =~ /^[ubr]$/) {
		return nearest_line_points($x, $y, @tags); # XXX
	    }
	} else {
	    if ($tags[0] =~ /^[sSlL]$/) {
		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;
    nearest_line_points($x, $y, @tags);
}

# Input arguments:
#   x/y: current canvas coordinates
#   tags: tags of the current canvas item
# Output:
#   ($index, middlepoint(new), firstpoint, secondpoint)
#   points are real coordinates
sub nearest_line_points {
    my($x, $y, @tags) = @_;
    my(@realcoords, @coords);
    if (defined $tags[3] && $tags[3] =~ /^(.+)-(\d+)$/) {
	my($type, $index) = ($1, $2);
	my $s;
	$s = $str_obj{$type};
	if (!defined $s) {
	    if (exists $str_file{$type}) {
		# XXX better: create a function type_to_filename
		my $filename = ($coord_system eq 'standard'
				? $str_file{$type}
				: "$str_file{$type}-orig"
			       );
		$str_obj{$type} = new Strassen $filename;
		$s = $str_obj{$type};
	    }
	    if (!defined $s) {
		die "Streets not defined for type $type, Filename is $str_file{$type} XXX";
	    }
	} else {
	    $s->reload;
	}
	my $ret = $s->get($index);
	if ($ret and @{$ret->[Strassen::COORDS]}) {
	    # Erste Methode. $str_width wird von 2 bis 4 inkrementiert
	    # (hngt von der Breite der Straen ab).
	    for my $str_width (2 .. 4) {
		my $i;
		my($lastxx, $lastyy, $lastrx, $lastry);
		for($i = 0; $i <= $#{$ret->[Strassen::COORDS]}; $i++) {
		    if ($ret->[Strassen::COORDS][$i] =~ /^(?:[A-Z])?(-?\d+),(-?\d+)$/) {
			my($rx, $ry) = ($1, $2);
			my($xx, $yy) = transpose($rx, $ry);
			push @realcoords, $rx, $ry;
			push @coords, transpose($xx, $yy);
			if (defined $lastxx &&
			    (($x >= $lastxx-$str_width &&
			      $x <= $xx+$str_width) ||
			     ($x >= $xx-$str_width     &&
			      $x <= $lastxx+$str_width)) &&
			    (($y >= $lastyy-$str_width &&
			      $y <= $yy+$str_width) ||
			     ($y >= $yy-$str_width     &&
			      $y <= $lastyy+$str_width))) {
			    my($p1, $p2) = anti_transpose($x, $y);
			    my($fp1, $fp2) = fusspunkt($lastrx, $lastry,
						       $rx, $ry,
						       $p1, $p2);
# XXX Achtung! $index kann nicht gebraucht werden, wenn
# mit Multistrassen gearbeitet wird. Lsung?
# Zuordnung von Strassen-Indices auf Multistrassen-Indices?
#XXX			return ((defined $multistrassen ? undef : $index),
# XXX test it:
			    my(@points) = ([int_round($fp1), int_round($fp2)],
					   [$lastrx, $lastry],
					   [$rx, $ry]);
			    if ($net and
				$net->{Strassen}->isa('MultiStrassen')) {
			      SEARCH: {
				    for my $i (0 .. $#{$net->{SourceAbk}}) {
					if ($net->{SourceAbk}[$i] eq $type) {
					    $index +=
					      $net->{Strassen}{FirstIndex}[$i];
					    last SEARCH;
					}
				    }
				    warn "Can't find index for MultiStrassen...";
				    undef $index;
				}
			    }
			    return ($index, @points);
			} else {
			    ($lastxx, $lastyy) = ($xx, $yy);
			    ($lastrx, $lastry) = ($rx, $ry);
			}
		    } else {
			die "Can't parse coord: $ret->[Strassen::COORDS][$i]";
		    }
		}
	    }
 	}
	warn "nearest_line_points: failed 1st method
Tags are @tags
Type is $type
Index is $index

Try 2nd method...";
    } else {
	die "Can't find index from tags: @tags";
    }
    # 2. Methode. Die nchsten zwei Punkte in @coords werden einfach als
    # Nachbarn deklariert. Funktioniert ganz gut, es sei denn, die Strae
    # hat einen *sehr* kurvigen Verlauf (90-Kurven etc.).
    my(@coords_dist, $nearest_i);
    my $i;
    if ($#coords > 0) {
	for($i = 0; $i < $#coords; $i+=2) {
	    my($lx, $ly) = ($coords[$i], $coords[$i+1]);
	    push(@coords_dist,
		 Strassen::Util::strecke([$x, $y],
					 [$coords[$i], $coords[$i+1]]));
	    if (!defined $nearest_i or
		$coords_dist[$nearest_i] > $coords_dist[-1]) {
		$nearest_i = $#coords_dist;
	    }
	}
    }
    my @res = ([anti_transpose($x, $y)]);
    if (!defined $nearest_i) {
	die "No nearest point???";
    } elsif ($nearest_i == 0) {
	push(@res, [@realcoords[0..1]], [@realcoords[2..3]]);
    } elsif ($nearest_i == $#coords_dist) {
	my $last = $#coords_dist;
	push(@res,
	     [@realcoords[$last*2-2 .. $last*2-1]],
	     [@realcoords[$last*2   .. $last*2+1]]);
    } elsif ($coords_dist[$nearest_i-1] < $coords_dist[$nearest_i+1]) {
	push(@res,
	     [@realcoords[$nearest_i*2-2 .. $nearest_i*2-1]],
	     [@realcoords[$nearest_i*2   .. $nearest_i*2+1]]);
    } else {
	push(@res,
	     [@realcoords[$nearest_i*2   .. $nearest_i*2+1]],
	     [@realcoords[$nearest_i*2+2 .. $nearest_i*2+3]]);
    }
    (undef, @res);
}

sub city_settings {
    $str_draw{'l'}     = 0;
    $p_draw{'o'}       = 0;
    $p_far_away{'o'}   = 0;
    $str_far_away{'w'} = 0;
    $str_far_away{'l'} = 0;
    $str_regions{'l'}  = [];
    $wasserumland      = 0;
    pending(1, map { "replot-$_" } ("str-l", "p-o", "str-w", "str-l"));
}

sub region_settings {
    $str_draw{'l'}     = 1;
    $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;
    $p_draw{'o'}       = 1;
    $p_far_away{'o'}   = 1;
    $str_far_away{'w'} = 1;
    $str_far_away{'l'} = 1;
    $str_regions{'l'}  = []; # XXX Sachsen-Anhalt?
    $wasserumland      = 1;
    pending(1, map { "replot-$_" } ("str-l", "p-o", "str-w", "str-l"));
}

# Definiert, wie die grafischen Objekte "gestapelt" werden sollen.
# Also ganz unten Gewsser und Flchen, dann Straen etc. und ganz oben
# Punkte wie Haltestellen, Orte und Kreuzungen.
# Allgemeine Flchen kommen unter Gewsser, damit man z.B. bei in
# Wldern gelegenen Seen nicht aufwendig ausschneiden muss.
# Ganz oben sind die mit "Custom draw" gezeichneten Strecken.
# Weitere Regeln: Labels von Orten sind unter anderen Ortspunkten (damit
# die Ortspunkte anwhlbar bleiben), dagegen sind Labels von Bahnhfen
# ber den Bahnhofspunkten und Bahnstrecken (mssen nicht anwhlbar sein).
# Development-Hilfen (fz) ganz oben anzeigen.
sub restack {
    my @real_order;
    @real_order = real_stack_order();

    foreach (@real_order) {
	$c->raise($_);
    }

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

# gibt das aktuelle Stacking aus
sub real_stack_order {
    my @real_order;
    if (defined @set_stack_order) {
	return @set_stack_order;
    }

    push @real_order, @special_lower;
    foreach (@normal_stack_order) {
	if (!$special_lower{$_} && !$special_raise{$_}) {
	    push @real_order, $_;
	}
    }
    push @real_order, @special_raise;
    @real_order;
}

### AutoLoad Sub
sub real_type_stack_order {
    my @real_order = real_stack_order();
    my @res;
    my %seen;
    foreach my $type (@real_order) {
	$type =~ s/^([^-]*)-.*/$1/;
	if (!$seen{$type}) {
	    push @res, $type;
	    $seen{$type}++;
	}
    }
    @res;
}

### AutoLoad Sub
sub set_normal_stack_order {
    @set_stack_order = @normal_stack_order;
    %special_lower = ();
    %special_raise = ();
    restack();
}

### AutoLoad Sub
sub special_normal {
    my($abk, $delay) = @_;

    if (exists $special_lower{$abk}) {
	delete $special_lower{$abk};
	remove_from_array(\@special_lower, $abk);
    }

    if (exists $special_raise{$abk}) {
	delete $special_raise{$abk};
	remove_from_array(\@special_raise, $abk);
    }

    restack() unless $delay;
}

### AutoLoad Sub
sub special_raise {
    my($abk, $delay) = @_;

    if (exists $special_lower{$abk}) {
	delete $special_lower{$abk};
	remove_from_array(\@special_lower, $abk);
    }

    $special_raise{$abk}++;
    remove_from_array(\@special_raise, $abk);
    push @special_raise, $abk;

    restack() unless $delay;
}

### AutoLoad Sub
sub special_lower {
    my($abk, $delay) = @_;

    if (exists $special_raise{$abk}) {
	delete $special_raise{$abk};
	remove_from_array(\@special_raise, $abk);
    }
    $special_lower{$abk}++;
    remove_from_array(\@special_lower, $abk);
    unshift @special_lower, $abk;

    restack() unless $delay;
}

sub remove_from_array {
    my($a_ref, $val) = @_;
    for(my $i = 0; $i <= $#{$a_ref}; $i++) {
	if ($a_ref->[$i] eq $val) {
	    splice @$a_ref, $i, 1;
	    $i--;
	}
    }
}

sub destroy_delayed_restack {
    destroy_delayed_sub('restack');
}

sub fix_stack_order {
    my($abk) = @_;
    if (!grep { $_ eq $abk } @normal_stack_order) {
	push @normal_stack_order, $abk, "$abk-fg";
    }
}

### AutoLoad Sub
sub add_to_stack {
    my($abk, $how, $other_abk) = @_;
    return if (grep { $_ eq $abk } @normal_stack_order);
    my $i = 0;
    for (@normal_stack_order) {
	if ($_ eq $other_abk) {
	    if ($how eq 'after') {
		splice @normal_stack_order, $i+1, 0, $abk, "$abk-fg";
		return;
	    } elsif ($how eq 'before') {
		splice @normal_stack_order, $i, 0, $abk, "$abk-fg";
		return;
	    } else {
		die "Cannot handle $how in add_to_stack";
	    }
	}
	$i++;
    }
    push @normal_stack_order, $abk, "$abk-fg";
}

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 : 0,
		           -delay => $slowcpu ? 1000 : 100,
		           -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 {
	   my $t = Tk::timeofday();
	   IncBusy($top) if $busy;
	   eval {
	       warn "restack\n"
		 if $verbose;
	       $sub->();
	       warn sprintf("Delayed sub $name took %.3fs\n",
			    Tk::timeofday()-$t)
		 if $verbose;
	   };
	   warn __LINE__ . ": $@" if $@;
	   DecBusy($top) if $busy;
       });
}

### AutoLoad Sub
sub show_logo { # und About
    my $as_about = shift || '';
    return unless $use_logo || $as_about;

    my $logotop = redisplay_top($top, "about-$as_about",
				-title => ($as_about ? M('ber').' ' : '')
				. 'BBBike',
				-background => 'white');
    return if !defined $logotop;

    $logotop->optionAdd("*" . substr($logotop->PathName, 1)
			. "*background" => 'white', 'startupFile');
    $logotop->optionAdd("*" . substr($logotop->PathName, 1)
			. "*foreground" => 'blue3', 'startupFile');
    $logotop->transient($top) unless $as_about;
    my $ff = $logotop->Frame(-relief => ($as_about ? 'ridge' : 'flat'),
			     -bd => ($as_about ? 2 : 0),
			    )->pack(-fill => 'both', -expand => 1);
    my $f = $ff->Frame->pack(-side => 'left',
			     -fill => 'both', -expand => 1,
			     -padx => 4, -pady => 4,
			    );
    my $Button_or_Label = ($as_about ? "Button" : "Label");
    my $www_b =
	$f->$Button_or_Label
	    (-text =>
	     "$progname $VERSION\n" .
	     "(File Rev $PROG_REVISION)\n\n" .
	     M("Ein Informationssystem fr\n" .
	       "Radfahrer in Berlin\n\n") .
	     " 1995-2003 Slaven Rezic",
	     -font => $font{'bold'},
	     -padx => 5,
	     -pady => 0,
	     -highlightthickness => 0,
	     -relief => 'flat',
	     -borderwidth => 0,
	     ($as_about ?
	      (-command => sub {
		   require WWWBrowser;
		   WWWBrowser::start_browser($BBBike::BBBIKE_WWW);
	       },
	      ) : ())
	    )->pack(-fill => 'x');
    $balloon->attach($www_b, -msg => M"WWW-Version aufrufen")
	if $balloon;
    my $copying_b =
	$f->$Button_or_Label
	    (-text => M"Siehe auch die Datei COPYING",
	     -padx => 5,
	     -highlightthickness => 0,
	     -relief => "flat",
	     -borderwidth => 0,
	     ($as_about ?
	      (-command => sub {
		   if (open(C, "$FindBin::RealBin/COPYING")) {
		       binmode C;
		       my $t = $top->Toplevel
			   (-title => M"COPYING",
			    -class => "Bbbike Copyright",
			   );
		       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);
		   }
	       }
	      ) : ()),
	    )->pack(-fill => "x");
    if ($as_about) {
	my $os_info = "OS: $^O";
	if ($win32s) {
	    $os_info .= " (Win32S-Modus)";
	}
	if ($os eq 'win') {
	    $os_info .= " (" . ($Config{'cc'} =~ /^gcc/
				? 'gcc' :
				($Config{'cc'} eq 'cl.exe'
				 ? 'Visual C'
				 : $Config{'cc'})) . ")";
	}
	# Are we running an emulation?
	if (is_in_path("uname")) {
	    chomp(my $real_os = `uname`);
	    if ($^O !~ /^$real_os$/i) {
		$os_info .= " (Real OS: $real_os)";
	    }
	}
	$f->Label(-text => "perl $]\nTk $Tk::VERSION\n$os_info",
		  -font => $font{'small'},
		  -justify => 'left',
		 )->pack(-anchor => 'w', -expand => 1,
			 -fill => 'x');
    }
    my $mail_b =
	$f->$Button_or_Label
	    (-text => $BBBike::EMAIL,
	     -padx => 5,
	     -pady => 0,
	     -relief => 'flat',
	     -borderwidth => 0,
	     -highlightthickness => 0,
	     ($as_about ?
	      (-command => sub {
		   if ($^O eq 'MSWin32') {
		       require Win32Util;
		       Win32Util::start_mail_composer($BBBike::EMAIL);
		   } else {
		       enter_send_mail(M"BBBike perl/Tk",
				       -to => $BBBike::EMAIL,
				      );
		   }
	       }) : ()),
	     -font => $font{'normal'})->pack(-fill => 'x');
    $balloon->attach($mail_b, -msg => M"Mail an den Autor schicken")
	if $balloon;

    $ff->Label(-image => $srtbike_photo
	      )->pack(-side => 'left', -anchor => "ne");
    if ($as_about) {
	my $okb = $logotop->Button(Name => 'ok',
				   -command => sub { hide_logo($as_about) },
				  )->pack(-anchor => 'c', -pady => 4);
	$logotop->bind('<Return>' => sub { $okb->invoke });
    } else {
	$logotop->transient($top);
    }
    $logotop->withdraw;
    $logotop->Popup(-popover => ($as_about ? 'cursor' : $top));
    $logotop->update; # damit der Inhalt sofort erscheint
}

### AutoLoad Sub
sub hide_logo {
    my $as_about = shift || '';
    my $t = $toplevel{"about-$as_about"};
    if (defined $t && Tk::Exists($t)) {
	$t->destroy;
	undef $toplevel{"about-$as_about"};
    }
}

######################################################################
# Utilities ...

### AutoLoad Sub
sub usage {
    my($msg, $getopt_listref) = @_;
    my(@getopt_list) = @$getopt_listref;
    if (defined $msg) {
	$msg .= "\n";
    } else {
	$msg = '';
    }

    my @opt;
    my $i;
    for($i = 0; $i <= $#getopt_list; $i+=2) {
	if ($getopt_list[$i] =~ /([^!=]+)(!|=.)?$/) {
	    my $mod = $2 || '';
	    if ($mod eq '!') {
		push @opt, map { "[-[no]$_]" } split(/\|/, $1);
	    } else {
		push @opt, map { "[-$_$mod]" } split(/\|/, $1);
	    }
	} else {
	    push @opt, "[-$getopt_list[$i]]";
	}
    }
    die $msg . wrap("usage: $progname ", "\t", join(" ", @opt))
      . "\n";
}

### AutoLoad Sub
sub windrose { # funktioniert nur mit quadratischen Buttons
    my($senkrecht) = @_; # "Geschwindigkeit" des Scrollens
    my $e = $windrose_button->XEvent;
    my($x, $y) = ($e->x, $e->y);
    my($w, $h) = ($windrose_button->width, $windrose_button->height);
    $senkrecht = 1 unless defined $senkrecht;

    my $is_center = sub {
	my($x, $y) = @_;
	($x > $w*0.4 && $x < $w*0.6 &&
	 $y > $h*0.4 && $y < $h*0.6)
    };
    my $center_delay;

    if ($is_center->($x, $y) && !$center_delay) {
	$center_delay = $c->after
	  (1000, sub {
	       undef $center_delay;
	       my $e = $windrose_button->XEvent;
	       my($x, $y) = ($e->x, $e->y);
	       if ($is_center->($x, $y)) {
		   $c->center_view;
	       }
	   });
    } elsif ($x-0.25*$w < 0.5*$y) {
	if ($x-0.75*$w > -0.5*$y) {
	    my($y) = $c->yview;
	    $c->yview(scroll =>  $senkrecht, 'units'); # S
	} elsif ($x+0.5*$w > 2*$y) {
	    $c->yview(scroll => -$senkrecht, 'units'); # N
	    $c->xview(scroll => -$senkrecht, 'units'); # W
	} elsif ($x-1.5*$w > -2*$y) {
	    $c->yview(scroll =>  $senkrecht, 'units'); # S
	    $c->xview(scroll => -$senkrecht, 'units'); # W
	} else {
	    $c->xview(scroll => -$senkrecht, 'units'); # W
	}
    } else {
	if ($x-0.75*$w < -0.5*$y) {
	    $c->yview(scroll => -$senkrecht, 'units'); # N
	} elsif ($x+0.5*$w < 2*$y) {
	    $c->yview(scroll =>  $senkrecht, 'units'); # S
	    $c->xview(scroll =>  $senkrecht, 'units'); # E
	} elsif ($x-1.5*$w < -2*$y) {
	    $c->yview(scroll => -$senkrecht, 'units'); # N
	    $c->xview(scroll =>  $senkrecht, 'units'); # E
	} else {
	    $c->xview(scroll =>  $senkrecht, 'units'); # E
	}
    }
}

### AutoLoad Sub
sub check_font {
    my $font = shift;
    eval { $top->Label(-font => $font)->destroy };
    $@ eq '';
}

sub IncBusy {
    my($top, %args) = @_;
    return if !Tk::Exists($top);

    if (!$top->{'Busy'}) {
	if (eval q{ require Tk::InputO; 1 }) {
	    for my $t ($top, values(%toplevel)) {
		next if !Tk::Exists($t);
		next if $args{-except} && $args{-except}{$t};
		my $io = (Tk::Exists($t->{'BusyIO'})
			  ? $t->{'BusyIO'}
			  : $t->InputO);
		$io->configure(-cursor => (defined $args{-cursor} ? $args{-cursor} : 'watch'));
		$io->place('-x' => 0, '-y' => 0, -relwidth => 1, -relheight => 1);
		$io->idletasks;
		$t->{'Busy'} = 1;
		$t->{'BusyIO'} = $io;
	    }
	} else {
	    # see changes in TkChange.pm
	    $top->Busy(-recurse => 1, %args);
	}
    }
    $top->{'BusyCount'}++;
}

sub DecBusy {
    my($top) = @_;
    return if !Tk::Exists($top);
    $top->{'BusyCount'}-- if $top->{'BusyCount'} > 0;
    if ($top->{'BusyCount'} < 1) {
	if ($top->{'BusyIO'}) {
	    for my $t ($top, values(%toplevel)) {
		next if !Tk::Exists($t) ||
		        !Tk::Exists($t->{'BusyIO'});
		$t->{'BusyIO'}->placeForget;
	    }
	    delete $top->{'Busy'};
	} else {
	    $top->Unbusy;
	}
    }
}

### AutoLoad Sub
sub ResetBusy {
    my $top = shift;
    return if !Tk::Exists($top);
    $top->Unbusy;
    $top->{'BusyCount'} = 0;
}

### AutoLoad Sub
sub redisplay_top {
    my($top, $name, %args) = @_;
    my $force = delete $args{-force};
    my $deiconify = (exists $args{-deiconify} ? delete $args{-deiconify} : 1);
    my $raise     = (exists $args{-raise}     ? delete $args{-raise}     : 1);
    if (!exists $args{-class}) {
	$args{-class} = "Bbbike Window";
    }
    my $t = $toplevel{$name};
    my $exists = 0;
    if (defined $t && Tk::Exists($t)) {
	if ($force) {
	    $t->destroy;
	    delete $toplevel{$name};
	} else {
	    $exists = 1;
	}
    }
    if ($exists) {
	$t->deiconify if $deiconify;
	# win32 bentigt zustzliches raise
	$t->raise     if $raise;
	undef;
    } else {
	$toplevel{$name} = $top->Toplevel(%args);
	$toplevel{$name}->transient($top) 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();
	} 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 = $res{-zeit};
	$lost_strecke_per_ampel = $res{-strecke};
	status_message(Mfmt("Einstellungen fr %s km/h: verlorene Zeit pro Ampel: %s s, verlorene Strecke pro Ampel: %d m", $speed, float_prec($lost_time_per_ampel, 1), $lost_strecke_per_ampel), "info");
    }
}

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) = @_;
    eval {
	require File::Spec;
	$file = File::Spec->canonpath($file);
    };
    my $max = $last_loaded_obj->{Max} || 4; # maximale Anzahl in @last_loaded
    my $i;
    for($i = 0; $i <= $#{ $last_loaded_obj->{List} }; $i++) {
	if ($last_loaded_obj->{List}->[$i] eq $file) {
	    splice @{ $last_loaded_obj->{List} }, $i, 1;
	    $i--;
	}
    }
    unshift @{ $last_loaded_obj->{List} }, $file;
    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'});
	my $file;
	foreach $file (@{ $last_loaded_obj->{List} }) {
	    $last_loaded_menu->command(-label => $file,
				       -command => [$last_loaded_obj->{Cb}, $file],
				      );
	}
    }
}

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

sub set_mouse_desc {
    if ($special_edit eq 'radweg') {
	$mouse_text[1] = M"Radweg editieren";
	$mouse_text[2] = M"Letzte Aktion wiederholen";
	$mouse_text[3] = '';
    } elsif ($special_edit eq 'ampel') {
	$mouse_text[1] = M"Ampel editieren";
	$mouse_text[2] = $mouse_text[3] = '';
    } else {
	$mouse_text[1] = M"Punkt zur Route hinzufgen\nmit Alt oder Shift: Mauscursor muss sich nicht ber einer Strae befinden";
	my $label = $b2_mode_desc{$b2_mode};
	if (defined $label) {
	    $mouse_text[2] = $label;
	} else {
	    $mouse_text[2] = "???";
	}
	if ($right_is_popup) {
	    $mouse_text[3] = M"Popup-Men";
	} else {
	    $mouse_text[3] = M"Gesamte Route lschen";
	}
    }
}

# Create the fontset for bbbike. Use $std_font as default normal font,
# or, if not defined, use the system default (e.g. from the option
# database). The fontset is stored to the global hash %font.
# $top is the main window.
sub set_fonts {
    my $std_font = shift;
    # backward compatibility with Tk 402:
    if ($Tk::VERSION <= 402.004) {
	set_fonts_402();
    } else {
	# XXX check it under all platforms!
	my $get_std_font = sub {
	    my $std_font = $top->optionGet('font', 'Font');
	    if (!defined $std_font || $std_font eq '') {
		my $l = $top->Label;
		$std_font = $l->cget(-font);
		if ($^O eq 'MSWin32') {
		    # XXX Force usage of Arial, otherwise "MS Sans
		    # Serif" is used on my system which is not nicely
		    # scalable.
		    my(%std_font) = $l->fontActual($std_font);
		    $std_font = $top->fontCreate(-family => 'Arial',
						 -size => $std_font{-size});
		}
		$l->destroy;
	    }
	    $std_font;
	};

	my $font_from_user = 0; # true, if from options or set interactively
	my $font_size_from_user = 0;
	if (!defined $std_font || $std_font eq '') {
	    # $font_family, $font_size, $font_weight from cmdline
	    if (defined $font_family && $font_family ne "" && !$kde) {
		if (!defined $font_size) {
		    my $std_font = $get_std_font->();
		    $font_size = $top->fontActual($std_font, '-size');
		} else {
		    $font_size_from_user = 1;
		}
		$font_from_user = 1;
		my(%a) = (-family => $font_family);
		if (defined $font_size && $font_size =~ /^-?\d+$/) {
		    $a{-size} = $font_size;
		}
		if (defined $font_weight && $font_weight ne '') {
		    $a{-weight} = $font_weight;
		}
		eval {
		    $std_font = $top->fontCreate(%a);
		};
		if ($@) {
		    my $err = $@;
		    $std_font = "helvetica 10";
		    warn Mfmt("Fehler beim Definieren des Zeichensatzes:\n" .
			      "%s\n" .
			      "Fallback auf den Zeichensatz <%s>.\n",
			      $err, $std_font) .
			 wrap("", "",
			      Mfmt("Dieser Fehler kann mglicherweise durch Korrigieren der Eintrge <fontfamily> und <fontheight> in <%s> oder <*font> in <~/.Xdefaults> behoben werden.",
				   catfile($bbbike_configdir, "config"))) .
			 "\n";
		}
		$top->optionAdd('*font' => $std_font, 'userDefault');
	    } else {
		$std_font = $get_std_font->();
	    }
	} else {
	    $font_from_user = $font_size_from_user = 1;
	}

	if ($std_font) {
	    $font{'normal'} = $top->fontCreate($top->fontActual($std_font));
	} else {
	    $font{'normal'} = $top->fontCreate;
	}

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

        my $pt = $normal_attr{'-size'}; # points or pixels depending on Tk ver
	my $win_width = @want_extends ? $want_extends[GEOMETRY_WIDTH] : $top->width;
	if ($win_width <= 800 && abs($pt) >= 10 && !$font_size_from_user) {
## XXX This is evil: because the fontsize will be from time to time smaller
## if the use resizes below the limits and then above the limits.
## On the other side, this will result in too big fonts on small
## displays. Solution?
	    if ($win_width <= 320) {
		$pt = $pt*8/14;
	    } elsif ($win_width <= 640) {
 		$pt = $pt*10/14;
 	    } else {
 		$pt = $pt*12/14;
 	    }
 	    $top->fontConfigure($font{'normal'}, -size => sprintf("%.f", $pt));
 	    $top->optionAdd('*font' => $font{'normal'}, 'userDefault');
	}
	if ($os eq 'win') {
	    $top->optionAdd('*font' => $font{'normal'}, 'userDefault');
	}

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

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

	$top->fontConfigure($font{'bold'},
			    -weight => 'bold');
	$top->fontConfigure($font{'fix15'},
			    -size => ($small_icons ? -8 : -15));
	$top->fontConfigure($font{'tiny'},
			    -size => sprintf("%.f", $minfs->($pt*8/14)));
	$top->fontConfigure($font{'small'},
			    -size => sprintf("%.f", $minfs->($pt*10/14)));
	$top->fontConfigure($font{'reduced'},
			    -size => sprintf("%.f", $minfs->($pt*12/14)));
	$top->fontConfigure($font{'large'},
			    -size => sprintf("%.f", $minfs->($pt*18/14)));
	$top->fontConfigure($font{'verylarge'},
			    -size => sprintf("%.f", $minfs->($pt*24/14)));
	$top->fontConfigure($font{'huge'},
			    -size => sprintf("%.f", $minfs->($pt*28/14)));
	$top->fontConfigure($font{'veryhuge'},
			    -size => sprintf("%.f", $minfs->($pt*36/14)));
	$top->fontConfigure($font{'standard'},
			    -size => $standard_height,
			    -slant => 'roman',
			    -underline => 0,
			    -overstrike => 0);
	if (abs($pt) >= 8) {
	    $font{'fixed'}
		= sprintf("-*-$fixed_font_family-medium-r-normal--*-%d-*-*-m-*-iso8859-1", $pt*10);
	} else {
	    $font{'fixed'} = "5x7"; # XXX really necessary?
	}

	my %min_sizes =
	    ('helvetica'	       => [10,8],
	     'times'		       => [12,10],
	     'lucida'		       => [9,8],
	     'new century schoolbook'  => [9,8],
	     'fixed'		       => [7,7],
	    );

	# Resize if necessary, to prevent fonts from being too small.
	# This is from looking at readable fonts under the iPAQ. I found
	# that Lucida can produce the smallest readable fonts.
	while(my($k,$v) = each %font) {
	    next if $k eq 'fixed'; # This is not a named font, so ignore this.
	    my $family = $top->fontActual($v, '-family');
	    my $minsize = $min_sizes{$family};
	    $minsize = [10,8] if !defined $minsize;
	    if ($top->fontMetrics($v, "-linespace") < $minsize->[0]) {
		$top->fontConfigure($v, -size => -$minsize->[1]);
	    }
	}
    }

    undef @font;
    foreach (qw(tiny small reduced normal large verylarge huge veryhuge)) {
	push @font, $_;
    }
}

# Setzt Bild, falls vorhanden, andernfalls ein Label
sub image_or_text {
    my($image, $text) = @_;
    if (defined $image) {
	(-image => $image);
    } else {
	(-text => $text);
    }
}

# Doc?
### AutoLoad Sub
sub image_from_file {
    my($top, $file, %args) = @_;
    my $mimetype  = $args{'-mimetype'};
    my $colormode = $args{'-colormode'} || 'color';

    if ($file =~ /\.jpe?g$/i ||
	(defined $args{-mimetype} and $args{-mimetype} eq 'image/jpeg')) {
	eval { require Tk::JPEG };
	if ($@) {
	    return if !perlmod_install_advice('Tk::JPEG');
	}
    } elsif ($file =~ /\.png$/i ||
	     (defined $args{-mimetype} and $args{-mimetype} eq 'image/png')) {
	eval { require Tk::PNG };
	if ($@) {
	    return if !perlmod_install_advice('Tk::PNG');
	}
    }

    if ($colormode eq 'mono') {
	$top->Bitmap(-file => $file);
    } elsif ($colormode eq 'pixmap') {
	$top->Pixmap(-file => $file);
    } elsif ($colormode eq 'gray') {
	$top->Photo(-file => $file, -palette => 8);
    } else {
	$top->Photo(-file => $file);
    }
}

# Ldt ein Bild.
sub load_photo {
    my($top, $file) = @_;
    my $photo;
    unless ($lowmem) {
	eval {
	    if ($file =~ /.xpm$/ && !$small_icons) {
		$photo = $top->Pixmap(-file => Tk::findINC($file));
	    } else {
		$photo = $top->Photo(-file => Tk::findINC($file));
	    }
	    if ($small_icons && $photo) {
		my $small_photo = $top->Photo(-width => $photo->width/2,
					      -height => $photo->height/2);
		$small_photo->copy($photo, -subsample => 2, 2);
		$photo->delete;
		$photo = $small_photo;
	    }
	};warn $@ if $@;
    }
    $photo;
}

sub load_cursor {
    my($def) = @_;
    return if $Tk::platform eq 'MSWin32'; # no support for custom cursors yet
    my $key = my $lang_def = $def;
    if ($def eq 'ziel') {
	$lang_def = M($def);
    }
    my $base = $lang_def . '_ptr.xbm';
    my $xbm = Tk::findINC($base);
    if (!defined $xbm) {
	warn Mfmt("Die Datei <%s> existiert nicht.", $base);
    } elsif (-r $xbm) {
	my $mask = Tk::findINC($lang_def . '_ptr_mask.xbm');
	if (-r $mask) {
	    $cursor{$key}      = $xbm;
	    $cursor_mask{$key} = $mask;
	}
    }
}

# do a correct isa call on scrolled widgets
sub subw_isa {
    my($w, $isa) = @_;
    if ($w->Subwidget('scrolled')) {
	$w = $w->Subwidget('scrolled');
    }
    $w->isa($isa);
}

# Callback bei einem Drop-Vorgang.
# Die Datei wird per load_save_route() geladen.
### AutoLoad Sub
sub accept_drop {
    my($c, $seln) = @_;
    my $filename;
    my @targ = $c->SelectionGet('-selection'=>$seln,'TARGETS');
    foreach (@targ) {
	if (/FILE_NAME/) {
	    $filename = $c->SelectionGet('-selection'=>$seln,'FILE_NAME');
	    last;
	}
	if ($os eq 'win' && /STRING/) {
	    $filename = $c->SelectionGet('-selection'=>$seln,$_);
	    last;
	}
    }
    if (defined $filename) {
	if ($filename =~ /\.bbd/i) {
	    plot_layer('str', $filename);
	} else {
	    load_save_route(0, $filename);
	}
    }
}


# Return the start and goal streets of the current route
### AutoLoad Sub
sub get_route_description {
    my $text = "";
    my @search_route = @{ get_act_search_route() };
    if (@search_route) {
	$text = $search_route[0][StrassenNetz::ROUTE_NAME] . " - " . $search_route[-1][StrassenNetz::ROUTE_NAME];
    }
    $text;
}

# Return the approximated center of the polyline.
# Coordinates of the polygon are supplied in @koord (flat list of x and y
# values).
### AutoLoad Sub
sub get_polyline_center {
    my(@koord) = @_;
    my $len = 0;
    for(my $i=2; $i<$#koord; $i+=2) {
	$len += Strassen::Util::strecke([@koord[$i-2,$i-1]],
					[@koord[$i,  $i+1]]);
    }
    my $len0 = 0;
    for(my $i=2; $i<$#koord; $i+=2) {
	$len0 += Strassen::Util::strecke([@koord[$i-2,$i-1]],
					 [@koord[$i,  $i+1]]);
	if ($len0 > $len/2) {
	    # XXX ungenau, besser machen!
	    return (($koord[$i-2]-$koord[$i])/2+$koord[$i],
		    ($koord[$i-1]-$koord[$i+1])/2+$koord[$i+1]);
	}
    }
    warn "Fallback for get_polyline_center, should not happen. Coords are @koord";
    (($koord[2]-$koord[0])/2+$koord[0],
     ($koord[3]-$koord[1])/2+$koord[1]);
}

### AutoLoad Sub
sub get_bbox_area {
    my($item) = @_;
    my(@bbox) = $c->bbox($item);
    abs(($bbox[2]-$bbox[0]) * ($bbox[3]-$bbox[1]));
}

# Erzeugt eine Backupdatei
### AutoLoad Sub
sub make_backup {
    my $file = shift;
    if (-e $file) {
	if (-f $file) {
	    my $backup = "$file~";
	    rename $file, $backup;
	} else {
	    status_message(Mfmt("%s ist keine gltige Datei, kein Backup.",
				$file),
			   'err');
	}
    }
}

use your qw($StrassenNetz::VERBOSE $Strassen::VERBOSE $wettermeldung2::VERBOSE
	    $Tk::SRTProgress::VERBOSE $Fahrinfo::VERBOSE
	    $Telefonbuch::VERBOSE $GfxConvert::VERBOSE $Hooks::VERBOSE
	    $FURadar::VERBOSE);

# Setzt die VERBOSE-Variable in den geladenen Modulen
### AutoLoad Sub
sub set_verbose {
    Strassen::set_verbose($verbose);
    $wettermeldung2::VERBOSE  = $verbose;
    $Tk::SRTProgress::VERBOSE = $verbose;
    $Fahrinfo::VERBOSE        = $verbose;
    $Telefonbuch::VERBOSE     = $verbose;
    $GfxConvert::VERBOSE      = $verbose;
    $Hooks::VERBOSE           = $verbose;
    $FURadar::VERBOSE         = $verbose;
}

# crops the array in $want_extends to the limits in $extends
sub crop_geometry {
    my($want_extends, $extends) = @_;

    # right/bottom limits
    my($maxx) = $extends->[GEOMETRY_WIDTH] + $extends->[GEOMETRY_X];
    my($maxy) = $extends->[GEOMETRY_HEIGHT] + $extends->[GEOMETRY_Y];

    if ($want_extends->[GEOMETRY_X] < $extends->[GEOMETRY_X]) {
	$want_extends->[GEOMETRY_X] = $extends->[GEOMETRY_X];
    }
    if ($want_extends->[GEOMETRY_Y] < $extends->[GEOMETRY_Y]) {
	$want_extends->[GEOMETRY_Y] = $extends->[GEOMETRY_Y];
    }
    if ($want_extends->[GEOMETRY_X] + $want_extends->[GEOMETRY_WIDTH] > $maxx) {
	$want_extends->[GEOMETRY_WIDTH] = $maxx - $want_extends->[GEOMETRY_X];
    }
    if ($want_extends->[GEOMETRY_Y] + $want_extends->[GEOMETRY_HEIGHT] > $maxy) {
	$want_extends->[GEOMETRY_HEIGHT] = $maxy - $want_extends->[GEOMETRY_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) = @_;
    $t->geometry("$extends[GEOMETRY_WIDTH]x$extends[GEOMETRY_HEIGHT]" .
		 "+$extends[GEOMETRY_X]+$extends[GEOMETRY_Y]");
}

sub fix_geometry {
    my $geom_string = shift || $top->geometry;
    my(@extends) = parse_geometry_string($geom_string);
    $extends[GEOMETRY_HEIGHT] += ($top->wrapper)[1];
    "$extends[GEOMETRY_WIDTH]x$extends[GEOMETRY_HEIGHT]" .
	"+$extends[GEOMETRY_X]+$extends[GEOMETRY_Y]"
}

# check if the toplevel is too large and resize, if appropriate
sub toplevel_checker {
    my($t) = @_;
    $t->update;
    my($sw,$sh) = ($t->screenwidth, $t->screenheight);
    my($x,$y,$w,$h) = ($t->x, $t->y, $t->width, $t->height);
    $w = $sw if ($w > $sw);
    $h = $sh if ($h > $sh);
    $x = 0 if ($x+$w > $sw || $x < 0);
    $y = 0 if ($y+$h > $sh || $y < 0);
    $t->geometry($w."x".$h."+$x+$y");
}

sub get_polar_location_of_route_end {
    return undef if !@realcoords;
    require Karte::Polar;
    my($px,$py) = $Karte::Polar::obj->standard2map(@{ $realcoords[-1] });
    "$px,$py";
}

sub my_popup {
    my $t = shift;
    $t->withdraw;
    $t->Popup(@popup_style);
}

sub optedit {
    my $opt_edit = $top->{GetoptEditor};
    if (Tk::Exists($opt_edit)) {
	$opt_edit->raise;
	return;
    }
    $opt_edit =	$opt->option_editor
	($top,
	 ($transient ? (-transient => $top) : ()),
	 (!defined $ENV{LANG} || $ENV{LANG} =~ /^de/ ?
	  (-string => {optedit => "Optionseditor",
		       undo => "Undo",
		       lastsaved => "Zuletzt gespeichert",
		       save => "Speichern",
		       defaults => "Voreinstellungen",
		       ok => "Ok",
		       apply => "Anwenden",
		       cancel => "Abbrechen",
		       helpfor => "Hilfe fr",
		      }
	  ) : ()),
	);
    $top->{GetoptEditor} = $opt_edit;
}

sub export_visible_map {
    my($fmt, $outfile) = @_;

    if (!defined $outfile) {
	$outfile = $top->getSaveFile
	    (-defaultextension => ".$fmt",
	     -title => Mfmt('%s-Datei sichern', uc($fmt)),
	     -initialdir => $save2_path);
    }
    return if !defined $outfile;
    $save2_path = dirname $outfile;

    $top->raise;
    $top->update;

    $top->Busy;
    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,
	    );

	if ($use_xwd_if_possible and
	    $fmt ne 'ps' and
	    is_in_path("xwd")) {

	    $args{-rotate} = -90 if $orientation eq 'portrait';

	    if ($fmt ne 'xwd') {
		require GfxConvert;
		GfxConvert::check($in_fmt, $fmt, $tmpfile, $outfile, %args);
	    }

	    $tmpfile = "/tmp/bbbike.$$.xwd";
	    $tmpfiles{$tmpfile}++;
	    system("xwd", "-out", "$tmpfile", "-id", $c->id);
	    $top->bell;
	    $in_fmt = "xwd";

	} else {

	    $args{-rotate} = -90 if $orientation eq 'landscape';

	    if ($fmt ne 'ps') {
		require GfxConvert;
		GfxConvert::check($in_fmt, $fmt, $tmpfile, $outfile, %args);
	    }

	    $tmpfile = create_postscript($c,
					 -colormode => 'color',
					 -rotate => 1,
					 -scale_a4 => 0,
					);
	    if (!defined $tmpfile) {
		die M"Temporre Postscript-Datei kann nicht erstellt werden.";
	    }
	    $in_fmt = "ps";
	}

	if ($fmt eq 'ps' || $fmt eq 'xwd') {
	    mv($tmpfile, $outfile);
	} else {
	    require GfxConvert;
	    # -mapcolor wandelt die Farbe der Nebenstraen
	    # (tk: grey99/ps: 0.9 0.9 0.9) nach wei um und setzt die
	    # Hintergrundfarbe von wei auf die Hintergrundfarbe des
	    # Canvases
	    GfxConvert::convert
		    ($in_fmt, $fmt, $tmpfile, $outfile,
		     %args,
		    );
	    $tmpfiles{$tmpfile}++;
	}
    };
    if ($@) {
	status_message($@, 'err');
    }
    $top->Unbusy;
}

sub start_process {
    my($token, $gather_command, $action_command) = @_;
    if (defined $processes{$token}) {
	status_message(M("Der Prozess $token laeuft noch (PID $processes{$token}) XXX"), "die");
	# XXX Abschiessen blabla
    }
    if (!$Config{d_fork}) {
	status_message(M("fork ist nicht verfuegbar XXX"), "die");
    }
    require Symbol;
    my $rdr = Symbol::gensym();
    my $wtr = Symbol::gensym();
    pipe($rdr, $wtr);
    my $pid = fork;
    if (!defined $pid) {
	status_message(M("Der Process konnte nicht gestartet werden."), "die");
    }
    if ($pid == 0) {
	# child
	close $rdr;
warn "gather command";
	my $result = $gather_command->();
warn "print result $result to $wtr";
#	select $wtr; $| = 1;
	print $wtr $result;
warn "printed";
	close $wtr;
warn "closed";
	sleep 99999;
	CORE::exit(0);
    }
    close $wtr;
    $processes{$token} = $pid;
    $top->fileevent($rdr, "readable", sub {
warn "readable";
			local $/ = undef;
			my $result = <$rdr>;
warn "got $result";
			close $rdr;
			$processes{$token} = undef;
warn "do action";
			$action_command->($result)
			    if $action_command;
		    });
}

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

package bbbike; # HACK for autosplit
