1# -*- perl -*-
2
3#
4# $Id: AltBerlin.pm,v 1.5 2006/09/17 20:20:41 eserte Exp $
5# Author: Slaven Rezic
6#
7# Copyright (C) 2006 Slaven Rezic. All rights reserved.
8# This package is free software; you can redistribute it and/or
9# modify it under the same terms as Perl itself.
10#
11# Mail: slaven@rezic.de
12# WWW:  http://www.rezic.de/eserte/
13#
14
15# Description (en): Link to maps from Alt-Berlin (alt-berlin.info)
16# Description (de): Link zu Alt-Berliner Stadtpl�nen (alt-berlin.info)
17package AltBerlin;
18
19use BBBikePlugin;
20push @ISA, 'BBBikePlugin';
21
22use strict;
23use vars qw($VERSION);
24$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);
25
26use vars qw($icon);
27
28use vars qw(%nr_to_year);
29%nr_to_year = qw(
3011 1738
3113 1760
3217 1789
3318 1836
3429 1869
358 1875
3615 1893
3712 1894
383 1895
3925 1896
401 1897
415 1899
4226 1906
432 1921
4420 1926
4521 1932
4619 1938
4714 1939
4833 1943
494 1945
5037 1945
5110 1946
5223 1954
5350 1957
549 1960
5522 1961
567 1989
57);
58
59sub register {
60    my $is_berlin = $main::city_obj && $main::city_obj->cityname eq 'Berlin';
61    if ($is_berlin) {
62	_create_image();
63	$main::info_plugins{__PACKAGE__ . ""} =
64	    { name => "Alt-Berlin (1946)",
65	      callback => sub { altberlin(@_, stadtplannr => 10) },
66	      #callback_3_std => sub { altberlin_url(@_) },
67	      callback_3 => sub { show_all_urls_menu(@_) },
68	      icon => $icon,
69	    };
70    } else {
71	main::status_message("Das AltBerlin-Plugin ist nur f�r Berlin verf�bar.", "err")
72		if !$main::booting;
73    }
74}
75
76sub _create_image {
77    if (!defined $icon) {
78	# Got from: http://www.alt-berlin.info/bilder/lupe.ico
79	$icon = $main::top->Photo
80	    (-format => 'gif',
81	     -data => <<EOF);
82R0lGODlhEAAQAPf+AEVGSmRmaQAECQAFCgAECBIZHhAVGG97gWJmaHB9gXSAhHV+gURLTQYO
83EAAZHgofIgcVFwUYGiYuL0dPUFdfYAALDCQvMBIvMSNNUAAlJgAiIwEtLAwYGDI8PDU/P2Fp
84aV1kZH6IhwM1LwA4MAE+MgBCNA5NPW97eAcYEwBMNABWNQJWNgBPLgNgNgBlNQBkNBc2J3yu
85lgRrNiB6TV+gfxRzQhh5Rh17SkmVbX+OhRYtHBswHyQ5IylBJ5q8llicTjRULzRTLpW4jX+V
86ekVqOYKFgZa8iEZoOFZ+QkZmNoezcZa7hV+KSGCNRm+fUpS9e5O3fWaSSZPAdpi9f7fPqGmU
87S5LEbZW9dZ3DgIW0XH+rWJvEeJbEaZ/IeZy/fJbDaIixX6nRf5/FeZy+epG6Y5zGa6DLb6nP
88fJ/Fb57CcXySVbHRfJmyaa3Kc46kXqS8caG4cKe7drvUfLvRgaq9cMLXhLfIgqa2cq27dsHN
89ibzHhZ6jc5+laLO5eL3Ci87TidDRjbi5h7m6icHCknh4ZJGOWM3KnMnHmuDal7ayh7SxiaOh
90jqKddb64j7Goe6Obdp+bhs3CkKieep6Vc8Kzg9vMmtbAg6aadrGkfs/Bmo2GddC8kK2derio
91g8u8m6STca+efMa4m/bZpeDGl9zCldO7j+vQoODHmaaUcrSigsm2kpSHb6ugjNK2h/3cpc6z
92h8Wsgd7BkraeeOjLmuPGlt/ClN7Bk9m9kNC1isCnf+fKmt7ClM+1iv7fqu7Qn+nMnNm9kda7
93j9O4jc2ziaOObdS6j8CogZ2Kaq2Ydd/EmMmxirWgfK6Zd5+MbbGce6WSc6GOcKWUeaSTeLyi
94etO2iti7j7ifeuPEmOHEmNC1jc60jMyyi7iigJyKbqmWetvEoZ6FZLqfeeLCldCxif/bqenH
95mti5j6mSctm9mOnNpsGrjNG5mO/Il9i0iMOmgp6Ha7OVc7SXeJZ/Za6Td8Woi/HDl5Z5X6OG
96aqSHa6GIcOGddWddWOGRbn1PP////wAAACH5BAAAAAAALAAAAAAQABAAAAiYAP0JHEiwoEF/
97CA4aPJJER4MPCql8QXbPHiE1PQgctMSvVDRp4MLhcSKhoI96+lwpUHeu2TI0AgqeCbUoRKtc
98sYTB41OhYJgDRZL98oULlrs+HAoaKbct0TFivXSJmwPAoDJQgyQZo1WMEpcCBqXEUXXIkLNI
99UPy9SAGh4BM9ggLBMSMwhg0RFBQapKFiAwi9BWtgAEyYcEAAOw==
100EOF
101    }
102}
103
104sub altberlin_url {
105    my(%args) = @_;
106
107    my $px = $args{px};
108    my $py = $args{py};
109    my $nr = $args{stadtplannr};
110
111    sprintf "http://www.alt-berlin.info/cgi/stp/lana.pl?nr=%s&gr=5&nord=%f&ost=%f", $nr, $py, $px;
112}
113
114sub altberlin {
115    my(%args) = @_;
116    my $url = altberlin_url(%args);
117    start_browser($url);
118}
119
120sub show_all_urls_menu {
121    my(%args) = @_;
122    my $w = $args{widget};
123    if (Tk::Exists($w->{"AltBerlinMenu"})) {
124	$w->{"AltBerlinMenu"}->destroy;
125    }
126    my $link_menu = $w->Menu(-title => "Alt-Berliner Karten",
127			     -tearoff => 0);
128    for my $nr (sort { $nr_to_year{$a} <=> $nr_to_year{$b} } keys %nr_to_year) {
129	$link_menu->command
130	    (-label => "$nr_to_year{$nr} (Nr. $nr)",
131	     -command => sub {
132		 altberlin(stadtplannr => $nr, %args);
133	     }
134	    );
135    }
136    $w->{"AltBerlinMenu"} = $link_menu;
137
138    my $e = $w->XEvent;
139    $link_menu->Post($e->X, $e->Y);
140    Tk->break;
141}
142
143sub start_browser {
144    my($url) = @_;
145    main::status_message("Der WWW-Browser wird mit der URL $url gestartet.", "info");
146    WWWBrowser::start_browser($url);
147}
148
1491;
150
151__END__
152
153# To get the nr-year mapping:
154#
155# perl -nle '/nr=(\d+).*overlib.*([12]\d{3})/ && print "$1 $2"' the_html_page.html
156