1# DO NOT EDIT! Generated by Generated_src.pm!
2
3package Strassen::Generated;
4
5package StrassenNetz;
6
7require Strassen::Util; # XXX move to subs
8
9sub make_net_slow_1 {
10    my($self, %args) = @_;
11
12    my $cacheable = defined $args{UseCache} ? $args{UseCache} : $Strassen::Util::cacheable;
13    if ($cacheable) {
14        return if $self->net_read_cache_1;
15    }
16
17    $self->{strecke_sub}   = \&Strassen::Util::strecke;
18    $self->{strecke_s_sub} = \&Strassen::Util::strecke_s;
19    $self->{to_koord_sub}  = \&Strassen::to_koord;
20    if ($self->{Strassen}{GlobalDirectives} && $self->{Strassen}{GlobalDirectives}{map} && $self->{Strassen}{GlobalDirectives}{map}[0] eq 'polar') {
21        $self->{strecke_sub}   = \&Strassen::Util::strecke_polar;
22	$self->{strecke_s_sub} = \&Strassen::Util::strecke_s_polar;
23        $self->{to_koord_sub}  = \&Strassen::to_koord_f;
24    }
25    local *strecke = $self->{strecke_sub};
26    local *to_koord = $self->{to_koord_sub};
27
28    if ($VERBOSE) {
29	warn "Using slow (type 1) version of make_net\n";
30    }
31
32    $self->{Net2Name}    = {}; # Zuordnung Strecke => Stra�enname
33    $self->{Net}         = {}; # Verbindungsnetz
34    my $net2name = $self->{Net2Name};
35
36    $self->{Wegfuehrung} = {}; # unerlaubte Wegf�hrung
37    $self->{Penalty}     = {}; # zus�tzliche Penalties
38    my $net      = $self->{Net};
39    my $strassen = $self->{Strassen};
40    $strassen->init;
41    while(1) {
42	my $ret = $strassen->next;
43	my @kreuzungen = @{$ret->[Strassen::COORDS()]};
44	last if @kreuzungen == 0;
45	my @kreuz_coord = @{to_koord(\@kreuzungen)};
46
47
48	for(my $i = 0; $i < $#kreuzungen; $i++) {
49	    # Integer reicht vollkommen aus, da die Angaben sowieso in m sind
50	    my $entf = int(strecke($kreuz_coord[$i], $kreuz_coord[$i+1]));
51 	    $net->{$kreuzungen[$i]}{$kreuzungen[$i+1]} = $entf;
52 	    $net->{$kreuzungen[$i+1]}{$kreuzungen[$i]} = $entf;
53# XXX not yet, but maybe someday necessary:
54#  	    if (exists $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]}) {
55#  		if (ref $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} ne 'ARRAY') {
56#  		    $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} = [ $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} ];
57#  		}
58#  		push @{ $net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} }, $strassen->pos;
59#  	    } else {
60		$net2name->{$kreuzungen[$i]}{$kreuzungen[$i+1]} = $strassen->pos;
61#	    }
62	}
63
64    }
65
66    if ($cacheable) {
67	$self->net_write_cache_1;
68    }
69
70    $self->{UseMLDBM} = 0;
71}
72
73sub net_read_cache_1 {
74    my($self) = @_;
75    my @src = $self->dependent_files;
76    if (!@src || grep { !defined $_ } @src) {
77	return 0;
78    }
79    my $cachefile = $self->get_cachefile;
80
81    my $net2name = Strassen::Util::get_from_cache("net2name_1_$cachefile", \@src);
82
83    my $net = Strassen::Util::get_from_cache("net_1_$cachefile", \@src);
84    if (
85
86	defined $net2name &&
87
88	defined $net
89       ) {
90
91	$self->{Net2Name} = $net2name;
92
93	$self->{Net} = $net;
94	if ($VERBOSE) {
95	    warn "Using cache for $cachefile\n";
96	}
97	return 1;
98    } else {
99	return 0;
100    }
101}
102
103sub net_write_cache_1 {
104    my($self) = @_;
105    my @src = $self->dependent_files;
106    if (!@src || grep { !defined $_ } @src) {
107	return;
108    }
109    my $cachefile = $self->get_cachefile;
110
111    Strassen::Util::write_cache($self->{Net2Name}, "net2name_1_$cachefile", -modifiable => 1);
112
113    Strassen::Util::write_cache($self->{Net}, "net_1_$cachefile", -modifiable => 1);
114    if ($VERBOSE) {
115        warn "Wrote cache ($cachefile)\n";
116    }
117}
118
119sub make_net_slow_2 {
120    my($self, %args) = @_;
121
122    my $cacheable = defined $args{UseCache} ? $args{UseCache} : $Strassen::Util::cacheable;
123    if ($cacheable) {
124        return if $self->net_read_cache_2;
125    }
126
127    $self->{strecke_sub}   = \&Strassen::Util::strecke;
128    $self->{strecke_s_sub} = \&Strassen::Util::strecke_s;
129    $self->{to_koord_sub}  = \&Strassen::to_koord;
130    if ($self->{Strassen}{GlobalDirectives} && $self->{Strassen}{GlobalDirectives}{map} && $self->{Strassen}{GlobalDirectives}{map}[0] eq 'polar') {
131        $self->{strecke_sub}   = \&Strassen::Util::strecke_polar;
132	$self->{strecke_s_sub} = \&Strassen::Util::strecke_s_polar;
133        $self->{to_koord_sub}  = \&Strassen::to_koord_f;
134    }
135    local *strecke = $self->{strecke_sub};
136    local *to_koord = $self->{to_koord_sub};
137
138    if ($VERBOSE) {
139	warn "Using slow (type 2) version of make_net\n";
140    }
141
142    $self->{Index2Pos}   = []; # Zuordnung Index-Paar => Pos im Stra�enfile
143    $self->{Coord2Index} = {}; # Zuordnung Koordinate => Index
144    $self->{Index2Coord} = []; # Zuordnung Index => Koordinate
145    $self->{Net}         = []; # Verbindungsnetz
146    my $index2pos   = $self->{Index2Pos};
147    my $coord2index = $self->{Coord2Index};
148    my $index2coord = $self->{Index2Coord};
149    my $pos = 0;
150
151    $self->{Wegfuehrung} = {}; # unerlaubte Wegf�hrung
152    $self->{Penalty}     = {}; # zus�tzliche Penalties
153    my $net      = $self->{Net};
154    my $strassen = $self->{Strassen};
155    $strassen->init;
156    while(1) {
157	my $ret = $strassen->next;
158	my @kreuzungen = @{$ret->[Strassen::COORDS()]};
159	last if @kreuzungen == 0;
160	my @kreuz_coord = @{to_koord(\@kreuzungen)};
161
162
163	my @k_i;
164	foreach my $cp (@kreuz_coord) {
165	    my $c = pack("l2", @$cp);
166	    if (!exists $coord2index->{$c}) {
167		$coord2index->{$c} = pack("l", $pos);
168		$index2coord->[$pos] = $c;
169		$pos++;
170	    }
171	    push @k_i, $coord2index->{$c};
172	}
173
174	for (my $i = 0; $i < $#k_i; $i++) {
175	    my $entf = pack("l",
176			    int(strecke($kreuz_coord[$i], $kreuz_coord[$i+1])));
177	    my $k_i_u  = unpack("l", $k_i[$i]);
178	    my $k_i1_u = unpack("l", $k_i[$i+1]);
179	    $net->[$k_i_u]  .= $k_i[$i+1] . $entf;
180	    $net->[$k_i1_u] .= $k_i[$i]   . $entf;
181	    $index2pos->[$k_i_u]  .= $k_i[$i+1] . pack("l", $strassen->pos);
182	    $index2pos->[$k_i1_u] .= $k_i[$i]   . pack("l", $strassen->pos);
183	}
184
185    }
186
187    if ($cacheable) {
188	$self->net_write_cache_2;
189    }
190
191    $self->{UseMLDBM} = 0;
192}
193
194sub net_read_cache_2 {
195    my($self) = @_;
196    my @src = $self->dependent_files;
197    if (!@src || grep { !defined $_ } @src) {
198	return 0;
199    }
200    my $cachefile = $self->get_cachefile;
201
202    my $coord2index = Strassen::Util::get_from_cache("coord2index_2_$cachefile", \@src);
203    my $index2coord = Strassen::Util::get_from_cache("index2coord_2_$cachefile", \@src);
204    my $index2pos   = Strassen::Util::get_from_cache("index2pos_2_$cachefile", \@src);
205
206    my $net = Strassen::Util::get_from_cache("net_2_$cachefile", \@src);
207    if (
208
209	defined $coord2index &&
210	defined $index2coord &&
211	defined $index2pos &&
212
213	defined $net
214       ) {
215
216	$self->{Coord2Index} = $coord2index;
217	$self->{Index2Coord} = $index2coord;
218	$self->{Index2Pos}   = $index2pos;
219
220	$self->{Net} = $net;
221	if ($VERBOSE) {
222	    warn "Using cache for $cachefile\n";
223	}
224	return 1;
225    } else {
226	return 0;
227    }
228}
229
230sub net_write_cache_2 {
231    my($self) = @_;
232    my @src = $self->dependent_files;
233    if (!@src || grep { !defined $_ } @src) {
234	return;
235    }
236    my $cachefile = $self->get_cachefile;
237
238    Strassen::Util::write_cache($self->{Coord2Index}, "coord2index_2_$cachefile");
239    Strassen::Util::write_cache($self->{Index2Coord}, "index2coord_2_$cachefile");
240    Strassen::Util::write_cache($self->{Index2Pos}, "index2pos_2_$cachefile");
241
242    Strassen::Util::write_cache($self->{Net}, "net_2_$cachefile", -modifiable => 1);
243    if ($VERBOSE) {
244        warn "Wrote cache ($cachefile)\n";
245    }
246}
247
248sub route_to_name_1 {
249    my($self, $route_ref, %args) = @_;
250    my @strname;
251    my $start_i = defined $args{'-startindex'} ? $args{'-startindex'} : 0;
252    my $combinestreet = defined $args{'-combinestreet'} ? $args{'-combinestreet'} : 1;
253    require Route;
254    require Strassen::Util;
255    require Strassen::Strasse;
256    local *strecke = $self->{strecke_sub} || \&Strassen::Util::strecke;
257    my $i;
258    for($i = 0; $i < $#{$route_ref}; $i++) {
259
260	my $xy1 = Route::_coord_as_string([$route_ref->[$i][0],
261					   $route_ref->[$i][1]]);
262	my $xy2 = Route::_coord_as_string([$route_ref->[$i+1][0],
263					   $route_ref->[$i+1][1]]);
264	my($str_i, $rueckwaerts) = $self->net2name($xy1, $xy2);
265	my $entf = $self->{Net}{$xy1}{$xy2};
266
267	# May happen if two same points follow subsequently in the route.
268	next if defined $entf && $entf == 0;
269	# May happen for inserted or moved points which are not anymore in the net.
270	if (!defined $entf) {
271	    $entf = strecke([split /,/, $xy1], [split /,/, $xy2]);
272	}
273	my $str;
274	if (!defined $str_i) {
275	    ($str_i, $rueckwaerts) = $self->nearest_street($xy1, $xy2);
276	}
277	if (defined $str_i) {
278	    if ($str_i =~ /^\d/) {
279		$str = $self->{Strassen}->get($str_i)->[0];
280		$str = Strasse::beautify_landstrasse($str, $rueckwaerts);
281	    } else {
282		$str = $str_i;
283	    }
284	} else {
285	    # Aha. Wir haben hier wahrscheinlich einen angeklickten
286	    # Punkt zwischen zwei Kurvenpunkten, der nicht mehr durch
287	    # add_net abgedeckt ist. Also wird einfach geraten, ob der
288	    # Punkt zur vorherigen Strecke geh�rt, indem der Schnittwinkel
289	    # �berpr�ft wird.
290	    # Der Algorithmus ist nicht perfekt, weil einige Schnittwinkel
291	    # im 90�-Bereich liegen, wo es sich trotzdem um die gleiche
292	    # Stra�e handelt. Naja.
293	    if ($i+1 < $#{$route_ref}) {
294		my($w) = schnittwinkel
295		  (split(/,/,$xy1),
296		   split(/,/,$xy2),
297		   split(/,/,Route::_coord_as_string
298			 ([$route_ref->[$i+2][0],
299			   $route_ref->[$i+2][1]])));
300		if ($w < 0.15 || $w > 3.00) {
301		    # ca. 10� Abweichung von der Geraden werden toleriert
302		    $str = ($#strname >= 0 ? $strname[$#strname]->[0] : '???');
303		}
304	    }
305	    # (Garantiert) unbekannte Stra�e.
306	    if (!defined $str) {
307		$str = "...";
308	    }
309	}
310	my($winkel, $richtung);
311	if ($i+1 < $#{$route_ref}) {
312	    ($richtung, $winkel) = Strassen::Util::abbiegen(@{$route_ref}[$i .. $i+2]);
313	    # This usually happens if either first and second or second and third
314	    # points are the same. Make sure that no warnings happen. But it would
315	    # be better if the caller made sure that this never happens...
316	    if (!defined $winkel) {
317		($richtung, $winkel) = ('', 0);
318	    }
319	}
320	my $extra;
321	if (@strname &&
322	    ($combinestreet && $str eq $strname[$#strname]->[ROUTE_NAME] &&
323	     !($strname[$#strname]->[ROUTE_EXTRA] && $strname[$#strname]->[ROUTE_EXTRA]{ImportantAngle}))) {
324	    $strname[$#strname][ROUTE_DIST] += $entf;
325	    $strname[$#strname][ROUTE_ANGLE] = $winkel;
326	    $strname[$#strname][ROUTE_DIR] = $richtung;
327	    $strname[$#strname][ROUTE_ARRAYINX][1] = $i+$start_i;
328	    $extra = $strname[$#strname][ROUTE_EXTRA];
329	    if ($extra) {
330		if ($args{-wanttrafficlights}) {
331		    $extra->{Trafficlights} = +0;
332		    $extra->{TrafficlightAtPoint} = 0;
333		}
334	    }
335	} else {
336	    my $val = [];
337	    $val->[ROUTE_NAME]	 = $str;
338	    $val->[ROUTE_DIST]	 = $entf;
339	    $val->[ROUTE_ANGLE]	 = $winkel;
340	    $val->[ROUTE_DIR]	 = $richtung;
341	    $val->[ROUTE_ARRAYINX] = [$i+$start_i, $i+$start_i];
342	    $extra = $val->[ROUTE_EXTRA] = {};
343	    if ($args{-wanttrafficlights}) {
344		$extra->{Trafficlights} = 0;
345		$extra->{TrafficlightAtPoint} = 0;
346	    }
347	    push @strname, $val;
348	}
349
350
351	if ($i+1 < $#{$route_ref}) {
352	    my $xy3 = Route::_coord_as_string([$route_ref->[$i+2][0],
353				               $route_ref->[$i+2][1]]);
354	    for my $neighbour (keys %{$self->{Net}{$xy2}}) {
355		next if $neighbour eq $xy1 || $neighbour eq $xy3;
356		my($this_richtung, $this_winkel) = Strassen::Util::abbiegen(@{$route_ref}[$i .. $i+1],
357									    [split/,/,$neighbour]);
358		next if !defined $this_winkel;
359		next if ($this_richtung ne $richtung && $this_winkel >= 30);
360		next if $winkel < $this_winkel;
361		$extra->{ImportantAngle} = '!';
362		{
363		    my($str_i, $rueckwaerts) = $self->net2name($xy2, $neighbour);
364		    if (defined $str_i) {
365			my $str = $self->{Strassen}->get($str_i)->[0];
366			$str = Strasse::beautify_landstrasse($str, $rueckwaerts);
367			$extra->{ImportantAngleCrossingName} = $str;
368		    }
369		}
370		last;
371	    }
372	}
373
374
375    }
376
377    @strname;
378}
379sub route_to_name_2 {
380    my($self, $route_ref, %args) = @_;
381    my @strname;
382    my $start_i = defined $args{'-startindex'} ? $args{'-startindex'} : 0;
383    my $combinestreet = defined $args{'-combinestreet'} ? $args{'-combinestreet'} : 1;
384    require Route;
385    require Strassen::Util;
386    require Strassen::Strasse;
387    local *strecke = $self->{strecke_sub} || \&Strassen::Util::strecke;
388    my $i;
389    for($i = 0; $i < $#{$route_ref}; $i++) {
390
391	my $xy1 = $self->{Coord2Index}->
392	  {pack("l2", $route_ref->[$i][0], $route_ref->[$i][1])};
393	my $xy1_u = unpack("l", $xy1);
394	my $xy2 = $self->{Coord2Index}->
395	  {pack("l2", $route_ref->[$i+1][0], $route_ref->[$i+1][1])};
396	my $str_i;
397	my $rueckwaerts = 0; # XXX
398	my $entf;
399	{
400	    # first find pos of neighbor
401	    my $net_s = $self->{Index2Pos}[$xy1_u];
402	    my $net_s_len = length($net_s);
403	    for(my $i = 0; $i < $net_s_len; $i+=8) {
404		if (substr($net_s, $i, 4) eq $xy2) {
405		    $str_i = unpack("l", substr($net_s, $i+4, 4));
406		    last;
407		}
408	    }
409	    # then find distance to neighbor
410	    $net_s = $self->{Net}[$xy1_u];
411	    $net_s_len = length($net_s);
412	    for(my $i = 0; $i < $net_s_len; $i+=8) {
413		if (substr($net_s, $i, 4) eq $xy2) {
414		    $entf = unpack("l", substr($net_s, $i+4, 4));
415		    last;
416		}
417	    }
418	}
419
420	# May happen if two same points follow subsequently in the route.
421	next if defined $entf && $entf == 0;
422	# May happen for inserted or moved points which are not anymore in the net.
423	if (!defined $entf) {
424	    $entf = strecke([split /,/, $xy1], [split /,/, $xy2]);
425	}
426	my $str;
427	if (!defined $str_i) {
428	    ($str_i, $rueckwaerts) = $self->nearest_street($xy1, $xy2);
429	}
430	if (defined $str_i) {
431	    if ($str_i =~ /^\d/) {
432		$str = $self->{Strassen}->get($str_i)->[0];
433		$str = Strasse::beautify_landstrasse($str, $rueckwaerts);
434	    } else {
435		$str = $str_i;
436	    }
437	} else {
438	    # Aha. Wir haben hier wahrscheinlich einen angeklickten
439	    # Punkt zwischen zwei Kurvenpunkten, der nicht mehr durch
440	    # add_net abgedeckt ist. Also wird einfach geraten, ob der
441	    # Punkt zur vorherigen Strecke geh�rt, indem der Schnittwinkel
442	    # �berpr�ft wird.
443	    # Der Algorithmus ist nicht perfekt, weil einige Schnittwinkel
444	    # im 90�-Bereich liegen, wo es sich trotzdem um die gleiche
445	    # Stra�e handelt. Naja.
446	    if ($i+1 < $#{$route_ref}) {
447		my($w) = schnittwinkel
448		  (split(/,/,$xy1),
449		   split(/,/,$xy2),
450		   split(/,/,Route::_coord_as_string
451			 ([$route_ref->[$i+2][0],
452			   $route_ref->[$i+2][1]])));
453		if ($w < 0.15 || $w > 3.00) {
454		    # ca. 10� Abweichung von der Geraden werden toleriert
455		    $str = ($#strname >= 0 ? $strname[$#strname]->[0] : '???');
456		}
457	    }
458	    # (Garantiert) unbekannte Stra�e.
459	    if (!defined $str) {
460		$str = "...";
461	    }
462	}
463	my($winkel, $richtung);
464	if ($i+1 < $#{$route_ref}) {
465	    ($richtung, $winkel) = Strassen::Util::abbiegen(@{$route_ref}[$i .. $i+2]);
466	    # This usually happens if either first and second or second and third
467	    # points are the same. Make sure that no warnings happen. But it would
468	    # be better if the caller made sure that this never happens...
469	    if (!defined $winkel) {
470		($richtung, $winkel) = ('', 0);
471	    }
472	}
473	my $extra;
474	if (@strname &&
475	    ($combinestreet && $str eq $strname[$#strname]->[ROUTE_NAME] &&
476	     !($strname[$#strname]->[ROUTE_EXTRA] && $strname[$#strname]->[ROUTE_EXTRA]{ImportantAngle}))) {
477	    $strname[$#strname][ROUTE_DIST] += $entf;
478	    $strname[$#strname][ROUTE_ANGLE] = $winkel;
479	    $strname[$#strname][ROUTE_DIR] = $richtung;
480	    $strname[$#strname][ROUTE_ARRAYINX][1] = $i+$start_i;
481	    $extra = $strname[$#strname][ROUTE_EXTRA];
482	    if ($extra) {
483		if ($args{-wanttrafficlights}) {
484		    $extra->{Trafficlights} = +0;
485		    $extra->{TrafficlightAtPoint} = 0;
486		}
487	    }
488	} else {
489	    my $val = [];
490	    $val->[ROUTE_NAME]	 = $str;
491	    $val->[ROUTE_DIST]	 = $entf;
492	    $val->[ROUTE_ANGLE]	 = $winkel;
493	    $val->[ROUTE_DIR]	 = $richtung;
494	    $val->[ROUTE_ARRAYINX] = [$i+$start_i, $i+$start_i];
495	    $extra = $val->[ROUTE_EXTRA] = {};
496	    if ($args{-wanttrafficlights}) {
497		$extra->{Trafficlights} = 0;
498		$extra->{TrafficlightAtPoint} = 0;
499	    }
500	    push @strname, $val;
501	}
502
503
504	warn "Cannot determine ImportantAngle with this format!";
505
506
507    }
508
509    @strname;
510}
511sub reachable_1 {
512    my($self, $coord) = @_;
513    if (!exists $self->{Net}{$coord}) {
514	warn "Die Koordinate $coord kann im Netz nicht erreicht werden\n"
515	  if $VERBOSE;
516	0;
517    } else {
518	1;
519    }
520}
521sub reachable_2 {
522    my($self, $coord) = @_;
523    if (!defined $self->{Net}[$self->{Coord2Index}{$coord}]) {
524	warn "Die Koordinate $coord kann im Netz nicht erreicht werden\n"
525	  if $VERBOSE;
526	0;
527    } else {
528	1;
529    }
530}
531
5321;
533