source: subversion/applications/utils/gary68/OSM/mapgen.pm @ 25772

Last change on this file since 25772 was 25772, checked in by gary68, 9 years ago

new mapgen version

  • Property svn:executable set to *
File size: 62.2 KB
Line 
1#
2# PERL mapgen module by gary68
3#
4# This module contains a lot of useful graphic functions for working with osm files and data. This enables you (in conjunction with osm.pm)
5# to easily draw custom maps.
6# Have a look at the last (commented) function below. It is useful for your main program!
7#
8#
9#
10#
11# Copyright (C) 2010, Gerhard Schwanz
12#
13# 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
14# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
20
21#
22# INFO
23#
24# graph top left coordinates: (0,0)
25# size for lines = pixel width / thickness
26#
27# 1.051 l0 calculation adapted
28
29
30package OSM::mapgen ; 
31
32use strict ;
33use warnings ;
34
35use Math::Trig;
36use File::stat;
37use Time::localtime;
38use List::Util qw[min max] ;
39use Encode ;
40use OSM::osm ;
41use OSM::QuadTree ;
42use GD ;
43use Geo::Proj4 ;
44
45use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
46
47$VERSION = '1.19' ;
48
49require Exporter ;
50
51@ISA = qw ( Exporter AutoLoader ) ;
52
53@EXPORT = qw (          addAreaIcon
54                        addOnewayArrows
55                        center
56                        convert
57                        createLabel
58                        createWayLabels
59                        declutterStat
60                        drawArea
61                        drawAreaMP
62                        drawAreaOcean
63                        drawAreaPix
64                        drawCircle
65                        drawCircleRadius
66                        drawCircleRadiusText
67                        drawCoords
68                        drawHead
69                        drawFoot
70                        drawGrid
71                        drawLegend
72                        drawNodeDot
73                        drawNodeDotRouteStops
74                        drawNodeDotPix
75                        drawNodeCircle
76                        drawNodeCirclePix
77                        drawPageNumber
78                        drawPageNumberTop
79                        drawPageNumberBottom
80                        drawPageNumberLeft
81                        drawPageNumberRight
82                        drawRuler
83                        drawTextPix
84                        drawTextPix2
85                        drawTextPixGrid
86                        drawWay
87                        drawWayBridge
88                        drawWayPix
89                        drawWayRoute
90                        fitsPaper
91                        getDimensions
92                        getScale
93                        getValue
94                        gridSquare
95                        initGraph
96                        initOneways
97                        labelWay
98                        placeLabelAndIcon
99                        printScale
100                        scalePoints
101                        scaleBase
102                        setdpi
103                        setBaseDpi
104                        simplifiedPercent
105                        sizePNG
106                        sizeSVG
107                        writeSVG ) ;
108
109#
110# constants
111#
112
113my %dashStyle = () ;
114my %dashDefinition = () ; # for 300 dpi
115@{$dashDefinition{1}} = (60,20,"round") ; #grid
116@{$dashDefinition{11}} = (16,16,"butt") ; # tunnel
117
118my $wayIndexLabelColor = 9 ;
119my $wayIndexLabelSize = 10 ;
120my $wayIndexLabelFont = 11 ;
121my $wayIndexLabelOffset = 12 ;
122my $wayIndexLegendLabel = 14 ;
123
124my $lineCap = "round" ;
125my $lineJoin = "round" ;
126
127my @occupiedAreas = () ;
128my $labelPathId = 0 ;
129
130my $qtWayLabels ;
131my $qtPoiLabels ;
132
133#
134# variables
135#
136my $proj ;
137my $projSizeX ;
138my $projSizeY ;
139my ($projLeft, $projRight, $projBottom, $projTop) ;
140
141
142my ($top, $bottom, $left, $right) ; # min and max real world coordinates
143my ($sizeX, $sizeY) ; # pic size in pixels
144
145my %svgOutputWays ;
146my %svgOutputNodes ;
147my @svgOutputAreas = () ;
148my @svgOutputText = () ;
149my @svgOutputPixel = () ;
150my @svgOutputPixelGrid = () ;
151my @svgOutputDef = () ;
152my @svgOutputPathText = () ;
153my @svgOutputIcons = () ;
154my @svgOutputRouteStops = () ;
155my $pathNumber = 0 ;
156my $svgBaseFontSize = 10 ;
157my @svgOutputRoutes = () ;
158
159my %areaDef = () ;
160my $areaNum = 1 ;
161
162my $numIcons = 0 ;
163my $numIconsMoved = 0 ;
164my $numIconsOmitted = 0 ;
165my $numLabels = 0 ;
166my $numLabelsMoved = 0 ;
167my $numLabelsOmitted = 0 ;
168my $numWayLabelsOmitted = 0 ;
169
170my $dpi = 0 ;
171my $baseDpi ;
172
173# clutter information
174my %clutter = () ;
175my %clutterIcon = () ;
176my @lines ;
177
178my $simplified = 0 ;
179my $simplifyTotal = 0 ;
180
181my $shieldPathId = 0 ;
182my %createdShields = () ; # key = name; value = id of path
183my %shieldXSize = () ;
184my %shieldYSize = () ;
185
186
187sub setdpi {
188        $dpi = shift ;
189}
190
191sub setBaseDpi {
192        $baseDpi = shift ;
193}
194
195
196sub initGraph {
197#
198# function initializes the picture, the colors and the background (white)
199#
200        my ($x, $l, $b, $r, $t, $color, $projection, $ellipsoid) = @_ ; 
201
202        # my $l0 = int($l) - 1 ;
203        my $l0 = int(($r+$l) / 2 ) ;
204
205        $proj = Geo::Proj4->new(
206                proj => $projection, 
207                ellps => $ellipsoid, 
208                lon_0 => $l0 
209                ) or die "parameter error: ".Geo::Proj4->error. "\n"; 
210
211
212        ($projLeft, $projBottom) = $proj->forward($b, $l) ; # lat/lon!!!
213        ($projRight, $projTop) = $proj->forward($t, $r) ; # lat/lon!!!
214
215        # print "PROJ: bounds: $projLeft $projRight $projBottom $projTop\n" ;
216
217        $projSizeX = $projRight - $projLeft ;
218        $projSizeY = $projTop - $projBottom ;
219
220        my $factor = $projSizeY / $projSizeX ;
221
222        # print "PROJ: $projSizeX x $projSizeY units, factor = $factor\n" ;
223       
224        $sizeX = int ($x) ;
225        $sizeY = int ($x * $factor) ;
226
227        # print "PROJ: $sizeX x $sizeY pixels\n" ;
228        # print "PROJ: t b l r $t $b $l $r\n" ;
229        # print "PROJ: pt pb pl pr $projTop $projBottom $projLeft $projRight\n" ;
230        # print "PROJ: factor $factor\n" ;
231        # print "PROJ: l0 $l0\n" ;
232
233        $top = $t ;
234        $left = $l ;
235        $right = $r ;
236        $bottom = $b ;
237
238        drawArea ($color, "", $l, $t, $r, $t, $r, $b, $l, $b, $l, $t) ;
239
240        $qtWayLabels = OSM::QuadTree->new(  -xmin  => 0,
241                                      -xmax  => $sizeX+100,
242                                      -ymin  => 0,
243                                      -ymax  => $sizeY+40,
244                                      -depth => 5);
245        $qtPoiLabels = OSM::QuadTree->new(  -xmin  => 0,
246                                      -xmax  => $sizeX+100,
247                                      -ymin  => 0,
248                                      -ymax  => $sizeY+40,
249                                      -depth => 5);
250        initDashes() ;
251}
252
253sub initDashes {
254#
255# sub creates internal dash styles according to base definition
256#
257        foreach my $style (keys %dashDefinition) {
258                my @array = @{$dashDefinition{$style}} ;
259                my $lc = pop @array ;
260                my $dashString = "" ;
261                foreach my $entry (@array) {
262                        my $entryScaled = scalePoints ( scaleBase ($entry) ) ;
263                        $dashString .= "$entryScaled," ;
264                }
265                $dashString .= $lc ;
266                $dashStyle{$style} = $dashString ;
267        }
268}
269
270
271
272sub convert {
273#
274# converts real world coordinates to system graph pixel coordinates
275#
276        my ($x, $y) = @_ ;
277
278        my ($x1, $y1) = $proj->forward($y, $x) ; # lat/lon!!!
279
280        my $x2 = int ( ($x1 - $projLeft) / ($projRight - $projLeft) * $sizeX ) ;
281        my $y2 = $sizeY - int ( ($y1 - $projBottom) / ($projTop - $projBottom) * $sizeY ) ;
282
283        return ($x2, $y2) ;
284}
285
286sub gridSquare {
287#
288# returns grid square of given coordinates for directories
289#
290        my ($lon, $lat, $parts) = @_ ;
291        my ($x, $y) = convert ($lon, $lat) ;
292        # my $partsY = $sizeY / ($sizeX / $parts) ;
293        my $xi = int ($x / ($sizeX / $parts)) + 1 ;
294        my $yi = int ($y / ($sizeX / $parts)) + 1 ;
295        if ( ($x >= 0) and ($x <= $sizeX) and ($y >= 0) and ($y <= $sizeY) ) {
296                return (chr($xi+64) . $yi) ;
297        }
298        else {
299                return undef ;
300        }
301}
302
303
304
305sub occupyArea {
306#
307# occupy area and make entry in quad tree for later use
308#
309        my ($x1, $x2, $y1, $y2) = @_ ;
310        # left, right, bottom, top (bottom > top!)
311        push @occupiedAreas, [$x1, $x2, $y1, $y2] ;
312        $qtPoiLabels->add ($#occupiedAreas, $x1, $y1, $x2, $y2) ;
313}
314
315sub areaOccupied {
316#
317# look up possible interfering objects in quad tree and check for collision
318#
319        my ($x1, $x2, $y1, $y2) = @_ ;
320        # left, right, bottom, top (bottom > top!)
321        my $occupied = 0 ;
322
323        my $ref2 = $qtPoiLabels->getEnclosedObjects ($x1, $y2, $x2, $y1) ;
324        my @index = @$ref2 ;
325        my @occupiedAreasTemp = () ;
326        foreach my $nr (@index) {
327                push @occupiedAreasTemp, $occupiedAreas[$nr] ;
328        } 
329
330        LAB1: foreach my $area (@occupiedAreasTemp) {
331                my $intersection = 1 ;
332                if ($x1 > $area->[1]) { $intersection = 0 ; } ;
333                if ($x2 < $area->[0]) { $intersection = 0 ; } ;
334                if ($y1 < $area->[3]) { $intersection = 0 ; } ;
335                if ($y2 > $area->[2]) { $intersection = 0 ; } ;
336                if ($intersection == 1) { 
337                        $occupied = 1 ; 
338                        last LAB1 ;     
339                }
340        }
341        return ($occupied) ;
342}
343
344sub splitLabel {
345#
346# split label text at space locations and then merge new parts if new part will be smaller than 21 chars
347#
348        my $text = shift ;
349        my @lines = split / /, $text ;
350        my $merged = 1 ;
351        while ($merged) {
352                $merged = 0 ;
353                LAB2: for (my $i=0; $i<$#lines; $i++) {
354                        if (length ($lines[$i] . " " . $lines[$i+1]) <= 20) {
355                                $lines[$i] = $lines[$i] . " " . $lines[$i+1] ;
356                                splice (@lines, $i+1, 1) ;
357                                $merged = 1 ;
358                                last LAB2 ;
359                        }
360                }
361        }
362        return (\@lines) ;
363}
364
365
366sub svgElementIcon {
367#
368# create SVG text for icons
369#
370        my ($x, $y, $icon, $sizeX, $sizeY) = @_ ;
371        my ($out) = "<image x=\"" . $x . "\"" ;
372        $out .= " y=\"" . $y . "\"" ;
373        if ($sizeX > 0) { $out .= " width=\"" . $sizeX . "\"" ; }
374        if ($sizeY > 0) { $out .= " height=\"" . $sizeY . "\"" ; }
375        $out .= " xlink:href=\"" . $icon . "\" />" ;
376
377        return ($out) ; 
378}
379
380sub drawHead {
381#
382# draws text on top left corner of the picture
383#
384        my ($text, $col, $size, $font) = @_ ;
385        push @svgOutputText, svgElementText (20, 20, $text, $size, $font, $col) ;
386}
387
388sub drawFoot {
389#
390# draws text on bottom left corner of the picture
391#
392        my ($text, $col, $size, $font) = @_ ;
393        my $posX = 80 ;
394        my $posY = 40 ;
395        push @svgOutputText, svgElementText (
396                scalePoints ( scaleBase ($posX) ), 
397                $sizeY - ( scalePoints ( scaleBase ($posY) ) ), 
398                $text, 
399                scalePoints ( scaleBase ($size) ) , 
400                $font, 
401                $col
402        ) ;
403}
404
405
406
407sub drawTextPix {
408#
409# draws text at pixel position
410# with small offset direction bottom
411#
412        my ($x1, $y1, $text, $col, $size, $font) = @_ ;
413
414        push @svgOutputPixel, svgElementText ($x1, $y1, $text, $size, $font, $col) ;
415}
416
417sub drawTextPixGrid {
418#
419# draws text at pixel position. code goes to grid
420#
421        my ($x1, $y1, $text, $col, $size) = @_ ;
422
423        push @svgOutputPixelGrid, svgElementText ($x1, $y1+9, $text, $size, "sans-serif", $col) ;
424}
425
426sub drawNodeDot {
427#
428# draws node as a dot at given real world coordinates
429#
430        my ($lon, $lat, $col, $size) = @_ ;
431        my ($x1, $y1) = convert ($lon, $lat) ;
432        push @{$svgOutputNodes{0}}, svgElementCircleFilled ($x1, $y1, $size, $col) ;
433}
434
435sub drawNodeDotRouteStops {
436#
437# draws node as a dot at given real world coordinates
438#
439        my ($lon, $lat, $col, $size) = @_ ;
440        my ($x1, $y1) = convert ($lon, $lat) ;
441        push @svgOutputRouteStops, svgElementCircleFilled ($x1, $y1, $size, $col) ;
442}
443
444sub drawNodeDotPix {
445#
446# draws node as a dot at given pixels
447#
448        my ($x1, $y1, $col, $size) = @_ ;
449        push @svgOutputPixel, svgElementCircleFilled ($x1, $y1, $size, $col) ;
450}
451
452
453sub drawCircle {
454        my ($lon, $lat, $radius, $color, $thickness) = @_ ;
455        # radius in meters
456
457        my ($x, $y) = convert ($lon, $lat) ;
458        my $thickness2 = scalePoints ($thickness) ;
459
460        my $radiusPixel = $radius / (1000 * distance ($left, $bottom, $right, $bottom) ) * $sizeX ;
461        push @svgOutputPixelGrid, svgElementCircle ($x, $y, $radiusPixel, $thickness2, $color) ;
462}
463
464sub drawWay {
465#
466# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
467# $size = thickness
468#
469        my ($layer, $col, $size, $dash, @nodes) = @_ ;
470        my $i ;
471        my @points = () ;
472
473        for ($i=0; $i<$#nodes; $i+=2) {
474                my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
475                push @points, $x ; push @points, $y ; 
476        }
477        push @{$svgOutputWays{$layer+$size/100}}, svgElementPolyline ($col, $size, $dash, @points) ;
478}
479
480sub drawWayBridge {
481#
482# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
483# $size = thickness
484#
485        my ($layer, $col, $size, $dash, @nodes) = @_ ;
486        my $i ;
487        my @points = () ;
488
489        if ($dash eq "11") { $dash = $dashStyle{11} ; }
490
491        for ($i=0; $i<$#nodes; $i+=2) {
492                my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
493                push @points, $x ; push @points, $y ; 
494        }
495        push @{$svgOutputWays{$layer+$size/100}}, svgElementPolylineBridge ($col, $size, $dash, @points) ;
496}
497
498sub drawWayPix {
499#
500# draws way as a line at given pixels. nodes have to be passed as array ($x, $y, $x, $y...)
501# $size = thickness
502#
503        my ($col, $size, $dash, @nodes) = @_ ;
504        my $i ;
505        my @points = () ;
506
507        for ($i=0; $i<$#nodes; $i+=2) {
508                my ($x, $y) = ($nodes[$i], $nodes[$i+1]) ;
509                push @points, $x ; push @points, $y ; 
510        }
511        push @svgOutputPixel, svgElementPolyline ($col, $size, $dash, @points) ;
512}
513
514sub drawWayPixGrid {
515#
516# draws way as a line at given pixels. nodes have to be passed as array ($x, $y, $x, $y...)
517# $size = thickness
518#
519        my ($col, $size, $dash, @nodes) = @_ ;
520        my $i ;
521        my @points = () ;
522
523        for ($i=0; $i<$#nodes; $i+=2) {
524                my ($x, $y) = ($nodes[$i], $nodes[$i+1]) ;
525                push @points, $x ; push @points, $y ; 
526        }
527        push @svgOutputPixelGrid, svgElementPolyline ($col, $size, $dash, @points) ;
528}
529
530
531sub labelWay {
532#
533# labels a way
534#
535        my ($col, $size, $font, $text, $tSpan, @nodes) = @_ ;
536        my $i ;
537        my @points = () ;
538
539        for ($i=0; $i<$#nodes; $i+=2) {
540                my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
541                push @points, $x ; push @points, $y ; 
542        }
543        my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
544        push @svgOutputDef, svgElementPath ($pathName, @points) ;
545        push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $text, $pathName, $tSpan, "middle", 50, 0) ;
546}
547
548
549sub createWayLabels {
550#
551# finally take all way label candidates and try to label them
552#
553        my ($ref, $ruleRef, $declutter, $halo, $svgName) = @_ ;
554        my @labelCandidates = @$ref ;
555        my @wayRules = @$ruleRef ;
556        my %notDrawnLabels = () ;
557        my %drawnLabels = () ;
558
559        # calc ratio to label ways first where label just fits
560        # these will be drawn first
561        foreach my $candidate (@labelCandidates) {
562                my $wLen = $candidate->[2] ;
563                my $lLen = $candidate->[3] ;
564                if ($wLen == 0) { $wLen = 1 ; }
565                if ($lLen == 0) { $lLen = 1 ; }
566                $candidate->[5] = $lLen / $wLen ;
567        }
568        @labelCandidates = sort { $b->[5] <=> $a->[5] } @labelCandidates ;
569
570        foreach my $candidate (@labelCandidates) {
571                my $rule = $candidate->[0] ; # integer
572                my @ruleData = @{$wayRules[$rule]} ;
573                my $name = $candidate->[1] ;
574                my $wLen = $candidate->[2] ;
575                my $lLen = $candidate->[3] ;
576                my @points = @{$candidate->[4]} ;
577
578                my $toLabel = 1 ;
579                if ( ($declutter eq "1") and ($points[0] > $points[-2]) and ( ($ruleData[1] eq "motorway") or ($ruleData[1] eq "trunk") ) ) {
580                        $toLabel = 0 ;
581                }
582
583                if ($lLen > $wLen*0.95) {
584                        $notDrawnLabels { $name } = 1 ;
585                }
586
587                if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) {
588                        # label too long
589                        $numWayLabelsOmitted++ ;
590                }
591                else {
592
593                        if (grep /shield/i, $name) {
594                                # create shield if necessary
595                                if ( ! defined $createdShields{ $name }) {
596                                        createShield ($name, $ruleData[$wayIndexLabelSize]) ;
597                                }
598
599                                # @points = (x1, y1, x2, y2 ... )
600                                # $wLen in pixels
601                                # $lLen in pixels
602                                # <use xlink:href="#a661" x="40" y="40" />
603
604                                my $shieldMaxSize = $shieldXSize{ $name } ;
605                                if ($shieldYSize{ $name } > $shieldMaxSize) { $shieldMaxSize = $shieldYSize{ $name } ; } 
606
607                                my $numShields = int ($wLen / ($shieldMaxSize * 12) ) ;
608                                # if ($numShields > 4) { $numShields = 4 ; }
609
610                                if ($numShields > 0) {
611                                        my $step = $wLen / ($numShields + 1) ;
612                                        my $position = $step ; 
613                                        while ($position < $wLen) {
614                                                my ($x, $y) = getPointOfWay (\@points, $position) ;
615                                                # print "XY: $x, $y\n" ;
616
617                                                # place shield if not occupied
618                       
619                                                my $x2 = int ($x - $shieldXSize{ $name } / 2) ;
620                                                my $y2 = int ($y - $shieldYSize{ $name } / 2) ;
621
622                                                # print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n" ;
623
624                                                if ( ! areaOccupied ($x2, $x2+$shieldXSize{ $name }, $y2+$shieldYSize{ $name }, $y2) ) {
625
626                                                        my $id = $createdShields{$name};
627                                                        push @svgOutputIcons, "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />" ;
628
629                                                        occupyArea ($x2, $x2+$shieldXSize{ $name }, $y2+$shieldYSize{ $name }, $y2) ;
630                                                }
631
632                                                $position += $step ;
633                                        }
634                                }
635
636                        }
637
638                        else {
639
640                                # print "$wLen - $name - $lLen\n" ;
641                                my $numLabels = int ($wLen / (4 * $lLen)) ;
642                                if ($numLabels < 1) { $numLabels = 1 ; }
643                                if ($numLabels > 4) { $numLabels = 4 ; }
644
645                                if ($numLabels == 1) {
646                                        my $spare = 0.95 * $wLen - $lLen ;
647                                        my $sparePercentHalf = $spare / ($wLen*0.95) *100 / 2 ;
648                                        my $startOffset = 50 - $sparePercentHalf ;
649                                        my $endOffset = 50 + $sparePercentHalf ;
650                                        # five possible positions per way
651                                        my $step = ($endOffset - $startOffset) / 5 ;
652                                        my @positions = () ;
653                                        my $actual = $startOffset ;
654                                        while ($actual <= $endOffset) {
655                                                my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ;
656                                                my @way = @$ref ;
657                                                my ($col) = lineCrossings (\@way) ;
658                                                # calc quality of position. distance from middle and bend angles
659                                                my $quality = $angle + abs (50 - $actual) ;
660                                                if ($col == 0) { push @positions, ["middle", $actual, $quality] ; }
661                                                $actual += $step ;
662                                        }
663                                        if (scalar @positions > 0) {
664                                                $drawnLabels { $name } = 1 ;
665                                                # sort by quality and take best one
666                                                @positions = sort {$a->[2] <=> $b->[2]} @positions ;
667                                                my ($pos) = shift @positions ;
668                                                my ($ref, $angle) = subWay (\@points, $lLen, $pos->[0], $pos->[1]) ;
669                                                my @finalWay = @$ref ;
670                                                my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
671                                                push @svgOutputDef, svgElementPath ($pathName, @points) ;
672                                                push @svgOutputPathText, svgElementPathTextAdvanced ($ruleData[$wayIndexLabelColor], $ruleData[$wayIndexLabelSize], 
673                                                        $ruleData[$wayIndexLabelFont], $name, $pathName, $ruleData[$wayIndexLabelOffset], $pos->[0], $pos->[1], $halo) ;
674                                                occupyLines (\@finalWay) ;
675                                        }
676                                        else {
677                                                $numWayLabelsOmitted++ ;
678                                        }
679                                }
680                                else { # more than one label
681                                        my $labelDrawn = 0 ;
682                                        my $interval = int (100 / ($numLabels + 1)) ;
683                                        my @positions = () ;
684                                        for (my $i=1; $i<=$numLabels; $i++) {
685                                                push @positions, $i * $interval ;
686                                        }
687                       
688                                        foreach my $position (@positions) {
689                                                my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ;
690                                                my (@finalWay) = @$refFinal ;
691                                                my ($collision) = lineCrossings (\@finalWay) ;
692                                                if ($collision == 0) {
693                                                        $labelDrawn = 1 ;
694                                                        $drawnLabels { $name } = 1 ;
695                                                        my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
696                                                        push @svgOutputDef, svgElementPath ($pathName, @finalWay) ;
697                                                        push @svgOutputPathText, svgElementPathTextAdvanced ($ruleData[$wayIndexLabelColor], $ruleData[$wayIndexLabelSize], 
698                                                                $ruleData[$wayIndexLabelFont], $name, $pathName, $ruleData[$wayIndexLabelOffset], "middle", 50, $halo) ;
699                                                        occupyLines (\@finalWay) ;
700                                                }
701                                                else {
702                                                        # print "INFO: $name labeled less often than desired.\n" ;
703                                                }
704                                        }
705                                        if ($labelDrawn == 0) {
706                                                $notDrawnLabels { $name } = 1 ;
707                                        }
708                                }
709                        }
710                }
711        }
712        my $labelFileName = $svgName ;
713        $labelFileName =~ s/\.svg/_NotDrawnLabels.txt/ ;
714        my $labelFile ;
715        open ($labelFile, ">", $labelFileName) or die ("couldn't open label file $labelFileName") ;
716        print $labelFile "Not drawn labels\n\n" ;
717        foreach my $labelName (sort keys %notDrawnLabels) {
718                if (!defined $drawnLabels { $labelName } ) {
719                        print $labelFile "$labelName\n" ;
720                }
721        }
722        close ($labelFile) ;
723
724}
725
726
727sub occupyLines {
728#
729# store drawn lines and make quad tree entries
730# accepts multiple coordinates that form a way
731#
732        my ($ref) = shift ;
733        my @coordinates = @$ref ;
734
735        for (my $i=0; $i<$#coordinates-2; $i+=2) {
736                push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
737                # print "PUSHED $coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]\n" ;
738                # drawWayPix ("black", 1, 0, @coordinates)
739
740                $qtWayLabels->add ($#lines, $coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]) ;
741
742        }
743}
744
745
746sub lineCrossings {
747#
748# checks for line collisions
749# accepts multiple lines in form of multiple coordinates
750#
751        my ($ref) = shift ;
752        my @coordinates = @$ref ;
753        my @testLines = () ;
754
755        for (my $i=0; $i<$#coordinates-2; $i+=2) {
756                push @testLines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
757        }
758
759        # find area of way
760        my ($found) = 0 ;
761        my $xMin = 999999 ; my $xMax = 0 ;
762        my $yMin = 999999 ; my $yMax = 0 ;
763        foreach my $l1 (@testLines) {
764                if ($l1->[0] > $xMax) { $xMax = $l1->[0] ; }
765                if ($l1->[0] < $xMin) { $xMin = $l1->[0] ; }
766                if ($l1->[1] > $yMax) { $yMax = $l1->[1] ; }
767                if ($l1->[1] < $yMin) { $yMin = $l1->[1] ; }
768        }
769       
770        # get indexes from quad tree
771        my $ref2 = $qtWayLabels->getEnclosedObjects ($xMin, $yMin, $xMax, $yMax) ;
772        # create array linesInArea
773        my @linesInAreaIndex = @$ref2 ;
774        my @linesInArea = () ;
775        foreach my $lineNr (@linesInAreaIndex) {
776                push @linesInArea, $lines[$lineNr] ;
777        } 
778
779        LABCR: foreach my $l1 (@testLines) {
780                foreach my $l2 (@linesInArea) {
781                        my ($x, $y) = intersection (@$l1, @$l2) ;
782                        if (($x !=0) and ($y != 0)) {
783                                $found = 1 ;
784                                last LABCR ;
785                        }
786                }
787        }
788        if ($found == 0) {
789                return 0 ;
790        }
791        else {
792                return 1 ;
793        }       
794}
795
796sub triangleNode {
797#
798# get segment of segment as coordinates
799# from start or from end of segment
800#
801        # 0 = start
802        # 1 = end
803        my ($x1, $y1, $x2, $y2, $len, $startEnd) = @_ ;
804        my ($c) = sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2) ;
805        my $percent = $len / $c ;
806
807        my ($x, $y) ;
808        if ($startEnd == 0 ) { 
809                $x = $x1 + ($x2-$x1)*$percent ;
810                $y = $y1 + ($y2-$y1)*$percent ;
811        }
812        else {
813                $x = $x2 - ($x2-$x1)*$percent ;
814                $y = $y2 - ($y2-$y1)*$percent ;
815        }
816        return ($x, $y) ;
817}
818
819
820sub subWay {
821#
822# takes coordinates and label information and creates new way/path
823# also calculates total angles / bends
824#
825        my ($ref, $labLen, $alignment, $position) = @_ ;
826        my @coordinates = @$ref ;
827        my @points ;
828        my @dists ;
829        my @angles = () ;
830
831        for (my $i=0; $i < $#coordinates; $i+=2) {
832                push @points, [$coordinates[$i],$coordinates[$i+1]] ;
833        }
834
835        $dists[0] = 0 ;
836        my $dist = 0 ;
837        if (scalar @points > 1) {
838                for (my $i=1;$i<=$#points; $i++) {
839                        $dist = $dist + sqrt ( ($points[$i-1]->[0]-$points[$i]->[0])**2 + ($points[$i-1]->[1]-$points[$i]->[1])**2 ) ;
840                        $dists[$i] = $dist ;
841                }                       
842        }
843
844        # calc angles at nodes
845        if (scalar @points > 2) {
846                for (my $i=1;$i<$#points; $i++) {
847                        $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]) ;
848                }                       
849        }
850
851        my $wayLength = $dist ;
852        my $refPoint = $wayLength / 100 * $position ;
853        my $labelStart ; my $labelEnd ;
854        if ($alignment eq "start") { # left
855                $labelStart = $refPoint ;
856                $labelEnd = $labelStart + $labLen ;
857        }
858        if ($alignment eq "end") { # right
859                $labelEnd = $refPoint ;
860                $labelStart = $labelEnd - $labLen ;
861        }
862        if ($alignment eq "middle") { # center
863                $labelEnd = $refPoint + $labLen / 2 ;
864                $labelStart = $refPoint - $labLen / 2 ;
865        }
866
867        # find start and end segments
868        my $startSeg ; my $endSeg ;
869        for (my $i=0; $i<$#points; $i++) {
870                if ( ($dists[$i]<=$labelStart) and ($dists[$i+1]>=$labelStart) ) { $startSeg = $i ; }
871                if ( ($dists[$i]<=$labelEnd) and ($dists[$i+1]>=$labelEnd) ) { $endSeg = $i ; }
872        }
873
874        my @finalWay = () ;
875        my $finalAngle = 0 ;
876        my ($sx, $sy) = triangleNode ($coordinates[$startSeg*2], $coordinates[$startSeg*2+1], $coordinates[$startSeg*2+2], $coordinates[$startSeg*2+3], $labelStart-$dists[$startSeg], 0) ;
877        push @finalWay, $sx, $sy ;
878
879        if ($startSeg != $endSeg) {
880                for (my $i=$startSeg+1; $i<=$endSeg; $i++) { 
881                        push @finalWay, $coordinates[$i*2], $coordinates[$i*2+1] ; 
882                        $finalAngle += abs ($angles[$i]) ;
883                }
884        }
885
886        my ($ex, $ey) = triangleNode ($coordinates[$endSeg*2], $coordinates[$endSeg*2+1], $coordinates[$endSeg*2+2], $coordinates[$endSeg*2+3], $labelEnd-$dists[$endSeg], 0) ;
887        push @finalWay, $ex, $ey ;
888       
889        return (\@finalWay, $finalAngle) ;     
890}
891
892sub intersection {
893#
894# returns intersection point of two lines, else (0,0)
895#
896        my ($g1x1) = shift ;
897        my ($g1y1) = shift ;
898        my ($g1x2) = shift ;
899        my ($g1y2) = shift ;
900       
901        my ($g2x1) = shift ;
902        my ($g2y1) = shift ;
903        my ($g2x2) = shift ;
904        my ($g2y2) = shift ;
905
906        if (($g1x1 == $g2x1) and ($g1y1 == $g2y1)) { # p1 = p1 ?
907                return ($g1x1, $g1y1) ;
908        }
909        if (($g1x1 == $g2x2) and ($g1y1 == $g2y2)) { # p1 = p2 ?
910                return ($g1x1, $g1y1) ;
911        }
912        if (($g1x2 == $g2x1) and ($g1y2 == $g2y1)) { # p2 = p1 ?
913                return ($g1x2, $g1y2) ;
914        }
915
916        if (($g1x2 == $g2x2) and ($g1y2 == $g2y2)) { # p2 = p1 ?
917                return ($g1x2, $g1y2) ;
918        }
919
920        my $g1m ;
921        if ( ($g1x2-$g1x1) != 0 )  {
922                $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
923        }
924        else {
925                $g1m = 999999 ;
926        }
927
928        my $g2m ;
929        if ( ($g2x2-$g2x1) != 0 ) {
930                $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
931        }
932        else {
933                $g2m = 999999 ;
934        }
935
936        if ($g1m == $g2m) {   # parallel
937                return (0, 0) ;
938        }
939
940        my ($g1b) = $g1y1 - $g1m * $g1x1 ; # abschnitte
941        my ($g2b) = $g2y1 - $g2m * $g2x1 ;
942
943        my ($sx) = ($g2b-$g1b) / ($g1m-$g2m) ;             # schnittpunkt
944        my ($sy) = ($g1m*$g2b - $g2m*$g1b) / ($g1m-$g2m);
945
946        my ($g1xmax) = max ($g1x1, $g1x2) ;
947        my ($g1xmin) = min ($g1x1, $g1x2) ;     
948        my ($g1ymax) = max ($g1y1, $g1y2) ;     
949        my ($g1ymin) = min ($g1y1, $g1y2) ;     
950
951        my ($g2xmax) = max ($g2x1, $g2x2) ;
952        my ($g2xmin) = min ($g2x1, $g2x2) ;     
953        my ($g2ymax) = max ($g2y1, $g2y2) ;     
954        my ($g2ymin) = min ($g2y1, $g2y2) ;     
955
956        if      (($sx >= $g1xmin) and
957                ($sx >= $g2xmin) and
958                ($sx <= $g1xmax) and
959                ($sx <= $g2xmax) and
960                ($sy >= $g1ymin) and
961                ($sy >= $g2ymin) and
962                ($sy <= $g1ymax) and
963                ($sy <= $g2ymax)) {
964                return ($sx, $sy) ;
965        }
966        else {
967                return (0, 0) ;
968        }
969} 
970
971sub angleMapgen {
972#
973# angle between lines/segments
974#
975        my ($g1x1) = shift ;
976        my ($g1y1) = shift ;
977        my ($g1x2) = shift ;
978        my ($g1y2) = shift ;
979        my ($g2x1) = shift ;
980        my ($g2y1) = shift ;
981        my ($g2x2) = shift ;
982        my ($g2y2) = shift ;
983
984        my $g1m ;
985        if ( ($g1x2-$g1x1) != 0 )  {
986                $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
987        }
988        else {
989                $g1m = 999999999 ;
990        }
991
992        my $g2m ;
993        if ( ($g2x2-$g2x1) != 0 ) {
994                $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
995        }
996        else {
997                $g2m = 999999999 ;
998        }
999
1000        if ($g1m == $g2m) {   # parallel
1001                return (0) ;
1002        }
1003        else {
1004                my $t1 = $g1m -$g2m ;
1005                my $t2 = 1 + $g1m * $g2m ;
1006                if ($t2 == 0) {
1007                        return 90 ;
1008                }
1009                else {
1010                        my $a = atan (abs ($t1/$t2)) / 3.141592654 * 180 ;
1011                        return $a ;
1012                }
1013        }
1014} 
1015
1016
1017#------------------------------------------------------------------------------------------------------------
1018
1019
1020sub drawArea {
1021#
1022# draws an area like waterway=riverbank or landuse=forest.
1023# pass color as string and nodes as list (x1, y1, x2, y2...) - real world coordinates
1024#
1025        my ($col, $icon, @nodes) = @_ ;
1026        my $i ;
1027        my @points = () ;
1028       
1029        for ($i=0; $i<$#nodes; $i+=2) {
1030                my ($x1, $y1) = convert ($nodes[$i], $nodes[$i+1]) ;
1031                push @points, $x1 ; push @points, $y1 ; 
1032        }
1033        push @svgOutputAreas, svgElementPolygonFilled ($col, $icon, @points) ;
1034}
1035
1036sub drawAreaPix {
1037#
1038# draws an area like waterway=riverbank or landuse=forest.
1039# pass color as string and nodes as list (x1, y1, x2, y2...) - pixels
1040# used for legend
1041#
1042        my ($col, $icon, @nodes) = @_ ;
1043        my $i ;
1044        my @points = () ;
1045        for ($i=0; $i<$#nodes; $i+=2) {
1046                my ($x1, $y1) = ($nodes[$i], $nodes[$i+1]) ;
1047                push @points, $x1 ; push @points, $y1 ; 
1048        }
1049        push @svgOutputPixel, svgElementPolygonFilled ($col, $icon, @points) ;
1050}
1051
1052sub drawAreaMP {
1053#
1054# draws an area like waterway=riverbank or landuse=forest.
1055# pass color as string and nodes as list (x1, y1, x2, y2...) - real world coordinates
1056#
1057# receives ARRAY of ARRAY of NODES LIST! NOT coordinates list like other functions
1058#
1059        my ($col, $icon, $ref, $refLon, $refLat) = @_ ;
1060        # my %lon = %$refLon ;
1061        # my %lat = %$refLat ;
1062        my @ways = @$ref ;
1063        my $i ;
1064        my @array = () ;
1065
1066        foreach my $way (@ways) {       
1067                my @actual = @$way ;
1068                # print "drawAreaMP - actual ring/way: @actual\n" ;
1069                        my @points = () ;
1070                for ($i=0; $i<$#actual; $i++) { # without last node! SVG command 'z'!
1071                        my ($x1, $y1) = convert ( $$refLon{$actual[$i]}, $$refLat{$actual[$i]} ) ;
1072                        push @points, $x1 ; push @points, $y1 ; 
1073                }
1074                push @array, [@points] ;
1075                # print "drawAreaMP - array pushed: @points\n" ;
1076        }
1077
1078        push @svgOutputAreas, svgElementMultiPolygonFilled ($col, $icon, \@array) ;
1079}
1080
1081
1082
1083sub drawRuler {
1084#
1085# draws ruler in top right corner, size is automatic
1086#
1087        my $col = shift ;
1088
1089        my $B ; my $B2 ;
1090        my $L ; my $Lpix ;
1091        my $x ;
1092        my $text ;
1093        my $rx = $sizeX - scalePoints (scaleBase (80)) ;
1094        my $ry = scalePoints (scaleBase (60)) ; #v1.17
1095        # my $ry = scalePoints (scaleBase (80)) ;
1096        my $lineThickness = 8 ; # at 300dpi
1097        my $textSize = 40 ; # at 300 dpi
1098        my $textDist = 60 ; # at 300 dpi
1099        my $lineLen = 40 ; # at 300 dpi
1100               
1101        $B = $right - $left ;                           # in degrees
1102        $B2 = $B * cos ($top/360*3.14*2) * 111.1 ;      # in km
1103        $text = "50m" ; $x = 0.05 ;                     # default length ruler
1104
1105        if ($B2 > 0.5) {$text = "100m" ; $x = 0.1 ; }   # enlarge ruler
1106        if ($B2 > 1) {$text = "500m" ; $x = 0.5 ; }     # enlarge ruler
1107        if ($B2 > 5) {$text = "1km" ; $x = 1 ; }
1108        if ($B2 > 10) {$text = "5km" ; $x = 5 ; }
1109        if ($B2 > 50) {$text = "10km" ; $x = 10 ; }
1110        $L = $x / (cos ($top/360*3.14*2) * 111.1 ) ;    # length ruler in km
1111        $Lpix = $L / $B * $sizeX ;                      # length ruler in pixels
1112
1113        push @svgOutputText, svgElementLine ($rx-$Lpix,$ry,$rx,$ry, $col, scalePoints( scaleBase ($lineThickness) ) ) ;
1114        push @svgOutputText, svgElementLine ($rx-$Lpix,$ry,$rx-$Lpix,$ry+scalePoints(scaleBase($lineLen)), $col, scalePoints( scaleBase ($lineThickness) ) ) ;
1115        push @svgOutputText, svgElementLine ($rx,$ry,$rx,$ry+scalePoints(scaleBase($lineLen)), $col, scalePoints( scaleBase ($lineThickness) )) ;
1116        push @svgOutputText, svgElementLine ($rx-$Lpix/2,$ry,$rx-$Lpix/2,$ry+scalePoints(scaleBase($lineLen/2)), $col, scalePoints( scaleBase ($lineThickness) ) ) ;
1117        push @svgOutputText, svgElementText ($rx-$Lpix, $ry+scalePoints(scaleBase($textDist)), $text, scalePoints(scaleBase($textSize)), "sans-serif", $col) ;
1118}
1119
1120sub drawGrid {
1121#
1122# draw grid on top of map. receives number of parts in x/lon direction
1123#
1124        my ($number, $color) = @_ ;
1125        my $part = $sizeX / $number ;
1126        my $numY = $sizeY / $part ;
1127        # vertical lines
1128        for (my $i = 1; $i <= $number; $i++) {
1129                drawWayPixGrid ($color, 1, $dashStyle{1}, $i*$part, 0, $i*$part, $sizeY) ;
1130                drawTextPixGrid (($i-1)*$part+$part/2, scalePoints(scaleBase(160)), chr($i+64), $color, scalePoints(scaleBase(60))) ;
1131        }
1132        # hor. lines
1133        for (my $i = 1; $i <= $numY; $i++) {
1134                drawWayPixGrid ($color, 1, $dashStyle{1}, 0, $i*$part, $sizeX, $i*$part) ;
1135                drawTextPixGrid (scalePoints(scaleBase(20)), ($i-1)*$part+$part/2, $i, $color, scalePoints(scaleBase(60))) ;
1136        }
1137}
1138
1139
1140
1141#####
1142# SVG
1143#####
1144
1145
1146sub writeSVG {
1147#
1148# writes svg elemets collected so far to file
1149#
1150        my ($fileName) = shift ;
1151        my $file ;
1152        my ($paper, $w, $h) = fitsPaper ($dpi) ;
1153
1154        open ($file, ">", $fileName) || die "can't open svg output file";
1155        print $file "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>\n" ;
1156        print $file "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\" >\n" ;
1157
1158        my ($svg) = "<svg version=\"1.1\" baseProfile=\"full\" xmlns=\"http://www.w3.org/2000/svg\" " ;
1159        $svg .= "xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:ev=\"http://www.w3.org/2001/xml-events\" " ;
1160        $svg .= "width=\"$w" . "cm\" height=\"$h" . "cm\" viewBox=\"0 0 $sizeX $sizeY\">\n" ;
1161        print $file $svg ;
1162
1163        print $file "<rect width=\"$sizeX\" height=\"$sizeY\" y=\"0\" x=\"0\" fill=\"#ffffff\" />\n" ;
1164
1165        print $file "<defs>\n" ;
1166        foreach (@svgOutputDef) { print $file $_, "\n" ; }
1167        print $file "</defs>\n" ;
1168
1169        print $file "<g id=\"Areas\">\n" ;
1170        foreach (@svgOutputAreas) { print $file $_, "\n" ; }
1171        print $file "</g>\n" ;
1172
1173        print $file "<g id=\"Ways\">\n" ;
1174        foreach my $layer (sort {$a <=> $b} (keys %svgOutputWays)) {
1175                foreach (@{$svgOutputWays{$layer}}) { print $file $_, "\n" ; }
1176        }
1177        print $file "</g>\n" ;
1178
1179        print $file "<g id=\"Nodes\">\n" ;
1180        foreach my $layer (sort {$a <=> $b} (keys %svgOutputNodes)) {
1181                foreach (@{$svgOutputNodes{$layer}}) { print $file $_, "\n" ; }
1182        }
1183        print $file "</g>\n" ;
1184
1185
1186        print $file "<g id=\"Routes\">\n" ;
1187        foreach (@svgOutputRoutes) { print $file $_, "\n" ; }
1188        print $file "</g>\n" ;
1189
1190        print $file "<g id=\"RouteStops\">\n" ;
1191        foreach (@svgOutputRouteStops) { print $file $_, "\n" ; }
1192        print $file "</g>\n" ;
1193
1194        print $file "<g id=\"Text\">\n" ;
1195        foreach (@svgOutputText) { print $file $_, "\n" ; }
1196        print $file "</g>\n" ;
1197
1198        print $file "<g id=\"Icons\">\n" ;
1199        foreach (@svgOutputIcons) { print $file $_, "\n" ; }
1200        print $file "</g>\n" ;
1201
1202        print $file "<g id=\"Labels\">\n" ;
1203        foreach (@svgOutputPathText) { print $file $_, "\n" ; }
1204        print $file "</g>\n" ;
1205
1206        print $file "<g id=\"Grid\">\n" ;
1207        foreach (@svgOutputPixelGrid) { print $file $_, "\n" ; }
1208        print $file "</g>\n" ;
1209
1210        print $file "<g id=\"Pixels\">\n" ;
1211        foreach (@svgOutputPixel) { print $file $_, "\n" ; }
1212        print $file "</g>\n" ;
1213
1214        print $file "</svg>\n" ;
1215        close ($file) ;
1216}
1217
1218sub svgElementText {
1219#
1220# creates string with svg element incl utf-8 encoding
1221#
1222        my ($x, $y, $text, $size, $font, $col) = @_ ; 
1223        my $svg = "<text x=\"" . $x . "\" y=\"" . $y . 
1224                "\" font-size=\"" . $size . 
1225                "\" font-family=\"" . $font . 
1226                "\" fill=\"" . $col . 
1227                "\">" . $text . "</text>" ;
1228        return $svg ;
1229}
1230
1231sub svgElementCircleFilled {
1232#
1233# draws circle filled
1234#
1235        my ($x, $y, $size, $col) = @_ ;
1236        my $svg = "<circle cx=\"" . $x . "\" cy=\"" . $y . "\" r=\"" . $size . "\" fill=\"" . $col  . "\" />" ;
1237        return $svg ;
1238}
1239
1240sub svgElementCircle {
1241#
1242# draws not filled circle / dot
1243#
1244        my ($x, $y, $radius, $size, $col) = @_ ;
1245        my $svg = "<circle cx=\"" . $x . "\" cy=\"" . $y . "\" r=\"" . $radius . "\" fill=\"none\" stroke=\"" . $col  . "\" stroke-width=\"$size\" />" ;
1246        return $svg ;
1247}
1248
1249sub svgElementLine {
1250#
1251# draws line between two points
1252#
1253        my ($x1, $y1, $x2, $y2, $col, $size) = @_ ;
1254        my $svg = "<polyline points=\"" . $x1 . "," . $y1 . " " . $x2 . "," . $y2 . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\"/>" ;
1255        return $svg ;
1256}
1257
1258
1259
1260
1261sub svgElementPolyline {
1262#
1263# draws way to svg
1264#
1265        my ($col, $size, $dash, @points) = @_ ;
1266
1267        my $refp = simplifyPoints (\@points) ;
1268        @points = @$refp ;
1269
1270
1271        my $svg = "<polyline points=\"" ;
1272        my $i ;
1273        for ($i=0; $i<scalar(@points)-1; $i+=2) {
1274                $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
1275        }
1276        if ($dash eq "none") { 
1277                my $lc = "round" ;
1278                $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" stroke-linecap=\"" . $lc . "\" stroke-linejoin=\"" . $lineJoin . "\" fill=\"none\" />" ;
1279        }
1280        else {
1281                my $lc = "" ; my $ds = "" ;
1282                ($lc, $ds) = getDashElements ($dash) ;
1283                $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" stroke-linecap=\"" . $lc . "\" stroke-linejoin=\"" . $lineJoin . "\" stroke-dasharray=\"" . $ds . "\" fill=\"none\" />" ;
1284        }
1285        return $svg ;
1286}
1287
1288
1289sub svgElementPolylineBridge {
1290#
1291# draws way to svg
1292#
1293        my ($col, $size, $dash, @points) = @_ ;
1294
1295        my $refp = simplifyPoints (\@points) ;
1296        @points = @$refp ;
1297
1298        my $svg = "<polyline points=\"" ;
1299        my $i ;
1300        for ($i=0; $i<scalar(@points)-1; $i+=2) {
1301                $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
1302        }
1303        if ($dash eq "none") { 
1304                $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" fill=\"none\" />" ;
1305        }
1306        else {
1307                my $lc = "" ; my $ds ;
1308                ($lc, $ds) = getDashElements ($dash) ;
1309                $svg = $svg . "\" stroke=\"" . $col . "\" stroke-width=\"" . $size . "\" stroke-linecap=\"" . $lc . "\" stroke-dasharray=\"" . $ds . "\" fill=\"none\" />" ;
1310        }
1311        return $svg ;
1312}
1313
1314
1315
1316sub getDashElements {
1317        my $string = shift ;
1318        my @a = split /,/, $string ;
1319        my $cap = pop @a ;
1320        my $ds = "" ; my $first = 1 ;
1321        foreach my $v (@a) {
1322                if ($first) {
1323                        $first = 0 ;
1324                }
1325                else {
1326                        $ds .= "," ;
1327                }
1328                $ds .= $v ;
1329        }
1330        # print "GETDE $cap, $ds\n" ;
1331        return ($cap, $ds) ;
1332}
1333
1334
1335
1336sub svgElementPath {
1337#
1338# creates path element for later use with textPath
1339#
1340        my ($pathName, @points) = @_ ;
1341
1342        my $refp = simplifyPoints (\@points) ;
1343        @points = @$refp ;
1344
1345        my $svg = "<path id=\"" . $pathName . "\" d=\"M " ;
1346        my $i ;
1347        my $first = 1 ;
1348        for ($i=0; $i<scalar(@points); $i+=2) {
1349                if ($first) {
1350                        $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
1351                        $first = 0 ;
1352                }
1353                else {
1354                        $svg = $svg . "L " . $points[$i] . "," . $points[$i+1] . " " ;
1355                }
1356        }
1357        $svg = $svg . "\" />\n" ;
1358}
1359
1360
1361sub svgElementPathTextAdvanced {
1362#
1363# draws text to path element; anchors: start, middle, end
1364#
1365        my ($col, $size, $font, $text, $pathName, $tSpan, $alignment, $offset, $halo) = @_ ;
1366
1367        my $svg = "<text font-family=\"" . $font . "\" " ;
1368        $svg = $svg . "font-size=\"" . $size . "\" " ;
1369
1370        if ($halo > 0) {
1371                $svg = $svg . "font-weight=\"bold\" " ;
1372                $svg = $svg . "stroke=\"white\" " ;
1373                $svg = $svg . "stroke-width=\"" . $halo . "\" " ;
1374                $svg = $svg . "opacity=\"90\%\" " ;
1375        }
1376
1377        $svg = $svg . "fill=\"" . $col . "\" >\n" ;
1378        $svg = $svg . "<textPath xlink:href=\"#" . $pathName . "\" text-anchor=\"" . $alignment . "\" startOffset=\"" . $offset . "%\" >\n" ;
1379        $svg = $svg . "<tspan dy=\"" . $tSpan . "\" >" . $text . " </tspan>\n" ;
1380        $svg = $svg . "</textPath>\n</text>\n" ;
1381        return $svg ;
1382}
1383
1384
1385sub svgElementPolygonFilled {
1386#
1387# draws areas in svg, filled with color
1388#
1389        my ($col, $icon, @points) = @_ ;
1390
1391        my $refp = simplifyPoints (\@points) ;
1392        @points = @$refp ;
1393
1394        my $i ;
1395        my $svg ;
1396        if (defined $areaDef{$icon}) {
1397                $svg = "<path fill-rule=\"evenodd\" style=\"fill:url(" . $areaDef{$icon} . ")\" d=\"" ;
1398                # print "AREA POLYGON with icon $icon drawn\n" ;
1399        }
1400        else {
1401                $svg = "<path fill-rule=\"evenodd\" fill=\"" . $col . "\" d=\"" ;
1402        }
1403
1404
1405        for ($i=0; $i<scalar(@points); $i+=2) {
1406                if ($i == 0) { $svg .= " M " ; } else { $svg .= " L " ; }
1407                $svg = $svg . $points[$i] . " " . $points[$i+1] ;
1408        }
1409        $svg .= " z" ;
1410
1411
1412
1413
1414#       for ($i=0; $i<scalar(@points); $i+=2) {
1415#               $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
1416#       }
1417        $svg = $svg . "\" />" ;
1418        return $svg ;
1419}
1420
1421sub svgElementMultiPolygonFilled {
1422#
1423# draws mp in svg, filled with color. accepts holes. receives ARRAY of ARRAY of coordinates
1424#
1425        my ($col, $icon, $ref) = @_ ;
1426
1427        my @ways = @$ref ;
1428        my $i ;
1429        my $svg ;
1430        if (defined $areaDef{$icon}) {
1431                $svg = "<path fill-rule=\"evenodd\" style=\"fill:url(" . $areaDef{$icon} . ")\" d=\"" ;
1432                # print "AREA PATH with icon $icon drawn\n" ;
1433        }
1434        else {
1435                $svg = "<path fill-rule=\"evenodd\" fill=\"" . $col . "\" d=\"" ;
1436        }
1437       
1438        foreach my $way (@ways) {
1439                my @actual = @$way ;
1440                # print "svg - actual: @actual\n" ;
1441                for ($i=0; $i<scalar(@actual); $i+=2) {
1442                        if ($i == 0) { $svg .= " M " ; } else { $svg .= " L " ; }
1443                        $svg = $svg . $actual[$i] . " " . $actual[$i+1] ;
1444                }
1445                $svg .= " z" ;
1446                # print "svg - text = $svg\n" ;
1447        }
1448
1449        $svg = $svg . "\" />" ;
1450        # print "svg - text = $svg\n" ;
1451        return $svg ;
1452}
1453
1454sub createLabel {
1455#
1456# takes @tags and labelKey(s) from style file and creates labelTextTotal and array of labels for directory
1457# takes more keys in one string - using a separator.
1458#
1459# § all listed keys will be searched for and values be concatenated
1460# # first of found keys will be used to select value
1461# "name§ref" will return all values if given
1462# "name#ref" will return name, if given. if no name is given, ref will be used. none given, no text
1463#
1464        my ($ref1, $styleLabelText, $lon, $lat) = @_ ;
1465        my @tags = @$ref1 ;
1466        my @keys ;
1467        my @labels = () ;
1468        my $labelTextTotal = "" ; 
1469
1470        if (grep /!/, $styleLabelText) { # AND
1471                @keys = split ( /!/, $styleLabelText) ;
1472                # print "par found: $styleLabelText; @keys\n" ;
1473                for (my $i=0; $i<=$#keys; $i++) {
1474                        if ($keys[$i] eq "_lat") { push @labels, $lat ; } 
1475                        if ($keys[$i] eq "_lon") { push @labels, $lon ; } 
1476                        foreach my $tag (@tags) {
1477                                if ($tag->[0] eq $keys[$i]) {
1478                                        push @labels, $tag->[1] ;
1479                                }
1480                        }
1481                }
1482                $labelTextTotal = "" ;
1483                foreach my $label (@labels) { $labelTextTotal .= $label . " " ; }
1484        }
1485        else { # PRIO
1486                @keys = split ( /#/, $styleLabelText) ;
1487                my $i = 0 ; my $found = 0 ;
1488                while ( ($i<=$#keys) and ($found == 0) ) {
1489                        if ($keys[$i] eq "_lat") { push @labels, $lat ; $found = 1 ; $labelTextTotal = $lat ; } 
1490                        if ($keys[$i] eq "_lon") { push @labels, $lon ; $found = 1 ; $labelTextTotal = $lon ; } 
1491                        foreach my $tag (@tags) {
1492                                if ($tag->[0] eq $keys[$i]) {
1493                                        push @labels, $tag->[1] ;
1494                                        $labelTextTotal = $tag->[1] ;
1495                                        $found = 1 ;
1496                                }
1497                        }
1498                        $i++ ;
1499                }               
1500        }
1501        return ( $labelTextTotal, \@labels) ;
1502}
1503
1504sub center {
1505#
1506# calculate center of area by averageing lons/lats. could be smarter because result could be outside of area! TODO
1507#
1508        my @nodes = @_ ;
1509        my $x = 0 ;
1510        my $y = 0 ;
1511        my $num = 0 ;
1512
1513        while (scalar @nodes > 0) { 
1514                my $y1 = pop @nodes ;
1515                my $x1 = pop @nodes ;
1516                $x += $x1 ;
1517                $y += $y1 ;
1518                $num++ ;
1519        }
1520        $x = $x / $num ;
1521        $y = $y / $num ;
1522        return ($x, $y) ;
1523}
1524
1525sub printScale {
1526#
1527# print scale based on dpi and global variables left, right etc.
1528#
1529        my ($dpi, $color) = @_ ;
1530
1531        my $dist = distance ($left, $bottom, $right, $bottom) ;
1532        my $inches = $sizeX / $dpi ;
1533        my $cm = $inches * 2.54 ;
1534        my $scale = int ( $dist / ($cm/100/1000)  ) ;
1535        $scale = int ($scale / 100) * 100 ;
1536        my $text = "1 : $scale" ;
1537        # sizes for 300 dpi
1538        my $posX = 350 ;
1539        my $posY = 50 ;
1540        my $size = 56 ;
1541        drawTextPix (
1542                $sizeX-scalePoints( scaleBase($posX) ), 
1543                scalePoints( scaleBase($posY) ), 
1544                $text, $color, 
1545                scalePoints( scaleBase ($size) ), "sans-serif"
1546        ) ;
1547}
1548
1549
1550sub getScale {
1551#
1552# calcs scale of map
1553#
1554        my ($dpi) = shift ;
1555
1556        my $dist = distance ($left, $bottom, $right, $bottom) ;
1557        my $inches = $sizeX / $dpi ;
1558        my $cm = $inches * 2.54 ;
1559        my $scale = int ( $dist / ($cm/100/1000)  ) ;
1560        $scale = int ($scale / 100) * 100 ;
1561
1562        return ($scale) ;
1563}
1564
1565sub fitsPaper {
1566#
1567# takes dpi and calculates on what paper size the map will fit. sizes are taken from global variables
1568#
1569        my ($dpi) = shift ;
1570
1571
1572
1573        my @sizes = () ;
1574        my $width = $sizeX / $dpi * 2.54 ;
1575        my $height = $sizeY / $dpi * 2.54 ;
1576        my $paper = "" ;
1577        push @sizes, ["4A0", 168.2, 237.8] ;
1578        push @sizes, ["2A0", 118.9, 168.2] ;
1579        push @sizes, ["A0", 84.1, 118.9] ;
1580        push @sizes, ["A1", 59.4, 84.1] ;
1581        push @sizes, ["A2", 42, 59.4] ;
1582        push @sizes, ["A3", 29.7, 42] ;
1583        push @sizes, ["A4", 21, 29.7] ;
1584        push @sizes, ["A5", 14.8, 21] ;
1585        push @sizes, ["A6", 10.5, 14.8] ;
1586        push @sizes, ["A7", 7.4, 10.5] ;
1587        push @sizes, ["none", 0, 0] ;
1588
1589        foreach my $size (@sizes) {
1590                if ( ( ($width<=$size->[1]) and ($height<=$size->[2]) ) or ( ($width<=$size->[2]) and ($height<=$size->[1]) ) ) {
1591                        $paper = $size->[0] ;
1592                }
1593        }
1594
1595        return ($paper, $width, $height) ;
1596}
1597
1598
1599
1600
1601sub drawCoords {
1602#
1603# draws coordinates grid on map
1604#
1605        my ($exp, $color) = @_ ;
1606        my $step = 10 ** $exp ;
1607
1608        # vert. lines
1609        my $start = int ($left / $step) + 1 ;
1610        my $actual = $start * $step ;
1611        while ($actual < $right) {
1612                # print "actualX: $actual\n" ;
1613                my ($x1, $y1) = convert ($actual, 0) ;
1614                drawTextPixGrid ($x1+scalePoints(scaleBase(10)), $sizeY-scalePoints(scaleBase(50)), $actual, $color, scalePoints(scaleBase(40))) ;
1615                drawWayPixGrid ($color, 1, "none", ($x1, 0, $x1, $sizeY) ) ;
1616                $actual += $step ;
1617        }
1618
1619        # hor lines
1620        $start = int ($bottom / $step) + 1 ;
1621        $actual = $start * $step ;
1622        while ($actual < $top) {
1623                # print "actualY: $actual\n" ;
1624                my ($x1, $y1) = convert (0, $actual) ;
1625                drawTextPixGrid ($sizeX-scalePoints(scaleBase(180)), $y1+scalePoints(scaleBase(30)), $actual, $color, scalePoints(scaleBase(40))) ;
1626                drawWayPixGrid ($color, 1, "none", (0, $y1, $sizeX, $y1) ) ;
1627                $actual += $step ;
1628        }
1629}
1630
1631
1632sub getValue {
1633#
1634# gets value of a certain tag
1635#
1636        my ($key, $ref) = @_ ;
1637        my @relationTags = @$ref ;
1638
1639        my $value = "" ;
1640        foreach my $tag (@relationTags) {
1641                if ($tag->[0] eq $key) { $value = $tag->[1] ; }
1642        }
1643        return ($value) ;
1644}
1645
1646
1647sub drawWayRoute {
1648#
1649# draws way as a line at given real world coordinates. nodes have to be passed as array ($lon, $lat, $lon, $lat...)
1650# $size = thickness
1651#
1652        my ($col, $size, $dash, $opacity, @nodes) = @_ ;
1653        my $i ;
1654        my @points = () ;
1655
1656        for ($i=0; $i<$#nodes; $i+=2) {
1657                my ($x, $y) = convert ($nodes[$i], $nodes[$i+1]) ;
1658                push @points, $x ; push @points, $y ; 
1659        }
1660        push @svgOutputRoutes, svgElementPolylineOpacity ($col, $size, $dash, $opacity, @points) ;
1661}
1662
1663
1664sub svgElementPolylineOpacity {
1665#
1666# draws way to svg with opacity; for routes
1667#
1668        my ($col, $size, $dash, $opacity, @points) = @_ ;
1669
1670        my $refp = simplifyPoints (\@points) ;
1671        @points = @$refp ;
1672
1673
1674        my $svg = "<polyline points=\"" ;
1675        my $i ;
1676        for ($i=0; $i<scalar(@points)-1; $i+=2) {
1677                $svg = $svg . $points[$i] . "," . $points[$i+1] . " " ;
1678        }
1679        if ($dash eq "none") { 
1680                my $lc = "round" ;
1681                $svg = $svg . "\" stroke=\"" . $col . 
1682                        "\" stroke-width=\"" . $size . 
1683                        "\" stroke-opacity=\"" . $opacity . 
1684                        "\" stroke-linecap=\"" . $lc . 
1685                        "\" stroke-linejoin=\"" . $lineJoin . "\" fill=\"none\" />" ;
1686        }
1687        else {
1688                my $lc = "" ; my $ds = "" ;
1689                ($lc, $ds) = getDashElements ($dash) ;
1690                $svg = $svg . "\" stroke=\"" . $col . 
1691                        "\" stroke-width=\"" . $size . 
1692                        "\" stroke-opacity=\"" . $opacity . 
1693                        "\" stroke-linecap=\"" . $lc . 
1694                        "\" stroke-linejoin=\"" . $lineJoin . 
1695                        "\" stroke-dasharray=\"" . $ds . 
1696                        "\" fill=\"none\" />" ;
1697        }
1698        return $svg ;
1699}
1700
1701
1702sub addAreaIcon {
1703#
1704# initial collection of area icons
1705#
1706        my $fileNameOriginal = shift ;
1707        # print "AREA: $fileNameOriginal\n" ;
1708        my $result = open (my $file, "<", $fileNameOriginal) ;
1709        close ($file) ;
1710        if ($result) {
1711                my ($x, $y) ;
1712                if (grep /.svg/, $fileNameOriginal) {
1713                        ($x, $y) = sizeSVG ($fileNameOriginal) ;
1714                        if ( ($x == 0) or ($y == 0) ) { 
1715                                $x = 32 ; $y = 32 ; 
1716                                print "WARNING: size of file $fileNameOriginal could not be determined. Set to 32px x 32px\n" ;
1717                        } 
1718                }
1719
1720                if (grep /.png/, $fileNameOriginal) {
1721                        ($x, $y) = sizePNG ($fileNameOriginal) ;
1722                }
1723
1724                if (!defined $areaDef{$fileNameOriginal}) {
1725
1726                        my $x1 = scalePoints( $x ) ; # scale area icons
1727                        my $y1 = scalePoints( $y ) ;
1728                        my $fx = $x1 / $x ;
1729                        my $fy = $y1 / $y ;
1730                       
1731                        # add defs to svg output
1732                        my $defName = "A" . $areaNum ;
1733                        # print "INFO area icon $fileNameOriginal, $defName, $x, $y --- $x1, $y1 --- $fx, $fy --- processed.\n" ;
1734                        $areaNum++ ;
1735
1736                        my $svgElement = "<pattern id=\"" . $defName . "\" width=\"" . $x . "\" height=\"" . $y . "\" " ;
1737                        $svgElement .= "patternTransform=\"translate(0,0) scale(" . $fx . "," . $fy . ")\" \n" ;
1738                        $svgElement .= "patternUnits=\"userSpaceOnUse\">\n" ;
1739                        $svgElement .= "  <image xlink:href=\"" . $fileNameOriginal . "\"/>\n" ;
1740                        $svgElement .= "</pattern>\n" ;
1741                        push @svgOutputDef, $svgElement ;
1742                        $defName = "#" . $defName ;
1743                        $areaDef{$fileNameOriginal} = $defName ;
1744                }
1745        }
1746        else {
1747                print "WARNING: area icon $fileNameOriginal not found!\n" ;
1748        }
1749}
1750
1751
1752
1753
1754sub svgEle {
1755#
1756# creates svg element string
1757#
1758        my ($a, $b) = @_ ;
1759        my $out = $a . "=\"" . $b . "\" " ;
1760        return ($out)
1761}
1762
1763
1764
1765sub initOneways {
1766#
1767# write marker defs to svg
1768#
1769        my $color = shift ;
1770        my $markerSize = scalePoints (scaleBase (20)) ;
1771
1772        push @svgOutputDef, "<marker id=\"Arrow1\"" ;
1773        push @svgOutputDef, "viewBox=\"0 0 10 10\" refX=\"5\" refY=\"5\"" ;
1774        push @svgOutputDef, "markerUnits=\"strokeWidth\"" ;
1775        push @svgOutputDef, "markerWidth=\"" . $markerSize . "\" markerHeight=\"" . $markerSize . "\"" ;
1776        push @svgOutputDef, "orient=\"auto\">" ;
1777        push @svgOutputDef, "<path d=\"M 0 4 L 6 4 L 6 2 L 10 5 L 6 8 L 6 6 L 0 6 Z\" fill=\"" . $color .  "\" />" ;
1778        push @svgOutputDef, "</marker>" ;
1779}
1780
1781
1782sub addOnewayArrows {
1783#
1784# adds oneway arrows to new pathes
1785#
1786        my ($wayNodesRef, $lonRef, $latRef, $direction, $thickness, $color, $layer) = @_ ;
1787        my @wayNodes = @$wayNodesRef ;
1788        my $minDist = scalePoints(scaleBase(25)) ;
1789        # print "OW: mindist = $minDist\n" ;
1790
1791        if ($direction == -1) { @wayNodes = reverse @wayNodes ; }
1792
1793        # create new pathes with new nodes
1794        for (my $i=0; $i<scalar(@wayNodes)-1;$i++) {
1795                my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
1796                my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ;
1797                my $xn = ($x2+$x1) / 2 ;
1798                my $yn = ($y2+$y1) / 2 ;
1799                if (sqrt (($x2-$x1)**2+($y2-$y1)**2) > $minDist) {
1800                        # create path
1801                        # use path
1802                        my $svg = "<path d=\"M $x1 $y1 L $xn $yn L $x2 $y2\" fill=\"none\" marker-mid=\"url(#Arrow1)\" />" ;
1803                       
1804                        push @{$svgOutputWays{$layer+$thickness/100}}, $svg ;
1805                }
1806        }
1807}
1808
1809sub declutterStat {
1810#
1811# creates print string with clutter/declutter information
1812#
1813        my $perc1 ;
1814        my $perc2 ;
1815        my $perc3 ;
1816        my $perc4 ;
1817        if ($numIcons != 0) {
1818                $perc1 = int ($numIconsMoved / $numIcons * 100) ;
1819                $perc2 = int ($numIconsOmitted / $numIcons * 100) ;
1820        }
1821        else {
1822                $perc1 = 0 ;
1823                $perc2 = 0 ;
1824        }
1825        if ($numLabels != 0) {
1826                $perc3 = int ($numLabelsMoved / $numLabels * 100) ;
1827                $perc4 = int ($numLabelsOmitted / $numLabels * 100) ;
1828        }
1829        else {
1830                $perc3 = 0 ;
1831                $perc4 = 0 ;
1832        }
1833
1834        my $out = "$numIcons icons drawn.\n" ; 
1835        $out .= "  $numIconsMoved moved. ($perc1 %)\n" ;
1836        $out .= "  $numIconsOmitted omitted (possibly with label!). ($perc2 %)\n" ;
1837
1838        $out .= "$numLabels labels drawn.\n" ; 
1839        $out .= "  $numLabelsMoved moved. ($perc3 %)\n" ;
1840        $out .= "  $numLabelsOmitted omitted. ($perc4 %)\n\n" ;
1841        $out .= "$numWayLabelsOmitted way labels omitted because way was too short, collision or declutter.\n" ;
1842
1843
1844}
1845
1846sub placeLabelAndIcon {
1847#
1848# intelligent icon and label placement alg.
1849#
1850        my ($lon, $lat, $offset, $thickness, $text, $color, $textSize, $font, $ppc, $icon, $iconSizeX, $iconSizeY, $allowIconMove, $halo) = @_ ;
1851
1852        my ($x, $y) = convert ($lon, $lat) ; # center !
1853        $y = $y + $offset ;
1854
1855        my ($ref) = splitLabel ($text) ;
1856        my (@lines) = @$ref ;
1857        my $numLines = scalar @lines ;
1858        my $maxTextLenPix = 0 ;
1859        my $orientation = "" ;
1860        my $lineDist = 2 ;
1861        my $tries = 0 ;
1862
1863        foreach my $line (@lines) {
1864                my $len = length ($line) * $ppc / 10 * $textSize ; # in pixels
1865                if ($len > $maxTextLenPix) { $maxTextLenPix = $len ; }
1866        }
1867        my $spaceTextX = $maxTextLenPix ;
1868        my $spaceTextY = $numLines * ($lineDist+$textSize) ;
1869
1870
1871        if ($icon ne "none") {
1872                $numIcons++ ;
1873                # space for icon?
1874                        my $sizeX1 = $iconSizeX ; if ($sizeX1 == 0) { $sizeX1 = 20 ; }
1875                        my $sizeY1 = $iconSizeY ; if ($sizeY1 == 0) { $sizeY1 = 20 ; }
1876                        my $iconX = $x - $sizeX1/2 ; # top left corner
1877                        my $iconY = $y - $sizeY1/2 ; 
1878
1879                        my @shifts = (0) ;
1880                        if ($allowIconMove eq "1") {
1881                                @shifts = ( 0, scalePoints(scaleBase(-15)), scalePoints(scaleBase(15)) ) ;
1882                        }
1883                        my $posFound = 0 ; my $posCount = 0 ;
1884                        LABAB: foreach my $xShift (@shifts) {
1885                                foreach my $yShift (@shifts) {
1886                                        $posCount++ ;
1887                                        if ( ! areaOccupied ($iconX+$xShift, $iconX+$sizeX1+$xShift, $iconY+$sizeY1+$yShift, $iconY+$yShift) ) {
1888                                                push @svgOutputIcons, svgElementIcon ($iconX+$xShift, $iconY+$yShift, $icon, $sizeX1, $sizeY1) ;
1889                                                occupyArea ($iconX+$xShift, $iconX+$sizeX1+$xShift, $iconY+$sizeY1+$yShift, $iconY+$yShift) ;
1890                                                $posFound = 1 ;
1891                                                if ($posCount > 1) { $numIconsMoved++ ; }
1892                                                $iconX = $iconX + $xShift ; # for later use with label
1893                                                $iconY = $iconY + $yShift ;
1894                                                last LABAB ;
1895                                        }
1896                                }
1897                        }
1898                        if ($posFound == 1) {
1899
1900                                # label text?
1901                                if ($text ne "") {
1902                                        $numLabels++ ;
1903
1904
1905                                        $sizeX1 += 1 ; $sizeY1 += 1 ;
1906
1907                                        my ($x1, $x2, $y1, $y2) ;
1908                                        # $x, $y centered
1909                                        # yes, check if space for label, choose position, draw
1910                                        # no, count omitted text
1911
1912                                        my @positions = () ; my $positionFound = 0 ;
1913                                        # pos 1 centered below
1914                                        $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $sizeY1/2 + $spaceTextY ; $y2 = $y + $sizeY1/2 ; $orientation = "centered" ; 
1915                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1916
1917                                        # pos 2/3 to the right, bottom, top
1918                                        $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y1 = $y + $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "left" ; 
1919                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1920                                        $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y2 = $y - $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "left" ; 
1921                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1922
1923                                        # pos 4 centered upon
1924                                        $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $sizeY1/2 ; $y2 = $y - $sizeY1/2 - $spaceTextY ; $orientation = "centered" ; 
1925                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1926
1927                                        # pos 5/6 to the right, below and upon
1928                                        $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y2 = $y + $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "left" ; 
1929                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1930                                        $x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y1 = $y - $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "left" ; 
1931                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1932
1933                                        # left normal, bottom, top
1934                                        $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y1 = $y + $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "right" ; 
1935                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1936                                        $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y2 = $y - $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "right" ; 
1937                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1938
1939                                        # left corners, bottom, top
1940                                        $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y2 = $y + $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "right" ; 
1941                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1942                                        $x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y1 = $y - $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "right" ; 
1943                                        push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1944
1945
1946                                        $tries = 0 ;
1947                                        LABB: foreach my $pos (@positions) {
1948                                                $tries++ ;
1949                                                $positionFound = checkAndDrawText ($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines, \@lines, $color, $textSize, $font, $lineDist, $halo) ;
1950                                                if ($positionFound == 1) {
1951                                                        last LABB ;
1952                                                }
1953                                        }
1954                                        if ($positionFound == 0) { $numLabelsOmitted++ ; }
1955                                        if ($tries > 1) { $numLabelsMoved++ ; }
1956                                }
1957                        }
1958                        else {
1959                                # no, count omitted
1960                                $numIconsOmitted++ ;
1961                        }
1962        }
1963        else { # only text
1964                my ($x1, $x2, $y1, $y2) ;
1965                # x1, x2, y1, y2
1966                # left, right, bottom, top             
1967                # choose space for text, draw
1968                # count omitted
1969
1970                $numLabels++ ;
1971                my @positions = () ;
1972                $x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "left" ; 
1973                push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1974                $x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y + $spaceTextY ; $y2 = $y ; $orientation = "left" ; 
1975                push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1976
1977                $x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ; 
1978                push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1979                $x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ; 
1980                push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1981
1982                $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $thickness ; $y2 = $y - ($thickness + $spaceTextY) ; $orientation = "centered" ; 
1983                push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1984                $x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $thickness + $spaceTextY ; $y2 = $y + $thickness ; $orientation = "centered" ; 
1985                push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
1986
1987                my $positionFound = 0 ;
1988                $tries = 0 ;
1989                LABA: foreach my $pos (@positions) {
1990                        $tries++ ;
1991                        # print "$lines[0]   $pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines\n" ;
1992                        $positionFound = checkAndDrawText ($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines, \@lines, $color, $textSize, $font, $lineDist, $halo) ;
1993                        if ($positionFound == 1) {
1994                                last LABA ;
1995                        }
1996                }
1997                if ($positionFound == 0) { $numLabelsOmitted++ ; }
1998                if ($tries > 1) { $numLabelsMoved++ ; }
1999        }
2000}
2001
2002
2003sub checkAndDrawText {
2004#
2005# checks if area available and if so draws text
2006#
2007        my ($x1, $x2, $y1, $y2, $orientation, $numLines, $ref, $col, $size, $font, $lineDist, $halo) = @_ ;
2008        my @lines = @$ref ;
2009
2010        if (!areaOccupied ($x1, $x2, $y1, $y2)) {
2011
2012                for (my $i=0; $i<=$#lines; $i++) {
2013                        my @points = ($x1, $y2+($i+1)*($size+$lineDist), $x2, $y2+($i+1)*($size+$lineDist)) ;
2014                        my $pathName = "LabelPath" . $labelPathId ; 
2015                        $labelPathId++ ;
2016                        push @svgOutputDef, svgElementPath ($pathName, @points) ;
2017                        if ($orientation eq "centered") {
2018                                push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $lines[$i], $pathName, 0, "middle", 50, $halo) ;
2019                        }
2020                        if ($orientation eq "left") {
2021                                push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $lines[$i], $pathName, 0, "start", 0, $halo) ;
2022                        }
2023                        if ($orientation eq "right") {
2024                                push @svgOutputPathText, svgElementPathTextAdvanced ($col, $size, $font, $lines[$i], $pathName, 0, "end", 100, $halo) ;
2025                        }
2026                }
2027
2028                occupyArea ($x1, $x2, $y1, $y2) ;
2029               
2030                return (1) ;
2031        }
2032        else {
2033                return 0 ;
2034        }
2035}
2036
2037sub getDimensions {
2038#
2039# returns dimensions of map
2040#
2041        return ($sizeX, $sizeY) ;
2042}
2043
2044
2045
2046sub drawAreaOcean {
2047        my ($col, $ref) = @_ ;
2048        push @svgOutputAreas, svgElementMultiPolygonFilled ($col, "none", $ref) ;
2049}
2050
2051sub sizePNG {
2052#
2053# evaluates size of png graphics
2054#
2055        my $fileName = shift ;
2056
2057        my ($x, $y) ;
2058        my $file ;
2059        my $result = open ($file, "<", $fileName) ;
2060        if ($result) {
2061                my $pic = newFromPng GD::Image($file) ;
2062                ($x, $y) = $pic->getBounds ;
2063                close ($file) ;
2064        }
2065        else {
2066                ($x, $y) = (0, 0) ;
2067        }
2068        return ($x, $y) ;
2069}
2070
2071sub sizeSVG {
2072#
2073# evaluates size of svg graphics
2074#
2075        my $fileName = shift ;
2076        my $file ;
2077        my ($x, $y) ; undef $x ; undef $y ;
2078
2079        my $result = open ($file, "<", $fileName) ;
2080        if ($result) {
2081                my $line ;
2082                while ($line = <$file>) {
2083                        my ($x1) = ( $line =~ /^.*width=\"([\d]+)px\"/ ) ; 
2084                        my ($y1) = ( $line =~ /^.*height=\"([\d]+)px\"/ ) ;
2085                        if (!defined $x1) {
2086                                ($x1) = ( $line =~ /^\s*width=\"([\d]+)\"/ ) ; 
2087
2088                        } 
2089                        if (!defined $y1) {
2090                                ($y1) = ( $line =~ /^\s*height=\"([\d]+)\"/ ) ; 
2091                        } 
2092                        if (defined $x1) { $x = $x1 ; }
2093                        if (defined $y1) { $y = $y1 ; }
2094                }
2095                close ($file) ;
2096        }
2097
2098        if ( (!defined $x) or (!defined $y) ) { 
2099                $x = 0 ; $y = 0 ; 
2100                print "WARNING: size of file $fileName could not be determined.\n" ;
2101        } 
2102        return ($x, $y) ;
2103}
2104
2105sub scalePoints {
2106        my $a = shift ;
2107        # my $b = $a ;
2108        my $b = $a / $baseDpi * $dpi ;
2109
2110        return (int ($b*10)) / 10 ;
2111}
2112
2113
2114sub scaleBase {
2115#
2116# function scales sizes given in 300dpi to base dpi given in rules so texts in legend, ruler etc. will appear in same size
2117#
2118        my $a = shift ;
2119        my $b = $a / 300 * $baseDpi ;
2120        return $b ;
2121}
2122
2123#-----------------------------------------------------------------------------
2124
2125sub simplifyPoints {
2126        my $ref = shift ;
2127        my @points = @$ref ;
2128        my @newPoints ;
2129        my $maxIndex = $#points ;
2130
2131        if (scalar @points > 4) {
2132                # push first
2133                push @newPoints, $points[0], $points[1] ;
2134
2135                # push other
2136                for (my $i=2; $i <= $maxIndex; $i+=2) {
2137                        $simplifyTotal++ ;
2138                        if ( ($points[$i]==$points[$i-2]) and ($points[$i+1]==$points[$i-1]) ) {
2139                                # same
2140                                $simplified++ ;
2141                        }
2142                        else {
2143                                push @newPoints, $points[$i], $points[$i+1] ;
2144                        }
2145                }
2146                return (\@newPoints) ;
2147        }
2148        else {
2149                return ($ref) ;
2150        }
2151
2152}
2153
2154sub simplifiedPercent {
2155        return ( int ($simplified / $simplifyTotal * 100) ) ;
2156}
2157
2158sub drawPageNumber {
2159        my ($size, $col, $num) = @_ ;
2160        my $x = $sizeX - scalePoints (scaleBase (80)) ;
2161        my $y = $sizeY - scalePoints (scaleBase (80)) ;
2162        drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
2163}
2164
2165sub drawPageNumberLeft {
2166        my ($size, $col, $num) = @_ ;
2167        my $x = scalePoints (scaleBase (80)) ;
2168        my $y = $sizeY / 2 ;
2169        drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
2170
2171}
2172
2173sub drawPageNumberBottom {
2174        my ($size, $col, $num) = @_ ;
2175        my $x = $sizeX / 2 ;
2176        my $y = $sizeY - scalePoints (scaleBase (80)) ;
2177        drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
2178
2179}
2180
2181sub drawPageNumberRight {
2182        my ($size, $col, $num) = @_ ;
2183        my $x = $sizeX - scalePoints (scaleBase (80)) ;
2184        my $y = $sizeY / 2 ;
2185        drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
2186
2187}
2188
2189sub drawPageNumberTop {
2190        my ($size, $col, $num) = @_ ;
2191        my $x = $sizeX / 2 ;
2192        my $y = scalePoints (scaleBase (80)) ;
2193        drawTextPixGrid ($x, $y, $num, $col, scalePoints ( scaleBase ($size) ) ) ;
2194
2195}
2196
2197
2198sub createShield {
2199        my ($name, $targetSize) = @_ ;
2200        my @a = split /:/, $name ;
2201        my $shieldFileName = $a[1] ;
2202        my $shieldText = $a[2] ;
2203
2204        if (! defined $createdShields{$name}) {
2205                open (my $file, "<", $shieldFileName) or die ("ERROR: shield definition $shieldFileName not found.\n") ;
2206                my @defText = <$file> ;
2207                close ($file) ;
2208
2209                # get size
2210                # calc scaling
2211                my $sizeX = 0 ;
2212                my $sizeY = 0 ;
2213                foreach my $line (@defText) {
2214                        if (grep /<svg/, $line) {
2215                                ($sizeY) = ( $line =~ /height=\"(\d+)px\"/ ) ;
2216                                ($sizeX) = ( $line =~ /width=\"(\d+)px\"/ ) ;
2217                                if ( (!defined $sizeX) or (!defined $sizeY) ) {
2218                                        die "ERROR: size of shield in $shieldFileName could not be determined.\n" ;
2219                                }
2220                        }
2221                }
2222                if ( ($sizeX == 0) or ($sizeY == 0) ) {
2223                        die "ERROR: initial size of shield $shieldFileName could not be determined.\n" ;
2224                }
2225
2226                my $scaleFactor = $targetSize / $sizeY ;
2227                # print "factor: $scaleFactor\n" ;
2228
2229                $shieldXSize{ $name } = int ($sizeX * $scaleFactor) ;
2230                $shieldYSize{ $name } = int ($sizeY * $scaleFactor) ;
2231
2232                $shieldPathId++ ;
2233                my $shieldPathName = "ShieldPath" . $shieldPathId ;
2234                my $shieldGroupName = "ShieldGroup" . $shieldPathId ;
2235
2236                foreach my $line (@defText) {
2237                        $line =~ s/REPLACEID/$shieldGroupName/ ;
2238                        $line =~ s/REPLACESCALE/$scaleFactor/g ;
2239                        $line =~ s/REPLACEPATH/$shieldPathName/ ;
2240                        $line =~ s/REPLACELABEL/$shieldText/ ;
2241                }
2242
2243                foreach my $line (@defText) {
2244                        push @svgOutputDef, $line ;
2245                        # print "DEF: $line" ;
2246                }
2247                # print "\n" ;
2248
2249                $createdShields{$name} = $shieldGroupName ;
2250        }
2251}
2252
2253
2254
2255sub getPointOfWay {
2256        #
2257        # returns point of way at distance/position
2258        #
2259
2260        my ($ref, $position) = @_ ;
2261        my @points = @$ref ;
2262
2263        my @double = () ;
2264        while (scalar @points > 0) {
2265                my $x = shift @points ;
2266                my $y = shift @points ;
2267                push @double, [$x, $y] ;
2268        }
2269
2270        my $i = 0 ; my $actLen = 0 ;
2271        while ($actLen < $position) {
2272                $actLen += sqrt ( ($double[$i]->[0]-$double[$i+1]->[0])**2 + ($double[$i]->[1]-$double[$i+1]->[1])**2 ) ;
2273                $i++ ;
2274        }
2275
2276        my $x = int (($double[$i]->[0] +  $double[$i-1]->[0]) / 2) ;
2277        my $y = int (($double[$i]->[1] +  $double[$i-1]->[1]) / 2) ;
2278
2279        # print "POW: $x, $y\n" ;
2280
2281        return ($x, $y) ;
2282}
2283
2284
2285
2286
2287
2288
22891 ;
2290
2291
Note: See TracBrowser for help on using the repository browser.