commit cc3d03f9ed29138b1c1741980e2a791eb379ecdd Author: Atlas Cove Date: Thu Jul 28 10:06:48 2022 +0100 Initial re-commit diff --git a/OSM/QuadTree.pm b/OSM/QuadTree.pm new file mode 100644 index 0000000..256ff5a --- /dev/null +++ b/OSM/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/OSM/gpx.pm b/OSM/gpx.pm new file mode 100755 index 0000000..fe14a34 --- /dev/null +++ b/OSM/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 +# + + +package OSM::gpx ; + +use strict ; +use warnings ; + +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +require Exporter ; + +@ISA = qw ( Exporter AutoLoader ) ; + +@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 / ; + 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>/ ) ; + my ($name) = ( $line =~ /(.+?)<\/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 //i, $line) { + $line = getLine() ; + } + } + + my ($name) = ( $line =~ /(.+?)<\/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 //i, $line) { + + if ( grep //i, $line) { + $line = getLine() ; + } + } + + $line = getLine() ; + + } + + # print " track segment finished\n" ; + } + + my ($name) = ( $line =~ /(.+?)<\/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/\//i ; + return $name ; +} + + +1 ; + + diff --git a/OSM/mapgen.pm b/OSM/mapgen.pm new file mode 100755 index 0000000..ac82144 --- /dev/null +++ b/OSM/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 + +# +# 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 ; + +@ISA = qw ( Exporter AutoLoader ) ; + +@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) = " 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 + # + + 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, "" ; + + 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 "\n" ; + print $file "\n" ; + + my ($svg) = "\n" ; + print $file $svg ; + + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputDef) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputAreas) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach my $layer (sort {$a <=> $b} (keys %svgOutputWays)) { + foreach (@{$svgOutputWays{$layer}}) { print $file $_, "\n" ; } + } + print $file "\n" ; + + print $file "\n" ; + foreach my $layer (sort {$a <=> $b} (keys %svgOutputNodes)) { + foreach (@{$svgOutputNodes{$layer}}) { print $file $_, "\n" ; } + } + print $file "\n" ; + + + print $file "\n" ; + foreach (@svgOutputRoutes) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputRouteStops) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputText) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputIcons) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputPathText) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputPixelGrid) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + foreach (@svgOutputPixel) { print $file $_, "\n" ; } + print $file "\n" ; + + print $file "\n" ; + close ($file) ; +} + +sub svgElementText { +# +# creates string with svg element incl utf-8 encoding +# + my ($x, $y, $text, $size, $font, $col) = @_ ; + my $svg = "" . $text . "" ; + return $svg ; +} + +sub svgElementCircleFilled { +# +# draws circle filled +# + my ($x, $y, $size, $col) = @_ ; + my $svg = "" ; + return $svg ; +} + +sub svgElementCircle { +# +# draws not filled circle / dot +# + my ($x, $y, $radius, $size, $col) = @_ ; + my $svg = "" ; + return $svg ; +} + +sub svgElementLine { +# +# draws line between two points +# + my ($x1, $y1, $x2, $y2, $col, $size) = @_ ; + my $svg = "" ; + return $svg ; +} + + + + +sub svgElementPolyline { +# +# draws way to svg +# + my ($col, $size, $dash, @points) = @_ ; + + my $refp = simplifyPoints (\@points) ; + @points = @$refp ; + + + my $svg = "" ; + } + 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 = "" ; + } + 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 = "\n" ; +} + + +sub svgElementPathTextAdvanced { +# +# draws text to path element; anchors: start, middle, end +# + my ($col, $size, $font, $text, $pathName, $tSpan, $alignment, $offset, $halo) = @_ ; + + my $svg = " 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 . "\n" ; + $svg = $svg . "" . $text . " \n" ; + $svg = $svg . "\n\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 = "" ; + 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 = "" ; + # 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 = "" ; + } + 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 = "\n" ; + $svgElement .= " \n" ; + $svgElement .= "\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, "" ; + push @svgOutputDef, "" ; + push @svgOutputDef, "" ; +} + + +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 $minDist) { + # create path + # use path + my $svg = "" ; + + 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 / 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/OSM/mapgenRules.pm b/OSM/mapgenRules.pm new file mode 100755 index 0000000..4eed571 --- /dev/null +++ b/OSM/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 + + +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 ; + +@ISA = qw ( Exporter AutoLoader ) ; + +@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/osm.pm b/OSM/osm.pm new file mode 100755 index 0000000..2623cb3 --- /dev/null +++ b/OSM/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 +# +# +# 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 /