6
my $cfgpoi = "poi.cfg";
7
my $cfgpoly = "poly.cfg";
8
my $cfgheader = "header.cfg";
10
my $codepage = "1251";
11
my $mapid = "12345432";
12
my $mapname = "OSM-test";
21
my $fixclosenodes = 1;
22
my $fixclosedist = 5.5;
33
my %yesno = ( "yes" => 1,
47
print STDERR "\n ---| OSM -> MP converter $version (c) 2008 liosha, xliosha\@gmail.com\n\n";
58
if ( (!$_) || /^\s*[\#\;]/ ) { next; }
60
my ($k, $v, $type, $llev, $hlev, $city) = split /\s+/;
62
$llev = 0 if ($llev eq "");
63
$hlev = 1 if ($hlev eq "");
64
$city = (($city ne "") ? 1 : 0);
65
$poitype{"$k=$v"} = [ $type, $llev, $hlev, $city ];
75
if ( (!$_) || /^\s*[\#\;]/ ) { next; }
79
my ($k, $v, $mode, $type, $llev, $hlev, $rp, @p) = split /\s+/;
82
if ($type =~ /(.+),(\d)/) { $type = $1; $prio = $2; }
83
$llev = 0 if ($llev eq "");
84
$hlev = 1 if ($hlev eq "");
86
$polytype{"$k=$v"} = [ $mode, $type, $prio, $llev, $hlev, $rp ];
97
open HEAD, $cfgheader;
99
s/^ID=.*$/ID=$mapid/i if ($mapid);
100
s/^Name=.*$/Name=$mapname/i if ($mapname);
101
s/^CodePage=.*$/CodePage=$codepage/i if ($codepage);
109
use POSIX qw(strftime);
110
print "\n; Converted from OpenStreetMap data with osm2mp $version (" . strftime ("%Y-%m-%d %H:%M:%S", localtime) . ")\n\n";
117
#### Loading nodes and writing POIs
121
print STDERR "Loading nodes... ";
122
print "\n\n\n; ### Points\n\n";
134
/^.*id=["'](\-?\d+)["'].*lat=["'](\-?\d+\.?\d*)["'].*lon=["'](\-?\d+\.?\d*)["'].*$/;
137
$nodes{$1} = $latlon;
145
/^.*k=["'](.*)["'].*v=["'](.*)["'].*$/;
146
$poi = "$1=$2" if ($poitype{"$1=$2"});
147
$poiname = convert_string ($2) if ($1 eq "name");
155
my @type = @{$poitype{$poi}};
157
print "; NodeID = $id\n";
160
printf "Type=%s\n", $type[0];
161
printf "Data%d=($latlon)\n", $type[1];
162
printf "EndLevel=%d\n", $type[2] if ($type[2] > $type[1]);
163
printf "City=Y\n", if ($type[3]);
164
print "Label=$poiname\n" if ($poiname);
170
printf STDERR "%d loaded, %d POIs dumped\n", scalar keys %nodes, $countpoi;
179
my $waypos = tell IN;
182
while (<IN>) { last if /\<relation/; }
184
my $relpos = tell IN;
192
#### Loading relations
199
print STDERR "Loading relations... ";
207
my ($tr_from, $tr_via, $tr_to);
211
if ( /\<relation/ ) {
212
/^.*id=["'](\-?\d+)["'].*$/;
216
undef $mp_outer; undef @mp_inner;
217
undef $tr_from; undef $tr_via; undef $tr_to;
222
/type=["'](\w+)["'].*ref=["'](\-?\d+)["'].*role=["'](\w+)["']/;
224
$mp_outer = $2 if ($3 eq "outer" && $1 eq "way");
225
push @mp_inner, $2 if ($3 eq "inner" && $1 eq "way");
227
$tr_from = $2 if ($3 eq "from" && $1 eq "way");
228
$tr_to = $2 if ($3 eq "to" && $1 eq "way");
229
$tr_via = $2 if ($3 eq "via" && $1 eq "node");
235
/k=["'](\w+)["'].*v=["'](\w+)["']/;
236
$reltype = $2 if ( $1 eq "type" );
240
if ( /\<\/relation/ ) {
241
if ( $reltype eq "multipolygon" ) {
242
$mpoly{$mp_outer} = [ @mp_inner ];
243
@mpholes{@mp_inner} = @mp_inner;
245
if ( $restrictions && $reltype eq "restriction" ) {
246
$trest{$id} = [ $tr_via, $tr_from, 0, -1, $tr_to, 0, -1 ];
247
push @{$waytr{$tr_from}}, $id;
248
push @{$waytr{$tr_to}}, $id;
253
} continue { $_ = <IN>; }
255
printf STDERR "%d multipolygons, %d turn restrictions\n", scalar keys %mpoly, scalar keys %trest;
262
#### Loading multipolygon holes and checking node dupes
264
print STDERR "Loading holes... ";
275
last if /\<relation/;
278
/^.*id=["'](\-?\d+)["'].*$/;
287
/^.*ref=["'](.*)["'].*$/;
288
if ($nodes{$1} && $1 ne $chain[-1] ) {
291
print "; ERROR: WayID=$id has dupes at ($nodes{$1})\n";
299
# print "; ERROR: WayID=$id has dupes\n" if ($dupcount>0);
301
## this way is multipolygon inner
302
if ( $mpholes{$id} ) {
303
$mpholes{$id} = [ @chain ];
307
} continue { $_ = <IN>; }
309
printf STDERR "%d loaded\n", scalar keys %mpholes;
316
#### Loading roads and writing other ways
321
print STDERR "Processing ways... ";
322
print "\n\n\n; ### Lines and polygons\n\n";
328
my $countpolygons = 0;
332
my ($poly, $polyname);
334
my ($polytoll, $polynoauto, $polynobus, $polynoped, $polynobic, $polynohgv);
338
last if /\<relation/;
341
/^.*id=["'](\-?\d+)["'].*$/;
361
/^.*ref=["'](.*)["'].*$/;
362
if ($nodes{$1} && $1 ne $chain[-1] ) {
369
/^.*k=["'](.*)["'].*v=["'](.*)["'].*$/;
370
$poly = "$1=$2" if ($polytype{"$1=$2"} && ($polytype{"$1=$2"}->[2] >= $polytype{$poly}->[2]));
371
$polyname = convert_string ($2) if ($1 eq "name");
373
$polydir = $yesno{$2} if ($1 eq "oneway");
374
$polytoll = $yesno{$2} if ($1 eq "toll");
375
$polynoauto = 1 - $yesno{$2} if ($1 eq "motorcar");
376
$polynobus = 1 - $yesno{$2} if ($1 eq "psv");
377
$polynoped = 1 - $yesno{$2} if ($1 eq "foot");
378
$polynobic = 1 - $yesno{$2} if ($1 eq "bicycle");
379
$polynohgv = 1 - $yesno{$2} if ($1 eq "hgv");
387
if ( $polytype{$poly}->[0] eq "r" && scalar @chain <= 1 ) {
388
print "; ERROR: Road WayID=$id has too few nodes at ($nodes{$chain[0]})\n";
390
if ( $polytype{$poly}->[0] eq "r" && scalar @chain > 1 ) {
391
my @rp = split /,/, $polytype{$poly}->[5];
392
$rp[2] = $polydir if defined $polydir;
393
$rp[3] = $polytoll if defined $polytoll;
394
$rp[5] = $rp[6] = $rp[8] = $polynoauto if defined $polynoauto;
395
$rp[7] = $polynobus if defined $polynobus;
396
$rp[9] = $polynoped if defined $polynoped;
397
$rp[10] = $polynobic if defined $polynobic;
398
$rp[11] = $polynohgv if defined $polynohgv;
400
$rchain{$id} = [ @chain ];
401
$rprops{$id} = [ $poly, $polyname, join (",",@rp) ];
403
# processing associated turn restrictions
405
for my $relid (@{$waytr{$id}}) {
406
if ($trest{$relid}->[1] eq $id) {
407
$trest{$relid}->[3] = indexof (\@chain, $trest{$relid}->[0]);
408
if ($rp[2] && $trest{$relid}->[3] != 0) { $trest{$relid}->[2] = 1; }
409
elsif ($trest{$relid}->[3] == 0 && !$rp[2]) { $trest{$relid}->[2] = -1; }
410
elsif ($trest{$relid}->[3] == $#chain) { $trest{$relid}->[2] = 1; }
412
if ($trest{$relid}->[4] eq $id) {
413
$trest{$relid}->[6] = indexof (\@chain, $trest{$relid}->[0]);
414
if ($rp[2] && $trest{$relid}->[6] != $#chain) { $trest{$relid}->[5] = 1; }
415
elsif ($trest{$relid}->[6] == 0) { $trest{$relid}->[5] = 1; }
416
elsif ($trest{$relid}->[6] == $#chain && !$rp[2]) { $trest{$relid}->[5] = -1; }
422
## this way is map line
423
if ( $polytype{$poly}->[0] eq "l" ) {
426
if ( scalar @chain < 2 ) {
427
print "; ERROR: WayID=$id has too few nodes at ($nodes{$chain[0]})\n";
431
my @type = @{$polytype{$poly}};
432
print "; WayID = $id\n";
434
print "${d}[POLYLINE]\n";
435
printf "${d}Type=%s\n", $type[1];
436
printf "${d}EndLevel=%d\n", $type[4] if ($type[4] > $type[3]);
437
print "${d}Label=$polyname\n" if ($polyname);
438
print "${d}DirIndicator=$polydir\n" if defined $polydir;
439
printf "${d}Data%d=(%s)\n", $type[3], join ("), (", @nodes{@chain});
440
print "${d}[END]\n\n\n";
443
## this way is map polygon
444
if ( $polytype{$poly}->[0] eq "p" ) {
447
if ( scalar @chain < 4 ) {
448
print "; ERROR: WayID=$id has too few nodes near ($nodes{$chain[0]})\n";
451
if ( $chain[0] ne $chain[-1] ) {
452
print "; ERROR: area WayID=$id is not closed at ($nodes{$chain[0]})\n";
455
my @type = @{$polytype{$poly}};
456
print "; WayID = $id\n";
458
print "${d}[POLYGON]\n";
459
printf "${d}Type=%s\n", $type[1];
460
printf "${d}EndLevel=%d\n", $type[4] if ($type[4] > $type[3]);
461
print "${d}Label=$polyname\n" if ($polyname);
462
printf "${d}Data%d=(%s)\n", $type[3], join ("), (", @nodes{@chain});
464
printf "; this is multipolygon with %d holes: %s\n", scalar @{$mpoly{$id}}, join (", ", @{$mpoly{$id}});
465
for my $hole (@{$mpoly{$id}}) {
466
if ($mpholes{$hole} ne $hole && @{$mpholes{$hole}}) {
467
printf "${d}Data%d=(%s)\n", $type[3], join ("), (", @nodes{@{$mpholes{$hole}}});
471
print "${d}[END]\n\n\n";
475
} continue { $_ = <IN>; }
477
printf STDERR "%d roads loaded
478
$countlines lines and $countpolygons polygons dumped\n", scalar keys %rchain;
484
#### Detecting end nodes
489
while (my ($road, $pchain) = each %rchain) {
490
$enodes{$pchain->[0]} ++;
491
$enodes{$pchain->[-1]} ++;
492
push @{$rstart{$pchain->[0]}}, $road;
505
print STDERR "Merging roads... ";
508
my @keys = keys %rchain;
511
while ($i < scalar @keys) {
514
if ($rmove{$r1}) { $i++; next; }
515
my $p1 = $rchain{$r1};
518
for my $r2 (@{$rstart{$p1->[-1]}}) {
519
if ( $r1 ne $r2 && $rprops{$r2}
520
&& join(":",@{$rprops{$r1}}) eq join(":",@{$rprops{$r2}})
521
&& lcos($p1->[-2],$p1->[-1],$rchain{$r2}->[1]) > $mergecos ) {
528
@list = sort { lcos($p1->[-2],$p1->[-1],$rchain{$b}->[1]) <=> lcos($p1->[-2],$p1->[-1],$rchain{$a}->[1]) } @list;
529
printf "; FIX: Road WayID=$r1 may be merged with %s at (%s)\n", join (", ", @list), $nodes{$p1->[-1]};
535
for my $relid (@{$waytr{$r2}}) {
536
if ($trest{$relid}->[1] eq $r2) {
537
print "; FIX: RelID=$relid FROM moved from WayID=$r2 to WayID=$r1\n";
538
$trest{$relid}->[1] = $r1;
539
$trest{$relid}->[3] += ( (scalar @{$rchain{$r1}}) - 1 );
540
push @{$waytr{$r1}}, $relid;
542
if ($trest{$relid}->[4] eq $r2) {
543
print "; FIX: RelID=$relid TO moved from WayID=$r2 to WayID=$r1\n";
544
$trest{$relid}->[4] = $r1;
545
$trest{$relid}->[6] += ( (scalar @{$rchain{$r1}}) - 1 );
546
push @{$waytr{$r1}}, $relid;
552
$enodes{$rchain{$r2}->[0]} -= 2;
553
push @{$rchain{$r1}}, @{$rchain{$r2}}[1..$#{$rchain{$r2}}];
556
@{$rstart{$p1->[-1]}} = grep { $_ ne $r2 } @{$rstart{$p1->[-1]}};
562
print STDERR "$countmerg merged\n";
569
#### Generating routing graph
574
print STDERR "Detecting road nodes... ";
575
print "\n\n\n; ### Routing nodes\n\n";
577
while (my ($road, $pchain) = each %rchain) {
578
for my $node (@{$pchain}) { $rnodes{$node} ++; }
582
for my $node (keys %rnodes) {
583
if ($rnodes{$node}>1 || $enodes{$node}>0) {
584
# printf "; NodID=$nodcount - NodeID=$node at (%s) - $rnodes{$node} roads, $enodes{$node} ends\n", $nodes{$node};
585
$nodid{$node} = $nodcount++;
589
printf STDERR "%d found\n", scalar keys %nodid;
595
#### Detecting duplicate road segments
602
print STDERR "Detecting duplicates... ";
603
print "\n\n\n; ### Duplicate roads\n\n";
605
while (my ($road, $pchain) = each %rchain) {
606
for (my $i=0; $i<$#{$pchain}; $i++) {
607
if ( $nodid{$pchain->[$i]} && $nodid{$pchain->[$i+1]} ) {
608
push @{$segways{join(":",( sort {$a cmp $b} ($pchain->[$i],$pchain->[$i+1]) ))}}, $road;
613
my $countdupsegs = 0;
614
my $countduproads = 0;
619
for my $seg (keys %segways) {
620
if ( $#{$segways{$seg}} > 0 ) {
621
# printf "; ERROR: Segment $seg is a part of %d roads - %s\n", scalar @{$segways{$seg}}, join (", ", @{$segways{$seg}});
623
my $roads = join ", ", ( sort {$a cmp $b} @{$segways{$seg}} );
624
$roadsegs{$roads} ++;
625
my ($point) = split (":", $seg);
626
$roadpos{$roads} = $nodes{$point};
630
for my $road (keys %roadsegs) {
632
printf "; ERROR: Roads $road has $roadsegs{$road} duplicate segments near ($roadpos{$road})\n";
635
printf STDERR "$countdupsegs segments, $countduproads roads\n";
641
#### Fixing self-intersections and long roads
648
print STDERR "Splitting roads... ";
649
while (my ($road, $pchain) = each %rchain) {
654
for (my $i=1; $i < scalar @{$pchain}; $i++) {
655
$rnod ++ if ( ${nodid{$pchain->[$i]}} );
656
if (scalar (grep { $_ eq $pchain->[$i] } @{$pchain}[$break..$i-1]) > 0) {
658
# print "; ERROR: WayID=$road has self-intersecton near (${nodes{$pchain->[$i]}}) ($i $j)\n";
659
if ($pchain->[$i] ne $pchain->[$j]) {
661
push @breaks, $break;
663
$break = ($i + $j) >> 1;
664
push @breaks, $break;
665
$nodid{$pchain->[$break]} = $nodcount++;
666
printf "; FIX: Added NodID=%d for NodeID=%s at (%s)\n", $nodid{$pchain->[$break]}, $pchain->[$break], $nodes{$pchain->[$break]};
672
# print "; ERROR: WayID=$road has too many nodes ($i $j)\n";
674
push @breaks, $break;
677
$j = $i if ($nodid{$pchain->[$i]});
679
if (scalar @breaks > 0) {
681
for my $relid (@{$waytr{$road}}) {
682
# FIXME: processing turn restrictions for splitted roads
683
print STDERR "Warning! Turn restriction RelID=$relid is not properly processed\n";
684
delete $trest{$relid};
687
printf "; FIX: WayID=$road is splitted at %s\n", join (", ", @breaks);
688
push @breaks, $#{$pchain};
689
for (my $i=0; $i<$#breaks; $i++) {
690
my $id = $road."/".($i+1);
691
printf "; FIX: Added road %s, nodes from %d to %d\n", $id, $breaks[$i], $breaks[$i+1];
692
$rchain{$id} = [ @{$pchain}[$breaks[$i] .. $breaks[$i+1]] ];
693
$rprops{$id} = $rprops{$road};
695
$#{$pchain} = $breaks[0];
698
print STDERR "$countself self-intersections, $countlong long roads\n";
704
#### Fixing "too close nodes" error
706
if ($fixclosenodes) {
710
print STDERR "Fixing close nodes... ";
711
while (my ($road, $pchain) = each %rchain) {
712
my $cnode = $pchain->[0];
713
for my $node (@{$pchain}[1..$#{$pchain}]) {
714
if ($node ne $cnode && $nodid{$node}) {
715
if (closenodes($cnode, $node)) {
716
print "; ERROR: too close nodes $cnode and $node, WayID=$road near (${nodes{$node}})\n";
723
print STDERR "$countclose pairs fixed\n";
735
print STDERR "Writing roads... ";
736
print "\n\n\n; ### Roads\n\n";
739
while (my ($road, $pchain) = each %rchain) {
740
my ($poly, $name, $rp) = @{$rprops{$road}};
741
my @type = @{$polytype{$poly}};
743
$roadid{$road} = $roadcount if ($waytr{$road});
745
# @type == [ $mode, $type, $prio, $llev, $hlev, $rp ]
746
print "; WayID = $road\n";
748
print "[POLYLINE]\n";
749
printf "Type=%s\n", $type[1];
750
printf "EndLevel=%d\n", $type[4] if ($type[4] > $type[3]);
751
print "Label=$name\n" if ($name);
752
print "DirIndicator=1\n" if ((split /\,/, $rp)[2]);
754
printf "Data%d=(%s)\n", $type[3], join ("), (", @nodes{@{$pchain}});
755
printf "RoadID=%d\n", $roadcount++;
756
printf "RouteParams=%s\n", $rp;
759
for (my $i=0; $i < scalar @{$pchain}; $i++) {
760
my $node = $pchain->[$i];
762
printf "Nod%d=%d,%d,0\n", $nodcount++, $i, $nodid{$node};
769
printf STDERR "%d written\n", $roadcount-1;
775
#### Writing turn restrictions
780
print "\n\n\n; ### Turn restrictions\n\n";
782
print STDERR "Writing restrictions... ";
784
while ( my ($relid, $rel) = each %trest ) {
786
printf "\n; RelID = $relid, %s\n", join(":", @{$rel});
788
if ($rel->[2] == 0) {
789
print "; ERROR: RelID=$relid has undefined FROM direction\n";
790
} elsif ($rel->[5] == 0) {
791
print "; ERROR: RelID=$relid has undefined TO direction\n";
792
} elsif ($rel->[3] == -1) {
793
print "; ERROR: RelID=$relid FROM road does'n contain VIA node\n";
794
} elsif ($rel->[6] == -1) {
795
print "; ERROR: RelID=$relid TO road does'n contain VIA node\n";
800
my $i = $rel->[3] - $rel->[2];
801
$i -= $rel->[2] while ($i>=0 && $i < $#{$rchain{$rel->[1]}} && !$nodid{$rchain{$rel->[1]}->[$i]});
802
my $j = $rel->[6] + $rel->[5];
803
$j += $rel->[5] while ($j>=0 && $j < $#{$rchain{$rel->[4]}} && !$nodid{$rchain{$rel->[4]}->[$j]});
805
print "[Restrict]\n";
806
printf "Nod=${nodid{$rel->[0]}}\n";
807
print "TraffPoints=${nodid{$rchain{$rel->[1]}->[$i]}},${nodid{$rel->[0]}},${nodid{$rchain{$rel->[4]}->[$j]}}\n";
808
print "TraffRoads=${roadid{$rel->[1]}},${roadid{$rel->[4]}}\n";
810
print "[END-Restrict]\n";
814
print STDERR "$counttrest written\n";
821
print STDERR "All done!!\n\n";
834
sub convert_string { # String
836
my $str = encode ("cp".$codepage, decode("utf8", $_[0]));
838
$str =~ s/\&\;/\&/gi;
839
$str =~ s/\&\;/\&/gi;
840
$str =~ s/\"\;/\"/gi;
841
$str =~ s/\&apos\;/\'/gi;
842
$str =~ s/\'\;/\'/gi;
843
$str =~ s/\/\;/\//gi;
844
$str =~ s/\\\;/\\/gi;
851
sub closenodes { # NodeID1, NodeID2
853
my ($lat1, $lon1) = split ",", $nodes{$_[0]};
854
my ($lat2, $lon2) = split ",", $nodes{$_[1]};
856
my ($clat, $clon) = ( ($lat1+$lat2)/2, ($lon1+$lon2)/2 );
857
my ($dlat, $dlon) = ( ($lat2-$lat1), ($lon2-$lon1) );
858
my $klon = cos ($clat*3.14159/180);
860
my $ldist = $fixclosedist * 180 / 20_000_000;
862
my $res = ($dlat**2 + ($dlon*$klon)**2) < $ldist**2;
867
$nodes{$_[0]} = ($clat - $ldist/2 * ($dlat==0 ? 1 : ($dlat <=> 0) )) . "," . $clon;
868
$nodes{$_[1]} = ($clat + $ldist/2 * ($dlat==0 ? 1 : ($dlat <=> 0) )) . "," . $clon;
870
my $azim = $dlat / $dlon;
871
my $ndlon = sqrt ($ldist**2 / ($klon**2 + $azim**2)) / 2;
872
my $ndlat = $ndlon * abs($azim);
874
$nodes{$_[0]} = ($clat - $ndlat * ($dlat <=> 0)) . "," . ($clon - $ndlon * ($dlon <=> 0));
875
$nodes{$_[1]} = ($clat + $ndlat * ($dlat <=> 0)) . "," . ($clon + $ndlon * ($dlon <=> 0));
883
sub lcos { # NodeID1, NodeID2, NodeID3
885
my ($lat1, $lon1) = split ",", $nodes{$_[0]};
886
my ($lat2, $lon2) = split ",", $nodes{$_[1]};
887
my ($lat3, $lon3) = split ",", $nodes{$_[2]};
889
my $klon = cos (($lat1+$lat2+$lat3)/3*3.14159/180);
891
my $xx = (($lat2-$lat1)**2+($lon2-$lon1)**2*$klon**2)*(($lat3-$lat2)**2+($lon3-$lon2)**2*$klon**2);
892
return -1 if ( $xx == 0);
893
return (($lat2-$lat1)*($lat3-$lat2)+($lon2-$lon1)*($lon3-$lon2)*$klon**2) / sqrt ($xx);
898
sub indexof { # \@array, $elem
900
for (my $i=0; $i < scalar @{$_[0]}; $i++)
901
{ return $i if ($_[0]->[$i] eq $_[1]); }
added
removed
Methods/Mapping/scripts/osm2mp/osm2mp.pl
