[libosm-gary68-perl] 01/17: Imported Upstream version 0.0~svn26727
Sebastiaan Couwenberg
sebastic at moszumanska.debian.org
Sun Jan 3 00:09:40 UTC 2016
This is an automated email from the git hooks/post-receive script.
sebastic pushed a commit to branch master
in repository libosm-gary68-perl.
commit 6cec75d20448ef229124a460b7283f83b756a926
Author: David Paleino <dapal at debian.org>
Date: Fri Sep 30 21:17:02 2011 +0200
Imported Upstream version 0.0~svn26727
---
QuadTree.pm | 365 +++++++++
gpx.pm | 199 +++++
mapgen.pm | 2291 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
mapgenRules.pm | 180 +++++
osm.pm | 1760 +++++++++++++++++++++++++++++++++++++++++++
osmDB.pm | 839 +++++++++++++++++++++
osmgraph.pm | 751 +++++++++++++++++++
7 files changed, 6385 insertions(+)
diff --git a/QuadTree.pm b/QuadTree.pm
new file mode 100644
index 0000000..256ff5a
--- /dev/null
+++ b/QuadTree.pm
@@ -0,0 +1,365 @@
+package OSM::QuadTree;
+
+use strict;
+use Carp;
+
+our $VERSION = 0.1;
+
+1;
+
+###############################
+#
+# sub new() - constructor
+#
+# Arguments are a hash:
+#
+# -xmin => minimum x value
+# -xmax => maximum x value
+# -ymin => minimum y value
+# -ymax => maximum y value
+# -depth => depth of tree
+#
+# Creating a new QuadTree objects automatically
+# segments the given area into quadtrees of the
+# specified depth.
+#
+###############################
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ my $obj = bless {} => $class;
+
+ $obj->{BACKREF} = {};
+ $obj->{OBJECTS} = [];
+ $obj->{ORIGIN} = [0, 0];
+ $obj->{SCALE} = 1;
+
+ my %args = @_;
+
+ for my $arg (qw/xmin ymin xmax ymax depth/) {
+ unless (exists $args{"-$arg"}) {
+ carp "- must specify $arg";
+ return undef;
+ }
+
+ $obj->{uc $arg} = $args{"-$arg"};
+ }
+
+ $obj->_segment;
+
+ return $obj;
+}
+
+###############################
+#
+# sub _segment() - private method
+#
+# This method does the actual segmentation
+# and stores everything internally.
+#
+###############################
+
+sub _segment {
+ my $obj = shift;
+
+ $obj->_addLevel(
+ $obj->{XMIN},
+ $obj->{YMIN},
+ $obj->{XMAX},
+ $obj->{YMAX},
+ 1, # current depth
+ 0, # current index
+ undef, # parent index
+ );
+
+}
+
+###############################
+#
+# sub _addLevel() - private method
+#
+# This method segments a given area
+# and adds a level to the tree.
+#
+###############################
+
+sub _addLevel {
+ my ($obj,
+ $xmin,
+ $ymin,
+ $xmax,
+ $ymax,
+ $curDepth,
+ $index,
+ $parent,
+ ) = @_;
+
+ $obj->{AREA} [$index] = [$xmin, $ymin, $xmax, $ymax];
+ $obj->{PARENT} [$index] = $parent;
+ $obj->{CHILDREN}[$index] = [];
+ $obj->{OBJECTS} [$index] = [];
+
+ if (defined $parent) {
+ push @{$obj->{CHILDREN}[$parent]} => $index;
+ }
+
+ return if $curDepth == $obj->{DEPTH};
+
+ my $xmid = $xmin + ($xmax - $xmin) / 2;
+ my $ymid = $ymin + ($ymax - $ymin) / 2;
+
+ # now segment in the following order (doesn't matter):
+ # top left, top right, bottom left, bottom right
+ $obj->_addLevel($xmin, $ymid, $xmid, $ymax, # tl
+ $curDepth + 1, 4 * $index + 1, $index);
+ $obj->_addLevel($xmid, $ymid, $xmax, $ymax, # tr
+ $curDepth + 1, 4 * $index + 2, $index);
+ $obj->_addLevel($xmin, $ymin, $xmid, $ymid, # bl
+ $curDepth + 1, 4 * $index + 3, $index);
+ $obj->_addLevel($xmid, $ymin, $xmax, $ymid, # br
+ $curDepth + 1, 4 * $index + 4, $index);
+}
+
+###############################
+#
+# sub add() - public method
+#
+# This method adds an object to the tree.
+# The arguments are a unique tag to identify
+# the object, and the bounding box of the object.
+# It automatically assigns the proper quadtree
+# sections to each object.
+#
+###############################
+
+sub add {
+ my ($self,
+ $objRef,
+ @coords,
+ ) = @_;
+
+ # assume that $objRef is unique.
+ # assume coords are (xmin, ymix, xmax, ymax).
+
+ # modify coords according to window.
+ @coords = $self->_adjustCoords(@coords);
+
+ ($coords[0], $coords[2]) = ($coords[2], $coords[0]) if
+ $coords[2] < $coords[0];
+ ($coords[1], $coords[3]) = ($coords[3], $coords[1]) if
+ $coords[3] < $coords[1];
+
+ $self->_addObjToChild(
+ 0, # current index
+ $objRef,
+ @coords,
+ );
+}
+
+###############################
+#
+# sub _addObjToChild() - private method
+#
+# This method is used internally. Given
+# a tree segment, an object and its area,
+# it checks to see whether the object is to
+# be included in the segment or not.
+# The object is not included if it does not
+# overlap the segment.
+#
+###############################
+
+sub _addObjToChild {
+ my ($self,
+ $index,
+ $objRef,
+ @coords,
+ ) = @_;
+
+ # first check if obj overlaps current segment.
+ # if not, return.
+ my ($cxmin, $cymin, $cxmax, $cymax) = @{$self->{AREA}[$index]};
+
+ return if
+ $coords[0] > $cxmax ||
+ $coords[2] < $cxmin ||
+ $coords[1] > $cymax ||
+ $coords[3] < $cymin;
+
+ # Only add the object to the segment if we are at the last
+ # level of the tree.
+ # Else, keep traversing down.
+
+ unless (@{$self->{CHILDREN}[$index]}) {
+ push @{$self->{OBJECTS}[$index]} => $objRef; # points from leaf to object
+ push @{$self->{BACKREF}{$objRef}} => $index; # points from object to leaf
+
+ } else {
+ # Now, traverse down the hierarchy.
+ for my $child (@{$self->{CHILDREN}[$index]}) {
+ $self->_addObjToChild(
+ $child,
+ $objRef,
+ @coords,
+ );
+ }
+ }
+}
+
+###############################
+#
+# sub delete() - public method
+#
+# This method deletes an object from the tree.
+#
+###############################
+
+sub delete {
+ my ($self,
+ $objRef,
+ ) = @_;
+
+ return unless exists $self->{BACKREF}{$objRef};
+
+ for my $i (@{$self->{BACKREF}{$objRef}}) {
+ $self->{OBJECTS}[$i] = grep {$_ ne $objRef} @{$self->{OBJECTS}[$i]};
+ }
+
+ delete $self->{BACKREF}{$objRef};
+}
+
+###############################
+#
+# sub getEnclosedObjects() - public method
+#
+# This method takes an area, and returns all objects
+# enclosed in that area.
+#
+###############################
+
+sub getEnclosedObjects {
+ my ($self,
+ @coords) = @_;
+
+ $self->{TEMP} = [];
+
+ @coords = $self->_adjustCoords(@coords);
+
+ $self->_checkOverlap(
+ 0, # current index
+ @coords,
+ );
+
+ # uniquify {TEMP}.
+ my %temp;
+ @temp{@{$self->{TEMP}}} = undef;
+
+ # PS. I don't check explicitly if those objects
+ # are enclosed in the given area. They are just
+ # part of the segments that are enclosed in the
+ # given area. TBD.
+
+ return [keys %temp];
+}
+
+###############################
+#
+# sub _adjustCoords() - private method
+#
+# This method adjusts the given coordinates
+# according to the stored window. This is used
+# when we 'zoom in' to avoid searching in areas
+# that are not visible in the canvas.
+#
+###############################
+
+sub _adjustCoords {
+ my ($self, @coords) = @_;
+
+ # modify coords according to window.
+ $_ = $self->{ORIGIN}[0] + $_ / $self->{SCALE}
+ for $coords[0], $coords[2];
+ $_ = $self->{ORIGIN}[1] + $_ / $self->{SCALE}
+ for $coords[1], $coords[3];
+
+ return @coords;
+}
+
+###############################
+#
+# sub _checkOverlap() - private method
+#
+# This method checks if the given coordinates overlap
+# the specified tree segment. If not, nothing happens.
+# If it does overlap, then it is called recuresively
+# on all the segment's children. If the segment is a
+# leaf, then its associated objects are pushed onto
+# a temporary array for later access.
+#
+###############################
+
+sub _checkOverlap {
+ my ($self,
+ $index,
+ @coords,
+ ) = @_;
+
+ # first check if obj overlaps current segment.
+ # if not, return.
+ my ($cxmin, $cymin, $cxmax, $cymax) = @{$self->{AREA}[$index]};
+
+ return if
+ $coords[0] >= $cxmax ||
+ $coords[2] <= $cxmin ||
+ $coords[1] >= $cymax ||
+ $coords[3] <= $cymin;
+
+ unless (@{$self->{CHILDREN}[$index]}) {
+ push @{$self->{TEMP}} => @{$self->{OBJECTS}[$index]};
+ } else {
+ # Now, traverse down the hierarchy.
+ for my $child (@{$self->{CHILDREN}[$index]}) {
+ $self->_checkOverlap(
+ $child,
+ @coords,
+ );
+ }
+ }
+}
+
+###############################
+#
+# sub setWindow() - public method
+#
+# This method takes an area as input, and
+# sets it as the active window. All new
+# calls to any method will refer to that area.
+#
+###############################
+
+sub setWindow {
+ my ($self, $sx, $sy, $s) = @_;
+
+ $self->{ORIGIN}[0] += $sx / $self->{SCALE};
+ $self->{ORIGIN}[1] += $sy / $self->{SCALE};
+ $self->{SCALE} *= $s;
+}
+
+###############################
+#
+# sub setWindow() - public method
+# This resets the window.
+#
+###############################
+
+sub resetWindow {
+ my $self = shift;
+
+ $self->{ORIGIN}[$_] = 0 for 0 .. 1;
+ $self->{SCALE} = 1;
+}
+
+
+
diff --git a/gpx.pm b/gpx.pm
new file mode 100755
index 0000000..fe14a34
--- /dev/null
+++ b/gpx.pm
@@ -0,0 +1,199 @@
+#
+# PERL mapweaver module by gary68
+#
+#
+#
+#
+# Copyright (C) 2011, Gerhard Schwanz
+#
+# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
+#
+
+
+package OSM::gpx ;
+
+use strict ;
+use warnings ;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+require Exporter ;
+
+ at ISA = qw ( Exporter AutoLoader ) ;
+
+ at EXPORT = qw ( readGPXFile
+ ) ;
+
+my $file ;
+my $line ;
+
+my $wptNr = 0 ;
+my $trkNr = 0 ;
+my $rteNr = 0 ;
+my %wpt = () ;
+my %trk = () ;
+my %rte = () ;
+
+
+
+
+sub readGPXFile {
+ my $name = shift ;
+
+ my $res = open ($file, "<", $name) ;
+
+ if ($res) {
+
+ $line = getLine() ;
+ while (defined $line) {
+
+ if ( grep /<wpt/i, $line) { readWpt() ; }
+ if ( grep /<rte/i, $line) { readRte() ; }
+ if ( grep /<trk/i, $line) { readTrk() ; }
+
+ $line = getLine() ;
+ }
+
+ close ($file) ;
+
+ }
+ else {
+ print "ERROR: can't open gpx file $name\n" ;
+ }
+
+ print "gpx file $name read. $wptNr waypoint(s), $trkNr track(s) and $rteNr route(s).\n" ;
+
+ return (\%wpt, \%rte, \%trk) ;
+}
+
+
+
+sub getLine {
+ $line = <$file> ;
+ if (defined $line) {
+ $line =~ s/\r//g ; # remove dos/win char at line end
+ }
+
+ if (defined $line) {
+ $line =~ s/^\s// ;
+ $line =~ s/\s$// ;
+ }
+
+ while ( (defined $line) and (length $line == 0) ) {
+ $line = <$file> ;
+ }
+ return $line ;
+}
+
+
+sub readWpt {
+ $wptNr++ ;
+ # print "read wpt $wptNr\n" ;
+ my ($lon) = ( $line =~ /lon=\"(.+?)\"/ ) ;
+ my ($lat) = ( $line =~ /lat=\"(.+?)\"/ ) ;
+
+ $wpt{$wptNr}{"lon"} = $lon ;
+ $wpt{$wptNr}{"lat"} = $lat ;
+
+ while ( ! grep /<\/wpt>/i, $line) {
+ my ($ele) = ( $line =~ /<ele>(.+?)<\/ele>/ ) ;
+ my ($name) = ( $line =~ /<name>(.+?)<\/name>/ ) ;
+ if (defined $name) { $wpt{$wptNr}{"name"} = cleanName ($name) ; }
+ if (defined $ele) { $wpt{$wptNr}{"ele"} = $ele ; }
+ $line = getLine() ;
+ }
+}
+
+
+sub readRte {
+ $rteNr++ ;
+ # print "read route $rteNr\n" ;
+ my $rteWptNr = 0 ;
+
+ $line = getLine() ;
+ while ( ! grep /<\/rte>/i, $line) {
+
+ if ( grep /<rtept/i, $line) {
+ $rteWptNr++ ;
+ my ($lon) = ( $line =~ /lon=\"(.+?)\"/ ) ;
+ my ($lat) = ( $line =~ /lat=\"(.+?)\"/ ) ;
+ $rte{$rteNr}{$rteWptNr}{"lon"} = $lon ;
+ $rte{$rteNr}{$rteWptNr}{"lat"} = $lat ;
+
+ while ( ! grep /<\/rtept>/i, $line) {
+ $line = getLine() ;
+ }
+ }
+
+ my ($name) = ( $line =~ /<name>(.+?)<\/name>/ ) ;
+ # if (defined $name) { $rte{$rteNr}{"name"} = cleanName ($name) ; }
+
+ $line = getLine() ;
+ }
+}
+
+
+
+sub readTrk {
+ $trkNr++ ;
+ my $trkSegNr = 0 ;
+ # print "read track $trkNr\n" ;
+
+ $line = getLine() ;
+ while ( ! grep /<\/trk>/i, $line) {
+
+ if ( grep /<trkseg/i, $line) {
+ $trkSegNr++ ;
+ # print " read track segment $trkSegNr\n" ;
+ my $wptNr = 0 ;
+
+ while ( ! grep /<\/trkseg>/i, $line) {
+
+ if ( grep /<trkpt/i, $line) {
+ $wptNr++ ;
+ # print " read track wpt $wptNr\n" ;
+ my ($lon) = ( $line =~ /lon=\"(.+?)\"/ ) ;
+ my ($lat) = ( $line =~ /lat=\"(.+?)\"/ ) ;
+ $trk{$trkNr}{$trkSegNr}{$wptNr}{"lon"} = $lon ;
+ $trk{$trkNr}{$trkSegNr}{$wptNr}{"lat"} = $lat ;
+
+ while ( ! grep /<\/trkpt>/i, $line) {
+ $line = getLine() ;
+ }
+ }
+
+ $line = getLine() ;
+
+ }
+
+ # print " track segment finished\n" ;
+ }
+
+ my ($name) = ( $line =~ /<name>(.+?)<\/name>/ ) ;
+ # if (defined $name) { $trk{$trkNr}{"name"} = cleanName ($name) ; }
+
+ $line = getLine() ;
+ # print " track finished\n" ;
+ }
+ # print "readTrK finished\n" ;
+}
+
+
+
+sub cleanName {
+ my $name = shift ;
+ $name =~ s/\<!\[CDATA\[//i ;
+ $name =~ s/\]\]>//i ;
+ return $name ;
+}
+
+
+1 ;
+
+
diff --git a/mapgen.pm b/mapgen.pm
new file mode 100755
index 0000000..ac82144
--- /dev/null
+++ b/mapgen.pm
@@ -0,0 +1,2291 @@
+#
+# PERL mapgen module by gary68
+#
+# This module contains a lot of useful graphic functions for working with osm files and data. This enables you (in conjunction with osm.pm)
+# to easily draw custom maps.
+# Have a look at the last (commented) function below. It is useful for your main program!
+#
+#
+#
+#
+# Copyright (C) 2010, Gerhard Schwanz
+#
+# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
+
+#
+# INFO
+#
+# graph top left coordinates: (0,0)
+# size for lines = pixel width / thickness
+#
+# 1.051 l0 calculation adapted
+
+
+package OSM::mapgen ; #
+
+use strict ;
+use warnings ;
+
+use Math::Trig;
+use File::stat;
+use Time::localtime;
+use List::Util qw[min max] ;
+use Encode ;
+use OSM::osm ;
+use OSM::QuadTree ;
+use GD ;
+use Geo::Proj4 ;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION = '1.19' ;
+
+require Exporter ;
+
+ at ISA = qw ( Exporter AutoLoader ) ;
+
+ at EXPORT = qw ( addAreaIcon
+ addOnewayArrows
+ center
+ convert
+ createLabel
+ createWayLabels
+ declutterStat
+ drawArea
+ drawAreaMP
+ drawAreaOcean
+ drawAreaPix
+ drawCircle
+ drawCircleRadius
+ drawCircleRadiusText
+ drawCoords
+ drawHead
+ drawFoot
+ drawGrid
+ drawLegend
+ drawNodeDot
+ drawNodeDotRouteStops
+ drawNodeDotPix
+ drawNodeCircle
+ drawNodeCirclePix
+ drawPageNumber
+ drawPageNumberTop
+ drawPageNumberBottom
+ drawPageNumberLeft
+ drawPageNumberRight
+ drawRuler
+ drawTextPix
+ drawTextPix2
+ drawTextPixGrid
+ drawWay
+ drawWayBridge
+ drawWayPix
+ drawWayRoute
+ fitsPaper
+ getDimensions
+ getScale
+ getValue
+ gridSquare
+ initGraph
+ initOneways
+ labelWay
+ placeLabelAndIcon
+ printScale
+ scalePoints
+ scaleBase
+ setdpi
+ setBaseDpi
+ simplifiedPercent
+ sizePNG
+ sizeSVG
+ writeSVG ) ;
+
+#
+# constants
+#
+
+my %dashStyle = () ;
+my %dashDefinition = () ; # for 300 dpi
+@{$dashDefinition{1}} = (60,20,"round") ; #grid
+@{$dashDefinition{11}} = (16,16,"butt") ; # tunnel
+
+my $wayIndexLabelColor = 9 ;
+my $wayIndexLabelSize = 10 ;
+my $wayIndexLabelFont = 11 ;
+my $wayIndexLabelOffset = 12 ;
+my $wayIndexLegendLabel = 14 ;
+
+my $lineCap = "round" ;
+my $lineJoin = "round" ;
+
+my @occupiedAreas = () ;
+my $labelPathId = 0 ;
+
+my $qtWayLabels ;
+my $qtPoiLabels ;
+
+#
+# variables
+#
+my $proj ;
+my $projSizeX ;
+my $projSizeY ;
+my ($projLeft, $projRight, $projBottom, $projTop) ;
+
+
+my ($top, $bottom, $left, $right) ; # min and max real world coordinates
+my ($sizeX, $sizeY) ; # pic size in pixels
+
+my %svgOutputWays ;
+my %svgOutputNodes ;
+my @svgOutputAreas = () ;
+my @svgOutputText = () ;
+my @svgOutputPixel = () ;
+my @svgOutputPixelGrid = () ;
+my @svgOutputDef = () ;
+my @svgOutputPathText = () ;
+my @svgOutputIcons = () ;
+my @svgOutputRouteStops = () ;
+my $pathNumber = 0 ;
+my $svgBaseFontSize = 10 ;
+my @svgOutputRoutes = () ;
+
+my %areaDef = () ;
+my $areaNum = 1 ;
+
+my $numIcons = 0 ;
+my $numIconsMoved = 0 ;
+my $numIconsOmitted = 0 ;
+my $numLabels = 0 ;
+my $numLabelsMoved = 0 ;
+my $numLabelsOmitted = 0 ;
+my $numWayLabelsOmitted = 0 ;
+
+my $dpi = 0 ;
+my $baseDpi ;
+
+# clutter information
+my %clutter = () ;
+my %clutterIcon = () ;
+my @lines ;
+
+my $simplified = 0 ;
+my $simplifyTotal = 0 ;
+
+my $shieldPathId = 0 ;
+my %createdShields = () ; # key = name; value = id of path
+my %shieldXSize = () ;
+my %shieldYSize = () ;
+
+
+sub setdpi {
+ $dpi = shift ;
+}
+
+sub setBaseDpi {
+ $baseDpi = shift ;
+}
+
+
+sub initGraph {
+#
+# function initializes the picture, the colors and the background (white)
+#
+ my ($x, $l, $b, $r, $t, $color, $projection, $ellipsoid) = @_ ;
+
+ # my $l0 = int($l) - 1 ;
+ my $l0 = int(($r+$l) / 2 ) ;
+
+ $proj = Geo::Proj4->new(
+ proj => $projection,
+ ellps => $ellipsoid,
+ lon_0 => $l0
+ ) or die "parameter error: ".Geo::Proj4->error. "\n";
+
+
+ ($projLeft, $projBottom) = $proj->forward($b, $l) ; # lat/lon!!!
+ ($projRight, $projTop) = $proj->forward($t, $r) ; # lat/lon!!!
+
+ # print "PROJ: bounds: $projLeft $projRight $projBottom $projTop\n" ;
+
+ $projSizeX = $projRight - $projLeft ;
+ $projSizeY = $projTop - $projBottom ;
+
+ my $factor = $projSizeY / $projSizeX ;
+
+ # print "PROJ: $projSizeX x $projSizeY units, factor = $factor\n" ;
+
+ $sizeX = int ($x) ;
+ $sizeY = int ($x * $factor) ;
+
+ # print "PROJ: $sizeX x $sizeY pixels\n" ;
+ # print "PROJ: t b l r $t $b $l $r\n" ;
+ # print "PROJ: pt pb pl pr $projTop $projBottom $projLeft $projRight\n" ;
+ # print "PROJ: factor $factor\n" ;
+ # print "PROJ: l0 $l0\n" ;
+
+ $top = $t ;
+ $left = $l ;
+ $right = $r ;
+ $bottom = $b ;
+
+ drawArea ($color, "", $l, $t, $r, $t, $r, $b, $l, $b, $l, $t) ;
+
+ $qtWayLabels = OSM::QuadTree->new( -xmin => 0,
+ -xmax => $sizeX+100,
+ -ymin => 0,
+ -ymax => $sizeY+40,
+ -depth => 5);
+ $qtPoiLabels = OSM::QuadTree->new( -xmin => 0,
+ -xmax => $sizeX+100,
+ -ymin => 0,
+ -ymax => $sizeY+40,
+ -depth => 5);
+ initDashes() ;
+}
+
+sub initDashes {
+#
+# sub creates internal dash styles according to base definition
+#
+ foreach my $style (keys %dashDefinition) {
+ my @array = @{$dashDefinition{$style}} ;
+ my $lc = pop @array ;
+ my $dashString = "" ;
+ foreach my $entry (@array) {
+ my $entryScaled = scalePoints ( scaleBase ($entry) ) ;
+ $dashString .= "$entryScaled," ;
+ }
+ $dashString .= $lc ;
+ $dashStyle{$style} = $dashString ;
+ }
+}
+
+
+
+sub convert {
+#
+# converts real world coordinates to system graph pixel coordinates
+#
+ my ($x, $y) = @_ ;
+
+ my ($x1, $y1) = $proj->forward($y, $x) ; # lat/lon!!!
+
+ my $x2 = int ( ($x1 - $projLeft) / ($projRight - $projLeft) * $sizeX ) ;
+ my $y2 = $sizeY - int ( ($y1 - $projBottom) / ($projTop - $projBottom) * $sizeY ) ;
+
+ return ($x2, $y2) ;
+}
+
+sub gridSquare {
+#
+# returns grid square of given coordinates for directories
+#
+ my ($lon, $lat, $parts) = @_ ;
+ my ($x, $y) = convert ($lon, $lat) ;
+ # my $partsY = $sizeY / ($sizeX / $parts) ;
+ my $xi = int ($x / ($sizeX / $parts)) + 1 ;
+ my $yi = int ($y / ($sizeX / $parts)) + 1 ;
+ if ( ($x >= 0) and ($x <= $sizeX) and ($y >= 0) and ($y <= $sizeY) ) {
+ return (chr($xi+64) . $yi) ;
+ }
+ else {
+ return undef ;
+ }
+}
+
+
+
+sub occupyArea {
+#
+# occupy area and make entry in quad tree for later use
+#
+ my ($x1, $x2, $y1, $y2) = @_ ;
+ # left, right, bottom, top (bottom > top!)
+ push @occupiedAreas, [$x1, $x2, $y1, $y2] ;
+ $qtPoiLabels->add ($#occupiedAreas, $x1, $y1, $x2, $y2) ;
+}
+
+sub areaOccupied {
+#
+# look up possible interfering objects in quad tree and check for collision
+#
+ my ($x1, $x2, $y1, $y2) = @_ ;
+ # left, right, bottom, top (bottom > top!)
+ my $occupied = 0 ;
+
+ my $ref2 = $qtPoiLabels->getEnclosedObjects ($x1, $y2, $x2, $y1) ;
+ my @index = @$ref2 ;
+ my @occupiedAreasTemp = () ;
+ foreach my $nr (@index) {
+ push @occupiedAreasTemp, $occupiedAreas[$nr] ;
+ }
+
+ LAB1: foreach my $area (@occupiedAreasTemp) {
+ my $intersection = 1 ;
+ if ($x1 > $area->[1]) { $intersection = 0 ; } ;
+ if ($x2 < $area->[0]) { $intersection = 0 ; } ;
+ if ($y1 < $area->[3]) { $intersection = 0 ; } ;
+ if ($y2 > $area->[2]) { $intersection = 0 ; } ;
+ if ($intersection == 1) {
+ $occupied = 1 ;
+ last LAB1 ;
+ }
+ }
+ return ($occupied) ;
+}
+
+sub splitLabel {
+#
+# split label text at space locations and then merge new parts if new part will be smaller than 21 chars
+#
+ my $text = shift ;
+ my @lines = split / /, $text ;
+ my $merged = 1 ;
+ while ($merged) {
+ $merged = 0 ;
+ LAB2: for (my $i=0; $i<$#lines; $i++) {
+ if (length ($lines[$i] . " " . $lines[$i+1]) <= 20) {
+ $lines[$i] = $lines[$i] . " " . $lines[$i+1] ;
+ splice (@lines, $i+1, 1) ;
+ $merged = 1 ;
+ last LAB2 ;
+ }
+ }
+ }
+ return (\@lines) ;
+}
+
+
+sub svgElementIcon {
+#
+# create SVG text for icons
+#
+ my ($x, $y, $icon, $sizeX, $sizeY) = @_ ;
+ my ($out) = "<image x=\"" . $x . "\"" ;
+ $out .= " y=\"" . $y . "\"" ;
+ if ($sizeX > 0) { $out .= " width=\"" . $sizeX . "\"" ; }
+ if ($sizeY > 0) { $out .= " height=\"" . $sizeY . "\"" ; }
+ $out .= " xlink:href=\"" . $icon . "\" />" ;
+
+ return ($out) ;
+}
+
+sub drawHead {
+#
+# draws text on top left corner of the picture
+#
+ my ($text, $col, $size, $font) = @_ ;
+ push @svgOutputText, svgElementText (20, 20, $text, $size, $font, $col) ;
+}
+
+sub drawFoot {
+#
+# draws text on bottom left corner of the picture
+#
+ my ($text, $col, $size, $font) = @_ ;
+ my $posX = 80 ;
+ my $posY = 40 ;
+ push @svgOutputText, svgElementText (
+ scalePoints ( scaleBase ($posX) ),
+ $sizeY - ( scalePoints ( scaleBase ($posY) ) ),
+ $text,
+ scalePoints ( scaleBase ($size) ) ,
+ $font,
+ $col
+ ) ;
+}
+
+
+
+sub drawTextPix {
+#
+# draws text at pixel position
+# with small offset direction bottom
+#
+ my ($x1, $y1, $text, $col, $size, $font) = @_ ;
+
+ push @svgOutputPixel, svgElementText ($x1, $y1, $text, $size, $font, $col) ;
+}
+
+sub drawTextPixGrid {
+#
+# draws text at pixel position. code goes to grid
+#
+ my ($x1, $y1, $text, $col, $size) = @_ ;
+
+ push @svgOutputPixelGrid, svgElementText ($x1, $y1+9, $text, $size, "sans-serif", $col) ;
+}
+
+sub drawNodeDot {
+#
+# draws node as a dot at given real world coordinates
+#
+ my ($lon, $lat, $col, $size) = @_ ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+ push @{$svgOutputNodes{0}}, svgElementCircleFilled ($x1, $y1, $size, $col) ;
+}
+
+sub drawNodeDotRouteStops {
+#
+# draws node as a dot at given real world coordinates
+#
+ my ($lon, $lat, $col, $size) = @_ ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+ push @svgOutputRouteStops, svgElementCircleFilled ($x1, $y1, $size, $col) ;
+}
+
+sub drawNodeDotPix {
+#
+# draws node as a dot at given pixels
+#
+ my ($x1, $y1, $col, $size) = @_ ;
+ push @svgOutputPixel, svgElementCircleFilled ($x1, $y1, $size, $col) ;
+}
+
+
+sub drawCircle {
+ my ($lon, $lat, $radius, $color, $thickness) = @_ ;
+ # radius in meters
+
+ my ($x, $y) = convert ($lon, $lat) ;
+ my $thickness2 = scalePoints ($thickness) ;
+
+ my $radiusPixel = $radius / (1000 * distance ($left, $bottom, $right, $bottom) ) * $sizeX ;
+ push @svgOutputPixelGrid, svgElementCircle ($x, $y, $radiusPixel, $thickness2, $color) ;
+}
+
+sub drawWay {
+#
+# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
+# $size = thickness
+#
+ my ($layer, $col, $size, $dash, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @{$svgOutputWays{$layer+$size/100}}, svgElementPolyline ($col, $size, $dash, @points) ;
+}
+
+sub drawWayBridge {
+#
+# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
+# $size = thickness
+#
+ my ($layer, $col, $size, $dash, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ if ($dash eq "11") { $dash = $dashStyle{11} ; }
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @{$svgOutputWays{$layer+$size/100}}, svgElementPolylineBridge ($col, $size, $dash, @points) ;
+}
+
+sub drawWayPix {
+#
+# draws way as a line at given pixels. nodes have to be passed as array ($x, $y, $x, $y...)
+# $size = thickness
+#
+ my ($col, $size, $dash, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @svgOutputPixel, svgElementPolyline ($col, $size, $dash, @points) ;
+}
+
+sub drawWayPixGrid {
+#
+# draws way as a line at given pixels. nodes have to be passed as array ($x, $y, $x, $y...)
+# $size = thickness
+#
+ my ($col, $size, $dash, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @svgOutputPixelGrid, svgElementPolyline ($col, $size, $dash, @points) ;
+}
+
+
+sub labelWay {
+#
+# labels a way
+#
+ my ($col, $size, $font, $text, $tSpan, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
+ push @svgOutputDef, svgElementPath ($pathName, @points) ;
+ push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $text, $pathName, $tSpan, "middle", 50, 0) ;
+}
+
+
+sub createWayLabels {
+#
+# finally take all way label candidates and try to label them
+#
+ my ($ref, $ruleRef, $declutter, $halo, $svgName) = @_ ;
+ my @labelCandidates = @$ref ;
+ my @wayRules = @$ruleRef ;
+ my %notDrawnLabels = () ;
+ my %drawnLabels = () ;
+
+ # calc ratio to label ways first where label just fits
+ # these will be drawn first
+ foreach my $candidate (@labelCandidates) {
+ my $wLen = $candidate->[2] ;
+ my $lLen = $candidate->[3] ;
+ if ($wLen == 0) { $wLen = 1 ; }
+ if ($lLen == 0) { $lLen = 1 ; }
+ $candidate->[5] = $lLen / $wLen ;
+ }
+ @labelCandidates = sort { $b->[5] <=> $a->[5] } @labelCandidates ;
+
+ foreach my $candidate (@labelCandidates) {
+ my $rule = $candidate->[0] ; # integer
+ my @ruleData = @{$wayRules[$rule]} ;
+ my $name = $candidate->[1] ;
+ my $wLen = $candidate->[2] ;
+ my $lLen = $candidate->[3] ;
+ my @points = @{$candidate->[4]} ;
+
+ my $toLabel = 1 ;
+ if ( ($declutter eq "1") and ($points[0] > $points[-2]) and ( ($ruleData[1] eq "motorway") or ($ruleData[1] eq "trunk") ) ) {
+ $toLabel = 0 ;
+ }
+
+ if ($lLen > $wLen*0.95) {
+ $notDrawnLabels { $name } = 1 ;
+ }
+
+ if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) {
+ # label too long
+ $numWayLabelsOmitted++ ;
+ }
+ else {
+
+ if (grep /shield/i, $name) {
+ # create shield if necessary
+ if ( ! defined $createdShields{ $name }) {
+ createShield ($name, $ruleData[$wayIndexLabelSize]) ;
+ }
+
+ # @points = (x1, y1, x2, y2 ... )
+ # $wLen in pixels
+ # $lLen in pixels
+ # <use xlink:href="#a661" x="40" y="40" />
+
+ my $shieldMaxSize = $shieldXSize{ $name } ;
+ if ($shieldYSize{ $name } > $shieldMaxSize) { $shieldMaxSize = $shieldYSize{ $name } ; }
+
+ my $numShields = int ($wLen / ($shieldMaxSize * 12) ) ;
+ # if ($numShields > 4) { $numShields = 4 ; }
+
+ if ($numShields > 0) {
+ my $step = $wLen / ($numShields + 1) ;
+ my $position = $step ;
+ while ($position < $wLen) {
+ my ($x, $y) = getPointOfWay (\@points, $position) ;
+ # print "XY: $x, $y\n" ;
+
+ # place shield if not occupied
+
+ my $x2 = int ($x - $shieldXSize{ $name } / 2) ;
+ my $y2 = int ($y - $shieldYSize{ $name } / 2) ;
+
+ # print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n" ;
+
+ if ( ! areaOccupied ($x2, $x2+$shieldXSize{ $name }, $y2+$shieldYSize{ $name }, $y2) ) {
+
+ my $id = $createdShields{$name};
+ push @svgOutputIcons, "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />" ;
+
+ occupyArea ($x2, $x2+$shieldXSize{ $name }, $y2+$shieldYSize{ $name }, $y2) ;
+ }
+
+ $position += $step ;
+ }
+ }
+
+ }
+
+ else {
+
+ # print "$wLen - $name - $lLen\n" ;
+ my $numLabels = int ($wLen / (4 * $lLen)) ;
+ if ($numLabels < 1) { $numLabels = 1 ; }
+ if ($numLabels > 4) { $numLabels = 4 ; }
+
+ if ($numLabels == 1) {
+ my $spare = 0.95 * $wLen - $lLen ;
+ my $sparePercentHalf = $spare / ($wLen*0.95) *100 / 2 ;
+ my $startOffset = 50 - $sparePercentHalf ;
+ my $endOffset = 50 + $sparePercentHalf ;
+ # five possible positions per way
+ my $step = ($endOffset - $startOffset) / 5 ;
+ my @positions = () ;
+ my $actual = $startOffset ;
+ while ($actual <= $endOffset) {
+ my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ;
+ my @way = @$ref ;
+ my ($col) = lineCrossings (\@way) ;
+ # calc quality of position. distance from middle and bend angles
+ my $quality = $angle + abs (50 - $actual) ;
+ if ($col == 0) { push @positions, ["middle", $actual, $quality] ; }
+ $actual += $step ;
+ }
+ if (scalar @positions > 0) {
+ $drawnLabels { $name } = 1 ;
+ # sort by quality and take best one
+ @positions = sort {$a->[2] <=> $b->[2]} @positions ;
+ my ($pos) = shift @positions ;
+ my ($ref, $angle) = subWay (\@points, $lLen, $pos->[0], $pos->[1]) ;
+ my @finalWay = @$ref ;
+ my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
+ push @svgOutputDef, svgElementPath ($pathName, @points) ;
+ push @svgOutputPathText, svgElementPathTextAdvanced ($ruleData[$wayIndexLabelColor], $ruleData[$wayIndexLabelSize],
+ $ruleData[$wayIndexLabelFont], $name, $pathName, $ruleData[$wayIndexLabelOffset], $pos->[0], $pos->[1], $halo) ;
+ occupyLines (\@finalWay) ;
+ }
+ else {
+ $numWayLabelsOmitted++ ;
+ }
+ }
+ else { # more than one label
+ my $labelDrawn = 0 ;
+ my $interval = int (100 / ($numLabels + 1)) ;
+ my @positions = () ;
+ for (my $i=1; $i<=$numLabels; $i++) {
+ push @positions, $i * $interval ;
+ }
+
+ foreach my $position (@positions) {
+ my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ;
+ my (@finalWay) = @$refFinal ;
+ my ($collision) = lineCrossings (\@finalWay) ;
+ if ($collision == 0) {
+ $labelDrawn = 1 ;
+ $drawnLabels { $name } = 1 ;
+ my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
+ push @svgOutputDef, svgElementPath ($pathName, @finalWay) ;
+ push @svgOutputPathText, svgElementPathTextAdvanced ($ruleData[$wayIndexLabelColor], $ruleData[$wayIndexLabelSize],
+ $ruleData[$wayIndexLabelFont], $name, $pathName, $ruleData[$wayIndexLabelOffset], "middle", 50, $halo) ;
+ occupyLines (\@finalWay) ;
+ }
+ else {
+ # print "INFO: $name labeled less often than desired.\n" ;
+ }
+ }
+ if ($labelDrawn == 0) {
+ $notDrawnLabels { $name } = 1 ;
+ }
+ }
+ }
+ }
+ }
+ my $labelFileName = $svgName ;
+ $labelFileName =~ s/\.svg/_NotDrawnLabels.txt/ ;
+ my $labelFile ;
+ open ($labelFile, ">", $labelFileName) or die ("couldn't open label file $labelFileName") ;
+ print $labelFile "Not drawn labels\n\n" ;
+ foreach my $labelName (sort keys %notDrawnLabels) {
+ if (!defined $drawnLabels { $labelName } ) {
+ print $labelFile "$labelName\n" ;
+ }
+ }
+ close ($labelFile) ;
+
+}
+
+
+sub occupyLines {
+#
+# store drawn lines and make quad tree entries
+# accepts multiple coordinates that form a way
+#
+ my ($ref) = shift ;
+ my @coordinates = @$ref ;
+
+ for (my $i=0; $i<$#coordinates-2; $i+=2) {
+ push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
+ # print "PUSHED $coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]\n" ;
+ # drawWayPix ("black", 1, 0, @coordinates)
+
+ $qtWayLabels->add ($#lines, $coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]) ;
+
+ }
+}
+
+
+sub lineCrossings {
+#
+# checks for line collisions
+# accepts multiple lines in form of multiple coordinates
+#
+ my ($ref) = shift ;
+ my @coordinates = @$ref ;
+ my @testLines = () ;
+
+ for (my $i=0; $i<$#coordinates-2; $i+=2) {
+ push @testLines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
+ }
+
+ # find area of way
+ my ($found) = 0 ;
+ my $xMin = 999999 ; my $xMax = 0 ;
+ my $yMin = 999999 ; my $yMax = 0 ;
+ foreach my $l1 (@testLines) {
+ if ($l1->[0] > $xMax) { $xMax = $l1->[0] ; }
+ if ($l1->[0] < $xMin) { $xMin = $l1->[0] ; }
+ if ($l1->[1] > $yMax) { $yMax = $l1->[1] ; }
+ if ($l1->[1] < $yMin) { $yMin = $l1->[1] ; }
+ }
+
+ # get indexes from quad tree
+ my $ref2 = $qtWayLabels->getEnclosedObjects ($xMin, $yMin, $xMax, $yMax) ;
+ # create array linesInArea
+ my @linesInAreaIndex = @$ref2 ;
+ my @linesInArea = () ;
+ foreach my $lineNr (@linesInAreaIndex) {
+ push @linesInArea, $lines[$lineNr] ;
+ }
+
+ LABCR: foreach my $l1 (@testLines) {
+ foreach my $l2 (@linesInArea) {
+ my ($x, $y) = intersection (@$l1, @$l2) ;
+ if (($x !=0) and ($y != 0)) {
+ $found = 1 ;
+ last LABCR ;
+ }
+ }
+ }
+ if ($found == 0) {
+ return 0 ;
+ }
+ else {
+ return 1 ;
+ }
+}
+
+sub triangleNode {
+#
+# get segment of segment as coordinates
+# from start or from end of segment
+#
+ # 0 = start
+ # 1 = end
+ my ($x1, $y1, $x2, $y2, $len, $startEnd) = @_ ;
+ my ($c) = sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2) ;
+ my $percent = $len / $c ;
+
+ my ($x, $y) ;
+ if ($startEnd == 0 ) {
+ $x = $x1 + ($x2-$x1)*$percent ;
+ $y = $y1 + ($y2-$y1)*$percent ;
+ }
+ else {
+ $x = $x2 - ($x2-$x1)*$percent ;
+ $y = $y2 - ($y2-$y1)*$percent ;
+ }
+ return ($x, $y) ;
+}
+
+
+sub subWay {
+#
+# takes coordinates and label information and creates new way/path
+# also calculates total angles / bends
+#
+ my ($ref, $labLen, $alignment, $position) = @_ ;
+ my @coordinates = @$ref ;
+ my @points ;
+ my @dists ;
+ my @angles = () ;
+
+ for (my $i=0; $i < $#coordinates; $i+=2) {
+ push @points, [$coordinates[$i],$coordinates[$i+1]] ;
+ }
+
+ $dists[0] = 0 ;
+ my $dist = 0 ;
+ if (scalar @points > 1) {
+ for (my $i=1;$i<=$#points; $i++) {
+ $dist = $dist + sqrt ( ($points[$i-1]->[0]-$points[$i]->[0])**2 + ($points[$i-1]->[1]-$points[$i]->[1])**2 ) ;
+ $dists[$i] = $dist ;
+ }
+ }
+
+ # calc angles at nodes
+ if (scalar @points > 2) {
+ for (my $i=1;$i<$#points; $i++) {
+ $angles[$i] = angleMapgen ($points[$i-1]->[0], $points[$i-1]->[1], $points[$i]->[0], $points[$i]->[1], $points[$i]->[0], $points[$i]->[1], $points[$i+1]->[0], $points[$i+1]->[1]) ;
+ }
+ }
+
+ my $wayLength = $dist ;
+ my $refPoint = $wayLength / 100 * $position ;
+ my $labelStart ; my $labelEnd ;
+ if ($alignment eq "start") { # left
+ $labelStart = $refPoint ;
+ $labelEnd = $labelStart + $labLen ;
+ }
+ if ($alignment eq "end") { # right
+ $labelEnd = $refPoint ;
+ $labelStart = $labelEnd - $labLen ;
+ }
+ if ($alignment eq "middle") { # center
+ $labelEnd = $refPoint + $labLen / 2 ;
+ $labelStart = $refPoint - $labLen / 2 ;
+ }
+
+ # find start and end segments
+ my $startSeg ; my $endSeg ;
+ for (my $i=0; $i<$#points; $i++) {
+ if ( ($dists[$i]<=$labelStart) and ($dists[$i+1]>=$labelStart) ) { $startSeg = $i ; }
+ if ( ($dists[$i]<=$labelEnd) and ($dists[$i+1]>=$labelEnd) ) { $endSeg = $i ; }
+ }
+
+ my @finalWay = () ;
+ my $finalAngle = 0 ;
+ my ($sx, $sy) = triangleNode ($coordinates[$startSeg*2], $coordinates[$startSeg*2+1], $coordinates[$startSeg*2+2], $coordinates[$startSeg*2+3], $labelStart-$dists[$startSeg], 0) ;
+ push @finalWay, $sx, $sy ;
+
+ if ($startSeg != $endSeg) {
+ for (my $i=$startSeg+1; $i<=$endSeg; $i++) {
+ push @finalWay, $coordinates[$i*2], $coordinates[$i*2+1] ;
+ $finalAngle += abs ($angles[$i]) ;
+ }
+ }
+
+ my ($ex, $ey) = triangleNode ($coordinates[$endSeg*2], $coordinates[$endSeg*2+1], $coordinates[$endSeg*2+2], $coordinates[$endSeg*2+3], $labelEnd-$dists[$endSeg], 0) ;
+ push @finalWay, $ex, $ey ;
+
+ return (\@finalWay, $finalAngle) ;
+}
+
+sub intersection {
+#
+# returns intersection point of two lines, else (0,0)
+#
+ my ($g1x1) = shift ;
+ my ($g1y1) = shift ;
+ my ($g1x2) = shift ;
+ my ($g1y2) = shift ;
+
+ my ($g2x1) = shift ;
+ my ($g2y1) = shift ;
+ my ($g2x2) = shift ;
+ my ($g2y2) = shift ;
+
+ if (($g1x1 == $g2x1) and ($g1y1 == $g2y1)) { # p1 = p1 ?
+ return ($g1x1, $g1y1) ;
+ }
+ if (($g1x1 == $g2x2) and ($g1y1 == $g2y2)) { # p1 = p2 ?
+ return ($g1x1, $g1y1) ;
+ }
+ if (($g1x2 == $g2x1) and ($g1y2 == $g2y1)) { # p2 = p1 ?
+ return ($g1x2, $g1y2) ;
+ }
+
+ if (($g1x2 == $g2x2) and ($g1y2 == $g2y2)) { # p2 = p1 ?
+ return ($g1x2, $g1y2) ;
+ }
+
+ my $g1m ;
+ if ( ($g1x2-$g1x1) != 0 ) {
+ $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
+ }
+ else {
+ $g1m = 999999 ;
+ }
+
+ my $g2m ;
+ if ( ($g2x2-$g2x1) != 0 ) {
+ $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
+ }
+ else {
+ $g2m = 999999 ;
+ }
+
+ if ($g1m == $g2m) { # parallel
+ return (0, 0) ;
+ }
+
+ my ($g1b) = $g1y1 - $g1m * $g1x1 ; # abschnitte
+ my ($g2b) = $g2y1 - $g2m * $g2x1 ;
+
+ my ($sx) = ($g2b-$g1b) / ($g1m-$g2m) ; # schnittpunkt
+ my ($sy) = ($g1m*$g2b - $g2m*$g1b) / ($g1m-$g2m);
+
+ my ($g1xmax) = max ($g1x1, $g1x2) ;
+ my ($g1xmin) = min ($g1x1, $g1x2) ;
+ my ($g1ymax) = max ($g1y1, $g1y2) ;
+ my ($g1ymin) = min ($g1y1, $g1y2) ;
+
+ my ($g2xmax) = max ($g2x1, $g2x2) ;
+ my ($g2xmin) = min ($g2x1, $g2x2) ;
+ my ($g2ymax) = max ($g2y1, $g2y2) ;
+ my ($g2ymin) = min ($g2y1, $g2y2) ;
+
+ if (($sx >= $g1xmin) and
+ ($sx >= $g2xmin) and
+ ($sx <= $g1xmax) and
+ ($sx <= $g2xmax) and
+ ($sy >= $g1ymin) and
+ ($sy >= $g2ymin) and
+ ($sy <= $g1ymax) and
+ ($sy <= $g2ymax)) {
+ return ($sx, $sy) ;
+ }
+ else {
+ return (0, 0) ;
+ }
+}
+
+sub angleMapgen {
+#
+# angle between lines/segments
+#
+ my ($g1x1) = shift ;
+ my ($g1y1) = shift ;
+ my ($g1x2) = shift ;
+ my ($g1y2) = shift ;
+ my ($g2x1) = shift ;
+ my ($g2y1) = shift ;
+ my ($g2x2) = shift ;
+ my ($g2y2) = shift ;
+
+ my $g1m ;
+ if ( ($g1x2-$g1x1) != 0 ) {
+ $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
+ }
+ else {
+ $g1m = 999999999 ;
+ }
+
+ my $g2m ;
+ if ( ($g2x2-$g2x1) != 0 ) {
+ $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
+ }
+ else {
+ $g2m = 999999999 ;
+ }
+
+ if ($g1m == $g2m) { # parallel
+ return (0) ;
+ }
+ else {
+ my $t1 = $g1m -$g2m ;
+ my $t2 = 1 + $g1m * $g2m ;
+ if ($t2 == 0) {
+ return 90 ;
+ }
+ else {
+ my $a = atan (abs ($t1/$t2)) / 3.141592654 * 180 ;
+ return $a ;
+ }
+ }
+}
+
+
+#------------------------------------------------------------------------------------------------------------
+
+
+sub drawArea {
+#
+# draws an area like waterway=riverbank or landuse=forest.
+# pass color as string and nodes as list (x1, y1, x2, y2...) - real world coordinates
+#
+ my ($col, $icon, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x1, $y1) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x1 ; push @points, $y1 ;
+ }
+ push @svgOutputAreas, svgElementPolygonFilled ($col, $icon, @points) ;
+}
+
+sub drawAreaPix {
+#
+# draws an area like waterway=riverbank or landuse=forest.
+# pass color as string and nodes as list (x1, y1, x2, y2...) - pixels
+# used for legend
+#
+ my ($col, $icon, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x1, $y1) = ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x1 ; push @points, $y1 ;
+ }
+ push @svgOutputPixel, svgElementPolygonFilled ($col, $icon, @points) ;
+}
+
+sub drawAreaMP {
+#
+# draws an area like waterway=riverbank or landuse=forest.
+# pass color as string and nodes as list (x1, y1, x2, y2...) - real world coordinates
+#
+# receives ARRAY of ARRAY of NODES LIST! NOT coordinates list like other functions
+#
+ my ($col, $icon, $ref, $refLon, $refLat) = @_ ;
+ # my %lon = %$refLon ;
+ # my %lat = %$refLat ;
+ my @ways = @$ref ;
+ my $i ;
+ my @array = () ;
+
+ foreach my $way (@ways) {
+ my @actual = @$way ;
+ # print "drawAreaMP - actual ring/way: @actual\n" ;
+ my @points = () ;
+ for ($i=0; $i<$#actual; $i++) { # without last node! SVG command 'z'!
+ my ($x1, $y1) = convert ( $$refLon{$actual[$i]}, $$refLat{$actual[$i]} ) ;
+ push @points, $x1 ; push @points, $y1 ;
+ }
+ push @array, [@points] ;
+ # print "drawAreaMP - array pushed: @points\n" ;
+ }
+
+ push @svgOutputAreas, svgElementMultiPolygonFilled ($col, $icon, \@array) ;
+}
+
+
+
+sub drawRuler {
+#
+# draws ruler in top right corner, size is automatic
+#
+ my $col = shift ;
+
+ my $B ; my $B2 ;
+ my $L ; my $Lpix ;
+ my $x ;
+ my $text ;
+ my $rx = $sizeX - scalePoints (scaleBase (80)) ;
+ my $ry = scalePoints (scaleBase (60)) ; #v1.17
+ # my $ry = scalePoints (scaleBase (80)) ;
+ my $lineThickness = 8 ; # at 300dpi
+ my $textSize = 40 ; # at 300 dpi
+ my $textDist = 60 ; # at 300 dpi
+ my $lineLen = 40 ; # at 300 dpi
+
+ $B = $right - $left ; # in degrees
+ $B2 = $B * cos ($top/360*3.14*2) * 111.1 ; # in km
+ $text = "50m" ; $x = 0.05 ; # default length ruler
+
+ if ($B2 > 0.5) {$text = "100m" ; $x = 0.1 ; } # enlarge ruler
+ if ($B2 > 1) {$text = "500m" ; $x = 0.5 ; } # enlarge ruler
+ if ($B2 > 5) {$text = "1km" ; $x = 1 ; }
+ if ($B2 > 10) {$text = "5km" ; $x = 5 ; }
+ if ($B2 > 50) {$text = "10km" ; $x = 10 ; }
+ $L = $x / (cos ($top/360*3.14*2) * 111.1 ) ; # length ruler in km
+ $Lpix = $L / $B * $sizeX ; # length ruler in pixels
+
+ push @svgOutputText, svgElementLine ($rx-$Lpix,$ry,$rx,$ry, $col, scalePoints( scaleBase ($lineThickness) ) ) ;
+ push @svgOutputText, svgElementLine ($rx-$Lpix,$ry,$rx-$Lpix,$ry+scalePoints(scaleBase($lineLen)), $col, scalePoints( scaleBase ($lineThickness) ) ) ;
+ push @svgOutputText, svgElementLine ($rx,$ry,$rx,$ry+scalePoints(scaleBase($lineLen)), $col, scalePoints( scaleBase ($lineThickness) )) ;
+ push @svgOutputText, svgElementLine ($rx-$Lpix/2,$ry,$rx-$Lpix/2,$ry+scalePoints(scaleBase($lineLen/2)), $col, scalePoints( scaleBase ($lineThickness) ) ) ;
+ push @svgOutputText, svgElementText ($rx-$Lpix, $ry+scalePoints(scaleBase($textDist)), $text, scalePoints(scaleBase($textSize)), "sans-serif", $col) ;
+}
+
+sub drawGrid {
+#
+# draw grid on top of map. receives number of parts in x/lon direction
+#
+ my ($number, $color) = @_ ;
+ my $part = $sizeX / $number ;
+ my $numY = $sizeY / $part ;
+ # vertical lines
+ for (my $i = 1; $i <= $number; $i++) {
+ drawWayPixGrid ($color, 1, $dashStyle{1}, $i*$part, 0, $i*$part, $sizeY) ;
+ drawTextPixGrid (($i-1)*$part+$part/2, scalePoints(scaleBase(160)), chr($i+64), $color, scalePoints(scaleBase(60))) ;
+ }
+ # hor. lines
+ for (my $i = 1; $i <= $numY; $i++) {
+ drawWayPixGrid ($color, 1, $dashStyle{1}, 0, $i*$part, $sizeX, $i*$part) ;
+ drawTextPixGrid (scalePoints(scaleBase(20)), ($i-1)*$part+$part/2, $i, $color, scalePoints(scaleBase(60))) ;
+ }
+}
+
+
+
+#####
+# SVG
+#####
+
+
+sub writeSVG {
+#
+# writes svg elemets collected so far to file
+#
+ my ($fileName) = shift ;
+ my $file ;
+ my ($paper, $w, $h) = fitsPaper ($dpi) ;
+
+ open ($file, ">", $fileName) || die "can't open svg output file";
+ print $file "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>\n" ;
+ print $file "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\" >\n" ;
+
+ my ($svg) = "<svg version=\"1.1\" baseProfile=\"full\" xmlns=\"http://www.w3.org/2000/svg\" " ;
+ $svg .= "xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:ev=\"http://www.w3.org/2001/xml-events\" " ;
+ $svg .= "width=\"$w" . "cm\" height=\"$h" . "cm\" viewBox=\"0 0 $sizeX $sizeY\">\n" ;
+ print $file $svg ;
+
+ print $file "<rect width=\"$sizeX\" height=\"$sizeY\" y=\"0\" x=\"0\" fill=\"#ffffff\" />\n" ;
+
+ print $file "<defs>\n" ;
+ foreach (@svgOutputDef) { print $file $_, "\n" ; }
+ print $file "</defs>\n" ;
+
+ print $file "<g id=\"Areas\">\n" ;
+ foreach (@svgOutputAreas) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Ways\">\n" ;
+ foreach my $layer (sort {$a <=> $b} (keys %svgOutputWays)) {
+ foreach (@{$svgOutputWays{$layer}}) { print $file $_, "\n" ; }
+ }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Nodes\">\n" ;
+ foreach my $layer (sort {$a <=> $b} (keys %svgOutputNodes)) {
+ foreach (@{$svgOutputNodes{$layer}}) { print $file $_, "\n" ; }
+ }
+ print $file "</g>\n" ;
+
+
+ print $file "<g id=\"Routes\">\n" ;
+ foreach (@svgOutputRoutes) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"RouteStops\">\n" ;
+ foreach (@svgOutputRouteStops) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Text\">\n" ;
+ foreach (@svgOutputText) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Icons\">\n" ;
+ foreach (@svgOutputIcons) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Labels\">\n" ;
+ foreach (@svgOutputPathText) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Grid\">\n" ;
+ foreach (@svgOutputPixelGrid) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Pixels\">\n" ;
+ foreach (@svgOutputPixel) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "</svg>\n" ;
+ close ($file) ;
+}
+
+sub svgElementText {
+#
+# creates string with svg element incl utf-8 encoding
+#
+ my ($x, $y, $text, $size, $font, $col) = @_ ;
+ my $svg = "<text x=\"" . $x . "\" y=\"" . $y .
+ "\" font-size=\"" . $size .
+ "\" font-family=\"" . $font .
+ "\" fill=\"" . $col .
+ "\">" . $text . "</text>" ;
+ return $svg ;
+}
+
+sub svgElementCircleFilled {
+#
+# draws circle filled
+#
+ my ($x, $y, $size, $col) = @_ ;
+ my $svg = "<circle cx=\"" . $x . "\" cy=\"" . $y . "\" r=\"" . $size . "\" fill=\"" . $col . "\" />" ;
+ return $svg ;
+}
+
+sub svgElementCircle {
+#
+# draws not filled circle / dot
+#
+ my ($x, $y, $radius, $size, $col) = @_ ;
+ my $svg = "<circle cx=\"" . $x . "\" cy=\"" . $y . "\" r=\"" . $radius . "\" fill=\"none\" stroke=\"" . $col . "\" stroke-width=\"$size\" />" ;
+ return $svg ;
+}
+
+sub svgElementLine {
+#
+# draws line between two points
+#
+ my ($x1, $y1, $x2, $y2, $col, $size) = @_ ;
+ my $svg = "<polyline points=\"" . $x1 . "," . $y1 . " " . $x2 . "," . $y2 . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\"/>" ;
+ return $svg ;
+}
+
+
+
+
+sub svgElementPolyline {
+#
+# draws way to svg
+#
+ my ($col, $size, $dash, @points) = @_ ;
+
+ my $refp = simplifyPoints (\@points) ;
+ @points = @$refp ;
+
+
+ my $svg = "<polyline points=\"" ;
+ my $i ;
+ for ($i=0; $i<scalar(@points)-1; $i+=2) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ if ($dash eq "none") {
+ my $lc = "round" ;
+ $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" stroke-linecap=\"" . $lc . "\" stroke-linejoin=\"" . $lineJoin . "\" fill=\"none\" />" ;
+ }
+ else {
+ my $lc = "" ; my $ds = "" ;
+ ($lc, $ds) = getDashElements ($dash) ;
+ $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" stroke-linecap=\"" . $lc . "\" stroke-linejoin=\"" . $lineJoin . "\" stroke-dasharray=\"" . $ds . "\" fill=\"none\" />" ;
+ }
+ return $svg ;
+}
+
+
+sub svgElementPolylineBridge {
+#
+# draws way to svg
+#
+ my ($col, $size, $dash, @points) = @_ ;
+
+ my $refp = simplifyPoints (\@points) ;
+ @points = @$refp ;
+
+ my $svg = "<polyline points=\"" ;
+ my $i ;
+ for ($i=0; $i<scalar(@points)-1; $i+=2) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ if ($dash eq "none") {
+ $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" fill=\"none\" />" ;
+ }
+ else {
+ my $lc = "" ; my $ds ;
+ ($lc, $ds) = getDashElements ($dash) ;
+ $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" stroke-linecap=\"" . $lc . "\" stroke-dasharray=\"" . $ds . "\" fill=\"none\" />" ;
+ }
+ return $svg ;
+}
+
+
+
+sub getDashElements {
+ my $string = shift ;
+ my @a = split /,/, $string ;
+ my $cap = pop @a ;
+ my $ds = "" ; my $first = 1 ;
+ foreach my $v (@a) {
+ if ($first) {
+ $first = 0 ;
+ }
+ else {
+ $ds .= "," ;
+ }
+ $ds .= $v ;
+ }
+ # print "GETDE $cap, $ds\n" ;
+ return ($cap, $ds) ;
+}
+
+
+
+sub svgElementPath {
+#
+# creates path element for later use with textPath
+#
+ my ($pathName, @points) = @_ ;
+
+ my $refp = simplifyPoints (\@points) ;
+ @points = @$refp ;
+
+ my $svg = "<path id=\"" . $pathName . "\" d=\"M " ;
+ my $i ;
+ my $first = 1 ;
+ for ($i=0; $i<scalar(@points); $i+=2) {
+ if ($first) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ $first = 0 ;
+ }
+ else {
+ $svg = $svg . "L " . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ }
+ $svg = $svg . "\" />\n" ;
+}
+
+
+sub svgElementPathTextAdvanced {
+#
+# draws text to path element; anchors: start, middle, end
+#
+ my ($col, $size, $font, $text, $pathName, $tSpan, $alignment, $offset, $halo) = @_ ;
+
+ my $svg = "<text font-family=\"" . $font . "\" " ;
+ $svg = $svg . "font-size=\"" . $size . "\" " ;
+
+ if ($halo > 0) {
+ $svg = $svg . "font-weight=\"bold\" " ;
+ $svg = $svg . "stroke=\"white\" " ;
+ $svg = $svg . "stroke-width=\"" . $halo . "\" " ;
+ $svg = $svg . "opacity=\"90\%\" " ;
+ }
+
+ $svg = $svg . "fill=\"" . $col . "\" >\n" ;
+ $svg = $svg . "<textPath xlink:href=\"#" . $pathName . "\" text-anchor=\"" . $alignment . "\" startOffset=\"" . $offset . "%\" >\n" ;
+ $svg = $svg . "<tspan dy=\"" . $tSpan . "\" >" . $text . " </tspan>\n" ;
+ $svg = $svg . "</textPath>\n</text>\n" ;
+ return $svg ;
+}
+
+
+sub svgElementPolygonFilled {
+#
+# draws areas in svg, filled with color
+#
+ my ($col, $icon, @points) = @_ ;
+
+ my $refp = simplifyPoints (\@points) ;
+ @points = @$refp ;
+
+ my $i ;
+ my $svg ;
+ if (defined $areaDef{$icon}) {
+ $svg = "<path fill-rule=\"evenodd\" style=\"fill:url(" . $areaDef{$icon} . ")\" d=\"" ;
+ # print "AREA POLYGON with icon $icon drawn\n" ;
+ }
+ else {
+ $svg = "<path fill-rule=\"evenodd\" fill=\"" . $col . "\" d=\"" ;
+ }
+
+
+ for ($i=0; $i<scalar(@points); $i+=2) {
+ if ($i == 0) { $svg .= " M " ; } else { $svg .= " L " ; }
+ $svg = $svg . $points[$i] . " " . $points[$i+1] ;
+ }
+ $svg .= " z" ;
+
+
+
+
+# for ($i=0; $i<scalar(@points); $i+=2) {
+# $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+# }
+ $svg = $svg . "\" />" ;
+ return $svg ;
+}
+
+sub svgElementMultiPolygonFilled {
+#
+# draws mp in svg, filled with color. accepts holes. receives ARRAY of ARRAY of coordinates
+#
+ my ($col, $icon, $ref) = @_ ;
+
+ my @ways = @$ref ;
+ my $i ;
+ my $svg ;
+ if (defined $areaDef{$icon}) {
+ $svg = "<path fill-rule=\"evenodd\" style=\"fill:url(" . $areaDef{$icon} . ")\" d=\"" ;
+ # print "AREA PATH with icon $icon drawn\n" ;
+ }
+ else {
+ $svg = "<path fill-rule=\"evenodd\" fill=\"" . $col . "\" d=\"" ;
+ }
+
+ foreach my $way (@ways) {
+ my @actual = @$way ;
+ # print "svg - actual: @actual\n" ;
+ for ($i=0; $i<scalar(@actual); $i+=2) {
+ if ($i == 0) { $svg .= " M " ; } else { $svg .= " L " ; }
+ $svg = $svg . $actual[$i] . " " . $actual[$i+1] ;
+ }
+ $svg .= " z" ;
+ # print "svg - text = $svg\n" ;
+ }
+
+ $svg = $svg . "\" />" ;
+ # print "svg - text = $svg\n" ;
+ return $svg ;
+}
+
+sub createLabel {
+#
+# takes @tags and labelKey(s) from style file and creates labelTextTotal and array of labels for directory
+# takes more keys in one string - using a separator.
+#
+# � all listed keys will be searched for and values be concatenated
+# # first of found keys will be used to select value
+# "name�ref" will return all values if given
+# "name#ref" will return name, if given. if no name is given, ref will be used. none given, no text
+#
+ my ($ref1, $styleLabelText, $lon, $lat) = @_ ;
+ my @tags = @$ref1 ;
+ my @keys ;
+ my @labels = () ;
+ my $labelTextTotal = "" ;
+
+ if (grep /!/, $styleLabelText) { # AND
+ @keys = split ( /!/, $styleLabelText) ;
+ # print "par found: $styleLabelText; @keys\n" ;
+ for (my $i=0; $i<=$#keys; $i++) {
+ if ($keys[$i] eq "_lat") { push @labels, $lat ; }
+ if ($keys[$i] eq "_lon") { push @labels, $lon ; }
+ foreach my $tag (@tags) {
+ if ($tag->[0] eq $keys[$i]) {
+ push @labels, $tag->[1] ;
+ }
+ }
+ }
+ $labelTextTotal = "" ;
+ foreach my $label (@labels) { $labelTextTotal .= $label . " " ; }
+ }
+ else { # PRIO
+ @keys = split ( /#/, $styleLabelText) ;
+ my $i = 0 ; my $found = 0 ;
+ while ( ($i<=$#keys) and ($found == 0) ) {
+ if ($keys[$i] eq "_lat") { push @labels, $lat ; $found = 1 ; $labelTextTotal = $lat ; }
+ if ($keys[$i] eq "_lon") { push @labels, $lon ; $found = 1 ; $labelTextTotal = $lon ; }
+ foreach my $tag (@tags) {
+ if ($tag->[0] eq $keys[$i]) {
+ push @labels, $tag->[1] ;
+ $labelTextTotal = $tag->[1] ;
+ $found = 1 ;
+ }
+ }
+ $i++ ;
+ }
+ }
+ return ( $labelTextTotal, \@labels) ;
+}
+
+sub center {
+#
+# calculate center of area by averageing lons/lats. could be smarter because result could be outside of area! TODO
+#
+ my @nodes = @_ ;
+ my $x = 0 ;
+ my $y = 0 ;
+ my $num = 0 ;
+
+ while (scalar @nodes > 0) {
+ my $y1 = pop @nodes ;
+ my $x1 = pop @nodes ;
+ $x += $x1 ;
+ $y += $y1 ;
+ $num++ ;
+ }
+ $x = $x / $num ;
+ $y = $y / $num ;
+ return ($x, $y) ;
+}
+
+sub printScale {
+#
+# print scale based on dpi and global variables left, right etc.
+#
+ my ($dpi, $color) = @_ ;
+
+ my $dist = distance ($left, $bottom, $right, $bottom) ;
+ my $inches = $sizeX / $dpi ;
+ my $cm = $inches * 2.54 ;
+ my $scale = int ( $dist / ($cm/100/1000) ) ;
+ $scale = int ($scale / 100) * 100 ;
+ my $text = "1 : $scale" ;
+ # sizes for 300 dpi
+ my $posX = 350 ;
+ my $posY = 50 ;
+ my $size = 56 ;
+ drawTextPix (
+ $sizeX-scalePoints( scaleBase($posX) ),
+ scalePoints( scaleBase($posY) ),
+ $text, $color,
+ scalePoints( scaleBase ($size) ), "sans-serif"
+ ) ;
+}
+
+
+sub getScale {
+#
+# calcs scale of map
+#
+ my ($dpi) = shift ;
+
+ my $dist = distance ($left, $bottom, $right, $bottom) ;
+ my $inches = $sizeX / $dpi ;
+ my $cm = $inches * 2.54 ;
+ my $scale = int ( $dist / ($cm/100/1000) ) ;
+ $scale = int ($scale / 100) * 100 ;
+
+ return ($scale) ;
+}
+
+sub fitsPaper {
+#
+# takes dpi and calculates on what paper size the map will fit. sizes are taken from global variables
+#
+ my ($dpi) = shift ;
+
+
+
+ my @sizes = () ;
+ my $width = $sizeX / $dpi * 2.54 ;
+ my $height = $sizeY / $dpi * 2.54 ;
+ my $paper = "" ;
+ push @sizes, ["4A0", 168.2, 237.8] ;
+ push @sizes, ["2A0", 118.9, 168.2] ;
+ push @sizes, ["A0", 84.1, 118.9] ;
+ push @sizes, ["A1", 59.4, 84.1] ;
+ push @sizes, ["A2", 42, 59.4] ;
+ push @sizes, ["A3", 29.7, 42] ;
+ push @sizes, ["A4", 21, 29.7] ;
+ push @sizes, ["A5", 14.8, 21] ;
+ push @sizes, ["A6", 10.5, 14.8] ;
+ push @sizes, ["A7", 7.4, 10.5] ;
+ push @sizes, ["none", 0, 0] ;
+
+ foreach my $size (@sizes) {
+ if ( ( ($width<=$size->[1]) and ($height<=$size->[2]) ) or ( ($width<=$size->[2]) and ($height<=$size->[1]) ) ) {
+ $paper = $size->[0] ;
+ }
+ }
+
+ return ($paper, $width, $height) ;
+}
+
+
+
+
+sub drawCoords {
+#
+# draws coordinates grid on map
+#
+ my ($exp, $color) = @_ ;
+ my $step = 10 ** $exp ;
+
+ # vert. lines
+ my $start = int ($left / $step) + 1 ;
+ my $actual = $start * $step ;
+ while ($actual < $right) {
+ # print "actualX: $actual\n" ;
+ my ($x1, $y1) = convert ($actual, 0) ;
+ drawTextPixGrid ($x1+scalePoints(scaleBase(10)), $sizeY-scalePoints(scaleBase(50)), $actual, $color, scalePoints(scaleBase(40))) ;
+ drawWayPixGrid ($color, 1, "none", ($x1, 0, $x1, $sizeY) ) ;
+ $actual += $step ;
+ }
+
+ # hor lines
+ $start = int ($bottom / $step) + 1 ;
+ $actual = $start * $step ;
+ while ($actual < $top) {
+ # print "actualY: $actual\n" ;
+ my ($x1, $y1) = convert (0, $actual) ;
+ drawTextPixGrid ($sizeX-scalePoints(scaleBase(180)), $y1+scalePoints(scaleBase(30)), $actual, $color, scalePoints(scaleBase(40))) ;
+ drawWayPixGrid ($color, 1, "none", (0, $y1, $sizeX, $y1) ) ;
+ $actual += $step ;
+ }
+}
+
+
+sub getValue {
+#
+# gets value of a certain tag
+#
+ my ($key, $ref) = @_ ;
+ my @relationTags = @$ref ;
+
+ my $value = "" ;
+ foreach my $tag (@relationTags) {
+ if ($tag->[0] eq $key) { $value = $tag->[1] ; }
+ }
+ return ($value) ;
+}
+
+
+sub drawWayRoute {
+#
+# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
+# $size = thickness
+#
+ my ($col, $size, $dash, $opacity, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @svgOutputRoutes, svgElementPolylineOpacity ($col, $size, $dash, $opacity, @points) ;
+}
+
+
+sub svgElementPolylineOpacity {
+#
+# draws way to svg with opacity; for routes
+#
+ my ($col, $size, $dash, $opacity, @points) = @_ ;
+
+ my $refp = simplifyPoints (\@points) ;
+ @points = @$refp ;
+
+
+ my $svg = "<polyline points=\"" ;
+ my $i ;
+ for ($i=0; $i<scalar(@points)-1; $i+=2) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ if ($dash eq "none") {
+ my $lc = "round" ;
+ $svg = $svg . "\" stroke=\"" . $col .
+ "\" stroke-width=\"" . $size .
+ "\" stroke-opacity=\"" . $opacity .
+ "\" stroke-linecap=\"" . $lc .
+ "\" stroke-linejoin=\"" . $lineJoin . "\" fill=\"none\" />" ;
+ }
+ else {
+ my $lc = "" ; my $ds = "" ;
+ ($lc, $ds) = getDashElements ($dash) ;
+ $svg = $svg . "\" stroke=\"" . $col .
+ "\" stroke-width=\"" . $size .
+ "\" stroke-opacity=\"" . $opacity .
+ "\" stroke-linecap=\"" . $lc .
+ "\" stroke-linejoin=\"" . $lineJoin .
+ "\" stroke-dasharray=\"" . $ds .
+ "\" fill=\"none\" />" ;
+ }
+ return $svg ;
+}
+
+
+sub addAreaIcon {
+#
+# initial collection of area icons
+#
+ my $fileNameOriginal = shift ;
+ # print "AREA: $fileNameOriginal\n" ;
+ my $result = open (my $file, "<", $fileNameOriginal) ;
+ close ($file) ;
+ if ($result) {
+ my ($x, $y) ;
+ if (grep /.svg/, $fileNameOriginal) {
+ ($x, $y) = sizeSVG ($fileNameOriginal) ;
+ if ( ($x == 0) or ($y == 0) ) {
+ $x = 32 ; $y = 32 ;
+ print "WARNING: size of file $fileNameOriginal could not be determined. Set to 32px x 32px\n" ;
+ }
+ }
+
+ if (grep /.png/, $fileNameOriginal) {
+ ($x, $y) = sizePNG ($fileNameOriginal) ;
+ }
+
+ if (!defined $areaDef{$fileNameOriginal}) {
+
+ my $x1 = scalePoints( $x ) ; # scale area icons
+ my $y1 = scalePoints( $y ) ;
+ my $fx = $x1 / $x ;
+ my $fy = $y1 / $y ;
+
+ # add defs to svg output
+ my $defName = "A" . $areaNum ;
+ # print "INFO area icon $fileNameOriginal, $defName, $x, $y --- $x1, $y1 --- $fx, $fy --- processed.\n" ;
+ $areaNum++ ;
+
+ my $svgElement = "<pattern id=\"" . $defName . "\" width=\"" . $x . "\" height=\"" . $y . "\" " ;
+ $svgElement .= "patternTransform=\"translate(0,0) scale(" . $fx . "," . $fy . ")\" \n" ;
+ $svgElement .= "patternUnits=\"userSpaceOnUse\">\n" ;
+ $svgElement .= " <image xlink:href=\"" . $fileNameOriginal . "\"/>\n" ;
+ $svgElement .= "</pattern>\n" ;
+ push @svgOutputDef, $svgElement ;
+ $defName = "#" . $defName ;
+ $areaDef{$fileNameOriginal} = $defName ;
+ }
+ }
+ else {
+ print "WARNING: area icon $fileNameOriginal not found!\n" ;
+ }
+}
+
+
+
+
+sub svgEle {
+#
+# creates svg element string
+#
+ my ($a, $b) = @_ ;
+ my $out = $a . "=\"" . $b . "\" " ;
+ return ($out)
+}
+
+
+
+sub initOneways {
+#
+# write marker defs to svg
+#
+ my $color = shift ;
+ my $markerSize = scalePoints (scaleBase (20)) ;
+
+ push @svgOutputDef, "<marker id=\"Arrow1\"" ;
+ push @svgOutputDef, "viewBox=\"0 0 10 10\" refX=\"5\" refY=\"5\"" ;
+ push @svgOutputDef, "markerUnits=\"strokeWidth\"" ;
+ push @svgOutputDef, "markerWidth=\"" . $markerSize . "\" markerHeight=\"" . $markerSize . "\"" ;
+ push @svgOutputDef, "orient=\"auto\">" ;
+ push @svgOutputDef, "<path d=\"M 0 4 L 6 4 L 6 2 L 10 5 L 6 8 L 6 6 L 0 6 Z\" fill=\"" . $color . "\" />" ;
+ push @svgOutputDef, "</marker>" ;
+}
+
+
+sub addOnewayArrows {
+#
+# adds oneway arrows to new pathes
+#
+ my ($wayNodesRef, $lonRef, $latRef, $direction, $thickness, $color, $layer) = @_ ;
+ my @wayNodes = @$wayNodesRef ;
+ my $minDist = scalePoints(scaleBase(25)) ;
+ # print "OW: mindist = $minDist\n" ;
+
+ if ($direction == -1) { @wayNodes = reverse @wayNodes ; }
+
+ # create new pathes with new nodes
+ for (my $i=0; $i<scalar(@wayNodes)-1;$i++) {
+ my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
+ my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ;
+ my $xn = ($x2+$x1) / 2 ;
+ my $yn = ($y2+$y1) / 2 ;
+ if (sqrt (($x2-$x1)**2+($y2-$y1)**2) > $minDist) {
+ # create path
+ # use path
+ my $svg = "<path d=\"M $x1 $y1 L $xn $yn L $x2 $y2\" fill=\"none\" marker-mid=\"url(#Arrow1)\" />" ;
+
+ push @{$svgOutputWays{$layer+$thickness/100}}, $svg ;
+ }
+ }
+}
+
+sub declutterStat {
+#
+# creates print string with clutter/declutter information
+#
+ my $perc1 ;
+ my $perc2 ;
+ my $perc3 ;
+ my $perc4 ;
+ if ($numIcons != 0) {
+ $perc1 = int ($numIconsMoved / $numIcons * 100) ;
+ $perc2 = int ($numIconsOmitted / $numIcons * 100) ;
+ }
+ else {
+ $perc1 = 0 ;
+ $perc2 = 0 ;
+ }
+ if ($numLabels != 0) {
+ $perc3 = int ($numLabelsMoved / $numLabels * 100) ;
+ $perc4 = int ($numLabelsOmitted / $numLabels * 100) ;
+ }
+ else {
+ $perc3 = 0 ;
+ $perc4 = 0 ;
+ }
+
+ my $out = "$numIcons icons drawn.\n" ;
+ $out .= " $numIconsMoved moved. ($perc1 %)\n" ;
+ $out .= " $numIconsOmitted omitted (possibly with label!). ($perc2 %)\n" ;
+
+ $out .= "$numLabels labels drawn.\n" ;
+ $out .= " $numLabelsMoved moved. ($perc3 %)\n" ;
+ $out .= " $numLabelsOmitted omitted. ($perc4 %)\n\n" ;
+ $out .= "$numWayLabelsOmitted way labels omitted because way was too short, collision or declutter.\n" ;
+
+
+}
+
+sub placeLabelAndIcon {
+#
+# intelligent icon and label placement alg.
+#
+ my ($lon, $lat, $offset, $thickness, $text, $color, $textSize, $font, $ppc, $icon, $iconSizeX, $iconSizeY, $allowIconMove, $halo) = @_ ;
+
+ my ($x, $y) = convert ($lon, $lat) ; # center !
+ $y = $y + $offset ;
+
+ my ($ref) = splitLabel ($text) ;
+ my (@lines) = @$ref ;
+ my $numLines = scalar @lines ;
+ my $maxTextLenPix = 0 ;
+ my $orientation = "" ;
+ my $lineDist = 2 ;
+ my $tries = 0 ;
+
+ foreach my $line (@lines) {
+ my $len = length ($line) * $ppc / 10 * $textSize ; # in pixels
+ if ($len > $maxTextLenPix) { $maxTextLenPix = $len ; }
+ }
+ my $spaceTextX = $maxTextLenPix ;
+ my $spaceTextY = $numLines * ($lineDist+$textSize) ;
+
+
+ if ($icon ne "none") {
+ $numIcons++ ;
+ # space for icon?
+ my $sizeX1 = $iconSizeX ; if ($sizeX1 == 0) { $sizeX1 = 20 ; }
+ my $sizeY1 = $iconSizeY ; if ($sizeY1 == 0) { $sizeY1 = 20 ; }
+ my $iconX = $x - $sizeX1/2 ; # top left corner
+ my $iconY = $y - $sizeY1/2 ;
+
+ my @shifts = (0) ;
+ if ($allowIconMove eq "1") {
+ @shifts = ( 0, scalePoints(scaleBase(-15)), scalePoints(scaleBase(15)) ) ;
+ }
+ my $posFound = 0 ; my $posCount = 0 ;
+ LABAB: foreach my $xShift (@shifts) {
+ foreach my $yShift (@shifts) {
+ $posCount++ ;
+ if ( ! areaOccupied ($iconX+$xShift, $iconX+$sizeX1+$xShift, $iconY+$sizeY1+$yShift, $iconY+$yShift) ) {
+ push @svgOutputIcons, svgElementIcon ($iconX+$xShift, $iconY+$yShift, $icon, $sizeX1, $sizeY1) ;
+ occupyArea ($iconX+$xShift, $iconX+$sizeX1+$xShift, $iconY+$sizeY1+$yShift, $iconY+$yShift) ;
+ $posFound = 1 ;
+ if ($posCount > 1) { $numIconsMoved++ ; }
+ $iconX = $iconX + $xShift ; # for later use with label
+ $iconY = $iconY + $yShift ;
+ last LABAB ;
+ }
+ }
+ }
+ if ($posFound == 1) {
+
+ # label text?
+ if ($text ne "") {
+ $numLabels++ ;
+
+
+ $sizeX1 += 1 ; $sizeY1 += 1 ;
+
+ my ($x1, $x2, $y1, $y2) ;
+ # $x, $y centered
+ # yes, check if space for label, choose position, draw
+ # no, count omitted text
+
+ my @positions = () ; my $positionFound = 0 ;
+ # pos 1 centered below
+ $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $sizeY1/2 + $spaceTextY ; $y2 = $y + $sizeY1/2 ; $orientation = "centered" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ # pos 2/3 to the right, bottom, top
+ $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y1 = $y + $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "left" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y2 = $y - $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "left" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ # pos 4 centered upon
+ $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $sizeY1/2 ; $y2 = $y - $sizeY1/2 - $spaceTextY ; $orientation = "centered" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ # pos 5/6 to the right, below and upon
+ $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y2 = $y + $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "left" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y1 = $y - $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "left" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ # left normal, bottom, top
+ $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y1 = $y + $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "right" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y2 = $y - $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "right" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ # left corners, bottom, top
+ $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y2 = $y + $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "right" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y1 = $y - $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "right" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+
+ $tries = 0 ;
+ LABB: foreach my $pos (@positions) {
+ $tries++ ;
+ $positionFound = checkAndDrawText ($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines, \@lines, $color, $textSize, $font, $lineDist, $halo) ;
+ if ($positionFound == 1) {
+ last LABB ;
+ }
+ }
+ if ($positionFound == 0) { $numLabelsOmitted++ ; }
+ if ($tries > 1) { $numLabelsMoved++ ; }
+ }
+ }
+ else {
+ # no, count omitted
+ $numIconsOmitted++ ;
+ }
+ }
+ else { # only text
+ my ($x1, $x2, $y1, $y2) ;
+ # x1, x2, y1, y2
+ # left, right, bottom, top
+ # choose space for text, draw
+ # count omitted
+
+ $numLabels++ ;
+ my @positions = () ;
+ $x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "left" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y + $spaceTextY ; $y2 = $y ; $orientation = "left" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ $x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $thickness ; $y2 = $y - ($thickness + $spaceTextY) ; $orientation = "centered" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+ $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $thickness + $spaceTextY ; $y2 = $y + $thickness ; $orientation = "centered" ;
+ push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
+
+ my $positionFound = 0 ;
+ $tries = 0 ;
+ LABA: foreach my $pos (@positions) {
+ $tries++ ;
+ # print "$lines[0] $pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines\n" ;
+ $positionFound = checkAndDrawText ($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines, \@lines, $color, $textSize, $font, $lineDist, $halo) ;
+ if ($positionFound == 1) {
+ last LABA ;
+ }
+ }
+ if ($positionFound == 0) { $numLabelsOmitted++ ; }
+ if ($tries > 1) { $numLabelsMoved++ ; }
+ }
+}
+
+
+sub checkAndDrawText {
+#
+# checks if area available and if so draws text
+#
+ my ($x1, $x2, $y1, $y2, $orientation, $numLines, $ref, $col, $size, $font, $lineDist, $halo) = @_ ;
+ my @lines = @$ref ;
+
+ if (!areaOccupied ($x1, $x2, $y1, $y2)) {
+
+ for (my $i=0; $i<=$#lines; $i++) {
+ my @points = ($x1, $y2+($i+1)*($size+$lineDist), $x2, $y2+($i+1)*($size+$lineDist)) ;
+ my $pathName = "LabelPath" . $labelPathId ;
+ $labelPathId++ ;
+ push @svgOutputDef, svgElementPath ($pathName, @points) ;
+ if ($orientation eq "centered") {
+ push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $lines[$i], $pathName, 0, "middle", 50, $halo) ;
+ }
+ if ($orientation eq "left") {
+ push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $lines[$i], $pathName, 0, "start", 0, $halo) ;
+ }
+ if ($orientation eq "right") {
+ push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $lines[$i], $pathName, 0, "end", 100, $halo) ;
+ }
+ }
+
+ occupyArea ($x1, $x2, $y1, $y2) ;
+
+ return (1) ;
+ }
+ else {
+ return 0 ;
+ }
+}
+
+sub getDimensions {
+#
+# returns dimensions of map
+#
+ return ($sizeX, $sizeY) ;
+}
+
+
+
+sub drawAreaOcean {
+ my ($col, $ref) = @_ ;
+ push @svgOutputAreas, svgElementMultiPolygonFilled ($col, "none", $ref) ;
+}
+
+sub sizePNG {
+#
+# evaluates size of png graphics
+#
+ my $fileName = shift ;
+
+ my ($x, $y) ;
+ my $file ;
+ my $result = open ($file, "<", $fileName) ;
+ if ($result) {
+ my $pic = newFromPng GD::Image($file) ;
+ ($x, $y) = $pic->getBounds ;
+ close ($file) ;
+ }
+ else {
+ ($x, $y) = (0, 0) ;
+ }
+ return ($x, $y) ;
+}
+
+sub sizeSVG {
+#
+# evaluates size of svg graphics
+#
+ my $fileName = shift ;
+ my $file ;
+ my ($x, $y) ; undef $x ; undef $y ;
+
+ my $result = open ($file, "<", $fileName) ;
+ if ($result) {
+ my $line ;
+ while ($line = <$file>) {
+ my ($x1) = ( $line =~ /^.*width=\"([\d]+)px\"/ ) ;
+ my ($y1) = ( $line =~ /^.*height=\"([\d]+)px\"/ ) ;
+ if (!defined $x1) {
+ ($x1) = ( $line =~ /^\s*width=\"([\d]+)\"/ ) ;
+
+ }
+ if (!defined $y1) {
+ ($y1) = ( $line =~ /^\s*height=\"([\d]+)\"/ ) ;
+ }
+ if (defined $x1) { $x = $x1 ; }
+ if (defined $y1) { $y = $y1 ; }
+ }
+ close ($file) ;
+ }
+
+ if ( (!defined $x) or (!defined $y) ) {
+ $x = 0 ; $y = 0 ;
+ print "WARNING: size of file $fileName could not be determined.\n" ;
+ }
+ return ($x, $y) ;
+}
+
+sub scalePoints {
+ my $a = shift ;
+ # my $b = $a ;
+ my $b = $a / $baseDpi * $dpi ;
+
+ return (int ($b*10)) / 10 ;
+}
+
+
+sub scaleBase {
+#
+# function scales sizes given in 300dpi to base dpi given in rules so texts in legend, ruler etc. will appear in same size
+#
+ my $a = shift ;
+ my $b = $a / 300 * $baseDpi ;
+ return $b ;
+}
+
+#-----------------------------------------------------------------------------
+
+sub simplifyPoints {
+ my $ref = shift ;
+ my @points = @$ref ;
+ my @newPoints ;
+ my $maxIndex = $#points ;
+
+ if (scalar @points > 4) {
+ # push first
+ push @newPoints, $points[0], $points[1] ;
+
+ # push other
+ for (my $i=2; $i <= $maxIndex; $i+=2) {
+ $simplifyTotal++ ;
+ if ( ($points[$i]==$points[$i-2]) and ($points[$i+1]==$points[$i-1]) ) {
+ # same
+ $simplified++ ;
+ }
+ else {
+ push @newPoints, $points[$i], $points[$i+1] ;
+ }
+ }
+ return (\@newPoints) ;
+ }
+ else {
+ return ($ref) ;
+ }
+
+}
+
+sub simplifiedPercent {
+ return ( int ($simplified / $simplifyTotal * 100) ) ;
+}
+
+sub drawPageNumber {
+ my ($size, $col, $num) = @_ ;
+ my $x = $sizeX - scalePoints (scaleBase (80)) ;
+ my $y = $sizeY - scalePoints (scaleBase (80)) ;
+ drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
+}
+
+sub drawPageNumberLeft {
+ my ($size, $col, $num) = @_ ;
+ my $x = scalePoints (scaleBase (80)) ;
+ my $y = $sizeY / 2 ;
+ drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
+
+}
+
+sub drawPageNumberBottom {
+ my ($size, $col, $num) = @_ ;
+ my $x = $sizeX / 2 ;
+ my $y = $sizeY - scalePoints (scaleBase (80)) ;
+ drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
+
+}
+
+sub drawPageNumberRight {
+ my ($size, $col, $num) = @_ ;
+ my $x = $sizeX - scalePoints (scaleBase (80)) ;
+ my $y = $sizeY / 2 ;
+ drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
+
+}
+
+sub drawPageNumberTop {
+ my ($size, $col, $num) = @_ ;
+ my $x = $sizeX / 2 ;
+ my $y = scalePoints (scaleBase (80)) ;
+ drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
+
+}
+
+
+sub createShield {
+ my ($name, $targetSize) = @_ ;
+ my @a = split /:/, $name ;
+ my $shieldFileName = $a[1] ;
+ my $shieldText = $a[2] ;
+
+ if (! defined $createdShields{$name}) {
+ open (my $file, "<", $shieldFileName) or die ("ERROR: shield definition $shieldFileName not found.\n") ;
+ my @defText = <$file> ;
+ close ($file) ;
+
+ # get size
+ # calc scaling
+ my $sizeX = 0 ;
+ my $sizeY = 0 ;
+ foreach my $line (@defText) {
+ if (grep /<svg/, $line) {
+ ($sizeY) = ( $line =~ /height=\"(\d+)px\"/ ) ;
+ ($sizeX) = ( $line =~ /width=\"(\d+)px\"/ ) ;
+ if ( (!defined $sizeX) or (!defined $sizeY) ) {
+ die "ERROR: size of shield in $shieldFileName could not be determined.\n" ;
+ }
+ }
+ }
+ if ( ($sizeX == 0) or ($sizeY == 0) ) {
+ die "ERROR: initial size of shield $shieldFileName could not be determined.\n" ;
+ }
+
+ my $scaleFactor = $targetSize / $sizeY ;
+ # print "factor: $scaleFactor\n" ;
+
+ $shieldXSize{ $name } = int ($sizeX * $scaleFactor) ;
+ $shieldYSize{ $name } = int ($sizeY * $scaleFactor) ;
+
+ $shieldPathId++ ;
+ my $shieldPathName = "ShieldPath" . $shieldPathId ;
+ my $shieldGroupName = "ShieldGroup" . $shieldPathId ;
+
+ foreach my $line (@defText) {
+ $line =~ s/REPLACEID/$shieldGroupName/ ;
+ $line =~ s/REPLACESCALE/$scaleFactor/g ;
+ $line =~ s/REPLACEPATH/$shieldPathName/ ;
+ $line =~ s/REPLACELABEL/$shieldText/ ;
+ }
+
+ foreach my $line (@defText) {
+ push @svgOutputDef, $line ;
+ # print "DEF: $line" ;
+ }
+ # print "\n" ;
+
+ $createdShields{$name} = $shieldGroupName ;
+ }
+}
+
+
+
+sub getPointOfWay {
+ #
+ # returns point of way at distance/position
+ #
+
+ my ($ref, $position) = @_ ;
+ my @points = @$ref ;
+
+ my @double = () ;
+ while (scalar @points > 0) {
+ my $x = shift @points ;
+ my $y = shift @points ;
+ push @double, [$x, $y] ;
+ }
+
+ my $i = 0 ; my $actLen = 0 ;
+ while ($actLen < $position) {
+ $actLen += sqrt ( ($double[$i]->[0]-$double[$i+1]->[0])**2 + ($double[$i]->[1]-$double[$i+1]->[1])**2 ) ;
+ $i++ ;
+ }
+
+ my $x = int (($double[$i]->[0] + $double[$i-1]->[0]) / 2) ;
+ my $y = int (($double[$i]->[1] + $double[$i-1]->[1]) / 2) ;
+
+ # print "POW: $x, $y\n" ;
+
+ return ($x, $y) ;
+}
+
+
+
+
+
+
+1 ;
+
+
diff --git a/mapgenRules.pm b/mapgenRules.pm
new file mode 100755
index 0000000..4eed571
--- /dev/null
+++ b/mapgenRules.pm
@@ -0,0 +1,180 @@
+#
+# PERL mapgenRules module by gary68
+#
+#
+# Copyright (C) 2010, Gerhard Schwanz
+#
+# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
+
+
+package OSM::mapgenRules ; #
+
+use strict ;
+use warnings ;
+
+use List::Util qw[min max] ;
+use OSM::osm ;
+use OSM::mapgen 1.19 ;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION = '1.19' ;
+
+require Exporter ;
+
+ at ISA = qw ( Exporter AutoLoader ) ;
+
+ at EXPORT = qw ( readRules printRules ) ;
+
+#
+# constants
+#
+
+#
+# variables
+#
+my @nodes = () ;
+my @ways = () ;
+my @routes = () ;
+
+sub readRules {
+ my $csvName = shift ;
+ # READ STYLE File
+ print "read style file and preprocess tile icons for areas...\n" ;
+ open (my $csvFile, "<", $csvName) or die ("ERROR: style file not found.") ;
+ my $line = <$csvFile> ; # omit SECTION
+
+ # READ NODE RULES
+ $line = <$csvFile> ;
+ while (! grep /^\"SECTION/, $line) {
+ if (! grep /^\"COMMENT/i, $line) {
+ my ($key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale) = ($line =~ /\"(.+)\" \"(.+)\" \"(.+)\" (\d+) \"(.+)\" \"(.+)\" (\d+) \"(.+)\" (\d+) (\d) \"(.+)\" \"(.+)\" (\d+) (\d+) (\d+)/ ) ;
+ # print "N $key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale\n" ;
+ push @nodes, [$key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale] ;
+ }
+ $line = <$csvFile> ;
+ }
+
+ # READ WAY RULES
+ $line = <$csvFile> ; # omit SECTION
+ while ( (! grep /^\"SECTION/, $line) and (defined $line) ) {
+ if (! grep /^\"COMMENT/i, $line) {
+ # print "way line: $line\n" ;
+ my ($key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale) =
+ ($line =~ /\"(.+)\" \"(.+)\" \"(.+)\" (\d+) \"(.+)\" \"(.+)\" (\d+) (\d+) \"(.+)\" \"(.+)\" (\d+) \"(.+)\" ([\d\-]+) (\d) \"(.+)\" (\d) \"(.+)\" (\d+) (\d+)/ ) ;
+ # print "W $key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale\n" ;
+ push @ways, [$key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale] ;
+ if (($areaIcon ne "") and ($areaIcon ne "none")) { addAreaIcon ($areaIcon) ; }
+ }
+ $line = <$csvFile> ;
+ }
+
+ # READ ROUTE RULES
+ #print "ROUTE LINE: $line\n" ;
+ $line = <$csvFile> ; # omit SECTION
+ #print "ROUTE LINE: $line\n" ;
+ while ( (! grep /^\"SECTION/, $line) and (defined $line) ) {
+ if (! grep /^\"COMMENT/i, $line) {
+ #print "ROUTE LINE: $line\n" ;
+ my ($route, $color, $thickness, $dash, $opacity, $label, $nodeThickness, $fromScale, $toScale) = ($line =~ /\"(.+)\" \"(.+)\" (\d+) \"(.+)\" (\d+) \"(.+)\" (\d+) (\d+) (\d+)/ ) ;
+ $opacity = $opacity / 100 ;
+ push @routes, [$route, $color, $thickness, $dash, $opacity, $label, $nodeThickness, $fromScale, $toScale] ;
+ }
+ $line = <$csvFile> ;
+ }
+ close ($csvFile) ;
+
+ foreach my $node (@nodes) {
+ $node->[3] = scalePoints ($node->[3]) ;
+ $node->[6] = scalePoints ($node->[6]) ;
+ $node->[8] = scalePoints ($node->[8]) ;
+ $node->[12] = scalePoints ($node->[12]) ;
+ }
+
+ foreach my $way (@ways) {
+ $way->[3] = scalePoints ($way->[3]) ;
+ $way->[6] = scalePoints ($way->[6]) ;
+ $way->[10] = scalePoints ($way->[10]) ;
+ $way->[12] = scalePoints ($way->[12]) ;
+ }
+
+ foreach my $route (@routes) {
+ $route->[2] = scalePoints ($route->[2]) ;
+ $route->[6] = scalePoints ($route->[6]) ;
+ }
+
+ foreach my $way (@ways) {
+ if ($way->[4] ne "none") {
+ # print "DASH BEFORE $way->[4]\n" ;
+ my @dash = split /,/, $way->[4] ;
+ my $dashNew = "" ;
+ my $cap = pop @dash ;
+ my $validCap = 0 ;
+ foreach my $c ("butt", "round", "square") {
+ if ($cap eq $c) { $validCap = 1 ; }
+ }
+ if ($validCap == 0) { $cap = "round" ; }
+ if (scalar @dash % 2 != 0) { die "ERROR: odd number in dash definition $way->[4]\n" ; }
+ foreach my $v (@dash) {
+ $v = scalePoints ($v) ;
+ $dashNew .= $v . "," ;
+ }
+ $dashNew .= $cap ;
+ $way->[4] = $dashNew ;
+ # print "DASH AFTER $way->[4]\n" ;
+ }
+ }
+
+ foreach my $route (@routes) {
+ if ($route->[3] ne "none") {
+ my @dash = split /,/, $route->[3] ;
+ my $dashNew = "" ;
+ my $cap = pop @dash ;
+ my $validCap = 0 ;
+ foreach my $c ("butt", "round", "square") {
+ if ($cap eq $c) { $validCap = 1 ; }
+ }
+ if ($validCap == 0) { $cap = "round" ; }
+ if (scalar @dash % 2 != 0) { die "ERROR: odd number in dash definition $route->[3]\n" ; }
+ foreach my $v (@dash) {
+ $v = scalePoints ($v) ;
+ $dashNew .= $v . "," ;
+ }
+ $dashNew .= $cap ;
+ $route->[3] = $dashNew ;
+ }
+ }
+
+ return (\@nodes, \@ways, \@routes) ;
+}
+
+
+sub printRules {
+ print "WAYS/AREAS\n" ;
+ foreach my $way (@ways) {
+ printf "%-20s %-20s %-10s %-6s %-6s %-10s %-6s %-6s %-10s %-10s %-10s %-10s %-6s %-6s %-15s %-6s %-20s %-10s %-10s\n", $way->[0], $way->[1], $way->[2], $way->[3], $way->[4], $way->[5], $way->[6], $way->[7], $way->[8], $way->[9], $way->[10], $way->[11], $way->[12], $way->[13], $way->[14], $way->[15], $way->[16], $way->[17], $way->[18] ;
+ }
+ print "\n" ;
+ print "NODES\n" ;
+ foreach my $node (@nodes) {
+ printf "%-20s %-20s %-10s %-10s %-10s %-10s %-10s %-10s %-10s %-10s %-15s %-20s %6s %-10s %-10s\n", $node->[0], $node->[1], $node->[2], $node->[3], $node->[4], $node->[5], $node->[6], $node->[7], $node->[8], $node->[9], $node->[10], $node->[11], $node->[12], $node->[13], $node->[14] ;
+ }
+ print "\n" ;
+
+ print "ROUTES\n" ;
+ foreach my $route (@routes) {
+ printf "%-20s %-20s %-10s %-10s %-10s %-10s %-10s %-10s %-10s\n", $route->[0], $route->[1], $route->[2], $route->[3], $route->[4], $route->[5], $route->[6], $route->[7], $route->[8] ;
+ }
+ print "\n" ;
+}
+
+
+1 ;
+
+
diff --git a/osm.pm b/osm.pm
new file mode 100755
index 0000000..2623cb3
--- /dev/null
+++ b/osm.pm
@@ -0,0 +1,1760 @@
+#
+#
+# PERL osm module by gary68
+#
+# !!! store as osm.pm in folder OSM in lib directory !!!
+#
+# This module contains a lot of useful functions for working with osm files and data. it also
+# includes functions for calculation and output.
+#
+#
+# Copyright (C) 2008, 2009, 2010 Gerhard Schwanz
+#
+# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
+#
+#
+# version 2
+# - added html table functions
+#
+# Version 3
+# - added project and angle
+# - added support for bz2 files
+#
+# Version 4
+# - add support for relations
+# - select multiple ways in JOSM link
+# - getNode2, getWay2: return tags as arrays
+#
+# Version 4.1
+# - getBugs added
+#
+# Version 4.2
+# - map compare link added
+#
+# Version 4.3
+# - regex for k/v changed
+#
+# Version 4.4
+# -added relation analyzer link
+#
+# Version 4.41 (gary68)
+# - changed regex for openosmfile from /node/ to /<node/ - seems better since changesets are now in planet...
+#
+# Version 4.5 (gary68)
+# - OSB address changed
+#
+# Version 4.6 (gary68)
+# - getnode2 error correction
+#
+# Version 4.7 (gary68)
+# - hidden iframe for josm links
+#
+# Version 4.8
+# - josm dont select added
+#
+# Version 4.9
+# - APIgetWay new
+#
+# Version 5.0
+# - new osm link function
+#
+# Version 5.1
+# - new hash function
+#
+# Version 5.2
+# - josm select nodes added
+#
+# Version 5.3
+# - new html output functions
+#
+# Version 5.4
+# - support negative ids
+#
+# Version 5.5
+# - support comments in osm files
+# - ignore a space after the last attribute in the <node> tag.
+#
+# Version 6.0
+# - regex improvements
+#
+# Version 7.0
+# - skip nodes and skip ways performance boost by using seek in files
+#
+# Version 7.1
+# - get...Xml functions added
+#
+#
+# Version 8.0
+# - read xml subs implemented for different getXXX
+#
+# Version 8.1
+# - diff db sub
+#
+# Version 8.2
+# - latexSanitizeString
+#
+# Version 8.4
+# - negative IDs
+#
+#
+# USAGE
+#
+# analyzerLink ($id) > $htmlString, link to relation analyzer
+# angle (x1,y1,x2,y2) > angle (N=0,E=90...)
+# APIgetWay ($id) > ($wayId, $wayUser, \@wayNodes, \@wayTags)
+# binSearch ($value, @ref) > $index or -1
+# closeOsmFile ()
+# checkOverlap (w1xMin, w1yMin, w1xMax, w1yMax, w2xMin, w2yMin, w2xMax, w2yMax) > 0=no overlap, 1=overlap
+# crossing (g1x1,g1y1,g1x2,g1y2,g2x1,g2y1,g2x2,g2y2) > ($sx, $sy)
+# distance (x1,y1,x2,y2) > $distance in km
+# getBugs ($lon, $lat, $bugsDownDist, $bugsMaxDist) > pos, down dist in deg, max dist in km -> html text
+# getNode2 () > ($gId, $gLon, $gLat, $gU, \@gTags) ; # in main @array = @$ref // returns k/v as array, not string!
+# getNode3 () > (\%nodeProperties \@nodeTags) ; # in main @array = @$ref // returns k/v as array, not string!
+# getNodeXml () > ($gId, $xml) ;
+# getRelation
+# getRelation3 > (\%properties, \@members, \@tags)
+# getWay2 () > ($gId, $gU, \@gNodes, \@gTags) ; # in main @array = @$ref // returns k/v as array, not string!
+# getWay3 () > (\%properties, \@Nodes, \@Tags) ;
+# getWayXml () > ($gId, $xml) ;
+# getRelationXml () > ($gId, $xml) ;
+# hashValue ($lon, $lat) > $hashValue 0.1 deg
+# hashValue2 ($lon, $lat) > $hashValue 0.01 deg
+# historyLink ($type, $key) > $htmlString
+# josmLinkDontSelect ($lon, $lat, $span) > $htmlString
+# josmLinkSelectWay ($lon, $lat, $span, $wayId) > $htmlString
+# josmLinkSelectWays ($lon, $lat, $span, @wayIds) > $htmlString
+# josmLinkSelectNode ($lon, $lat, $span, $nodeId) > $htmlString
+# josmLinkSelectNodes ($lon, $lat, $span, @nodes) > $htmlString
+# DON'T USE ANYMORE! josmLink ($lon, $lat, $span, $wayId) > $htmlString
+# mapCompareLink ($lon, $lat, $zoom) > $htmlString
+# openOsmFile ($file) > osm file open and $line set to first node (*.osm or *.osm.bz2)
+# osbLink ($lon, $lat, $zoom) > $htmlString
+# osmLink ($lon, $lat, $zoom) > $htmlString
+# osmLinkMarkerWay ($lon, $lat, $zoom, $way) > $htmlString
+# picLinkMapnik ($lon, $lat, $zoom) > $htmlString
+# picLinkOsmarender ($lon, $lat, $zoom) > $htmlString
+# printGPXHeader ($file)
+# printGPXFoot ($file)
+# printGPXWaypoint ($file, $lon, $lat, $text)
+# printHTMLCellCenter ($file, $value)
+# printHTMLCellLeft ($file, $value)
+# printHTMLCellLeftEM
+# printHTMLCellLeftTwoValues
+# printHTMLCellRight ($file, $value)
+# printHTMLFoot ($file) > print foot to file
+# printHTMLHeader ($file, $title) > print header to file
+# printHTMLHeaderiFrame ($file) > print iFrame code for josm links, call before body
+# printHTMLRowStart ($file)
+# printHTMLRowEnd ($file)
+# printHTMLTableFoot ($file)
+# printHTMLTableHead ($file)
+# printHTMLTableHeadings ($file, @list)
+# printHTMLTableRowLeft ($file, @list)
+# printHTMLTableRowRight ($file, @list)
+# printNodeList ($file, @list)
+# printProgress ($program, $osm, $startTime, $fullCount, $actualCount)
+# printWayList ($file, @list)
+# project (x1, y1, angle, dist) > (x2,y2)
+# shortestDistance ($gx1, $gy1, $gx2, $gy2, $nx, $ny) > roughly the distance of node to segment in km
+# skipNodes ()
+# skipWays ()
+# stringFileInfo ($file) > $string
+# stringTimeSpent ($timeSpent in seconds) > $string
+# tileNumber ($lon,$lat,$zoom) > ($xTile, $yTile)
+#
+
+
+
+
+package OSM::osm ;
+
+use strict;
+use warnings;
+
+use OSM::osmDB ;
+use LWP::Simple;
+use Math::Trig;
+# use IO::Handle ;
+use File::stat;
+use Time::localtime;
+use List::Util qw[min max] ;
+use Compress::Bzip2 ; # install packet "libcompress-bzip2-perl"
+ # if you have problems with this module/library then just comment out all lines using these functions
+ # and don't use zipped files
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK) ;
+
+$VERSION = '8.4' ;
+
+my $apiUrl = "http://www.openstreetmap.org/api/0.6/" ; # way/Id
+
+require Exporter ;
+
+ at ISA = qw ( Exporter AutoLoader ) ;
+
+ at EXPORT = qw (analyzerLink applyDiffFile getBugs getNode getNode2 getNode3 getNodeXml getWay getWay2 getWay3 getWayXml getRelation getRelation3 getRelationXml crossing historyLink hashValue hashValue2 tileNumber openOsmFile osmLink osmLinkMarkerWay osbLink mapCompareLink josmLink josmLinkDontSelect josmLinkSelectWay josmLinkSelectWays josmLinkSelectNode josmLinkSelectNodes printHTMLHeader printHTMLFoot stringTimeSpent distance angle project picLinkMapnik picLinkOsmarender stringFileInfo [...]
+
+our $line ;
+our $file ;
+our $fileName ;
+my $bufferSize = 512000 ;
+
+my $bz ; my $isBz2 ;
+
+######
+# file
+######
+sub openOsmFile {
+ $fileName = shift ;
+
+ if (grep /.bz2/, $fileName) { $isBz2 = 1 ; } else { $isBz2 = 0 ; }
+
+ if ($isBz2) {
+ $bz = bzopen($fileName, "rb") or die "Cannot open $fileName: $bzerrno\n" ;
+ }
+ else {
+ open ($file, "<", $fileName) || die "can't open osm file" ;
+ }
+
+ nextLine() ;
+ while ( ! (grep /\<node/, $line) ) {
+ nextLine() ;
+ #print "LINE: $line" ;
+ }
+ return 1 ;
+}
+
+sub closeOsmFile {
+ if ($isBz2) {
+ $bz->bzclose() ;
+ }
+ else {
+ close ($file) ;
+ }
+}
+
+sub stringFileInfo {
+ my $file = shift ;
+ my $string = "file " . $file . " " . ctime(stat($file)->mtime) ;
+ return ($string) ;
+}
+
+sub nextLine {
+ do {
+ if ($isBz2) {
+ $bz->bzreadline($line) ;
+ }
+ else {
+ $line = <$file> ;
+ }
+ } while ($line =~ /^<!--/) ;
+}
+
+sub seek_to_way_section
+{
+ my $sb = stat ($fileName) ;
+ my $size = $sb->size ;
+
+ my $firstindex = 0;
+ my $lastindex = $size;
+ my $index = int($size / 2) ;
+
+ while(1)
+ {
+ my $buf;
+ seek($file, $index, 0);
+ read($file, $buf, $bufferSize);
+ my $relationstart = index($buf, "<relation id");
+ my $waystart = index($buf, "<way id");
+ my $nodestart = index($buf, "<node id");
+ # print "$index $nodestart $waystart $relationstart\n" ;
+ if (($waystart > -1) && ($nodestart > -1))
+ {
+ seek($file, $index + $waystart - 1, 0);
+ return;
+ }
+ # elsif ($waystart > -1)
+ elsif ( ($waystart > -1) or ($relationstart > -1) )
+ {
+ $lastindex = $index;
+ $index = int(($index + $firstindex) / 2);
+ }
+ else
+ {
+ $firstindex = $index;
+ $index = int(($index + $lastindex) / 2);
+ }
+ }
+}
+
+sub seek_to_relation_section
+{
+ my $sb = stat ($fileName) ;
+ my $size = $sb->size ;
+ my $firstindex = 0;
+ my $lastindex = $size;
+ my $index = int($size / 2);
+
+ while(1)
+ {
+ my $buf;
+ seek($file, $index, 0);
+ read($file, $buf, $bufferSize);
+ my $relationstart = index($buf, "<relation id");
+ my $waystart = index($buf, "<way id");
+ my $nodestart = index($buf, "<node id");
+ # print "$index $nodestart $waystart $relationstart\n" ;
+ if (($relationstart > -1) && ($waystart > -1))
+ {
+ seek($file, $index + $relationstart - 1, 0);
+ return;
+ }
+ elsif ($relationstart > -1)
+ {
+ $lastindex = $index;
+ $index = int(($index + $firstindex) / 2);
+ }
+ else
+ {
+ $firstindex = $index;
+ $index = int(($index + $lastindex) / 2);
+ }
+ }
+}
+
+
+
+#######
+# NODES
+#######
+sub skipNodes {
+ if ($isBz2) {
+ while ( ! (grep /<way/, $line) ) {
+ nextLine() ;
+ }
+ }
+ else {
+ seek_to_way_section() ;
+ nextLine() ;
+ }
+}
+
+sub getNode {
+ my $gId ;
+ my $gLon ;
+ my $gLat ;
+ my $gU ;
+ my @gTags = () ;
+ if($line =~ /^\s*\<node/) {
+
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+ my ($u) = ($line =~ / user=[\'\"](.+?)[\'\"]/ ) ;
+ my ($lon) = ($line =~ / lon=[\'\"](.+?)[\'\"]/ ) ;
+ my ($lat) = ($line =~ / lat=[\'\"](.+?)[\'\"]/ ) ;
+
+ if (!defined $u) { $u = "undefined" ; }
+
+ if (! defined $id ) {
+ print "WARNING reading osm file, line follows (expecting id, lon, lat and user for node):\n", $line, "\n" ;
+ }
+
+ unless ($id) { next; }
+ if (! (defined ($lat))) { next; }
+ if (! (defined ($lon))) { next; }
+ if ( (grep (/"\s*>/, $line)) or (grep (/'\s*>/, $line)) ) { # more lines, get tags
+ nextLine() ;
+ while (!grep(/<\/node>/, $line)) {
+
+ my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
+
+ if ( (defined ($k)) and (defined ($v)) ) {
+ my $tag = $k . ":" . $v ;
+ push @gTags, $tag ;
+ }
+ else {
+ #print "WARNING tag not recognized: ", $line, "\n" ;
+ }
+ nextLine() ;
+ }
+ nextLine() ;
+ }
+ else {
+ nextLine() ;
+ }
+ $gId = $id ;
+ $gLon = $lon ;
+ $gLat = $lat ;
+ $gU = $u ;
+ } # node
+ else {
+ return (-1, -1, -1, -1, -1) ;
+ } # node
+ #print "$gId $gLon $gLat $gU\n" ;
+ return ($gId, $gLon, $gLat, $gU, \@gTags) ; # in main @array = @$ref
+} # getNode
+
+
+sub getNode2 {
+ my $gId ; my $gLon ; my $gLat ; my $gU ;
+ my ($ref0, $ref1) ;
+ if($line =~ /^\s*\<node/) {
+ ($ref0, $ref1) = readNode () ;
+ my %properties = %$ref0 ;
+ $gId = $properties{"id"} ;
+ $gLon = $properties{"lon"} ;
+ $gLat = $properties{"lat"} ;
+ $gU = $properties{"user"} ;
+ } # node
+ else {
+ return (-1, -1, -1, -1, -1) ;
+ } # node
+ return ($gId, $gLon, $gLat, $gU, $ref1) ;
+} # getNode2
+
+
+sub getNode3 {
+ my $ref0 ; my $ref1 ;
+ if($line =~ /^\s*\<node/) {
+ ($ref0, $ref1) = readNode () ;
+ }
+ else {
+ return (undef, undef) ;
+ }
+ return ($ref0, $ref1) ;
+} # getNode3
+
+
+sub readNode {
+ my $id ;
+ my $propRef = () ;
+ my @nodeTags = () ;
+
+ ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+
+ if (! defined $id ) {
+ print "WARNING reading osm file, line follows (expecting id, lon, lat and user for node):\n", $line, "\n" ;
+ }
+ else {
+ $propRef = getProperties ($line, "node", $id) ;
+ if ( (grep (/"\s*>/, $line)) or (grep (/'\s*>/, $line)) ) { # more lines, get tags
+ nextLine() ;
+ while (!grep(/<\/node>/, $line)) {
+ my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
+ if ( (defined ($k)) and (defined ($v)) ) {
+ my $tag = [$k, $v] ;
+ push @nodeTags, $tag ;
+ }
+ else {
+ #print "WARNING tag not recognized: ", $line, "\n" ;
+ }
+ nextLine() ;
+ }
+ nextLine() ;
+ }
+ else {
+ nextLine() ;
+ }
+ }
+ return ($propRef, \@nodeTags) ;
+}
+
+sub getProperties {
+ my ($line, $type, $id) = @_ ;
+ my $version ; my $timestamp ; my $uid ; my $lon ; my $lat ; my $u ; my $cs ;
+ my %properties = () ;
+ ($u) = ($line =~ / user=[\'\"](.+?)[\'\"]/ ) ;
+ ($version) = ($line =~ / version=[\'\"](.+?)[\'\"]/ ) ;
+ ($timestamp) = ($line =~ / timestamp=[\'\"](.+?)[\'\"]/ ) ;
+ ($uid) = ($line =~ / uid=[\'\"](.+?)[\'\"]/ ) ;
+ ($cs) = ($line =~ / changeset=[\'\"](.+?)[\'\"]/ ) ;
+
+ if ( ! defined $u) { $u = "undefined" ; }
+ if ( ! defined $version) { $version = "0" ; }
+ if ( ! defined $uid) { $uid = 0 ; }
+ if ( ! defined $timestamp) { $timestamp = "" ; }
+ if ( ! defined $cs) { $cs = "" ; }
+ $properties{"id"} = $id ;
+ $properties{"user"} = $u ;
+ $properties{"uid"} = $uid ;
+ $properties{"version"} = $version ;
+ $properties{"timestamp"} = $timestamp ;
+ $properties{"changeset"} = $cs ;
+ if ($type eq "node") {
+ ($lon) = ($line =~ / lon=[\'\"](.+?)[\'\"]/ ) ;
+ ($lat) = ($line =~ / lat=[\'\"](.+?)[\'\"]/ ) ;
+ if ( ! defined $lon) { $lon = 0 ; }
+ if ( ! defined $lat) { $lat = 0 ; }
+ $properties{"lon"} = $lon ;
+ $properties{"lat"} = $lat ;
+ }
+ return ( \%properties ) ;
+}
+
+sub getNodeXml {
+ my $gId ;
+ my $xml ;
+ my $id ;
+ if($line =~ /^\s*\<node/) {
+ $xml .= $line;
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+
+ if (! defined $id ) {
+ print "WARNING reading osm file, line follows (expecting id, lon, lat and user for node):\n", $line, "\n" ;
+ }
+
+ unless ($id) { next; }
+ if ( (grep (/"\s*>/, $line)) or (grep (/'\s*>/, $line)) ) { # more lines, get tags
+ nextLine() ;
+ while (!grep(/<\/node>/, $line)) {
+
+ $xml .= $line ;
+
+ nextLine() ;
+ }
+ $line =~ /\/node>/ ;
+ $xml .= $line;
+
+ nextLine() ;
+ }
+ else {
+ nextLine() ;
+ }
+ $gId = $id ;
+ } # node
+ else {
+ return (-1, "") ;
+ } # node
+ #print "$gId $gLon $gLat $gU\n" ;
+ return ($gId, $xml) ; # in main @array = @$ref
+} # getNodeXml
+
+
+######
+# WAYS
+######
+
+sub skipWays {
+ if ($isBz2) {
+ while ( ! (grep /<relation/, $line) ) {
+ nextLine() ;
+ }
+ }
+ else {
+ seek_to_relation_section() ;
+ nextLine() ;
+ }
+}
+
+sub getWay {
+ my $gId ;
+ my $gU ;
+ my @gTags ;
+ my @gNodes ;
+ if($line =~ /^\s*\<way/) {
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+ my ($u) = ($line =~ / user=[\'\"](.+?)[\'\"]/ ) ;
+
+ if (!defined $u) { $u = "undefined" ; }
+
+ if (! defined $id ) { print "ERROR: $line\n" ; }
+
+ nextLine() ;
+ while (not($line =~ /\/way>/)) { # more way data
+ #get nodes and type
+ my ($node) = ($line =~ /^\s*\<nd ref=[\'\"]([\d\-]+)[\'\"]/); # get node id
+
+ my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
+
+ if (!(($node) or ($k and defined($v) ))) {
+ #print "WARNING tag not recognized", $line, "\n" ;
+ }
+
+ if ($node) {
+ push @gNodes, $node ;
+ }
+
+ #get tags
+ if ($k and defined($v)) {
+ my $tag = $k . ":" . $v ;
+ push @gTags, $tag ;
+ }
+ nextLine() ;
+ }
+ nextLine() ;
+ $gId = $id ;
+ $gU = $u ;
+ }
+ else {
+ return (-1, -1, -1, -1) ;
+ }
+ return ($gId, $gU, \@gNodes, \@gTags) ;
+} # way
+
+sub getWay2 {
+ my $gId ;
+ my $gU ;
+ my @gTags ;
+ my @gNodes ;
+ my ($ref0, $ref1, $ref2) ;
+ if($line =~ /^\s*\<way/) {
+ ($ref0, $ref1, $ref2) = readWay () ;
+ my %properties = %$ref0 ;
+ $gId = $properties{"id"} ;
+ $gU = $properties{"user"} ;
+ }
+ else {
+ return (-1, -1, -1, -1) ;
+ }
+ return ($gId, $gU, $ref1, $ref2) ;
+} # getWay2
+
+sub getWay3 {
+ my $ref0 ; my $ref1 ; my $ref3 ;
+ if($line =~ /^\s*\<way/) {
+ ($ref0, $ref1, $ref3) = readWay () ;
+ }
+ else {
+ return (undef, undef, undef) ;
+ }
+ return ($ref0, $ref1, $ref3) ;
+}
+
+sub readWay {
+ my @gNodes = () ; my @gTags = () ;
+ my $propRef ;
+
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+ if (! defined $id ) {
+ print "WARNING reading osm file, line follows :\n", $line, "\n" ;
+ }
+ else {
+ $propRef = getProperties ($line, "way", $id) ;
+
+ if ( ! grep /\/>/, $line) {
+ nextLine() ;
+ while (not($line =~ /\/way>/)) { # more way data
+ #get nodes and type
+ my ($node) = ($line =~ /^\s*\<nd ref=[\'\"]([\d\-]+)[\'\"]/); # get node id
+ my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
+
+ if (!(($node) or ($k and defined($v) ))) {
+ #print "WARNING tag not recognized", $line, "\n" ;
+ }
+
+ if ($node) {
+ push @gNodes, $node ;
+ }
+
+ #get tags
+ if ($k and defined($v)) {
+ my $tag = [$k, $v] ;
+ push @gTags, $tag ;
+ }
+ nextLine() ;
+ }
+ }
+ nextLine() ;
+ }
+ return ($propRef, \@gNodes, \@gTags) ;
+}
+
+sub getWayXml {
+ my $gId ;
+ my $xml ;
+ if($line =~ /^\s*\<way/) {
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+
+ if (! defined $id ) { print "ERROR: $line\n" ; }
+
+ $xml = $line;
+ nextLine() ;
+ while (not($line =~ /\/way>/)) { # more way data
+ #get nodes and type
+ $xml .= $line;
+ nextLine() ;
+ }
+ $xml .= $line;
+ nextLine() ;
+ $gId = $id ;
+ }
+ else {
+ return (-1, "") ;
+ }
+ return ($gId, $xml) ;
+} # getWayXml
+
+
+###########
+# RELATIONS
+###########
+
+sub getRelation {
+ my $gId ;
+ my $gU ;
+ my ($ref1, $ref2) ;
+ my $propRef ;
+
+ if ($line =~ /^\s*\<relation/) {
+
+ ($propRef, $ref1, $ref2) = readRelation () ;
+ my %properties = %$propRef ;
+
+ $gId = $properties{"id"} ;
+ $gU = $properties{"user"} ;
+ }
+ else {
+ return (-1, -1, -1, -1) ;
+ }
+ return ($gId, $gU, $ref1, $ref2) ;
+}
+
+sub getRelation3 {
+ my $ref0 ; my $ref1 ; my $ref2 ;
+ if($line =~ /^\s*\<relation/) {
+ ($ref0, $ref1, $ref2) = readRelation () ;
+ }
+ else {
+ return (undef, undef, undef) ;
+ }
+ return ($ref0, $ref1, $ref2) ;
+}
+
+sub readRelation {
+ my $propRef ; my @gTags ; my @gMembers ;
+
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+
+ if (! defined $id ) {
+ print "ERROR: $line\n" ;
+ }
+ else {
+
+ $propRef = getProperties ($line, "relation", $id) ;
+
+ if ( ! grep /\/>/, $line) {
+ nextLine() ;
+ while (not($line =~ /\/relation>/)) { # more data
+ if ($line =~ /<member/) {
+ my ($memberType) = ($line =~ /^\s*\<member type=[\'\"]([\w]*)[\'\"]/);
+ my ($memberRef) = ($line =~ /^.+ref=[\'\"]([\d\-]+)[\'\"]/);
+ my ($memberRole) = ($line =~ /^.+role=[\'\"](.*)[\'\"]/);
+ if (!$memberRole) { $memberRole = "none" ; }
+ my @member = [$memberType, $memberRef, $memberRole] ;
+ push @gMembers, @member ;
+ }
+ if ($line =~ /<tag/) {
+ my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
+ if (!(($k and defined($v) ))) {
+ $k = "unknown" ; $v = "unknown" ;
+ }
+ my $tag = [$k, $v] ;
+ push @gTags, $tag ;
+ }
+ nextLine() ;
+ }
+ }
+ nextLine() ;
+ }
+ return ($propRef, \@gMembers, \@gTags) ;
+}
+
+
+sub getRelationXml {
+ my $gId ;
+ my $xml;
+
+ if ($line =~ /^\s*\<relation/) {
+
+ my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
+ if (! defined $id ) { print "ERROR: $line\n" ; }
+ $xml .= $line;
+ unless ($id) { next ; }
+
+ nextLine() ;
+ while (not($line =~ /\/relation>/)) { # more data
+ $xml .= $line;
+ nextLine() ;
+ }
+ $gId = $id ;
+ $xml .= $line;
+ nextLine() ;
+ }
+ else {
+ return (-1, "") ;
+ }
+ return ($gId, $xml) ;
+}
+
+
+###########
+# CROSSINGS
+###########
+
+# crossing
+sub crossing {
+
+ my ($g1x1) = shift ;
+ my ($g1y1) = shift ;
+ my ($g1x2) = shift ;
+ my ($g1y2) = shift ;
+
+ my ($g2x1) = shift ;
+ my ($g2y1) = shift ;
+ my ($g2x2) = shift ;
+ my ($g2y2) = shift ;
+
+ #printf "g1: %f/%f %f/%f\n", $g1x1, $g1y1, $g1x2, $g1y2 ;
+ #printf "g2: %f/%f %f/%f\n", $g2x1, $g2y1, $g2x2, $g2y2 ;
+
+
+
+ # wenn punkte gleich, dann 0 !!!
+ # nur geraden pr fen, wenn node ids ungleich !!!
+
+ if (($g1x1 == $g2x1) and ($g1y1 == $g2y1)) { # p1 = p1 ?
+ #print "gleicher punkt\n" ;
+ return (0, 0) ;
+ }
+ if (($g1x1 == $g2x2) and ($g1y1 == $g2y2)) { # p1 = p2 ?
+ #print "gleicher punkt\n" ;
+ return (0, 0) ;
+ }
+ if (($g1x2 == $g2x1) and ($g1y2 == $g2y1)) { # p2 = p1 ?
+ #print "gleicher punkt\n" ;
+ return (0, 0) ;
+ }
+
+ if (($g1x2 == $g2x2) and ($g1y2 == $g2y2)) { # p2 = p1 ?
+ #print "gleicher punkt\n" ;
+ return (0, 0) ;
+ }
+
+
+ my $g1m ;
+ if ( ($g1x2-$g1x1) != 0 ) {
+ $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
+ }
+ else {
+ $g1m = 999999 ;
+ }
+
+ my $g2m ;
+ if ( ($g2x2-$g2x1) != 0 ) {
+ $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
+ }
+ else {
+ $g2m = 999999 ;
+ }
+
+ #printf "Steigungen: m1=%f m2=%f\n", $g1m, $g2m ;
+
+ if ($g1m == $g2m) { # parallel
+ #print "parallel\n" ;
+ return (0, 0) ;
+ }
+
+ my ($g1b) = $g1y1 - $g1m * $g1x1 ; # abschnitte
+ my ($g2b) = $g2y1 - $g2m * $g2x1 ;
+
+ #printf "b1=%f b2=%f\n", $g1b, $g2b ;
+
+
+ # wenn punkt auf gerade, dann 1 - DELTA Pr fung !!! delta?
+
+
+ my ($sx) = ($g2b-$g1b) / ($g1m-$g2m) ; # schnittpunkt
+ my ($sy) = ($g1m*$g2b - $g2m*$g1b) / ($g1m-$g2m);
+
+ #print "schnitt: ", $sx, "/", $sy, "\n" ;
+
+ my ($g1xmax) = max ($g1x1, $g1x2) ;
+ my ($g1xmin) = min ($g1x1, $g1x2) ;
+ my ($g1ymax) = max ($g1y1, $g1y2) ;
+ my ($g1ymin) = min ($g1y1, $g1y2) ;
+
+ my ($g2xmax) = max ($g2x1, $g2x2) ;
+ my ($g2xmin) = min ($g2x1, $g2x2) ;
+ my ($g2ymax) = max ($g2y1, $g2y2) ;
+ my ($g2ymin) = min ($g2y1, $g2y2) ;
+
+ if (($sx >= $g1xmin) and
+ ($sx >= $g2xmin) and
+ ($sx <= $g1xmax) and
+ ($sx <= $g2xmax) and
+ ($sy >= $g1ymin) and
+ ($sy >= $g2ymin) and
+ ($sy <= $g1ymax) and
+ ($sy <= $g2ymax)) {
+ #print "*******IN*********\n" ;
+ return ($sx, $sy) ;
+ }
+ else {
+ #print "OUT\n" ;
+ return (0, 0) ;
+ }
+
+} # crossing
+
+
+
+####################
+# string linkHistory
+####################
+sub historyLink {
+ my ($type, $key) = @_;
+ return "<a href=\"http://www.openstreetmap.org/browse/$type/$key/history\">$key</a>";
+}
+
+
+
+##############
+# TILE NUMBERS
+##############
+sub tileNumber {
+ my ($lon,$lat,$zoom) = @_;
+ my $xtile = int( ($lon+180)/360 *2**$zoom ) ;
+ my $ytile = int( (1 - log(tan($lat*pi/180) + sec($lat*pi/180))/pi)/2 *2**$zoom ) ;
+ return(($xtile, $ytile));
+}
+
+
+############
+# hashValues
+############
+sub hashValue {
+ my $lon = shift ;
+ my $lat = shift ;
+
+ my $lo = int ($lon*10) * 10000 ;
+ my $la = int ($lat*10) ;
+
+ return ($lo+$la) ;
+}
+
+sub hashValue2 {
+ my $lon = shift ;
+ my $lat = shift ;
+
+ my $lo = int ($lon*100) * 100000 ;
+ my $la = int ($lat*100) ;
+
+ return ($lo+$la) ;
+}
+
+
+######
+# calc
+######
+sub angle {
+#
+# angle from point 1 to point 2
+# N = 0, O = 90, S = 180, W = 270
+#
+ my ($x1, $y1, $x2, $y2) = @_ ;
+
+ my $d_lat = ($y2-$y1) * 111.11 ;
+ my $d_lon = ($x2-$x1) * cos($y1/360*3.14*2) * 111.11 ;
+ my $a = - rad2deg(atan2($d_lat,$d_lon)) + 90 ;
+
+ if ($a < 0) { $a += 360 ; }
+
+ return $a ;
+}
+
+sub project {
+#
+# project point from point by angle and distance in km
+# N = 0, O = 90, S = 180, W = 270
+#
+#
+ my ($x1, $y1, $angle, $dist) = @_ ;
+ my $x2; my $y2 ;
+ my $dLat ; my $dLon ;
+
+ $dLat = $dist * cos ($angle/360*3.141592654*2) ;
+ $dLon = $dist * sin ($angle/360*3.141592654*2) ;
+
+ $x2 = $x1 + $dLon / (111.11 * cos($y1/360*3.14*2) ) ;
+ $y2 = $y1 + $dLat / 111.11 ;
+
+ return ($x2, $y2) ;
+}
+
+sub distance {
+ my ($x1, $y1, $x2, $y2) = @_ ;
+ my ($d_lat) = ($y2 - $y1) * 111.11 ;
+ my ($d_lon) = ($x2 - $x1) * cos ( $y1 / 360 * 3.14 * 2 ) * 111.11;
+ my ($dist) = sqrt ($d_lat*$d_lat+$d_lon*$d_lon);
+ return ($dist) ;
+}
+
+sub shortestDistance {
+ #
+ # distance in km ONLY ROUGHLY !!! TODO
+ # better calc point on line first and then calc distance with function above!
+ #
+ my ($gx1, $gy1, $gx2, $gy2, $nx, $ny) = @_ ;
+ my $m ; my $b ; my $t ;
+
+ $t = $gx2 - $gx1 ;
+ if ($t == 0) {
+ my ($d1) = distance ($gx1, $gy1, $nx, $ny) ;
+ my ($d2) = distance ($gx2, $gy2, $nx, $ny) ;
+ my ($d3) = distance ($gx1, $gy1, $gx2, $gy2) ;
+ my ($d4) = abs ($nx - $gx1) * 111.11 * cos ( $gy1 / 360 * 3.14 * 2 ) ;
+ if ( ($d1 <= $d3) and ($d2 <= $d3) ) {
+ return (abs ($d4)) ;
+ }
+ else {
+ return (999) ;
+ }
+ }
+ else {
+ my ($d10) = distance ($gx1, $gy1, $nx, $ny) ;
+ my ($d20) = distance ($gx2, $gy2, $nx, $ny) ;
+ my ($d30) = distance ($gx1, $gy1, $gx2, $gy2) ;
+
+ $m = ($gy2 - $gy1) / $t ;
+ $b = $gy1 - $m * $gx1 ;
+ my ($d40) = ($ny - $m * $nx - $b) / sqrt ($m * $m + 1) ;
+
+ if ( ($d10 <= $d30) and ($d20 <= $d30) ) {
+ my $result = abs ($d40 * 111.11) ;
+ # print "dist = $result\n" ;
+ return $result ;
+ }
+ else {
+ return (999) ;
+ }
+ }
+}
+
+sub checkOverlap {
+ my ($w1xMin, $w1yMin, $w1xMax, $w1yMax, $w2xMin, $w2yMin, $w2xMax, $w2yMax) = @_ ;
+
+ my $result = 1 ;
+
+ if ($w1xMin > $w2xMax) { $result = 0 ; }
+ if ($w2xMin > $w1xMax) { $result = 0 ; }
+ if ($w1yMin > $w2yMax) { $result = 0 ; }
+ if ($w2yMin > $w1yMax) { $result = 0 ; }
+
+ return $result ;
+}
+
+#######
+# links
+#######
+
+sub picLinkMapnik {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $zoom = shift ;
+ my (@res) = tileNumber ($lon, $lat, $zoom) ;
+ my $link = "<img src=\"http://tile.openstreetmap.org/" . $zoom . "/" . $res[0] . "/" . $res[1] . ".png\">" ;
+ return ($link) ;
+}
+
+sub picLinkOsmarender {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $zoom = shift ;
+ my (@res) = tileNumber ($lon, $lat, $zoom) ;
+ my $link = "<img src=\"http://tah.openstreetmap.org/Tiles/tile/" . $zoom . "/" . $res[0] . "/" . $res[1] . ".png\">" ;
+ return ($link) ;
+}
+
+
+
+sub osmLink {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $zoom = shift ;
+ my $string = "<A HREF=\"http://www.openstreetmap.org/?mlat=" . $lat . "&mlon=" . $lon . "&zoom=" . $zoom . "\">OSM</A>" ;
+ return ($string) ;
+}
+
+sub osmLinkMarkerWay {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $zoom = shift ;
+ my $way = shift ;
+ my $string = "<A HREF=\"http://www.openstreetmap.org/?mlat=" . $lat . "&mlon=" . $lon . "&zoom=" . $zoom . "&way=" . $way . "\">OSM marked</A>" ;
+ return ($string) ;
+}
+
+sub osbLink {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $zoom = shift ;
+ my $string = "<A HREF=\"http://openstreetbugs.schokokeks.org/?lon=" . $lon . "&lat=" . $lat . "&zoom=" . $zoom . "\">OSB</A>" ;
+ return ($string) ;
+}
+
+sub mapCompareLink {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $zoom = shift ;
+ my $string = "<A HREF=\"http://tools.geofabrik.de/mc/?mt0=mapnik&mt1=tah&lon=" . $lon . "&lat=" . $lat . "&zoom=" . $zoom . "\">mapcompare</A>" ;
+ return ($string) ;
+}
+
+sub josmLink {
+#
+# DON'T USE ANY LONGER
+#
+ my $lon = shift ;
+ my $lat = shift ;
+ my $span = shift ;
+ my $way = shift ;
+ my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
+ my $temp = $lon - $span ;
+ $string = $string . "left=" . $temp ;
+ $temp = $lon + $span ;
+ $string = $string . "&right=" . $temp ;
+ $temp = $lat + $span ;
+ $string = $string . "&top=" . $temp ;
+ $temp = $lat - $span ;
+ $string = $string . "&bottom=" . $temp ;
+ $string = $string . "&select=way" . $way ;
+ $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
+ return ($string) ;
+}
+
+sub josmLinkDontSelect {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $span = shift ;
+ my $way = shift ;
+ my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
+ my $temp = $lon - $span ;
+ $string = $string . "left=" . $temp ;
+ $temp = $lon + $span ;
+ $string = $string . "&right=" . $temp ;
+ $temp = $lat + $span ;
+ $string = $string . "&top=" . $temp ;
+ $temp = $lat - $span ;
+ $string = $string . "&bottom=" . $temp ;
+ $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
+ return ($string) ;
+}
+
+sub josmLinkSelectWay {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $span = shift ;
+ my $way = shift ;
+ my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
+ my $temp = $lon - $span ;
+ $string = $string . "left=" . $temp ;
+ $temp = $lon + $span ;
+ $string = $string . "&right=" . $temp ;
+ $temp = $lat + $span ;
+ $string = $string . "&top=" . $temp ;
+ $temp = $lat - $span ;
+ $string = $string . "&bottom=" . $temp ;
+ $string = $string . "&select=way" . $way ;
+ $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
+ return ($string) ;
+}
+
+sub josmLinkSelectWays {
+ my ($lon, $lat, $span, @ways) = @_ ;
+ my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
+ my $temp = $lon - $span ;
+ $string = $string . "left=" . $temp ;
+ $temp = $lon + $span ;
+ $string = $string . "&right=" . $temp ;
+ $temp = $lat + $span ;
+ $string = $string . "&top=" . $temp ;
+ $temp = $lat - $span ;
+ $string = $string . "&bottom=" . $temp ;
+ $string = $string . "&select=way" . $ways[0] ;
+ if (scalar @ways > 1) {
+ my $i ;
+ for ($i=1; $i < scalar @ways; $i++) {
+ $string = $string . ",way" . $ways[$i] ;
+ }
+ }
+ $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
+ return ($string) ;
+}
+
+sub josmLinkSelectNode {
+ my $lon = shift ;
+ my $lat = shift ;
+ my $span = shift ;
+ my $node = shift ;
+ my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
+ my $temp = $lon - $span ;
+ $string = $string . "left=" . $temp ;
+ $temp = $lon + $span ;
+ $string = $string . "&right=" . $temp ;
+ $temp = $lat + $span ;
+ $string = $string . "&top=" . $temp ;
+ $temp = $lat - $span ;
+ $string = $string . "&bottom=" . $temp ;
+ $string = $string . "&select=node" . $node ;
+ $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
+ return ($string) ;
+}
+
+sub josmLinkSelectNodes {
+ my ($lon, $lat, $span, @nodes) = @_ ;
+ my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
+ my $temp = $lon - $span ;
+ $string = $string . "left=" . $temp ;
+ $temp = $lon + $span ;
+ $string = $string . "&right=" . $temp ;
+ $temp = $lat + $span ;
+ $string = $string . "&top=" . $temp ;
+ $temp = $lat - $span ;
+ $string = $string . "&bottom=" . $temp ;
+ $string = $string . "&select=node" . $nodes[0] ;
+ if (scalar @nodes > 1) {
+ my $i ;
+ for ($i=1; $i < scalar @nodes; $i++) {
+ $string = $string . ",node" . $nodes[$i] ;
+ }
+ }
+ $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
+ return ($string) ;
+}
+
+
+sub analyzerLink {
+ my $id = shift ;
+
+ my $result = "<A HREF=\"http://betaplace.emaitie.de/webapps.relation-analyzer/analyze.jsp?relationId=" . $id . "\">" . $id . "</A>" ;
+ return $result ;
+}
+
+
+#####
+# GPX
+#####
+
+sub printGPXHeader {
+ my $file = shift ;
+
+ print $file "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?>\n" ;
+ print $file "<gpx xmlns=\"http://www.topografix.com/GPX/1/1\" creator=\"Gary68script\" version=\"1.1\"\n" ;
+ print $file " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"\n" ;
+ print $file " xsi:schemaLocation=\"http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd\">\n" ;
+}
+
+
+
+
+sub printGPXFoot {
+ my $file = shift ;
+
+ print $file "</gpx>\n" ;
+}
+
+
+
+
+sub printGPXWaypoint {
+ my ($file, $lon, $lat, $text) = @_ ;
+
+ print $file "<wpt lat=\"", $lat, "\" lon=\"", $lon, "\">" ;
+ print $file "<desc>", $text, "</desc></wpt>\n" ;
+}
+
+#######
+
+# other
+#######
+
+sub stringTimeSpent {
+ my $timeSpent = shift ;
+ my $string ;
+ $string = ($timeSpent/(60*60))%99 . " hours, " . ($timeSpent/60)%60 . " minutes and " . $timeSpent%60 . " seconds" ;
+ return ($string) ;
+}
+
+sub binSearch {
+ my ($find, $aRef) = @_ ;
+
+ my ($lower, $upper) = (0, @$aRef - 1) ;
+
+ my $result ;
+
+ while ($upper >= $lower) {
+ $result = int( ($lower + $upper) / 2) ;
+ if ($aRef->[$result] < $find) {
+ $lower = $result + 1 ;
+ }
+ elsif ($aRef->[$result] > $find) {
+ $upper = $result - 1 ;
+ }
+ else {
+ return ($result) ;
+ }
+ }
+ return (-1) ;
+}
+
+sub printProgress {
+ my $program = shift ;
+ my $osm = shift ;
+ my $startTime = shift ;
+ my $fullCount = shift ;
+ my $actualCount = shift ;
+
+ my ($percent) = $actualCount / $fullCount * 100 ;
+ my ($time_spent) = (time() - $startTime) / 3600 ;
+ my ($tot_time) = $time_spent / $actualCount * $fullCount ;
+ my ($to_go) = $tot_time - $time_spent ;
+ printf STDERR "$program - file: %s %d/100 Ttot=%2.1fhrs Ttogo=%2.1fhrs \n", $osm, $percent, $tot_time, $to_go ;
+}
+
+
+######
+# html
+######
+
+sub printHTMLiFrameHeader {
+ my $file = shift ;
+ my $title = shift ;
+ print $file "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"";
+ print $file " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">";
+ print $file "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">\n";
+ print $file "<head><title>", $title, "</title>\n";
+ print $file "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />\n";
+ print $file "</head>\n";
+ print $file "<iframe style=\"display:none\" id=\"hiddenIframe\" name=\"hiddenIframe\"></iframe>\n" ;
+ print $file "<body>\n";
+ return (1) ;
+}
+
+sub printHTMLHeader {
+ my $file = shift ;
+ my $title = shift ;
+ print $file "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"";
+ print $file " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">";
+ print $file "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">\n";
+ print $file "<head><title>", $title, "</title>\n";
+ print $file "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />\n";
+ print $file "</head>\n<body>\n";
+ return (1) ;
+}
+
+sub printHTMLFoot {
+ my $file = shift ;
+ print $file "</body>\n</html>\n" ;
+ return (1) ;
+}
+
+sub printWayList {
+ my ($file, @list) = @_ ;
+ print $file "<table border=\"1\">\n";
+ print $file "<tr>\n" ;
+ print $file "<th>Line</th>\n" ;
+ print $file "<th>WayId</th>\n" ;
+ print $file "</tr>\n" ;
+
+ my $i = 0 ;
+ foreach (@list) {
+ $i++ ;
+ print $file "<tr><td>$i</td><td>", historyLink ("way", $_) , "</td></tr>\n" ;
+ }
+
+ print $file "</table>\n";
+}
+
+sub printNodeList {
+ my ($file, @list) = @_ ;
+ print $file "<table border=\"1\">\n";
+ print $file "<tr>\n" ;
+ print $file "<th>Line</th>\n" ;
+ print $file "<th>NodeId</th>\n" ;
+ print $file "</tr>\n" ;
+
+ my $i = 0 ;
+ foreach (@list) {
+ $i++ ;
+ print $file "<tr><td>$i</td><td>", historyLink ("node", $_) , "</td></tr>\n" ;
+ }
+
+ print $file "</table>\n";
+}
+
+sub printHTMLTableHead {
+ my ($file) = shift ;
+ print $file "<table border=\"1\">\n" ;
+}
+
+sub printHTMLTableFoot {
+ my ($file) = shift ;
+ print $file "</table>\n" ;
+}
+
+sub printHTMLTableHeadings {
+ my ($file, @list) = @_ ;
+ print $file "<tr>\n" ;
+ foreach (@list) { print $file "<th>" . $_ . "</th>\n" ; }
+ print $file "</tr>\n" ;
+}
+
+sub printHTMLTableRowLeft {
+ my ($file, @list) = @_ ;
+ print $file "<tr>\n" ;
+ foreach (@list) { print $file "<td align=\"left\">" . $_ . "</td>\n" ; }
+ print $file "</tr>\n" ;
+}
+
+sub printHTMLTableRowRight {
+ my ($file, @list) = @_ ;
+ print $file "<tr>\n" ;
+ foreach (@list) { print $file "<td align=\"right\">" . $_ . "</td>\n" ; }
+ print $file "</tr>\n" ;
+}
+
+sub printHTMLCellLeft {
+ my ($file) = shift ;
+ my ($value) = shift ;
+ print $file "<td align=\"left\">" . $value . "</td>\n" ;
+}
+
+sub printHTMLCellLeftEM {
+ my ($file) = shift ;
+ my ($value) = shift ;
+ print $file "<td align=\"left\"><em>" . $value . "</em></td>\n" ;
+}
+
+sub printHTMLCellLeftTwoValues {
+ my ($file) = shift ;
+ my ($value1) = shift ;
+ my ($value2) = shift ;
+ print $file "<td align=\"left\">" . $value1 . "<br><em>" . $value2 . "</em></td>\n" ;
+}
+
+
+
+sub printHTMLCellCenter {
+ my ($file) = shift ;
+ my ($value) = shift ;
+ print $file "<td align=\"center\">" . $value . "</td>\n" ;
+}
+
+sub printHTMLCellRight {
+ my ($file) = shift ;
+ my ($value) = shift ;
+ print $file "<td align=\"right\">" . $value . "</td>\n" ;
+}
+
+sub printHTMLRowStart {
+ my ($file) = shift ;
+ print $file "<tr>\n" ;
+}
+
+sub printHTMLRowEnd {
+ my ($file) = shift ;
+ print $file "</tr>\n" ;
+}
+
+sub printHTMLiFrame {
+ my ($file) = shift ;
+ print $file "<iframe style=\"display:none\" id=\"hiddenIframe\" name=\"hiddenIframe\"></iframe>\n" ;
+}
+
+sub getBugs {
+ my ($lon, $lat, $bugsDownDist, $bugsMaxDist) = @_ ;
+ my $resultString = "" ;
+ my ($x1, $y1, $x2, $y2 ) ;
+ my %lon = () ;
+ my %lat = () ;
+ my %text = () ;
+ my %open = () ;
+ my %user = () ;
+
+ $x1 = $lon - $bugsDownDist ;
+ $x2 = $lon + $bugsDownDist ;
+ $y1 = $lat - $bugsDownDist ;
+ $y2 = $lat + $bugsDownDist ;
+ #print "get bugs $x1, $y1, $x2, $y2...\n" ;
+
+ sleep 1.5 ;
+ my ($url) = 'http://openstreetbugs.appspot.com/getBugs?b=' . $y1 . '&t=' . $y2 . '&l=' . $x1 . '&r=' . $x2 ;
+ my ($content) = get $url ;
+ if (!defined $content) {
+ $resultString = "bugs request error<br>" ;
+ }
+ else {
+ # process string
+ #print "CONTENT\n", $content, "\n\n" ;
+ open my $sh, '<', \$content or die $!;
+ while (<$sh>) {
+ my $line = $_ ;
+ #print "actual line: $line\n" ;
+ my ($id) = ($line =~ /^putAJAXMarker\((\d+),/) ;
+ my ($text) = ($line =~ /^.*\"([-\w\W\d\D\s\']+)\"/) ;
+ my ($user) = ($line =~ /^.*\[([-\w\W\d\D\s\']+)\]/) ;
+ my ($lon, $lat) = ($line =~ /,([-]?[\d]+\.[\d]+),([-]?[\d]+\.[\d]+)/);
+ my ($open) = ($line =~ /.*(\d)\);$/) ;
+ if (!$user) { $user = "-" ; }
+ #print "\nfields found: $id $text $user $lon $lat $open\n\n" ;
+ $text =~ s/<hr \/>/:::/g ; # replace <HR /> horizontal rulers by ":::"
+ $lon{$id} = $lon;
+ $lat{$id} = $lat ;
+ $text{$id} = $text ;
+ if ($open == 0) { $open{$id} = "OPEN" ; } else { $open{$id} = "CLOSED" ; }
+ $user{$id} = $user ;
+
+ }
+ close $sh or die $!;
+ my $id ;
+ foreach $id (keys %lon) {
+ my ($d) = distance ($lon, $lat, $lon{$id}, $lat{$id}) ;
+ #print "check id: $id, distance: $d", , "\n" ;
+ if ($d < $bugsMaxDist) {
+ $d = int ($d * 1000) ;
+ $resultString = $resultString . "<strong>" . $open{$id} . "</strong>" . " (" . $d . "m)<br>" ;
+ $resultString = $resultString . $text{$id} . "<br>" ;
+ }
+ }
+ }
+
+ #print "$resultString\n\n" ;
+ return $resultString ;
+}
+
+
+sub APIgetWay {
+#
+# wayId == 0 returned if error
+#
+ my ($wayId) = shift ;
+
+ my $content ;
+ my $url ;
+ my $try = 0 ;
+ my $wayUser = "" ;
+ my @wayNodes = () ;
+ my @wayTags = () ;
+
+ #print "\nAPI request for way $wayId\n" ;
+
+ while ( (!defined($content)) and ($try < 4) ) {
+ $url = $apiUrl . "way/" . $wayId ;
+ $content = get $url ;
+ $try++ ;
+ }
+
+ #print "API result:\n$content\n\n" ;
+
+ if (!defined $content) {
+ print "ERROR: error receiving OSM query result for way $wayId\n" ;
+ $wayId = 0 ;
+ $content = "" ;
+ }
+ if (grep(/<error>/, $content)) {
+ print "ERROR: invalid OSM query result for way $wayId\n" ;
+ $wayId = 0 ;
+ }
+
+ if (defined $content) {
+ # parse $content
+ if ($wayId != 0) {
+ my (@lines) = split /\n/, $content ;
+ foreach my $line (@lines) {
+ if (grep /<way id/, $line ) {
+ my ($u) = ($line =~ /^.+user=[\'\"](.*)[\'\"]/) ;
+ if (defined $u) { $wayUser = $u ; }
+ }
+ if (grep /<nd ref/, $line ) {
+ my ($node) = ($line =~ /^\s*\<nd ref=[\'\"](\d+)[\'\"]/) ;
+ if (defined $node) { push @wayNodes, $node ; }
+ }
+ if (grep /<tag k=/, $line ) {
+ my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
+ if ( (defined $k) and (defined $v) ) { push @wayTags, [$k, $v] ; }
+ }
+ }
+ }
+
+
+ }
+
+ #print "\nAPI result:\n$wayId\nNodes: @wayNodes\nTags: " ;
+ #foreach my $t (@wayTags) { print "$t->[0]:$t->[1] \n" ; }
+
+ return ($wayId, $wayUser, \@wayNodes, \@wayTags) ;
+}
+
+# -------------------------------------------------------------------------------
+
+sub applyDiffFile {
+ my ($dbName, $fileName) = @_ ;
+ my $mode = "" ;
+ my $object = "" ;
+ my ($propRef, $tagRef, $nodeRef, $memberRef) ;
+ my $nodeCount = 0 ;
+ my $wayCount = 0 ;
+ my $relationCount = 0 ;
+
+ open ($file, "<", $fileName) or die ("ERROR: could not open diff file $fileName\n") ;
+ dbConnect ($dbName) ;
+
+ $line = <$file> ;
+ $line = <$file> ;
+ $line = <$file> ;
+ while ( ! grep /<\/osmchange/i, $line) {
+ ($mode) = ( $line =~ /<(.+)>/ ) ;
+ $line = <$file> ;
+ # print "MODE: $mode\n" ;
+ while ( ! grep /<\/$mode>/i, $line) {
+ if (grep /<node/i, $line) {
+ $nodeCount++ ;
+ ($propRef, $tagRef) = getNode3() ;
+ my $id = $$propRef{"id"} ;
+ if ( ($mode eq "delete") or ($mode eq "modify") ) {
+ deleteDBNode ($id) ;
+ # print " deleting node $id\n" ;
+ }
+ if ( ($mode eq "modify") or ($mode eq "create") ) {
+ storeDBNode ($propRef, $tagRef) ;
+ # print " storing node $id\n" ;
+ }
+ }
+ if (grep /<way/i, $line) {
+ $wayCount++ ;
+ ($propRef, $nodeRef, $tagRef) = getWay3() ;
+
+ my $id = $$propRef{"id"} ;
+ if ( ($mode eq "delete") or ($mode eq "modify") ) {
+ deleteDBWay ($id) ;
+ # print " deleting way $id\n" ;
+ }
+ if ( ($mode eq "modify") or ($mode eq "create") ) {
+ storeDBWay ($propRef, $nodeRef, $tagRef) ;
+ # print " storing way $id\n" ;
+ }
+ }
+ if (grep /<relation/i, $line) {
+ $relationCount++ ;
+ ($propRef, $memberRef, $tagRef) = getRelation3() ;
+ my $id = $$propRef{"id"} ;
+ if ( ($mode eq "delete") or ($mode eq "modify") ) {
+ deleteDBRelation ($id) ;
+ # print " deleting relation $id\n" ;
+ }
+ if ( ($mode eq "modify") or ($mode eq "create") ) {
+ storeDBRelation ($propRef, $memberRef, $tagRef) ;
+ # print " storing relation $id\n" ;
+ }
+ }
+ }
+ $line = <$file> ; # end of mode
+ }
+
+ dbDisconnect () ;
+ close ($file) ;
+
+ print "$nodeCount nodes processed.\n" ;
+ print "$wayCount ways processed.\n" ;
+ print "$relationCount relations processed.\n" ;
+}
+
+# -----------------------------------------------------------------------------------------------------
+
+sub convertToLatex {
+ my $text = shift ;
+
+ my %validLatex = () ;
+ my %replaceLatex = () ;
+
+ $replaceLatex{'_'} = '\\_' ;
+ $replaceLatex{'&'} = '\\&' ;
+ $replaceLatex{'$'} = '\\$' ;
+ $replaceLatex{'%'} = '\\%' ;
+ $replaceLatex{'{'} = '\\{' ;
+ $replaceLatex{'}'} = '\\}' ;
+ $replaceLatex{'#'} = '\\#' ;
+
+ $replaceLatex{'^'} = "\\textasciicircum " ;
+ $replaceLatex{'\\'} = "\\textbackslash " ;
+
+ foreach my $c (0..9) {
+ $validLatex{$c} = 1 ;
+ }
+ foreach my $c ("a".."z") {
+ $validLatex{$c} = 1 ;
+ }
+ foreach my $c ("A".."Z") {
+ $validLatex{$c} = 1 ;
+ }
+ foreach my $c ( qw (! + * - : . ; § / = ? ) ) {
+ $validLatex{$c} = 1 ;
+ }
+ foreach my $c ( ' ', '"', "\'", '(', ')', '[', ']', ',' ) {
+ $validLatex{$c} = 1 ;
+ }
+
+ $validLatex{"\t"} = 1 ;
+ ($text) = ($text =~ /^(.*)$/ ) ;
+
+ my $out = "" ;
+ my @chars ;
+ @chars = split //, $text ;
+
+ for (my $i=0; $i<=$#chars; $i++) {
+ my $c = $chars[$i] ;
+ # print "$c ", ord ($c), "\n" ;
+ if (defined $validLatex{$c}) {
+ $out .= $c ;
+ }
+ elsif (defined $replaceLatex{$c}) {
+ $out .= $replaceLatex{$c} ;
+ }
+ else {
+ if ( ($i < $#chars) and ($c eq chr (195)) ) {
+ my $found = 0 ;
+ foreach my $c2 (164, 182, 188, 132, 150, 156, 159) {
+ if ($chars[$i+1] eq chr($c2)) {
+ $found = 1 ;
+ }
+ }
+ if ($found) {
+ $out .= $c . $chars[$i+1] ;
+ $i++ ;
+ }
+ }
+ if ( ($i < $#chars) and ($c eq chr (194)) ) {
+ if ( ord $chars[$i+1] == 176 ) {
+ $out .= '$^{\\circ }$' ;
+ $i++ ;
+ }
+ }
+ }
+ }
+
+ return $out ;
+
+}
+
+
+sub replaceHTMLCode {
+ my $text = shift ;
+
+ ($text) = ($text =~ /^(.*)$/ ) ;
+
+ $text =~ s/\'/\'/g ;
+ $text =~ s/\"/\'/g ;
+ $text =~ s/\&/\&/g ;
+
+ return $text ;
+}
+
+
+1 ;
+
+
diff --git a/osmDB.pm b/osmDB.pm
new file mode 100755
index 0000000..fd2c6ff
--- /dev/null
+++ b/osmDB.pm
@@ -0,0 +1,839 @@
+#
+#
+#
+#
+#
+# Copyright (C) 2010, Gerhard Schwanz
+#
+# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
+#
+
+# requires osmdb.ini file in program directory for credentials containing two information
+#
+# user=NAME
+# password=PASSWORD
+#
+
+
+# TODO
+#
+# db size
+#
+#
+
+
+package OSM::osmDB ;
+
+my $DBuser = "" ; # to be read from ini file
+my $DBpassword = "" ;
+
+my $tempDir = "/tmp" ;
+
+use strict ;
+use warnings ;
+
+use DBI ;
+use OSM::osm ;
+
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION = '1.0' ;
+
+require Exporter ;
+
+ at ISA = qw ( Exporter AutoLoader ) ;
+
+ at EXPORT = qw ( bulkLoad
+ dbConnect
+ dbDisconnect
+ deleteDBNode
+ deleteDBWay
+ deleteDBRelation
+ getDBNode
+ getDBWay
+ getDBWayNodesCoords
+ getDBRelation
+ getTag
+ initTableNodes
+ initTableWays
+ initTableRelations
+ loopInitNodes
+ loopGetNextNode
+ loopInitRelations
+ loopGetNextRelation
+ loopInitWays
+ loopGetNextWay
+ printMaxValues
+ storeDBNode
storeDBWay
storeDBRelation
) ;
+
+
+my $dbh ;
+my $sthLoopNodes ;
+my $sthLoopWays ;
+my $sthLoopRelations ;
+
+my $maxK = 0 ;
+my $maxV = 0 ;
+
+# ----------------------------------------------------------------------------
+
+sub deleteDBNode {
+ my $id = shift ;
+ $dbh->do("DELETE FROM nodes WHERE id = $id") ;
+ $dbh->do("DELETE FROM nodetags WHERE id = $id") ;
+}
+
+sub deleteDBWay {
+ my $id = shift ;
+ $dbh->do("DELETE FROM ways WHERE id = $id") ;
+ $dbh->do("DELETE FROM waytags WHERE id = $id") ;
+ $dbh->do("DELETE FROM waynodes WHERE id = $id") ;
+}
+
+sub deleteDBRelation {
+ my $id = shift ;
+ $dbh->do("DELETE FROM relations WHERE id = $id") ;
+ $dbh->do("DELETE FROM relationtags WHERE id = $id") ;
+ $dbh->do("DELETE FROM relationmembers WHERE id = $id") ;
+}
+
+# ----------------------------------------------------------------------------
+
+
+
+sub storeDBNode {
+ my ($aRef0, $aRef1) = @_ ;
+ my %nodeProperties = %$aRef0 ;
+ my @nodeTags = @$aRef1 ;
+
+ my $id = $nodeProperties{'id'} ;
+ my $lon = $nodeProperties{'lon'} ;
+ my $lat = $nodeProperties{'lat'} ;
+ my $user = $nodeProperties{'user'} ;
+ my $version = $nodeProperties{'version'} ;
+ my $timestamp = $nodeProperties{'timestamp'} ;
+ my $uid = $nodeProperties{'uid'} ;
+ my $changeset = $nodeProperties{'changeset'} ;
+
+ $dbh->do("INSERT INTO nodes (id, lon, lat, user, version, timestamp, uid, changeset) VALUES ($id, $lon, $lat, '$user', $version, '$timestamp', $uid, $changeset)") ;
+
+ my $nodeId = $nodeProperties{'id'} ;
+ foreach my $t (@nodeTags) {
+ my $k = $t->[0] ;
+ my $v = $t->[1] ;
+ if (length $k > $maxK) { $maxK = length $k ; }
+ if (length $v > $maxV) { $maxV = length $v ; }
+ $dbh->do("INSERT INTO nodetags (id, k, v) VALUES ($nodeId, '$k', '$v')") ;
+ }
+}
+
+sub storeDBWay {
+ my ($aRef0, $aRef1, $aRef2) = @_ ;
+ my %wayProperties = %$aRef0 ;
+ my @wayNodes = @$aRef1 ;
+ my @wayTags = @$aRef2 ;
+
+ my $id = $wayProperties{'id'} ;
+ my $user = $wayProperties{'user'} ;
+ my $version = $wayProperties{'version'} ;
+ my $timestamp = $wayProperties{'timestamp'} ;
+ my $uid = $wayProperties{'uid'} ;
+ my $changeset = $wayProperties{'changeset'} ;
+
+ $dbh->do("INSERT INTO ways (id, user, version, timestamp, uid, changeset) VALUES ($id, '$user', $version, '$timestamp', $uid, $changeset)") ;
+
+ my $wayId = $wayProperties{'id'} ;
+ foreach my $t (@wayTags) {
+ my $k = $t->[0] ;
+ my $v = $t->[1] ;
+ if (length $k > $maxK) { $maxK = length $k ; }
+ if (length $v > $maxV) { $maxV = length $v ; }
+ $dbh->do("INSERT INTO waytags (id, k, v) VALUES ($wayId, '$k', '$v')") ;
+ }
+
+ my $i = 0 ;
+ foreach my $n (@wayNodes) {
+ $dbh->do("INSERT INTO waynodes (id, s, nodeid) VALUES ($wayId, $i, $n)") ;
+ $i++ ;
+ }
+}
+
+
+sub storeDBRelation {
+ my ($aRef0, $aRef1, $aRef2) = @_ ;
+ my %relationProperties = %$aRef0 ;
+ my @relationMembers = @$aRef1 ;
+ my @relationTags = @$aRef2 ;
+
+ my $id = $relationProperties{'id'} ;
+ my $user = $relationProperties{'user'} ;
+ my $version = $relationProperties{'version'} ;
+ my $timestamp = $relationProperties{'timestamp'} ;
+ my $uid = $relationProperties{'uid'} ;
+ my $changeset = $relationProperties{'changeset'} ;
+ $dbh->do("INSERT INTO relations (id, user, version, timestamp, uid, changeset) VALUES ($id, '$user', $version, '$timestamp', $uid, $changeset)") ;
+
+ my $relationId = $relationProperties{'id'} ;
+ foreach my $t (@relationTags) {
+ my $k = $t->[0] ;
+ my $v = $t->[1] ;
+ if (length $k > $maxK) { $maxK = length $k ; }
+ if (length $v > $maxV) { $maxV = length $v ; }
+ $dbh->do("INSERT INTO relationtags (id, k, v) VALUES ($relationId, '$k', '$v')") ;
+ }
+
+ my $i = 0 ;
+ foreach my $m (@relationMembers) {
+ my $type = $m->[0] ;
+ my $mid = $m->[1] ;
+ my $role = $m->[2] ;
+ $dbh->do("INSERT INTO relationmembers (id, s, type, memberid, role) VALUES ($relationId, $i, '$type', $mid, '$role')") ;
+ $i++ ;
+ }
+}
+
+sub printMaxValues {
+ print "\nmax key length = $maxK\n" ;
+ print "max val length = $maxV\n\n" ;
+}
+
+
+# ----------------------------------------------------------------------------
+
+sub loopInitNodes {
+ my ($k, $v) = @_ ;
+ my $kq = "" ;
+ my $vq = "" ;
+ my $and = "" ;
+
+ if (defined $k) { $kq = " k = '$k'" ; }
+ if (defined $v) { $vq = " v = '$v'" ; }
+
+ if ( (defined $k) and (defined $v) ) {
+ $and = " AND " ;
+ }
+
+ if ( (! defined $k) and (! defined $v) ) {
+ $sthLoopNodes = $dbh->prepare("SELECT id FROM nodes ORDER BY id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ }
+ else {
+ my $q = "SELECT id from nodetags WHERE $kq $and $vq ORDER BY id" ;
+ $sthLoopNodes = $dbh->prepare("$q") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ }
+
+ $sthLoopNodes->execute() or die "Couldn't execute statement: " . $sthLoopNodes->errstr ;
+}
+
+sub loopGetNextNode {
+ my $id = undef ;
+ my @data ;
+ if (@data = $sthLoopNodes->fetchrow_array()) {
$id = $data[0] ;
+ }
+ else {
+ $sthLoopNodes->finish ;
+ $id = undef ;
+ }
+ return $id ;
+}
+
+sub loopInitWays {
+ my ($k, $v) = @_ ;
+ my $kq = "" ;
+ my $vq = "" ;
+ my $and = "" ;
+
+ if (defined $k) { $kq = " k = '$k'" ; }
+ if (defined $v) { $vq = " v = '$v'" ; }
+
+ if ( (defined $k) and (defined $v) ) {
+ $and = " AND " ;
+ }
+
+ if ( (! defined $k) and (! defined $v) ) {
+ $sthLoopWays = $dbh->prepare("SELECT id FROM ways ORDER BY id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ }
+ else {
+ my $q = "SELECT id from waytags WHERE $kq $and $vq ORDER BY id" ;
+ $sthLoopWays = $dbh->prepare("$q") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ }
+
+ $sthLoopWays->execute() or die "Couldn't execute statement: " . $sthLoopWays->errstr ;
+}
+
+sub loopGetNextWay {
+ my $id = undef ;
+ my @data ;
+ if (@data = $sthLoopWays->fetchrow_array()) {
$id = $data[0] ;
+ }
+ else {
+ $sthLoopWays->finish ;
+ $id = undef ;
+ }
+ return $id ;
+}
+
+sub loopInitRelations {
+ my ($k, $v) = @_ ;
+ my $kq = "" ;
+ my $vq = "" ;
+ my $and = "" ;
+
+ if (defined $k) { $kq = " k = '$k'" ; }
+ if (defined $v) { $vq = " v = '$v'" ; }
+
+ if ( (defined $k) and (defined $v) ) {
+ $and = " AND " ;
+ }
+
+ if ( (! defined $k) and (! defined $v) ) {
+ $sthLoopRelations = $dbh->prepare("SELECT id FROM relations ORDER BY id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ }
+ else {
+ my $q = "SELECT id from relationtags WHERE $kq $and $vq ORDER BY id" ;
+ $sthLoopRelations = $dbh->prepare("$q") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ }
+
+ $sthLoopRelations->execute() or die "Couldn't execute statement: " . $sthLoopRelations->errstr ;
+}
+
+sub loopGetNextRelation {
+ my $id = undef ;
+ my @data ;
+ if (@data = $sthLoopRelations->fetchrow_array()) {
$id = $data[0] ;
+ }
+ else {
+ $sthLoopRelations->finish ;
+ $id = undef ;
+ }
+ return $id ;
+}
+
+
+# ----------------------------------------------------------------------------
+
+
+sub getTag {
+ my ($type, $id, $key) = @_ ;
+ my $tag = undef ;
+
+ my $tableName = "" ;
+ if ($type eq "node") { $tableName = "nodetags" ; }
+ if ($type eq "way") { $tableName = "waytags" ; }
+ if ($type eq "relation") { $tableName = "relationtags" ; }
+
+ if ($tableName ne "") {
+ my $sth = $dbh->prepare("SELECT v FROM $tableName WHERE id = $id AND k='$key'") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ my @data ;
+ $sth->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ while (@data = $sth->fetchrow_array()) {
+ $tag = $data[0] ;
+ }
+ $sth->finish ;
+ }
+ return $tag ;
+}
+
+sub getDBWayNodesCoords {
+ my $wayId = shift ;
+ my %lon = () ;
+ my %lat = () ;
+
+ my $sth = $dbh->prepare("SELECT nodes.id,lon,lat FROM waynodes, nodes WHERE waynodes.id=$wayId AND waynodes.nodeid=nodes.id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ my @data ;
+ $sth->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ while (@data = $sth->fetchrow_array()) {
my $id = $data[0] ;
+ my $lo = $data[1] ;
+ my $la = $data[2] ;
+ $lon{$id} = $lo ;
+ $lat{$id} = $la ;
+ }
+
+ return (\%lon, \%lat) ;
+}
+
+sub getDBNode {
+ my $id = shift ;
+
+ my $user = undef ;
+ my $lon = undef ;
+ my $lat = undef ;
+ my $version = "0" ;
+ my $timestamp = "" ;
+ my $uid = 0 ;
+ my $changeset = 0 ;
+ my @nodeTags = () ;
+ my $refTags = undef ;
+ my %properties = () ;
+ my $refProperties = undef ;
+
+ my $sth = $dbh->prepare("SELECT * FROM nodes WHERE id = $id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ my @data ;
+ $sth->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ while (@data = $sth->fetchrow_array()) {
+ $lon = $data[1] ;
+ $lat = $data[2] ;
+ $user = $data[3] ;
+ $version = $data[4] ;
+ $timestamp = $data[5] ;
+ $uid = $data[6] ;
+ $changeset = $data[7] ;
+ $properties{"user"} = $user ;
+ $properties{"lon"} = $lon ;
+ $properties{"lat"} = $lat ;
+ $properties{"version"} = $version ;
+ $properties{"timestamp"} = $timestamp ;
+ $properties{"uid"} = $uid ;
+ $properties{"changeset"} = $changeset ;
+ }
+
+ if ($sth->rows == 0) {
+ print STDERR "ERROR: node $id not found in DB.\n\n" ;
+ }
+ $sth->finish ;
+
+ my $sth2 = $dbh->prepare("SELECT * FROM nodetags WHERE id = $id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ my @tagdata;
+ $sth2->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ my @data2 ;
+ while (@data2 = $sth2->fetchrow_array()) {
+ my $k = $data2[1] ;
+ my $v = $data2[2] ;
+ push @nodeTags, [$k, $v] ;
+ }
+ $sth2->finish ;
+
+ $refTags = \@nodeTags ;
+ $refProperties = \%properties ;
+
+ return ($refProperties, $refTags) ;
+}
+
+sub getDBWay {
+ my $id = shift ;
+
+ my $user = undef ;
+ my $version = "0" ;
+ my $timestamp = "" ;
+ my $uid = 0 ;
+ my $changeset = 0 ;
+ my @wayTags = () ;
+ my @wayNodes = () ;
+ my %properties = () ;
+ my $refNodes = undef ;
+ my $refTags = undef ;
+ my $refProperties = undef ;
+
+ my $sth = $dbh->prepare("SELECT * FROM ways WHERE id = $id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ my @data ;
+ $sth->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ while (@data = $sth->fetchrow_array()) {
$user = $data[1] ;
+ $version = $data[2] ;
+ $timestamp = $data[3] ;
+ $uid = $data[4] ;
+ $changeset = $data[5] ;
+ $properties{"user"} = $user ;
+ $properties{"version"} = $version ;
+ $properties{"timestamp"} = $timestamp ;
+ $properties{"uid"} = $uid ;
+ $properties{"changeset"} = $changeset ;
+ }
+
+ if ($sth->rows == 0) {
+ print STDERR "ERROR: node $id not found in DB.\n\n" ;
+ }
+ $sth->finish ;
+
+ my $sth2 = $dbh->prepare("SELECT * FROM waytags WHERE id = $id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ $sth2->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ my @data2 ;
+ while (@data2 = $sth2->fetchrow_array()) {
+ my $k = $data2[1] ;
+ my $v = $data2[2] ;
+ push @wayTags, [$k, $v] ;
+ }
+ $sth2->finish ;
+
+ my $sth3 = $dbh->prepare("SELECT * FROM waynodes WHERE id = $id ORDER BY s") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ $sth3->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ my @data3 ;
+ while (@data3 = $sth3->fetchrow_array()) {
+ my $n = $data3[2] ;
+ push @wayNodes, $n ;
+ }
+ $sth3->finish ;
+
+ $refTags = \@wayTags ;
+ $refNodes = \@wayNodes ;
+ $refProperties = \%properties ;
+ return ($refProperties, $refNodes, $refTags) ;
+}
+
+sub getDBRelation {
+ my $id = shift ;
+
+ my $user = undef ;
+ my $version = "0" ;
+ my $timestamp = "" ;
+ my $uid = 0 ;
+ my $changeset = 0 ;
+ my @relationTags = () ;
+ my @relationMembers = () ;
+ my %properties = () ;
+ my $refMembers = undef ;
+ my $refTags = undef ;
+ my $refProperties = undef ;
+
+ my $sth = $dbh->prepare("SELECT * FROM relations WHERE id = $id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ my @data ;
+ $sth->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ while (@data = $sth->fetchrow_array()) {
$user = $data[1] ;
+ $version = $data[2] ;
+ $timestamp = $data[3] ;
+ $uid = $data[4] ;
+ $changeset = $data[5] ;
+ $properties{"user"} = $user ;
+ $properties{"version"} = $version ;
+ $properties{"timestamp"} = $timestamp ;
+ $properties{"uid"} = $uid ;
+ $properties{"changeset"} = $changeset ;
+ }
+
+ if ($sth->rows == 0) {
+ print STDERR "ERROR: node $id not found in DB.\n\n" ;
+ }
+ $sth->finish ;
+
+ my $sth2 = $dbh->prepare("SELECT * FROM relationtags WHERE id = $id") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ $sth2->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ my @data2 ;
+ while (@data2 = $sth2->fetchrow_array()) {
+ my $k = $data2[1] ;
+ my $v = $data2[2] ;
+ push @relationTags, [$k, $v] ;
+ }
+ $sth2->finish ;
+
+ my $sth3 = $dbh->prepare("SELECT * FROM relationmembers WHERE id = $id ORDER BY s") or die "Couldn't prepare statement: " . $dbh->errstr ;
+ $sth3->execute() or die "Couldn't execute statement: " . $sth->errstr ;
+ my @data3 ;
+ while (@data3 = $sth3->fetchrow_array()) {
+ my $type = $data3[2] ;
+ my $memId = $data3[3] ;
+ my $role = $data3[4] ;
+ push @relationMembers, [$type, $memId, $role] ;
+ }
+ $sth3->finish ;
+
+ $refTags = \@relationTags ;
+ $refMembers = \@relationMembers ;
+ $refProperties = \%properties ;
+ return ($refProperties, $refMembers, $refTags) ;
+}
+
+# ----------------------------------------------------------------------------
+
+sub dbConnect {
+ my $DBname = shift ;
+
+ readINI() ;
+
+ $dbh = DBI->connect("DBI:mysql:$DBname", $DBuser, $DBpassword) or die ("error connecting DB: $DBI::errstr\n") ;
+ print STDERR "successfully connected to DB $DBname\n" ;
+}
+
+
+sub dbDisconnect {
+ $dbh->disconnect() ;
+ print STDERR "DB disconnected\n" ;
+}
+
+
+
+# ----------------------------------------------------------------------------
+
+sub initTableNodes {
+ $dbh->do("DROP TABLE nodes") ;
+ $dbh->do("create table nodes ( id BIGINT, lon DOUBLE, lat DOUBLE, user VARCHAR(50), version INTEGER, timestamp VARCHAR(20), uid INTEGER, changeset INTEGER )") ;
+ $dbh->do("CREATE UNIQUE INDEX i_nodeids ON nodes (id)") ;
+
+ $dbh->do("DROP TABLE nodetags") ;
+ $dbh->do("create table nodetags (id BIGINT, k VARCHAR(50), v VARCHAR(256))") ;
+ $dbh->do("CREATE INDEX i_nodeids2 ON nodetags (id)") ;
+ $dbh->do("CREATE INDEX i_nodekeys ON nodetags (k(12))") ;
+ $dbh->do("CREATE INDEX i_nodevalues ON nodetags (v(12))") ;
+}
+
+sub initTableWays {
+ $dbh->do("DROP TABLE ways") ;
+ $dbh->do("create table ways (id BIGINT, user VARCHAR(50), version INTEGER, timestamp VARCHAR(20), uid INTEGER, changeset INTEGER)") ;
+ $dbh->do("CREATE UNIQUE INDEX i_wayids ON ways (id)") ;
+
+ $dbh->do("DROP TABLE waytags") ;
+ $dbh->do("create table waytags (id BIGINT, k VARCHAR(50), v VARCHAR(256))") ;
+ $dbh->do("CREATE INDEX i_wayids2 ON waytags (id)") ;
+ $dbh->do("CREATE INDEX i_waykeys ON waytags (k(12))") ;
+ $dbh->do("CREATE INDEX i_wayvalues ON waytags (v(12))") ;
+
+ $dbh->do("DROP TABLE waynodes") ;
+ $dbh->do("create table waynodes (id BIGINT, s INT, nodeid BIGINT)") ;
+ $dbh->do("CREATE INDEX i_wayids3 ON waynodes (id)") ;
+}
+
+sub initTableRelations {
+ $dbh->do("DROP TABLE relations") ;
+ $dbh->do("create table relations (id BIGINT, user VARCHAR(50), version INTEGER, timestamp VARCHAR(20), uid INTEGER, changeset INTEGER)") ;
+ $dbh->do("CREATE UNIQUE INDEX i_relationids ON relations (id)") ;
+
+ $dbh->do("DROP TABLE relationtags") ;
+ $dbh->do("create table relationtags (id BIGINT, k VARCHAR(50), v VARCHAR(256))") ;
+ $dbh->do("CREATE INDEX i_relationids2 ON relationtags (id)") ;
+ $dbh->do("CREATE INDEX i_relationkeys ON relationtags (k(12))") ;
+ $dbh->do("CREATE INDEX i_relationvalues ON relationtags (v(12))") ;
+
+ $dbh->do("DROP TABLE relationmembers") ;
+ $dbh->do("create table relationmembers (id BIGINT, s INT, type VARCHAR(20), memberid BIGINT, role VARCHAR(20))") ;
+ $dbh->do("CREATE INDEX i_relationids3 ON relationmembers (id)") ;
+}
+
+# --------------------------------------------------------------------------
+
+sub readINI {
+ my $file ;
+ open ($file, "<", "osmdb.ini") or die ("ERROR: could not open ./osmdb.ini\n") ;
+ my $line ;
+ while ($line = <$file>) {
+ my ($k, $v) = ( $line =~ /(.+)=(.+)/ ) ;
+ if ((defined $k) and (defined $v)) {
+ if ($k eq "password") { $DBpassword = $v ; }
+ if ($k eq "user") { $DBuser = $v ; }
+ }
+ }
+ close ($file) ;
+}
+
+# --------------------------------------------------------------------------
+
+sub bulkLoad {
+ my ($file, $dbName) = @_ ;
+ my $nodeCount = 0 ;
+ my $wayCount = 0 ;
+ my $relationCount = 0 ;
+
+ my $wayId ;
+ my $wayId2 ;
+ my $wayUser ;
+ my @wayNodes ;
+ my @wayTags ;
+ my $nodeId ;
+ my $nodeUser ;
+ my $nodeLat ;
+ my $nodeLon ;
+ my @nodeTags ;
+ my $relationId ;
+ my $relationUser ;
+ my @relationTags ;
+ my @relationMembers ;
+ my %nodeProperties ;
+ my %wayProperties ;
+ my %relationProperties ;
+ my $aRef0 ;
+ my $aRef1 ;
+ my $aRef2 ;
+
+ OSM::osm::openOsmFile ($file) ;
+
+ print STDERR "INFO: processing nodes...\n" ;
+ print STDERR "reading nodes...\n" ;
+
+ open (my $nodesFile, ">", $tempDir . "/nodes.txt") ;
+ open (my $nodetagsFile, ">", $tempDir . "/nodetags.txt") ;
+
+ ($aRef0, $aRef1) = OSM::osm::getNode3 () ;
+ if (defined $aRef0) {
+ @nodeTags = @$aRef1 ;
+ %nodeProperties = %$aRef0 ;
+ }
+
+ while (defined $aRef0) {
+ $nodeCount++ ;
+
+ print $nodesFile "$nodeProperties{'id'}\t$nodeProperties{'lon'}\t$nodeProperties{'lat'}\t" ;
+ print $nodesFile "$nodeProperties{'user'}\t$nodeProperties{'version'}\t$nodeProperties{'timestamp'}\t" ;
+ print $nodesFile "$nodeProperties{'uid'}\t$nodeProperties{'changeset'}\n" ;
+
+ my $nodeId = $nodeProperties{'id'} ;
+ foreach my $t (@nodeTags) {
+ my $k = $t->[0] ;
+ my $v = $t->[1] ;
+ print $nodetagsFile "$nodeId\t$k\t$v\n" ;
+ }
+
+ # next
+ ($aRef0, $aRef1) = OSM::osm::getNode3 () ;
+ if (defined $aRef0) {
+ @nodeTags = @$aRef1 ;
+ %nodeProperties = %$aRef0 ;
+ }
+ }
+
+ close ($nodesFile) ;
+ close ($nodetagsFile) ;
+
+ dbConnect ($dbName) ;
+ initTableNodes() ;
+ print STDERR "load nodes data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/nodes.txt' INTO TABLE nodes") ;
+ print STDERR "load nodetags data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/nodetags.txt' INTO TABLE nodetags") ;
+ dbDisconnect ($dbName) ;
+
+ `rm $tempDir/nodes.txt` ;
+ `rm $tempDir/nodetags.txt` ;
+
+ print STDERR "INFO: $nodeCount nodes processed.\n" ;
+
+ # -----------
+
+ print STDERR "INFO: processing ways...\n" ;
+ print STDERR "reading ways...\n" ;
+
+ open (my $waysFile, ">", $tempDir . "/ways.txt") ;
+ open (my $waytagsFile, ">", $tempDir . "/waytags.txt") ;
+ open (my $waynodesFile, ">", $tempDir . "/waynodes.txt") ;
+
+ ($aRef0, $aRef1, $aRef2) = OSM::osm::getWay3 () ;
+ if (defined $aRef0) {
+ %wayProperties = %$aRef0 ;
+ @wayNodes = @$aRef1 ;
+ @wayTags = @$aRef2 ;
+ }
+ while (defined $aRef0) {
+ $wayCount++ ;
+
+ print $waysFile "$wayProperties{'id'}\t" ;
+ print $waysFile "$wayProperties{'user'}\t$wayProperties{'version'}\t$wayProperties{'timestamp'}\t" ;
+ print $waysFile "$wayProperties{'uid'}\t$wayProperties{'changeset'}\n" ;
+
+ my $wayId = $wayProperties{'id'} ;
+ foreach my $t (@wayTags) {
+ my $k = $t->[0] ;
+ my $v = $t->[1] ;
+ print $waytagsFile "$wayId\t$k\t$v\n" ;
+ }
+
+ my $i = 0 ;
+ foreach my $n (@wayNodes) {
+ print $waynodesFile "$wayId\t$i\t$n\n" ;
+ $i++ ;
+ }
+
+
+ # next way
+ ($aRef0, $aRef1, $aRef2) = OSM::osm::getWay3 () ;
+ if (defined $aRef0) {
+ %wayProperties = %$aRef0 ;
+ @wayNodes = @$aRef1 ;
+ @wayTags = @$aRef2 ;
+ }
+ }
+
+ close ($waysFile) ;
+ close ($waytagsFile) ;
+ close ($waynodesFile) ;
+
+ dbConnect ($dbName) ;
+ initTableWays() ;
+ print STDERR "load ways data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/ways.txt' INTO TABLE ways") ;
+ print STDERR "load waytags data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/waytags.txt' INTO TABLE waytags") ;
+ print STDERR "load waynodes data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/waynodes.txt' INTO TABLE waynodes") ;
+ dbDisconnect ($dbName) ;
+
+ `rm $tempDir/ways.txt` ;
+ `rm $tempDir/waytags.txt` ;
+ `rm $tempDir/waynodes.txt` ;
+
+ print STDERR "INFO: $wayCount ways processed.\n" ;
+
+ # -----------
+
+ print STDERR "INFO: processing relations...\n" ;
+ print STDERR "reading relations...\n" ;
+
+ open (my $relationsFile, ">", $tempDir . "/relations.txt") ;
+ open (my $relationtagsFile, ">", $tempDir . "/relationtags.txt") ;
+ open (my $relationmembersFile, ">", $tempDir . "/relationmembers.txt") ;
+
+ ($aRef0, $aRef1, $aRef2) = OSM::osm::getRelation3 () ;
+ if (defined $aRef0) {
+ %relationProperties = %$aRef0 ;
+ @relationMembers = @$aRef1 ;
+ @relationTags = @$aRef2 ;
+ }
+
+ while (defined $aRef0) {
+ $relationCount++ ;
+
+ print $relationsFile "$relationProperties{'id'}\t" ;
+ print $relationsFile "$relationProperties{'user'}\t$relationProperties{'version'}\t$relationProperties{'timestamp'}\t" ;
+ print $relationsFile "$relationProperties{'uid'}\t$relationProperties{'changeset'}\n" ;
+
+ my $relationId = $relationProperties{'id'} ;
+ foreach my $t (@relationTags) {
+ my $k = $t->[0] ;
+ my $v = $t->[1] ;
+ print $relationtagsFile "$relationId\t$k\t$v\n" ;
+ }
+
+ my $n = 0 ;
+ foreach my $m (@relationMembers) {
+ my $t = $m->[0] ;
+ my $i = $m->[1] ;
+ my $r = $m->[2] ;
+ print $relationmembersFile "$relationId\t$n\t$t\t$i\t$r\n" ;
+ $n++ ;
+ }
+
+ #next
+ ($aRef0, $aRef1, $aRef2) = OSM::osm::getRelation3 () ;
+ if (defined $aRef0) {
+ %relationProperties = %$aRef0 ;
+ @relationMembers = @$aRef1 ;
+ @relationTags = @$aRef2 ;
+ }
+ }
+
+ close ($relationsFile) ;
+ close ($relationtagsFile) ;
+ close ($relationmembersFile) ;
+
+ dbConnect ($dbName) ;
+ initTableRelations() ;
+ print STDERR "load relations data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/relations.txt' INTO TABLE relations") ;
+ print STDERR "load relationtags data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/relationtags.txt' INTO TABLE relationtags") ;
+ print STDERR "load relationmembers data...\n" ;
+ $dbh->do("LOAD DATA LOCAL INFILE '$tempDir/relationmembers.txt' INTO TABLE relationmembers") ;
+ dbDisconnect ($dbName) ;
+
+ `rm $tempDir/relations.txt` ;
+ `rm $tempDir/relationtags.txt` ;
+ `rm $tempDir/relationmembers.txt` ;
+
+ print STDERR "INFO: $relationCount relations processed.\n" ;
+
+ OSM::osm::closeOsmFile () ;
+
+}
+
+
1 ;
diff --git a/osmgraph.pm b/osmgraph.pm
new file mode 100755
index 0000000..e4ca301
--- /dev/null
+++ b/osmgraph.pm
@@ -0,0 +1,751 @@
+#
+# PERL osmgraph module by gary68
+#
+# !!! store as osmgraph.pm in folder OSM in lib directory !!!
+#
+# This module contains a lot of useful graphic functions for working with osm files and data. This enables you (in conjunction with osm.pm)
+# to easily draw custom maps. Although not as sophisticated as Mapnik, Osmarender and KOSMOS.
+# Have a look at the last (commented) function below. It is useful for your main program!
+#
+#
+#
+#
+# Copyright (C) 2009, Gerhard Schwanz
+#
+# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
+
+#
+# USAGE
+#
+#
+# drawArea ($color, @nodes) - real world
+# drawAreaPix ($color, @nodes) - pixels
+# drawChartColumns ($lon, $lat, $offX, $offY, $sizeY, $columnWidthPix, $yMax, $color, @values)
+# drawCircleRadius ($lon, $lat, $radius, $size, $color)
+# drawCircleRadiusText ($lon, $lat, $radius, $size, $color, $text)
+# drawHead ($text, $color, $size) / size (1..5)
+# drawFoot ($text, $color, $size) / size (1..5)
+# drawLegend ($size, @entries) / size (1..5) ("t1", "col1", "t2", "col2")
+# drawNodeDot ($lon, $lat, $color, $size) / size (1..5) - real world
+# drawNodeDotPix ($lon, $lat, $color, $size) / size (1..5) - pixels
+# drawNodeCircle ($lon, $lat, $color, $size) / size (1..5) - real world
+# drawNodeCirclePix ($lon, $lat, $color, $size) / size (1..5) - pixels
+# drawRuler ($color)
+# drawTextPix ($x, $y, $text, $color, $size) / size (1..5) bottom left = (0,0)
+# drawTextPix2 ($x, $y, $text, $color, $size) / size (1..5) top left = (0,0)
+# drawTextPos ($lon, $lat, $offX, $offY, $text, $color, $size) / size (1..5)
+# drawWay ($color, $size, @nodes) / size = thickness / real world
+# drawWayPix ($color, $size, @nodes) / size = thickness / pixels
+# enableSVG ()
+# initGraph ($sizeX, $left, $bottom, $right, $top) / real world coordinates, sizeX in pixels, Y automatic
+# labelWay ($col, $size, $font, $text, $tSpan, @nodes) / size can be 0..5 (or bigger...) / $tSpan = offset to line/way
+# writeGraph ($fileName)
+# writeSVG ($fileName)
+#
+#
+# INTERNAL
+#
+# convert ($x, $y) -> ($x1, $y1) pixels in graph
+#
+# INFO
+#
+# graph top left coordinates: (0,0)
+# font size (1..5). 1 = smallest, 5 = giant
+# size for lines = pixel width / thickness
+# pass color as string, i.e. "black". list see farther down.
+#
+#
+
+package OSM::osmgraph ; #
+
+use strict ;
+use warnings ;
+
+use Math::Trig;
+use File::stat;
+use Time::localtime;
+use List::Util qw[min max] ;
+use GD ;
+use Encode ;
+
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION = '3.0' ; # PUBLISHED
+
+require Exporter ;
+
+ at ISA = qw ( Exporter AutoLoader ) ;
+
+ at EXPORT = qw ( drawArea drawAreaPix drawCircleRadius drawCircleRadiusText drawChartColumns drawHead drawFoot drawLegend drawNodeDot drawNodeDotPix drawNodeCircle drawNodeCirclePix drawRuler drawTextPix drawTextPix2 drawTextPos drawWay drawWayPix enableSVG initGraph labelWay writeGraph writeSVG) ;
+
+#
+# constants
+#
+
+my %colorHash ;
+
+@{$colorHash{"black"}} = (0, 0, 0) ;
+@{$colorHash{"darkgray"}} = (79,79,79) ;
+@{$colorHash{"gray"}} = (145, 145, 145) ;
+@{$colorHash{"lightgray"}} = (207, 207, 207) ;
+@{$colorHash{"white"}} = (255, 255, 255) ;
+
+@{$colorHash{"red"}} = (255, 0, 0) ;
+@{$colorHash{"orange"}} = (255, 165, 0) ;
+@{$colorHash{"darkorange"}} = (255, 140, 0) ;
+@{$colorHash{"tomato"}} = (255, 140, 0) ;
+@{$colorHash{"yellow"}} = (255, 255, 0) ;
+
+@{$colorHash{"blue"}} = (0, 0, 255) ;
+@{$colorHash{"lightblue"}} = (135, 206, 235) ;
+@{$colorHash{"pink"}} = (255, 105, 180) ;
+@{$colorHash{"green"}} = (0, 255, 0) ;
+@{$colorHash{"darkgreen"}} = (105, 139, 105) ;
+@{$colorHash{"lightgreen"}} = (0, 255, 127) ;
+@{$colorHash{"brown"}} = (139, 69, 19) ;
+@{$colorHash{"lightbrown"}} = (244, 164, 96) ;
+
+my %fonts ;
+$fonts{1} = gdTinyFont ;
+$fonts{2} = gdSmallFont ;
+$fonts{3} = gdMediumBoldFont ;
+$fonts{4} = gdLargeFont ;
+$fonts{5} = gdGiantFont ;
+
+#
+# variables
+#
+my $image ;
+my %color ;
+
+my ($top, $bottom, $left, $right) ; # min and max real world coordinates
+my ($sizeX, $sizeY) ; # pic size in pixels
+
+my $svgEnabled = 0 ;
+
+my @svgOutputWaysNodes = () ;
+my @svgOutputAreas = () ;
+my @svgOutputText = () ;
+my @svgOutputPixel = () ;
+my @svgOutputDef = () ;
+my @svgOutputPathText = () ;
+my $pathNumber = 0 ;
+my $svgBaseFontSize = 10 ;
+
+
+sub initGraph {
+#
+# function initializes the picture, the colors and the background (white)
+#
+ my ($x, $l, $b, $r, $t) = @_ ;
+
+ $sizeX = $x ;
+ $sizeY = $x * ($t - $b) / ($r - $l) / cos ($t/360*3.14*2) ;
+ $top = $t ;
+ $left = $l ;
+ $right = $r ;
+ $bottom = $b ;
+
+ $image = new GD::Image($sizeX, $sizeY);
+ $image->trueColor() ;
+
+ my $c ;
+ foreach $c (keys %colorHash) {
+ $color{$c} = $image->colorAllocate(@{$colorHash{$c}}) ;
+ }
+
+ $image->filledRectangle(0,0,$sizeX-1,$sizeY-1,$color{"white"}) ;
+
+}
+
+sub writeGraph {
+#
+# writes the created graph to a file
+#
+ my $fileName = shift ;
+ my $picFile ;
+
+ open ($picFile, ">", $fileName) || die ("error opening graph file") ;
+ binmode $picFile ;
+ print $picFile $image->png ;
+ close $picFile ;
+}
+
+sub convert {
+#
+# converts real world coordinates to system graph pixel coordinates
+#
+ my ($x, $y) = @_ ;
+
+ my ($x1) = int( ($x - $left) / ($right - $left) * $sizeX ) ;
+ my ($y1) = $sizeY - int( ($y - $bottom) / ($top - $bottom) * $sizeY ) ;
+
+ return ($x1, $y1) ;
+}
+
+sub drawHead {
+#
+# draws text on top left corner of the picture
+#
+ my ($text, $col, $size) = @_ ;
+ $image->string($fonts{$size}, 20, 20, encode("iso-8859-1", decode("utf8", $text)), $color{$col} ) ;
+
+ if ($svgEnabled) {
+ push @svgOutputText, svgElementText (20, 20, $text, $size, $col, "") ;
+ }
+}
+
+sub drawFoot {
+#
+# draws text on bottom left corner of the picture, below legend
+#
+ my ($text, $col, $size) = @_ ;
+ $image->string($fonts{$size}, 20, ($sizeY-20), encode("iso-8859-1", decode("utf8", $text)), $color{$col} ) ;
+
+ if ($svgEnabled) {
+ push @svgOutputText, svgElementText (20, ($sizeY-20), $text, $size, $col, "") ;
+ }
+}
+
+
+sub drawTextPos {
+#
+# draws text at given real world coordinates. however an offset can be given for not to interfere with node dot i.e.
+#
+ my ($lon, $lat, $offX, $offY, $text, $col, $size) = @_ ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+ $x1 = $x1 + $offX ;
+ $y1 = $y1 - $offY ;
+
+ $image->string($fonts{$size}, $x1, $y1, encode("iso-8859-1", decode("utf8", $text)), $color{$col}) ;
+ if ($svgEnabled) {
+ push @svgOutputText, svgElementText ($x1, $y1, $text, $size, $col, "") ;
+ }
+}
+
+
+sub drawTextPix {
+#
+# draws text at pixel position
+#
+ my ($x1, $y1, $text, $col, $size) = @_ ;
+
+ $image->string($fonts{$size}, $x1, $sizeY-$y1, encode("iso-8859-1", decode("utf8", $text)), $color{$col}) ;
+ if ($svgEnabled) {
+ push @svgOutputText, svgElementText ($x1, $sizeY-$y1, $text, $size, $col, "") ;
+ }
+}
+
+sub drawTextPix2 {
+#
+# draws text at pixel position
+#
+ my ($x1, $y1, $text, $col, $size) = @_ ;
+
+ $image->string($fonts{$size}, $x1, $y1, encode("iso-8859-1", decode("utf8", $text)), $color{$col}) ;
+ if ($svgEnabled) {
+ push @svgOutputPixel, svgElementText ($x1, $y1+9, $text, $size, $col, "") ;
+ }
+}
+
+sub drawNodeDot {
+#
+# draws node as a dot at given real world coordinates
+#
+ my ($lon, $lat, $col, $size) = @_ ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+ $image->filledEllipse($x1, $y1, $size, $size, $color{$col}) ;
+
+ if ($svgEnabled) {
+ push @svgOutputWaysNodes, svgElementCircleFilled ($x1, $y1, $size, $col) ;
+ }
+}
+
+sub drawNodeDotPix {
+#
+# draws node as a dot at given pixels
+#
+ my ($x1, $y1, $col, $size) = @_ ;
+ $image->filledEllipse($x1, $y1, $size, $size, $color{$col}) ;
+
+ if ($svgEnabled) {
+ push @svgOutputPixel, svgElementCircleFilled ($x1, $y1, $size, $col) ;
+ }
+}
+
+sub drawNodeCircle {
+#
+# draws node as a circle at given real world coordinates
+#
+ my ($lon, $lat, $col, $size) = @_ ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+
+ $image->setThickness(2) ;
+ $image->ellipse($x1, $y1, $size, $size, $color{$col}) ;
+ $image->setThickness(1) ;
+
+ if ($svgEnabled) {
+ push @svgOutputWaysNodes, svgElementCircle ($x1, $y1, $size, 2, $col) ;
+ }
+}
+
+sub drawNodeCirclePix {
+#
+# draws node as a circle at given real world coordinates
+#
+ my ($x1, $y1, $col, $size) = @_ ;
+
+ $image->setThickness(2) ;
+ $image->ellipse($x1, $y1, $size, $size, $color{$col}) ;
+ $image->setThickness(1) ;
+
+ if ($svgEnabled) {
+ push @svgOutputWaysNodes, svgElementCircle ($x1, $y1, $size, 2, $col) ;
+ }
+}
+
+sub drawCircleRadius {
+#
+# draws circle at real world coordinates with radius in meters
+#
+ my ($lon, $lat, $radius, $size, $col) = @_ ;
+ my $radX ; my $radY ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+
+ $radX = ($radius/1000) / (($right - $left) * 111.1) / cos ($top/360*3.14*2) * $sizeX ;
+ $radY = $radX ;
+ $image->setThickness($size) ;
+ $image->ellipse($x1, $y1, 2*$radX, 2*$radY, $color{$col}) ;
+ $image->setThickness(1) ;
+ if ($svgEnabled) {
+ push @svgOutputWaysNodes, svgElementCircle ($x1, $y1, $radX, $size, $col) ;
+ }
+}
+
+sub drawCircleRadiusText {
+#
+# draws circle at real world coordinates with radius in meters
+#
+ my ($lon, $lat, $radius, $size, $col, $text) = @_ ;
+ my $radX ; my $radY ;
+ my ($x1, $y1) = convert ($lon, $lat) ;
+
+ $radX = ($radius/1000) / (($right - $left) * 111.1) / cos ($top/360*3.14*2) * $sizeX ;
+ $radY = $radX ;
+ $image->setThickness($size) ;
+ $image->ellipse($x1, $y1, 2*$radX, 2*$radY, $color{$col}) ;
+ $image->setThickness(1) ;
+ if ($size > 4 ) { $size = 4 ; }
+ $image->string($fonts{$size+1}, $x1, $y1+$radY+1, $text, $color{$col}) ;
+ if ($svgEnabled) {
+ push @svgOutputWaysNodes, svgElementCircle ($x1, $y1, $radX, $size, $col) ;
+ push @svgOutputText, svgElementText ($x1, $y1+$radY+10, $text, $size, $col, "") ;
+ }
+
+}
+
+
+sub drawWay {
+#
+# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
+# $size = thickness
+#
+ my ($col, $size, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ $image->setThickness($size) ;
+ for ($i=0; $i<$#nodes-2; $i+=2) {
+ my ($x1, $y1) = convert ($nodes[$i], $nodes[$i+1]) ;
+ my ($x2, $y2) = convert ($nodes[$i+2], $nodes[$i+3]) ;
+ $image->line($x1,$y1,$x2,$y2,$color{$col}) ;
+ }
+ if ($svgEnabled) {
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @svgOutputWaysNodes, svgElementPolyline ($col, $size, @points) ;
+ }
+ $image->setThickness(1) ;
+}
+
+sub drawWayPix {
+#
+# draws way as a line at given pixels. nodes have to be passed as array ($x, $y, $x, $y...)
+# $size = thickness
+#
+ my ($col, $size, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ $image->setThickness($size) ;
+ for ($i=0; $i<$#nodes-2; $i+=2) {
+ my ($x1, $y1) = ($nodes[$i], $nodes[$i+1]) ;
+ my ($x2, $y2) = ($nodes[$i+2], $nodes[$i+3]) ;
+ $image->line($x1,$y1,$x2,$y2,$color{$col}) ;
+ }
+ if ($svgEnabled) {
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ push @svgOutputPixel, svgElementPolyline ($col, $size, @points) ;
+ }
+ $image->setThickness(1) ;
+}
+
+
+sub labelWay {
+#
+# labels a way (ONLY SVG!)
+#
+ my ($col, $size, $font, $text, $tSpan, @nodes) = @_ ;
+ my $i ;
+ my @points = () ;
+
+ #print "labelWay: $col, $size, $font, $text\n" ;
+
+ if ($svgEnabled) {
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
+ push @points, $x ; push @points, $y ;
+ }
+ my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
+ push @svgOutputDef, svgElementPath ($pathName, @points) ;
+ push @svgOutputPathText, svgElementPathText ($col, $size, $font, $text, $pathName, $tSpan) ;
+ }
+ $image->setThickness(1) ;
+}
+
+
+sub drawArea {
+#
+# draws an area like waterway=riverbank or landuse=forest.
+# pass color as string and nodes as list (x1, y1, x2, y2...) - real world coordinates
+#
+ my ($col, @nodes) = @_ ;
+ my $i ;
+ my $poly ; my @points = () ;
+ $poly = new GD::Polygon ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x1, $y1) = convert ($nodes[$i], $nodes[$i+1]) ;
+ $poly->addPt ($x1, $y1) ;
+ push @points, $x1 ; push @points, $y1 ;
+ }
+ $image->filledPolygon ($poly, $color{$col}) ;
+ if ($svgEnabled) {
+ push @svgOutputAreas, svgElementPolygonFilled ($col, @points) ;
+ }
+}
+
+sub drawAreaPix {
+#
+# draws an area like waterway=riverbank or landuse=forest.
+# pass color as string and nodes as list (x1, y1, x2, y2...) - pixels
+#
+ my ($col, @nodes) = @_ ;
+ my $i ;
+ my $poly ; my @points = () ;
+ $poly = new GD::Polygon ;
+
+ for ($i=0; $i<$#nodes; $i+=2) {
+ my ($x1, $y1) = ($nodes[$i], $nodes[$i+1]) ;
+ $poly->addPt ($x1, $y1) ;
+ push @points, $x1 ; push @points, $y1 ;
+ }
+ $image->filledPolygon ($poly, $color{$col}) ;
+ if ($svgEnabled) {
+ push @svgOutputPixel, svgElementPolygonFilled ($col, @points) ;
+ }
+}
+
+
+
+sub drawRuler {
+#
+# draws ruler in top right corner, size is automatic
+#
+ my $col = shift ;
+
+ my $B ;
+ my $B2 ;
+ my $L ;
+ my $Lpix ;
+ my $x ;
+ my $text ;
+ my $rx = $sizeX - 20 ;
+ my $ry = 20 ;
+
+ $B = $right - $left ; # in degrees
+ $B2 = $B * cos ($top/360*3.14*2) * 111.1 ; # in km
+ $text = "100m" ; $x = 0.1 ; # default length ruler
+ if ($B2 > 5) {$text = "500m" ; $x = 0.5 ; } # enlarge ruler
+ if ($B2 > 10) {$text = "1km" ; $x = 1 ; }
+ if ($B2 > 50) {$text = "5km" ; $x = 5 ; }
+ if ($B2 > 100) {$text = "10km" ; $x = 10 ; }
+ $L = $x / (cos ($top/360*3.14*2) * 111.1 ) ; # length ruler in km
+ $Lpix = $L / $B * $sizeX ; # length ruler in pixels
+
+ $image->setThickness(1) ;
+ $image->line($rx-$Lpix,$ry,$rx,$ry,$color{$col}) ;
+ $image->line($rx-$Lpix,$ry,$rx-$Lpix,$ry+10,$color{$col}) ;
+ $image->line($rx,$ry,$rx,$ry+10,$color{$col}) ;
+ $image->line($rx-$Lpix/2,$ry,$rx-$Lpix/2,$ry+5,$color{$col}) ;
+ $image->string(gdSmallFont, $rx-$Lpix, $ry+15, $text, $color{$col}) ;
+
+ if ($svgEnabled) {
+ push @svgOutputText, svgElementLine ($rx-$Lpix,$ry,$rx,$ry, $col, 1) ;
+ push @svgOutputText, svgElementLine ($rx-$Lpix,$ry,$rx-$Lpix,$ry+10, $col, 1) ;
+ push @svgOutputText, svgElementLine ($rx,$ry,$rx,$ry+10, $col, 1) ;
+ push @svgOutputText, svgElementLine ($rx-$Lpix/2,$ry,$rx-$Lpix/2,$ry+5, $col, 1) ;
+ push @svgOutputText, svgElementText ($rx-$Lpix, $ry+15, $text, 2, $col, "") ;
+ }
+}
+
+
+
+sub drawLegend {
+#
+# draws legend (list of strings with different colors) in lower left corner, above foot. pass ("text", "color", ...)
+#
+ my ($size, @entries) = @_ ;
+ my $i ;
+ my $offset = 40 ;
+
+ for ($i=0; $i<$#entries; $i+=2) {
+ $image->string($fonts{$size}, 20, ($sizeY-$offset), $entries[$i], $color{$entries[$i+1]}) ;
+ $offset += 20 ;
+ if ($svgEnabled) {
+ push @svgOutputText, svgElementText (20, ($sizeY-$offset), $entries[$i], $size, $entries[$i+1], "") ;
+ }
+ }
+}
+
+
+
+
+sub drawChartColumns {
+#
+# draws a column chart at given real world coordinates. however, an offset can be given to bring distance between node/position and chart.
+# pass max column size (Y), column width in pixels and YMAX. values below 0 and above YMAX will be truncated.
+# chart will be framed black and gray.
+#
+ my ($lon, $lat, $offX, $offY, $colSizeY, $columnWidthPix, $yMax, $col, @values) = @_ ;
+ my ($x, $y) = convert ($lon, $lat) ;
+ $x = $x + $offX ;
+ $y = $y - $offY ;
+ my $num = scalar (@values) ;
+
+ $image->line($x,$y,$x+$num*$columnWidthPix,$y,$color{$col}) ; #lower
+ $image->line($x,$y,$x,$y-$colSizeY,$color{$col}) ; #left
+ $image->line($x,$y-$colSizeY,$x+$num*$columnWidthPix,$y-$colSizeY,$color{"gray"}) ; #top
+ $image->line($x+$num*$columnWidthPix,$y,$x+$num*$columnWidthPix,$y-$colSizeY,$color{"gray"}) ; #right
+
+ my $i ;
+ for ($i=0; $i<=$#values; $i++) {
+ if ($values[$i] > $yMax) { $values[$i] = $yMax ; }
+ if ($values[$i] < 0) { $values[$i] = 0 ; }
+ my $yCol = ($values[$i] / $yMax) * $colSizeY ;
+ $image->filledRectangle($x+$i*$columnWidthPix, $y, $x+($i+1)*$columnWidthPix, $y-$yCol, $color{$col}) ;
+ }
+
+ # TODO SVG output
+
+}
+
+#####
+# SVG
+#####
+
+
+sub enableSVG {
+#
+# only when called will svg elements be collected for later export to file
+#
+ $svgEnabled = 1 ;
+}
+
+sub writeSVG {
+#
+# writes svg elemets collected so far to file
+#
+ my ($fileName) = shift ;
+ my $file ;
+ open ($file, ">", $fileName) || die "can't open svg output file";
+ print $file "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>\n" ;
+ print $file "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\" >\n" ;
+ print $file "<svg version=\"1.1\" baseProfile=\"full\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:ev=\"http://www.w3.org/2001/xml-events\" width=\"$sizeX\" height=\"$sizeY\" >\n" ;
+ print $file "<rect width=\"$sizeX\" height=\"$sizeY\" y=\"0\" x=\"0\" fill=\"#ffffff\" />\n" ;
+
+ print $file "<defs>\n" ;
+ foreach (@svgOutputDef) { print $file $_, "\n" ; }
+ print $file "</defs>\n" ;
+
+ print $file "<g id=\"Areas\">\n" ;
+ foreach (@svgOutputAreas) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"WaysAndNodes\">\n" ;
+ foreach (@svgOutputWaysNodes) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Text\">\n" ;
+ foreach (@svgOutputText) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Labels\">\n" ;
+ foreach (@svgOutputPathText) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "<g id=\"Pixels\">\n" ;
+ foreach (@svgOutputPixel) { print $file $_, "\n" ; }
+ print $file "</g>\n" ;
+
+ print $file "</svg>\n" ;
+ close ($file) ;
+}
+
+sub svgElementText {
+#
+# creates string with svg element incl utf-8 encoding
+# TODO support different fonts
+#
+ my ($x, $y, $text, $size, $col, $font) = @_ ;
+ my $fontSize = 12 + ($size - 1) * 4 ;
+ my $svg = "<text x=\"" . $x . "\" y=\"" . $y . "\" font-size=\"" . $fontSize . "\" fill=\"#" . colorToHex(@{$colorHash{$col}}) . "\">" . $text . "</text>" ;
+ return $svg ;
+}
+
+sub svgElementCircleFilled {
+#
+# draws circle not filled
+#
+ my ($x, $y, $size, $col) = @_ ;
+ my $svg = "<circle cx=\"" . $x . "\" cy=\"" . $y . "\" r=\"" . $size . "\" fill=\"#" . colorToHex(@{$colorHash{$col}}) . "\" />" ;
+ return $svg ;
+}
+
+sub svgElementCircle {
+#
+# draws filled circle / dot
+#
+ my ($x, $y, $radius, $size, $col) = @_ ;
+ my $svg = "<circle cx=\"" . $x . "\" cy=\"" . $y . "\" r=\"" . $radius . "\" fill=\"none\" stroke=\"#" . colorToHex(@{$colorHash{$col}}) . "\" stroke-width=\"2\" />" ;
+ return $svg ;
+}
+
+sub svgElementLine {
+#
+# draws line between two points
+#
+ my ($x1, $y1, $x2, $y2, $col, $size) = @_ ;
+ my $svg = "<polyline points=\"" . $x1 . "," . $y1 . " " . $x2 . "," . $y2 . "\" stroke=\"#" . colorToHex(@{$colorHash{$col}}) . "\" stroke-width=\"" . $size . "\"/>" ;
+ return $svg ;
+}
+
+sub svgElementPolyline {
+#
+# draws way to svg
+#
+ my ($col, $size, @points) = @_ ;
+ my $svg = "<polyline points=\"" ;
+ my $i ;
+ for ($i=0; $i<scalar(@points)-1; $i+=2) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ $svg = $svg . "\" stroke=\"#" . colorToHex(@{$colorHash{$col}}) . "\" stroke-width=\"" . $size . "\" fill=\"none\" />" ;
+ return $svg ;
+}
+
+sub svgElementPath {
+#
+# creates path element for later use with textPath
+#
+ my ($pathName, @points) = @_ ;
+ my $svg = "<path id=\"" . $pathName . "\" d=\"M " ;
+ my $i ;
+ my $first = 1 ;
+ for ($i=0; $i<scalar(@points); $i+=2) {
+ if ($first) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ $first = 0 ;
+ }
+ else {
+ $svg = $svg . "L " . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ }
+ $svg = $svg . "\" />\n" ;
+}
+
+sub svgElementPathText {
+#
+# draws text to path element
+#
+ my ($col, $size, $font, $text, $pathName, $tSpan) = @_ ;
+ my $fontSize = 12 + ($size - 1) * 4 ;
+ my $svg = "<text font-family=\"" . $font . "\" " ;
+ $svg = $svg . "font-size=\"" . $fontSize . "\" " ;
+ $svg = $svg . "fill=\"#" . colorToHex(@{$colorHash{$col}}) . "\" >\n" ;
+ $svg = $svg . "<textPath xlink:href=\"#" . $pathName . "\" text-anchor=\"middle\" startOffset=\"50%\" >\n" ;
+ $svg = $svg . "<tspan dy=\"" . $tSpan . "\" >" . $text . " </tspan>\n" ;
+ $svg = $svg . "</textPath>\n</text>\n" ;
+ return $svg ;
+}
+
+sub svgElementPolygonFilled {
+#
+# draws areas in svg, filled with color
+#
+ my ($col, @points) = @_ ;
+ my $i ;
+ my $svg = "<polygon fill=\"#" . colorToHex(@{$colorHash{$col}}) . "\" points=\"" ;
+ for ($i=0; $i<scalar(@points); $i+=2) {
+ $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
+ }
+ $svg = $svg . "\" />" ;
+ return $svg ;
+}
+
+sub colorToHex {
+#
+# converts array of integers (rgb) to hex string without hash # (internaly used)
+#
+ my @arr = @_ ;
+ my $string = "" ;
+ $string = sprintf "%02x", $arr[0] ;
+ $string = $string . sprintf "%02x", $arr[1] ;
+ $string = $string . sprintf "%02x", $arr[2] ;
+ return $string ;
+}
+
+1 ;
+
+#
+# copy this useful function to your main program and uncomment, if needed
+#
+# sub nodes2Coordinates {
+#
+# transform list of nodeIds to list of lons/lats
+#
+# my @nodes = @_ ;
+# my $i ;
+# my @result = () ;
+#
+# #print "in @nodes\n" ;
+#
+# for ($i=0; $i<=$#nodes; $i++) {
+# push @result, $lon{$nodes[$i]} ;
+# push @result, $lat{$nodes[$i]} ;
+# }
+# return @result ;
+#}
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-grass/libosm-gary68-perl.git
More information about the Pkg-grass-devel
mailing list