# # 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 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;