802 lines
19 KiB
Perl
802 lines
19 KiB
Perl
#
|
|
# 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 mwMisc ;
|
|
|
|
use strict ;
|
|
use warnings ;
|
|
|
|
use Math::Trig;
|
|
use Math::Polygon ;
|
|
use List::Util qw[min max] ;
|
|
|
|
use mwConfig ;
|
|
use mwFile ;
|
|
# use mwMap ;
|
|
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
|
|
|
require Exporter ;
|
|
|
|
@ISA = qw ( Exporter AutoLoader ) ;
|
|
|
|
@EXPORT = qw ( getValue
|
|
createLabel
|
|
buildRings
|
|
angleMapgen
|
|
triangleNode
|
|
intersection
|
|
areaSize
|
|
isIn
|
|
processPageNumbers
|
|
processRectangles
|
|
sizePNG
|
|
sizeSVG
|
|
createDirPdf
|
|
getPointOfWay
|
|
nodes2Coordinates
|
|
areaCenter
|
|
createTextSVG
|
|
wayVisible
|
|
labelTransform
|
|
) ;
|
|
|
|
|
|
|
|
sub getValue {
|
|
my ($key, $aRef) = @_ ;
|
|
my $value = undef ;
|
|
foreach my $kv (@$aRef) {
|
|
if ($kv->[0] eq $key) { $value = $kv->[1]; }
|
|
}
|
|
return $value ;
|
|
}
|
|
|
|
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 buildRings {
|
|
#
|
|
# accepts ref to array of ways and option if unclosed rings shoulf be returned
|
|
# closeOpt == 1 returns only closed rings
|
|
#
|
|
# returns two refs to arrays of arrays: ways and nodes
|
|
#
|
|
my ($ref, $closeOpt) = @_ ;
|
|
my (@allWays) = @$ref ;
|
|
my @ringWays = () ;
|
|
my @ringNodes = () ;
|
|
my $ringCount = 0 ;
|
|
|
|
my ($memWayNodesRef, $memWayTagsRef) = mwFile::getWayPointers() ;
|
|
|
|
# print "build rings for @allWays\n" ;
|
|
if (cv('debug') eq "1" ) { print "BR: called.\n" ; }
|
|
while ( scalar @allWays > 0) {
|
|
# build new test ring
|
|
my (@currentWays) = () ; my (@currentNodes) = () ;
|
|
push @currentWays, $allWays[0] ;
|
|
if (cv('debug') eq "1" ) { print "BR: initial way for next ring id= $allWays[0]\n" ; }
|
|
push @currentNodes, @{$$memWayNodesRef{$allWays[0]}} ;
|
|
my $startNode = $currentNodes[0] ;
|
|
my $endNode = $currentNodes[-1] ;
|
|
if (cv('debug') eq "1" ) { print "BR: initial start and end node $startNode $endNode\n" ; }
|
|
my $closed = 0 ;
|
|
shift @allWays ; # remove first element
|
|
if ($startNode == $endNode) { $closed = 1 ; }
|
|
|
|
my $success = 1 ;
|
|
while ( ($closed == 0) and ( (scalar @allWays) > 0) and ($success == 1) ) {
|
|
# try to find new way
|
|
if (cv('debug') eq "1" ) { print "TRY TO FIND NEW WAY\n" ; }
|
|
$success = 0 ;
|
|
if (cv('debug') eq "1" ) { print "BR: actual start and end node $startNode $endNode\n" ; }
|
|
my $i = 0 ;
|
|
while ( ($i < (scalar @allWays) ) and ($success == 0) ) {
|
|
if (cv('debug') eq "1" ) { print "BR: testing way $i = $allWays[$i]\n" ; }
|
|
if (cv('debug') eq "1" ) { print "BR: rev in front?\n" ; }
|
|
if ( $$memWayNodesRef{$allWays[$i]}[0] == $startNode ) {
|
|
$success = 1 ;
|
|
# reverse in front
|
|
@currentWays = ($allWays[$i], @currentWays) ;
|
|
@currentNodes = (reverse (@{$$memWayNodesRef{$allWays[$i]}}), @currentNodes) ;
|
|
splice (@allWays, $i, 1) ;
|
|
}
|
|
if ($success ==0) {
|
|
if (cv('debug') eq "1" ) { print "BR: app at end?\n" ; }
|
|
if ( $$memWayNodesRef{$allWays[$i]}[0] == $endNode) {
|
|
$success = 1 ;
|
|
# append at end
|
|
@currentWays = (@currentWays, $allWays[$i]) ;
|
|
@currentNodes = (@currentNodes, @{$$memWayNodesRef{$allWays[$i]}}) ;
|
|
splice (@allWays, $i, 1) ;
|
|
}
|
|
}
|
|
if ($success ==0) {
|
|
if (cv('debug') eq "1" ) { print "BR: app in front?\n" ; }
|
|
if ( $$memWayNodesRef{$allWays[$i]}[-1] == $startNode) {
|
|
$success = 1 ;
|
|
# append in front
|
|
@currentWays = ($allWays[$i], @currentWays) ;
|
|
@currentNodes = (@{$$memWayNodesRef{$allWays[$i]}}, @currentNodes) ;
|
|
splice (@allWays, $i, 1) ;
|
|
}
|
|
}
|
|
if ($success ==0) {
|
|
if (cv('debug') eq "1" ) { print "BR: rev at end?\n" ; }
|
|
if ( $$memWayNodesRef{$allWays[$i]}[-1] == $endNode) {
|
|
$success = 1 ;
|
|
# append reverse at the end
|
|
@currentWays = (@currentWays, $allWays[$i]) ;
|
|
@currentNodes = (@currentNodes, (reverse (@{$$memWayNodesRef{$allWays[$i]}}))) ;
|
|
splice (@allWays, $i, 1) ;
|
|
}
|
|
}
|
|
$i++ ;
|
|
} # look for new way that fits
|
|
|
|
$startNode = $currentNodes[0] ;
|
|
$endNode = $currentNodes[-1] ;
|
|
if ($startNode == $endNode) {
|
|
$closed = 1 ;
|
|
if (cv('debug') eq "1" ) { print "BR: ring now closed\n" ;}
|
|
}
|
|
} # new ring
|
|
|
|
# examine ring and act
|
|
if ( ($closed == 1) or ($closeOpt == 0) ) {
|
|
# eliminate double nodes in @currentNodes
|
|
my $found = 1 ;
|
|
while ($found) {
|
|
$found = 0 ;
|
|
LABCN: for (my $i=0; $i<$#currentNodes; $i++) {
|
|
if ($currentNodes[$i] == $currentNodes[$i+1]) {
|
|
$found = 1 ;
|
|
splice @currentNodes, $i, 1 ;
|
|
last LABCN ;
|
|
}
|
|
}
|
|
}
|
|
# add data to return data
|
|
@{$ringWays[$ringCount]} = @currentWays ;
|
|
@{$ringNodes[$ringCount]} = @currentNodes ;
|
|
$ringCount++ ;
|
|
}
|
|
}
|
|
return (\@ringWays, \@ringNodes) ;
|
|
}
|
|
|
|
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 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 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 isIn {
|
|
# checks two polygons
|
|
# return 0 = neither
|
|
# 1 = p1 is in p2
|
|
# 2 = p2 is in p1
|
|
my ($p1, $p2) = @_ ;
|
|
|
|
my ($p1In2) = 1 ;
|
|
my ($p2In1) = 1 ;
|
|
|
|
# p1 in p2 ?
|
|
foreach my $pt1 ($p1->points) {
|
|
if ($p2->contains ($pt1) ) {
|
|
# good
|
|
}
|
|
else {
|
|
$p1In2 = 0 ;
|
|
}
|
|
}
|
|
|
|
# p2 in p1 ?
|
|
foreach my $pt2 ($p2->points) {
|
|
if ($p1->contains ($pt2) ) {
|
|
# good
|
|
}
|
|
else {
|
|
$p2In1 = 0 ;
|
|
}
|
|
}
|
|
|
|
if ($p1In2 == 1) {
|
|
return 1 ;
|
|
}
|
|
elsif ($p2In1 == 1) {
|
|
return 2 ;
|
|
}
|
|
else {
|
|
return 0 ;
|
|
}
|
|
}
|
|
|
|
# -------------------------------------------------------------------------------
|
|
|
|
sub processPageNumbers {
|
|
if ( cv('pageNumbers') ne "") {
|
|
my $pnSize ; my $pnColor ;
|
|
my @a = split /,/, cv('pageNumbers') ;
|
|
if (scalar @a >= 3) {
|
|
$pnSize = $a[0] ;
|
|
$pnColor = $a[1] ;
|
|
my $pnNumber = $a[2] ;
|
|
|
|
if ($pnNumber != 0) {
|
|
drawPageNumber ($pnSize, $pnColor, $pnNumber) ;
|
|
}
|
|
}
|
|
if (scalar @a == 7) {
|
|
# draw 4 other positions if ne 0!!!
|
|
if ($a[3] != 0) { # left
|
|
drawPageNumberLeft ($pnSize, $pnColor, $a[3]) ;
|
|
}
|
|
if ($a[4] != 0) { # bottom
|
|
drawPageNumberBottom ($pnSize, $pnColor, $a[4]) ;
|
|
}
|
|
if ($a[5] != 0) { # right
|
|
drawPageNumberRight ($pnSize, $pnColor, $a[5]) ;
|
|
}
|
|
if ($a[6] != 0) { # top
|
|
drawPageNumberTop ($pnSize, $pnColor, $a[6]) ;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub drawPageNumber {
|
|
my ($size, $col, $num) = @_ ;
|
|
my ($sizeX, $sizeY) = mwMap::getDimensions() ;
|
|
my $x = $sizeX - 2 * $size ;
|
|
my $y = $sizeY - 2 * $size ;
|
|
my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
|
|
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
|
|
}
|
|
|
|
sub drawPageNumberLeft {
|
|
my ($size, $col, $num) = @_ ;
|
|
my ($sizeX, $sizeY) = mwMap::getDimensions() ;
|
|
my $x = 2 * $size ;
|
|
my $y = $sizeY / 2 ;
|
|
my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
|
|
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
|
|
}
|
|
|
|
sub drawPageNumberBottom {
|
|
my ($size, $col, $num) = @_ ;
|
|
my ($sizeX, $sizeY) = mwMap::getDimensions() ;
|
|
my $x = $sizeX / 2 ;
|
|
my $y = $sizeY - 2 * $size ;
|
|
my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
|
|
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
|
|
}
|
|
|
|
sub drawPageNumberRight {
|
|
my ($size, $col, $num) = @_ ;
|
|
my ($sizeX, $sizeY) = mwMap::getDimensions() ;
|
|
my $x = $sizeX - 2 * $size ;
|
|
my $y = $sizeY / 2 ;
|
|
my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
|
|
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
|
|
}
|
|
|
|
sub drawPageNumberTop {
|
|
my ($size, $col, $num) = @_ ;
|
|
my ($sizeX, $sizeY) = mwMap::getDimensions() ;
|
|
my $x = $sizeX / 2 ;
|
|
my $y = 2 * $size ;
|
|
my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
|
|
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
|
|
}
|
|
|
|
# ---------------------------------------------------------------------
|
|
|
|
sub processRectangles {
|
|
my $no = 0 ;
|
|
|
|
if ( cv('rectangles') ne "") {
|
|
my @rects ;
|
|
@rects = split /#/, cv('rectangles') ;
|
|
foreach my $r (@rects) {
|
|
$no++ ;
|
|
my @coords ;
|
|
@coords = split /,/, $r ;
|
|
|
|
my $left = $coords[0] ;
|
|
my $bottom = $coords[1] ;
|
|
my $right = $coords[2] ;
|
|
my $top = $coords[3] ;
|
|
|
|
my @nodes ;
|
|
push @nodes, convert ($left, $bottom) ;
|
|
push @nodes, convert ($right, $bottom) ;
|
|
push @nodes, convert ($right, $top) ;
|
|
push @nodes, convert ($left, $top) ;
|
|
push @nodes, convert ($left, $bottom) ;
|
|
|
|
# drawWay (10, "black", 5, "none", @nodes) ;
|
|
my $svgString = "fill=\"none\" stroke=\"black\" stroke-width=\"7\" " ;
|
|
drawWay (\@nodes, 0, $svgString, "rectangles", undef) ;
|
|
# drawRect ($left, $bottom, $right, $top, 1, $svgString, "rectangles") ;
|
|
|
|
if ( cv('pagenumbers') ne "") {
|
|
my $x = ($right + $left) / 2 ;
|
|
my $y = ($bottom + $top) / 2 ;
|
|
my $xp ; my $yp ;
|
|
($xp, $yp) = convert ($x, $y) ;
|
|
# drawTextPixGrid ($xp, $yp, $no, $pnColor, scalePoints ( scaleBase ($pnSize) ) ) ;
|
|
my $svgString = "fill=\"black\" font-size=\"60\" " ;
|
|
drawText ($xp, $yp, 0, $no, $svgString, "rectangles") ;
|
|
}
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
# --------------------------------------------------------------------
|
|
|
|
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 createDirPdf {
|
|
if ((cv('dir') eq "1") or (cv('poi') eq "1")) {
|
|
if (cv('grid') > 0) {
|
|
my $dirPdfName = cv('out') ;
|
|
$dirPdfName =~ s/.svg/_dir.pdf/ ;
|
|
my $sName = "none" ;
|
|
my $pName = "none" ;
|
|
|
|
my $prg = cv ('dirprg') ;
|
|
|
|
if (cv('dir') eq "1") { $sName = cv('directoryname') ; }
|
|
if (cv('poi') eq "1") { $pName = cv('poiname') ; }
|
|
my $dirColNum = cv ('dircolnum') ;
|
|
my $dirTitle = cv ('dirtitle') ;
|
|
print "\ncalling perl $prg $sName $pName $dirTitle $dirPdfName $dirColNum\n\n" ;
|
|
`perl $prg $sName $pName \"$dirTitle\" $dirPdfName $dirColNum > out.txt` ;
|
|
}
|
|
else {
|
|
print "WARNING: directory PDF will not be created because -grid was not specified\n" ;
|
|
}
|
|
|
|
}
|
|
else {
|
|
print "WARNING: directory PDF will not be created because neither -dir nor -poi was specified\n" ;
|
|
}
|
|
}
|
|
|
|
# -----------------------------------------------------------------------------
|
|
|
|
sub getPointOfWay {
|
|
#
|
|
# returns point of way at distance/position
|
|
# coordinates and units are pixels
|
|
|
|
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) ;
|
|
}
|
|
|
|
# ----------------------------------------------------------------
|
|
|
|
sub nodes2Coordinates {
|
|
#
|
|
# transform list of nodeIds to list of x/y
|
|
# straight array in and out
|
|
#
|
|
my @nodes = @_ ;
|
|
my $i ;
|
|
|
|
my @result = () ;
|
|
|
|
my ($lonRef, $latRef) = mwFile::getNodePointers() ;
|
|
|
|
foreach my $n (@nodes) {
|
|
my ($x, $y) = mwMap::convert ( $$lonRef{$n}, $$latRef{$n}) ;
|
|
push @result, $x, $y ;
|
|
}
|
|
|
|
return @result ;
|
|
}
|
|
|
|
|
|
sub areaCenter {
|
|
#
|
|
# calculate center of area by averageing lons/lats. could be smarter because result could be outside of area! TODO
|
|
#
|
|
my $ref = shift ;
|
|
my @nodes = @$ref ;
|
|
|
|
# print "CENTER: @nodes\n" ;
|
|
|
|
my $x = 0 ;
|
|
my $y = 0 ;
|
|
my $num = 0 ;
|
|
|
|
my ($lonRef, $latRef) = getNodePointers() ;
|
|
|
|
foreach my $n (@nodes) {
|
|
$x += $$lonRef{$n} ;
|
|
$y += $$latRef{$n} ;
|
|
$num++ ;
|
|
}
|
|
$x = $x / $num ;
|
|
$y = $y / $num ;
|
|
return ($x, $y) ;
|
|
|
|
}
|
|
|
|
|
|
sub areaSize {
|
|
my $ref = shift ; # nodes
|
|
my @nodes = @$ref ;
|
|
|
|
# print "SIZE: @nodes\n" ;
|
|
|
|
my ($lonRef, $latRef) = mwFile::getNodePointers() ;
|
|
|
|
my @poly = () ;
|
|
foreach my $node ( @nodes ) {
|
|
my ($x, $y) = mwMap::convert ($$lonRef{$node}, $$latRef{$node}) ;
|
|
push @poly, [$x, $y] ;
|
|
}
|
|
my ($p) = Math::Polygon->new(@poly) ;
|
|
my $size = $p->area ;
|
|
|
|
return $size ;
|
|
}
|
|
|
|
# ---------------------------------------------------------------
|
|
|
|
sub createTextSVG {
|
|
my ($fontFamily, $font, $bold, $italic, $size, $color, $strokeWidth, $strokeColor) = @_ ;
|
|
|
|
my $svg = "" ;
|
|
|
|
if ( (defined $font) and ( $font ne "") ) {
|
|
$svg .= "font=\"$font\" " ;
|
|
}
|
|
if ( (defined $fontFamily) and ( $fontFamily ne "") ) {
|
|
$svg .= "font-family=\"$fontFamily\" " ;
|
|
}
|
|
|
|
if ( (defined $bold) and ( lc ($bold) eq "yes") ) {
|
|
$svg .= "font-weight=\"bold\" " ;
|
|
}
|
|
if ( (defined $italic) and ( lc ($italic) eq "yes") ) {
|
|
$svg .= "font-style=\"italic\" " ;
|
|
}
|
|
|
|
if ( (defined $size) and ( $size ne "") ) {
|
|
$svg .= "font-size=\"$size\" " ;
|
|
}
|
|
if ( (defined $color) and ( $color ne "") ) {
|
|
$svg .= "fill=\"$color\" " ;
|
|
}
|
|
|
|
if ( (defined $strokeColor) and ( $strokeColor ne "") ) {
|
|
$svg .= "stroke=\"$strokeColor\" " ;
|
|
}
|
|
if ( (defined $strokeWidth) and ( $strokeWidth ne "") ) {
|
|
$svg .= "stroke-width=\"$strokeWidth\" " ;
|
|
}
|
|
|
|
|
|
|
|
return $svg ;
|
|
}
|
|
|
|
# --------------------------------------------------------------------
|
|
|
|
sub wayVisible {
|
|
my $ref = shift ;
|
|
my @points = @$ref ;
|
|
my ($sizeX, $sizeY) = mwMap::getDimensions() ;
|
|
|
|
my $result = 0 ;
|
|
|
|
for (my $i = 0; $i < $#points; $i += 2) {
|
|
my $x = $points[$i] ;
|
|
my $y = $points[$i+1] ;
|
|
if ( ( $x >= 0 ) and ( $y >= 0 ) and ( $x <= $sizeX ) and ( $y <= $sizeY ) ) {
|
|
$result = 1 ;
|
|
}
|
|
}
|
|
return $result ;
|
|
}
|
|
|
|
# --------------------------------------------------------------------
|
|
|
|
sub labelTransform {
|
|
my ($label, $cmd) = @_ ;
|
|
if ($cmd ne "") {
|
|
eval $cmd ;
|
|
if ($@) { print "ERROR processing label '$label' with command: '$cmd'\nERROR: $@\n" ; }
|
|
}
|
|
return $label ;
|
|
}
|
|
|
|
|
|
1 ;
|
|
|
|
|